Function: PC-do-completion
PC-do-completion is a byte-compiled function defined in
complete.el.gz.
Signature
(PC-do-completion &optional MODE BEG END GOTO-END)
Documentation
Internal function to do the work of partial completion.
Text to be completed lies between BEG and END. Normally when replacing text in the minibuffer, this function replaces up to point-max (as is appropriate for completing a file name). If GOTO-END is non-nil, however, it instead replaces up to END.
Source Code
;; Defined in /usr/src/emacs/lisp/obsolete/complete.el.gz
;; TODO document MODE magic...
(defun PC-do-completion (&optional mode beg end goto-end)
"Internal function to do the work of partial completion.
Text to be completed lies between BEG and END. Normally when
replacing text in the minibuffer, this function replaces up to
point-max (as is appropriate for completing a file name). If
GOTO-END is non-nil, however, it instead replaces up to END."
(or beg (setq beg (minibuffer-prompt-end)))
(or end (setq end (point-max)))
(let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal)
'PC-read-file-name-internal
minibuffer-completion-table))
(pred minibuffer-completion-predicate)
(filename (funcall PC-completion-as-file-name-predicate))
(dirname nil) ; non-nil only if a filename is being completed
;; The following used to be "(dirlength 0)" which caused the erasure of
;; the entire buffer text before `point' when inserting a completion
;; into a buffer.
dirlength
(str (buffer-substring beg end))
(incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str)))
(ambig nil)
basestr origstr
env-on
regex
p offset
abbreviated
(poss nil)
helpposs
(case-fold-search completion-ignore-case))
;; Check if buffer contents can already be considered complete
(if (and (eq mode 'exit)
(test-completion str table pred))
'complete
;; Do substitutions in directory names
(and filename
(setq basestr (or (file-name-directory str) ""))
(setq dirlength (length basestr))
;; Do substitutions in directory names
(setq p (substitute-in-file-name basestr))
(not (string-equal basestr p))
(setq str (concat p (file-name-nondirectory str)))
(progn
(delete-region beg end)
(insert str)
(setq end (+ beg (length str)))))
;; Prepare various delimiter strings
(or (equal PC-word-delimiters PC-delims)
(setq PC-delims PC-word-delimiters
PC-delim-regex (concat "[" PC-delims "]")
PC-ndelims-regex (concat "[^" PC-delims "]*")
PC-delims-list (append PC-delims nil)))
;; Add wildcards if necessary
(and filename
(let ((dir (file-name-directory str))
(file (file-name-nondirectory str))
;; The base dir for file-completion was passed in `predicate'.
(default-directory (if (stringp pred) (expand-file-name pred)
default-directory)))
(while (and (stringp dir) (not (file-directory-p dir)))
(setq dir (directory-file-name dir))
(setq file (concat (replace-regexp-in-string
PC-delim-regex "*\\&"
(file-name-nondirectory dir))
"*/" file))
(setq dir (file-name-directory dir)))
(setq origstr str str (concat dir file))))
;; Look for wildcard expansions in directory name
(and filename
(string-match "\\*.*/" str)
(let ((pat str)
;; The base dir for file-completion was passed in `predicate'.
(default-directory (if (stringp pred) (expand-file-name pred)
default-directory))
files)
(setq p (1+ (string-match "/[^/]*\\'" pat)))
(while (setq p (string-match PC-delim-regex pat p))
(setq pat (concat (substring pat 0 p)
"*"
(substring pat p))
p (+ p 2)))
(setq files (file-expand-wildcards (concat pat "*")))
(if files
(let ((dir (file-name-directory (car files)))
(p files))
(while (and (setq p (cdr p))
(equal dir (file-name-directory (car p)))))
(if p
(setq filename nil table nil
pred (if (stringp pred) nil pred)
ambig t)
(delete-region beg end)
(setq str (concat dir (file-name-nondirectory str)))
(insert str)
(setq end (+ beg (length str)))))
(if origstr
;; If the wildcards were introduced by us, it's
;; possible that PC-read-file-name-internal can
;; still find matches for the original string
;; even if we couldn't, so remove the added
;; wildcards.
(setq str origstr)
(setq filename nil table nil
pred (if (stringp pred) nil pred))))))
;; Strip directory name if appropriate
(if filename
(if incname
(setq basestr (substring str incname)
dirname (substring str 0 incname))
(setq basestr (file-name-nondirectory str)
dirname (file-name-directory str))
;; Make sure str is consistent with its directory and basename
;; parts. This is important on DOZe'NT systems when str only
;; includes a drive letter, like in "d:".
(setq str (concat dirname basestr)))
(setq basestr str))
;; Convert search pattern to a standard regular expression
(setq regex (regexp-quote basestr)
offset (if (and (> (length regex) 0)
(not (eq (aref basestr 0) ?\*))
(or (eq PC-first-char t)
(and PC-first-char filename))) 1 0)
p offset)
(while (setq p (string-match PC-delim-regex regex p))
(if (eq (aref regex p) ? )
(setq regex (concat (substring regex 0 p)
PC-ndelims-regex
PC-delim-regex
(substring regex (1+ p)))
p (+ p (length PC-ndelims-regex) (length PC-delim-regex)))
(let ((bump (if (memq (aref regex p)
'(?$ ?^ ?\. ?* ?+ ?? ?\[ ?\] ?\\))
-1 0)))
(setq regex (concat (substring regex 0 (+ p bump))
PC-ndelims-regex
(substring regex (+ p bump)))
p (+ p (length PC-ndelims-regex) 1)))))
(setq p 0)
(if filename
(while (setq p (string-search "\\*" regex p))
(setq regex (concat (substring regex 0 p)
"[^/]*"
(substring regex (+ p 2))))))
;;(setq the-regex regex)
(setq regex (concat "\\`" regex))
(and (> (length basestr) 0)
(= (aref basestr 0) ?$)
(setq env-on t
table PC-env-vars-alist
pred nil))
;; Find an initial list of possible completions
(unless (setq p (string-match (concat PC-delim-regex
(if filename "\\|\\*" ""))
str
(+ (length dirname) offset)))
;; Minibuffer contains no hyphens -- simple case!
(setq poss (all-completions (if env-on basestr str)
table
pred))
(unless (or poss (string-equal str ""))
;; Try completion as an abbreviation, e.g. "mvb" ->
;; "m-v-b" -> "multiple-value-bind", but only for
;; non-empty strings.
(setq origstr str
abbreviated t)
(if filename
(cond
;; "alpha" or "/alpha" -> expand whole path.
((string-match "^/?\\([A-Za-z0-9]+\\)$" str)
(setq
basestr ""
p nil
poss (file-expand-wildcards
(concat "/"
(mapconcat #'list (match-string 1 str) "*/")
"*"))
beg (1- beg)))
;; Alphanumeric trailer -> expand trailing file
((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str)
(setq regex (concat "\\`"
(mapconcat #'list
(match-string 2 str)
"[A-Za-z0-9]*[^A-Za-z0-9]"))
p (1+ (length (match-string 1 str))))))
(setq regex (concat "\\`" (mapconcat (lambda (c)
(regexp-quote (string c)))
str "[^-]*-"))
p 1))))
(when p
;; Use all-completions to do an initial cull. This is a big win,
;; since all-completions is written in C!
(let ((compl (all-completions (if env-on
(file-name-nondirectory (substring str 0 p))
(substring str 0 p))
table
pred)))
(setq p compl)
(when (and compl abbreviated)
(if filename
(progn
(setq p nil)
(dolist (x compl)
(when (string-match regex x)
(push x p)))
(setq basestr (try-completion "" p)))
(setq basestr (mapconcat #'list str "-"))
(delete-region beg end)
(setq end (+ beg (length basestr)))
(insert basestr))))
(while p
(and (string-match regex (car p))
(progn
(set-text-properties 0 (length (car p)) '() (car p))
(setq poss (cons (car p) poss))))
(setq p (cdr p))))
;; If table had duplicates, they can be here.
(delete-dups poss)
;; Handle completion-ignored-extensions
(and filename
(not (eq mode 'help))
(let ((p2 poss))
;; Build a regular expression representing the extensions list
(or (equal completion-ignored-extensions PC-ignored-extensions)
(setq PC-ignored-regexp
(concat "\\("
(mapconcat
#'regexp-quote
(setq PC-ignored-extensions
completion-ignored-extensions)
"\\|")
"\\)\\'")))
;; Check if there are any without an ignored extension.
;; Also ignore `.' and `..'.
(setq p nil)
(while p2
(or (string-match PC-ignored-regexp (car p2))
(string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2))
(setq p (cons (car p2) p)))
(setq p2 (cdr p2)))
;; If there are "good" names, use them
(and p (setq poss p))))
;; Now we have a list of possible completions
(cond
;; No valid completions found
((null poss)
(if (and (eq mode 'word)
(not PC-word-failed-flag))
(let ((PC-word-failed-flag t))
(delete-char -1)
(PC-do-completion 'word))
(when abbreviated
(delete-region beg end)
(insert origstr))
(beep)
(PC-temp-minibuffer-message (if ambig
" [Ambiguous dir name]"
(if (eq mode 'help)
" [No completions]"
" [No match]")))
nil))
;; More than one valid completion found
((or (cdr (setq helpposs poss))
(memq mode '(help word)))
;; Is the actual string one of the possible completions?
(setq p (and (not (eq mode 'help)) poss))
(while (and p
(not (string-equal (car p) basestr)))
(setq p (cdr p)))
(and p (null mode)
(PC-temp-minibuffer-message " [Complete, but not unique]"))
(if (and p
(not (and (null mode)
(eq this-command last-command))))
t
;; If ambiguous, try for a partial completion
(let ((improved nil)
prefix
(pt nil)
(skip "\\`"))
;; Check if next few letters are the same in all cases
(if (and (not (eq mode 'help))
(setq prefix (PC-try-completion
(PC-chunk-after basestr skip) poss)))
(let ((first t) i)
(if (eq mode 'word)
(setq prefix (PC-chop-word prefix basestr)))
(goto-char (+ beg (length dirname)))
(while (and (progn
(setq i 0) ; index into prefix string
(while (< i (length prefix))
(if (and (< (point) end)
(or (eq (downcase (aref prefix i))
(downcase (following-char)))
(and (looking-at " ")
(memq (aref prefix i)
PC-delims-list))))
;; replace " " by the actual delimiter
;; or input char by prefix char
(progn
(delete-char 1)
(insert (substring prefix i (1+ i))))
;; insert a new character
(progn
(and filename (looking-at "\\*")
(progn
(delete-char 1)
(setq end (1- end))))
(setq improved t)
(insert (substring prefix i (1+ i)))
(setq end (1+ end))))
(setq i (1+ i)))
(or pt (setq pt (point)))
(looking-at PC-delim-regex))
(setq skip (concat skip
(regexp-quote prefix)
PC-ndelims-regex)
prefix (PC-try-completion
(PC-chunk-after
;; not basestr, because that does
;; not reflect insertions
(buffer-substring
(+ beg (length dirname)) end)
skip)
(mapcar
(lambda (x)
(when (string-match skip x)
(substring x (match-end 0))))
poss)))
(or (> i 0) (> (length prefix) 0))
(or (not (eq mode 'word))
(and first (> (length prefix) 0)
(setq first nil
prefix (substring prefix 0 1))))))
(goto-char (if (eq mode 'word) end
(or pt beg)))))
(if (and (eq mode 'word)
(not PC-word-failed-flag))
(if improved
;; We changed it... would it be complete without the space?
(if (test-completion (buffer-substring
(field-beginning) (1- end))
table pred)
(delete-region (1- end) end)))
(if improved
;; We changed it... enough to be complete?
(and (eq mode 'exit)
(test-completion-ignore-case (field-string) table pred))
;; If totally ambiguous, display a list of completions
(if (or (eq completion-auto-help t)
(and completion-auto-help
(eq last-command this-command))
(eq mode 'help))
(let ((prompt-end (minibuffer-prompt-end)))
(with-output-to-temp-buffer "*Completions*"
(display-completion-list (sort helpposs #'string-lessp))
(setq PC-do-completion-end end
PC-goto-end goto-end)
(with-current-buffer standard-output
;; Record which part of the buffer we are completing
;; so that choosing a completion from the list
;; knows how much old text to replace.
;; This was briefly nil in the non-dirname case.
;; However, if one calls PC-lisp-complete-symbol
;; on "(ne-f" with point on the hyphen, PC offers
;; all completions starting with "(ne", some of
;; which do not match the "-f" part (maybe it
;; should not, but it does). In such cases,
;; completion gets confused trying to figure out
;; how much to replace, so we tell it explicitly
;; (ie, the number of chars in the buffer before beg).
;;
;; Note that choose-completion-string-functions
;; plays around with point.
(with-suppressed-warnings ((obsolete
completion-base-size))
(setq completion-base-size
(if dirname
dirlength
(- beg prompt-end)))))))
(PC-temp-minibuffer-message " [Next char not unique]"))
;; Expansion of filenames is not reversible,
;; so just keep the prefix.
(when (and abbreviated filename)
(delete-region (point) end))
nil)))))
;; Only one possible completion
(t
(if (and (equal basestr (car poss))
(not (and env-on filename))
(not abbreviated))
(if (null mode)
(PC-temp-minibuffer-message " [Sole completion]"))
(delete-region beg end)
(insert (format "%s"
(if filename
(substitute-in-file-name (concat dirname (car poss)))
(car poss)))))
t)))))