;;; complete.el --- partial completion mechanism plus other goodies
;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: abbrev convenience
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(cond ((not bind)
;; These bindings are the default bindings. It would be better to
;; restore the previous bindings.
+ (define-key read-expression-map "\e\t" 'lisp-complete-symbol)
+
(define-key completion-map "\t" 'minibuffer-complete)
(define-key completion-map " " 'minibuffer-complete-word)
(define-key completion-map "?" 'minibuffer-completion-help)
- (define-key must-match-map "\t" 'minibuffer-complete)
- (define-key must-match-map " " 'minibuffer-complete-word)
(define-key must-match-map "\r" 'minibuffer-complete-and-exit)
(define-key must-match-map "\n" 'minibuffer-complete-and-exit)
- (define-key must-match-map "?" 'minibuffer-completion-help)
(define-key global-map [remap lisp-complete-symbol] nil))
(PC-default-bindings
+ (define-key read-expression-map "\e\t" 'PC-lisp-complete-symbol)
+
(define-key completion-map "\t" 'PC-complete)
(define-key completion-map " " 'PC-complete-word)
(define-key completion-map "?" 'PC-completion-help)
(define-key completion-map "\e\n" 'PC-force-complete-and-exit)
(define-key completion-map "\e?" 'PC-completion-help)
- (define-key must-match-map "\t" 'PC-complete)
- (define-key must-match-map " " 'PC-complete-word)
(define-key must-match-map "\r" 'PC-complete-and-exit)
(define-key must-match-map "\n" 'PC-complete-and-exit)
- (define-key must-match-map "?" 'PC-completion-help)
- (define-key must-match-map "\e\t" 'PC-complete)
- (define-key must-match-map "\e " 'PC-complete-word)
(define-key must-match-map "\e\r" 'PC-complete-and-exit)
(define-key must-match-map "\e\n" 'PC-complete-and-exit)
- (define-key must-match-map "\e?" 'PC-completion-help)
(define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol)))))
+(defvar PC-do-completion-end nil
+ "Internal variable used by `PC-do-completion'.")
+
+(make-variable-buffer-local 'PC-do-completion-end)
+
+(defvar PC-goto-end nil
+ "Internal variable set in `PC-do-completion', used in
+`choose-completion-string-functions'.")
+
+(make-variable-buffer-local 'PC-goto-end)
+
;;;###autoload
(define-minor-mode partial-completion-mode
"Toggle Partial Completion mode.
(remove-hook 'find-file-not-found-functions 'PC-look-for-include-file))
((not PC-disable-includes)
(add-hook 'find-file-not-found-functions 'PC-look-for-include-file)))
- ;; ... with some underhand redefining.
- (cond ((not partial-completion-mode)
- (ad-disable-advice 'read-file-name-internal 'around 'PC-include-file)
- (ad-activate 'read-file-name-internal))
- ((not PC-disable-includes)
- (ad-enable-advice 'read-file-name-internal 'around 'PC-include-file)
- (ad-activate 'read-file-name-internal)))
;; Adjust the completion selection in *Completion* buffers to the way
;; we work. The default minibuffer completion code only completes the
;; text before point and leaves the text after point alone (new in
(if partial-completion-mode 'add-hook 'remove-hook)
'choose-completion-string-functions
(lambda (choice buffer mini-p base-size)
- (if mini-p (goto-char (point-max)))
+ ;; When completing M-: (lisp- ) with point before the ), it is
+ ;; not appropriate to go to point-max (unlike the filename case).
+ (if (and (not PC-goto-end)
+ mini-p)
+ (goto-char (point-max))
+ ;; Need a similar hack for the non-minibuffer-case -- gm.
+ (when PC-do-completion-end
+ (goto-char PC-do-completion-end)
+ (setq PC-do-completion-end nil)))
+ (setq PC-goto-end nil)
nil))
;; Build the env-completion and mapping table.
(when (and partial-completion-mode (null PC-env-vars-alist))
(PC-do-complete-and-exit)))
(defun PC-do-complete-and-exit ()
- (if (= (point-max) (minibuffer-prompt-end)) ; Duplicate the "bug" that Info-menu relies on...
- (exit-minibuffer)
+ (cond
+ ((= (point-max) (minibuffer-prompt-end))
+ ;; Duplicate the "bug" that Info-menu relies on...
+ (exit-minibuffer))
+ ((eq minibuffer-completion-confirm 'confirm-only)
+ (if (or (eq last-command this-command)
+ (test-completion (field-string)
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+ (exit-minibuffer)
+ (PC-temp-minibuffer-message " [Confirm]")))
+ (t
(let ((flag (PC-do-completion 'exit)))
(and flag
(if (or (eq flag 'complete)
(not minibuffer-completion-confirm))
(exit-minibuffer)
- (PC-temp-minibuffer-message " [Confirm]"))))))
+ (PC-temp-minibuffer-message " [Confirm]")))))))
(defun PC-completion-help ()
;; Returns the sequence of non-delimiter characters that follow regexp in string.
(defun PC-chunk-after (string regexp)
(if (not (string-match regexp string))
- (let ((message (format "String %s didn't match regexp %s" string regexp)))
- (message message)
- (error message)))
+ (let ((message "String %s didn't match regexp %s"))
+ (message message string regexp)
+ (error message string regexp)))
(let ((result (substring string (match-end 0))))
;; result may contain multiple chunks
(if (string-match PC-delim-regex result)
(let ((completion-ignore-case nil))
(test-completion str table pred))))
-(defun PC-do-completion (&optional mode beg end)
+;; The following function is an attempt to work around two problems:
+
+;; (1) When complete.el was written, (try-completion "" '(("") (""))) used to
+;; return the value "". With a change from 2002-07-07 it returns t which caused
+;; `PC-lisp-complete-symbol' to fail with a "Wrong type argument: sequencep, t"
+;; error. `PC-try-completion' returns STRING in this case.
+
+;; (2) (try-completion "" '((""))) returned t before the above-mentioned change.
+;; Since `PC-chop-word' operates on the return value of `try-completion' this
+;; case might have provoked a similar error as in (1). `PC-try-completion'
+;; returns "" instead. I don't know whether this is a real problem though.
+
+;; Since `PC-try-completion' is not a guaranteed to fix these bugs reliably, you
+;; should try to look at the following discussions when you encounter problems:
+;; - emacs-pretest-bug ("Partial Completion" starting 2007-02-23),
+;; - emacs-devel ("[address-of-OP: Partial completion]" starting 2007-02-24),
+;; - emacs-devel ("[address-of-OP: EVAL and mouse selection in *Completions*]"
+;; starting 2007-03-05).
+(defun PC-try-completion (string alist &optional predicate)
+ "Like `try-completion' but return STRING instead of t."
+ (let ((result (try-completion string alist predicate)))
+ (if (eq result t) string result)))
+
+;; 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 minibuffer-completion-table)
+ (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
- (dirlength 0)
+ (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)
env-on
regex
p offset
+ abbreviated
(poss nil)
helpposs
(case-fold-search completion-ignore-case))
;; If completion-ignore-case is non-nil, insert the
;; completion string since that may have a different case.
(when completion-ignore-case
- (setq str (try-completion str table pred))
+ (setq str (PC-try-completion str table pred))
(delete-region beg end)
(insert str))
'complete)
"*"
(substring pat p))
p (+ p 2)))
- (setq files (PC-expand-many-files (concat pat "*")))
+ (setq files (file-expand-wildcards (concat pat "*")))
(if files
(let ((dir (file-name-directory (car files)))
(p files))
(insert str)
(setq end (+ beg (length str)))))
(if origstr
- ;; If the wildcards were introduced by us, it's possible
- ;; that read-file-name-internal (especially our
- ;; PC-include-file advice) can still find matches for the
- ;; original string even if we couldn't, so remove the
- ;; added wildcards.
+ ;; 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 nil)))))
pred nil))
;; Find an initial list of possible completions
- (if (not (setq p (string-match (concat PC-delim-regex
+ (unless (setq p (string-match (concat PC-delim-regex
(if filename "\\|\\*" ""))
str
- (+ (length dirname) offset))))
+ (+ (length dirname) offset)))
;; Minibuffer contains no hyphens -- simple case!
- (setq poss (all-completions (if env-on
- basestr str)
+ (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 #'list 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
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)))))
+ (setq p (cdr p))))
;; If table had duplicates, they can be here.
(delete-dups poss)
(and p (setq poss p))))
;; Now we have a list of possible completions
+
(cond
;; No valid completions found
(let ((PC-word-failed-flag t))
(delete-backward-char 1)
(PC-do-completion 'word))
+ (when abbreviated
+ (delete-region beg end)
+ (insert origstr))
(beep)
(PC-temp-minibuffer-message (if ambig
" [Ambiguous dir name]"
;; Check if next few letters are the same in all cases
(if (and (not (eq mode 'help))
- (setq prefix (try-completion (PC-chunk-after basestr skip)
- poss)))
+ (setq prefix (PC-try-completion
+ (PC-chunk-after basestr skip) poss)))
(let ((first t) i)
;; Retain capitalization of user input even if
;; completion-ignore-case is set.
(forward-char 1)
(if (and (< (point) end)
(and (looking-at " ")
- (memq (aref prefix i)
+ (memq (aref prefix i)
PC-delims-list)))
;; replace " " by the actual delimiter
(progn
(insert (substring prefix i (1+ i))))
;; insert a new character
(progn
- (and filename (looking-at "\\*")
- (progn
- (delete-char 1)
- (setq end (1- end))))
+ (and filename (looking-at "\\*")
+ (progn
+ (delete-char 1)
+ (setq end (1- end))))
(setq improved t)
- (insert (substring prefix i (1+ i)))
+ (insert (substring prefix i (1+ i)))
(setq end (1+ end)))))
(setq i (1+ i)))
(or pt (setq pt (point)))
(setq skip (concat skip
(regexp-quote prefix)
PC-ndelims-regex)
- prefix (try-completion
+ prefix (PC-try-completion
(PC-chunk-after
;; not basestr, because that does
;; not reflect insertions
;; We changed it... would it be complete without the space?
(if (test-completion (buffer-substring 1 (1- end))
- table pred)
+ table pred)
(delete-region (1- end) end)))
(if improved
(and completion-auto-help
(eq last-command this-command))
(eq mode 'help))
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list (sort helpposs 'string-lessp))
- (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.
- (setq completion-base-size dirlength)))
- (PC-temp-minibuffer-message " [Next char not unique]"))
- nil)))))
+ (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.
+ (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 (and env-on filename))
+ (not abbreviated))
(if (null mode)
(PC-temp-minibuffer-message " [Sole completion]"))
(delete-region beg end)
(defun PC-temp-minibuffer-message (message)
"A Lisp version of `temp_minibuffer_message' from minibuf.c."
(cond (PC-not-minibuffer
- (message message)
+ (message "%s" message)
(sit-for 2)
(message ""))
((fboundp 'temp-minibuffer-message)
(setq quit-flag nil
unread-command-events '(7))))))))
+;; Does not need to be buffer-local (?) because only used when one
+;; PC-l-c-s immediately follows another.
+(defvar PC-lisp-complete-end nil
+ "Internal variable used by `PC-lisp-complete-symbol'.")
(defun PC-lisp-complete-symbol ()
"Perform completion on Lisp symbol preceding point.
Otherwise, all symbols with function definitions, values
or properties are considered."
(interactive)
- (let* ((end (point))
+ (let* ((end
+ (save-excursion
+ (with-syntax-table lisp-mode-syntax-table
+ (skip-syntax-forward "_w")
+ (point))))
(beg (save-excursion
(with-syntax-table lisp-mode-syntax-table
(backward-sexp 1)
(or (boundp sym) (fboundp sym)
(symbol-plist sym))))))
(PC-not-minibuffer t))
- (PC-do-completion nil beg end)))
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2007-03/msg01211.html
+ ;;
+ ;; This deals with cases like running PC-l-c-s on "M-: (n-f".
+ ;; The first call to PC-l-c-s expands this to "(ne-f", and moves
+ ;; point to the hyphen [1]. If one calls PC-l-c-s immediately after,
+ ;; then without the last-command check, one is offered all
+ ;; completions of "(ne", which is presumably not what one wants.
+ ;;
+ ;; This is arguably (at least, it seems to be the existing intended
+ ;; behaviour) what one _does_ want if point has been explicitly
+ ;; positioned on the hyphen. Note that if PC-do-completion (qv) binds
+ ;; completion-base-size to nil, then completion does not replace the
+ ;; correct amount of text in such cases.
+ ;;
+ ;; Neither of these problems occur when using PC for filenames in the
+ ;; minibuffer, because in that case PC-do-completion is called without
+ ;; an explicit value for END, and so uses (point-max). This is fine for
+ ;; a filename, because the end of the filename must be at the end of
+ ;; the minibuffer. The same is not true for lisp symbols.
+ ;;
+ ;; [1] An alternate fix would be to not move point to the hyphen
+ ;; in such cases, but that would make the behaviour different from
+ ;; that for filenames. It seems PC moves point to the site of the
+ ;; first difference between the possible completions.
+ ;;
+ ;; Alternatively alternatively, maybe end should be computed in
+ ;; the same way as beg. That would change the behaviour though.
+ (if (equal last-command 'PC-lisp-complete-symbol)
+ (PC-do-completion nil beg PC-lisp-complete-end t)
+ (if PC-lisp-complete-end
+ (move-marker PC-lisp-complete-end end)
+ (setq PC-lisp-complete-end (copy-marker end t)))
+ (PC-do-completion nil beg end t))))
(defun PC-complete-as-file-name ()
"Perform completion on file names preceding point.
(point-min) t)
(+ (point) 2)
(point-min)))
- (minibuffer-completion-table 'read-file-name-internal)
+ (minibuffer-completion-table 'PC-read-file-name-internal)
(minibuffer-completion-predicate "")
(PC-not-minibuffer t))
(goto-char end)
(PC-do-completion nil beg end)))
-;; Use the shell to do globbing.
-;; This could now use file-expand-wildcards instead.
-
-(defun PC-expand-many-files (name)
- (with-current-buffer (generate-new-buffer " *Glob Output*")
- (erase-buffer)
- (when (and (file-name-absolute-p name)
- (not (file-directory-p default-directory)))
- ;; If the current working directory doesn't exist `shell-command'
- ;; signals an error. So if the file names we're looking for don't
- ;; depend on the working directory, switch to a valid directory first.
- (setq default-directory "/"))
- (shell-command (concat "echo " name) t)
- (goto-char (point-min))
- ;; CSH-style shells were known to output "No match", whereas
- ;; SH-style shells tend to simply output `name' when no match is found.
- (if (looking-at (concat ".*No match\\|\\(^\\| \\)\\("
- (regexp-quote name)
- "\\|"
- (regexp-quote (expand-file-name name))
- "\\)\\( \\|$\\)"))
- nil
- (insert "(\"")
- (while (search-forward " " nil t)
- (delete-backward-char 1)
- (insert "\" \""))
- (goto-char (point-max))
- (delete-backward-char 1)
- (insert "\")")
- (goto-char (point-min))
- (let ((files (read (current-buffer))) (p nil))
- (kill-buffer (current-buffer))
- (or (equal completion-ignored-extensions PC-ignored-extensions)
- (setq PC-ignored-regexp
- (concat "\\("
- (mapconcat
- 'regexp-quote
- (setq PC-ignored-extensions
- completion-ignored-extensions)
- "\\|")
- "\\)\\'")))
- (setq p nil)
- (while files
- ;; This whole process of going through to shell, to echo, and
- ;; finally parsing the output is a hack. It breaks as soon as
- ;; there are spaces in the file names or when the no-match
- ;; message changes. To make up for it, we check that what we read
- ;; indeed exists, so we may miss some files, but we at least won't
- ;; list non-existent ones.
- (or (not (file-exists-p (car files)))
- (string-match PC-ignored-regexp (car files))
- (setq p (cons (car files) p)))
- (setq files (cdr files)))
- p))))
-
;; Facilities for loading C header files. This is independent from the
;; main completion code. See also the variable `PC-include-file-path'
;; at top of this file.
(setq sorted (cdr sorted)))
compressed))))
-(defadvice read-file-name-internal (around PC-include-file disable)
- (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0))
- (let* ((string (ad-get-arg 0))
- (action (ad-get-arg 2))
- (name (substring string (match-beginning 1) (match-end 1)))
+(defun PC-read-file-name-internal (string dir action)
+ "Extend `read-file-name-internal' to handle include files.
+This is only used by "
+ (if (string-match "<\\([^\"<>]*\\)>?\\'" string)
+ (let* ((name (match-string 1 string))
(str2 (substring string (match-beginning 0)))
(completion-table
- (mapcar (lambda (x) (format "<%s>" x))
+ (mapcar (lambda (x)
+ (format (if (string-match "/\\'" x) "<%s" "<%s>") x))
(PC-include-file-all-completions
name (PC-include-file-path)))))
- (setq ad-return-value
(cond
((not completion-table) nil)
((eq action 'lambda) (test-completion str2 completion-table nil))
- ((eq action nil) (try-completion str2 completion-table nil))
- ((eq action t) (all-completions str2 completion-table nil)))))
- ad-do-it))
+ ((eq action nil) (PC-try-completion str2 completion-table nil))
+ ((eq action t) (all-completions str2 completion-table nil))))
+ (read-file-name-internal string dir action)))
\f
(provide 'complete)