X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/92677e25c1f4bf54cc99c9707018a409e66f0a8b..adbf7978dddf948e85d41cd69cc81234e508b9c3:/lisp/complete.el diff --git a/lisp/complete.el b/lisp/complete.el index a20fb7d651..d3ff6c5398 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -1,10 +1,10 @@ ;;; complete.el --- partial completion mechanism plus other goodies -;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Dave Gillespie -;; Keywords: abbrev -;; Version: 2.03 +;; Keywords: abbrev convenience ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. ;; This file is part of GNU Emacs. @@ -21,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -47,7 +47,7 @@ ;; and the partial completer will use the Meta versions of the keys. -;; Usage: M-x PC-mode. Now, during completable minibuffer entry, +;; Usage: M-x partial-completion-mode. During completable minibuffer entry, ;; ;; TAB means to do a partial completion; ;; SPC means to do a partial complete-word; @@ -62,7 +62,7 @@ ;; ;; in your .emacs file. To load partial completion automatically, put ;; -;; (PC-mode t) +;; (partial-completion-mode t) ;; ;; in your .emacs file, too. Things will be faster if you byte-compile ;; this file when you install it. @@ -78,17 +78,6 @@ ;; The regular M-TAB (lisp-complete-symbol) command also supports ;; partial completion in this package. -;; This package also contains a wildcard feature for C-x C-f (find-file). -;; For example, `C-x C-f *.c RET' loads all .c files at once, exactly -;; as if you had typed C-x C-f separately for each file. Completion -;; is supported in connection with wildcards. Currently only the `*' -;; wildcard character works. - -;; File name completion does not do partial completion of directories -;; on the path, e.g., "/u/b/f" will not complete to "/usr/bin/foo", -;; but you can put *'s in the path to accomplish this: "/u*/b*/f". -;; Stars are required for performance reasons. - ;; In addition, this package includes a feature for accessing include ;; files. For example, `C-x C-f RET' reads the file ;; /usr/include/sys/time.h. The variable PC-include-file-path is a @@ -101,21 +90,8 @@ (defgroup partial-completion nil "Partial Completion of items." :prefix "pc-" - :group 'minibuffer) - -(defcustom partial-completion-mode nil - "Toggle Partial Completion mode. -When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is -nil) is enhanced so that if some string is divided into words and each word is -delimited by a character in `PC-word-delimiters', partial words are completed -as much as possible and `*' characters are treated likewise in file names. -You must modify via \\[customize] for this variable to have an effect." - :set (lambda (symbol value) - (partial-completion-mode (or value 0))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'partial-completion - :require 'complete) + :group 'minibuffer + :group 'convenience) (defcustom PC-first-char 'find-file "*Control how the first character of a string is to be interpreted. @@ -127,7 +103,7 @@ If non-nil and non-t, the first character is taken literally only for file name completion." :type '(choice (const :tag "delimiter" nil) (const :tag "literal" t) - (sexp :tag "find-file" :format "%t\n" find-file)) + (other :tag "find-file" find-file)) :group 'partial-completion) (defcustom PC-meta-flag t @@ -142,7 +118,7 @@ Some arcane rules: If `]' is in this string, it must come first. If `^' is in this string, it must not come first. If `-' is in this string, it must come first or right after `]'. -In other words, if S is this string, then `[S]' must be a legal Emacs regular +In other words, if S is this string, then `[S]' must be a valid Emacs regular expression (not containing character ranges like `a-z')." :type 'string :group 'partial-completion) @@ -153,11 +129,6 @@ If nil, means use the colon-separated path in the variable $INCPATH instead." :type '(repeat directory) :group 'partial-completion) -(defcustom PC-disable-wildcards nil - "*If non-nil, wildcard support in \\[find-file] is disabled." - :type 'boolean - :group 'partial-completion) - (defcustom PC-disable-includes nil "*If non-nil, include-file support in \\[find-file] is disabled." :type 'boolean @@ -165,59 +136,12 @@ If nil, means use the colon-separated path in the variable $INCPATH instead." (defvar PC-default-bindings t "If non-nil, default partial completion key bindings are suppressed.") - -(defvar PC-old-read-file-name-internal nil) -;;;###autoload -(defun partial-completion-mode (&optional arg) - "Toggle Partial Completion mode. -With prefix ARG, turn Partial Completion mode on if ARG is positive. - -When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is -nil) is enhanced so that if some string is divided into words and each word is -delimited by a character in `PC-word-delimiters', partial words are completed -as much as possible. +(defvar PC-env-vars-alist nil + "A list of the environment variable names and values.") -For example, M-x p-c-b expands to M-x partial-completion-mode since no other -command begins with that sequence of characters, and -\\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no -other file in that directory begin with that sequence of characters. - -Unless `PC-disable-wildcards' is non-nil, the \"*\" wildcard is interpreted -specially when entering file or directory names. For example, -\\[find-file] *.c RET finds each C file in the currenty directory, and -\\[find-file] */foo_bar.c TAB completes the directory name as far as possible. - -Unless `PC-disable-includes' is non-nil, the \"<...>\" sequence is interpreted -specially in \\[find-file]. For example, -\\[find-file] RET finds the file /usr/include/sys/time.h. -See also the variable `PC-include-file-path'." - (interactive "P") - (let ((on-p (if arg - (> (prefix-numeric-value arg) 0) - (not partial-completion-mode)))) - ;; Deal with key bindings... - (PC-bindings on-p) - ;; Deal with wildcard file feature... - (cond ((not on-p) - (remove-hook 'find-file-not-found-hooks 'PC-try-load-many-files)) - ((not PC-disable-wildcards) - (add-hook 'find-file-not-found-hooks 'PC-try-load-many-files))) - ;; Deal with include file feature... - (cond ((not on-p) - (remove-hook 'find-file-not-found-hooks 'PC-look-for-include-file)) - ((not PC-disable-includes) - (add-hook 'find-file-not-found-hooks 'PC-look-for-include-file))) - ;; ... with some underhand redefining. - (cond ((and (not on-p) (functionp PC-old-read-file-name-internal)) - (fset 'read-file-name-internal PC-old-read-file-name-internal)) - ((and (not PC-disable-includes) (not PC-old-read-file-name-internal)) - (setq PC-old-read-file-name-internal - (symbol-function 'read-file-name-internal)) - (fset 'read-file-name-internal - 'PC-read-include-file-name-internal))) - ;; Finally set the mode variable. - (setq partial-completion-mode on-p))) + +(defvar PC-old-read-file-name-internal nil) (defun PC-bindings (bind) (let ((completion-map minibuffer-local-completion-map) @@ -261,16 +185,50 @@ See also the variable `PC-include-file-path'." (define-key global-map "\e\t" 'PC-lisp-complete-symbol))))) -;; Because the `partial-completion-mode' option is defined before the -;; `partial-completion-mode' command and its callee, we give the former a -;; default `:initialize' keyword value. Otherwise, the `:set' keyword value -;; would be called to initialise the variable value, and that would call the -;; as-yet undefined `partial-completion-mode' function. -;; Since the default `:initialize' keyword value (obviously) does not turn on -;; Partial Completion Mode, we do that here, once the `partial-completion-mode' -;; function and its callee are defined. -(when partial-completion-mode - (partial-completion-mode t)) +;;;###autoload +(define-minor-mode partial-completion-mode + "Toggle Partial Completion mode. +With prefix ARG, turn Partial Completion mode on if ARG is positive. + +When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is +nil) is enhanced so that if some string is divided into words and each word is +delimited by a character in `PC-word-delimiters', partial words are completed +as much as possible and `*' characters are treated likewise in file names. + +For example, M-x p-c-m expands to M-x partial-completion-mode since no other +command begins with that sequence of characters, and +\\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no +other file in that directory begin with that sequence of characters. + +Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted +specially in \\[find-file]. For example, +\\[find-file] RET finds the file `/usr/include/sys/time.h'. +See also the variable `PC-include-file-path'." + :global t :group 'partial-completion + ;; Deal with key bindings... + (PC-bindings partial-completion-mode) + ;; Deal with include file feature... + (cond ((not partial-completion-mode) + (remove-hook 'find-file-not-found-hooks 'PC-look-for-include-file)) + ((not PC-disable-includes) + (add-hook 'find-file-not-found-hooks 'PC-look-for-include-file))) + ;; ... with some underhand redefining. + (cond ((and (not partial-completion-mode) + (functionp PC-old-read-file-name-internal)) + (fset 'read-file-name-internal PC-old-read-file-name-internal)) + ((and (not PC-disable-includes) (not PC-old-read-file-name-internal)) + (setq PC-old-read-file-name-internal + (symbol-function 'read-file-name-internal)) + (fset 'read-file-name-internal + 'PC-read-include-file-name-internal))) + (when (and partial-completion-mode (null PC-env-vars-alist)) + (setq PC-env-vars-alist + (mapcar (lambda (string) + (let ((d (string-match "=" string))) + (cons (concat "$" (substring string 0 d)) + (and d (substring string (1+ d)))))) + process-environment)))) + (defun PC-complete () "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. @@ -346,7 +304,7 @@ See `PC-complete' for details." (PC-do-complete-and-exit))) (defun PC-do-complete-and-exit () - (if (= (buffer-size) 0) ; Duplicate the "bug" that Info-menu relies on... + (if (= (point-max) (minibuffer-prompt-end)) ; Duplicate the "bug" that Info-menu relies on... (exit-minibuffer) (let ((flag (PC-do-completion 'exit))) (and flag @@ -390,17 +348,18 @@ The function takes no arguments, and typically looks at the value of `minibuffer-completion-table' and the minibuffer contents.") (defun PC-do-completion (&optional mode beg end) - (or beg (setq beg (point-min))) + (or beg (setq beg (minibuffer-prompt-end))) (or end (setq end (point-max))) (let* ((table minibuffer-completion-table) (pred minibuffer-completion-predicate) (filename (funcall PC-completion-as-file-name-predicate)) (dirname nil) - dirlength + (dirlength 0) (str (buffer-substring beg end)) (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) (ambig nil) basestr + env-on regex p offset (poss nil) @@ -409,23 +368,21 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;; Check if buffer contents can already be considered complete (if (and (eq mode 'exit) - (PC-is-complete-p str table pred)) + (test-completion str table pred)) 'complete - ;; Record how many characters at the beginning are not included - ;; in completion. - (setq dirlength - (if filename - (length (file-name-directory str)) - 0)) - ;; Do substitutions in directory names (and filename - (not (equal str (setq p (substitute-in-file-name str)))) - (progn + (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 p) - (setq str p end (+ beg (length str))))) + (insert str) + (setq end (+ beg (length str))))) ;; Prepare various delimiter strings (or (equal PC-word-delimiters PC-delims) @@ -434,10 +391,27 @@ of `minibuffer-completion-table' and the minibuffer contents.") 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 is passed in `predicate'. + (default-directory (expand-file-name pred))) + (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 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 is passed in `predicate'. + (default-directory (expand-file-name pred)) files) (setq p (1+ (string-match "/[^/]*\\'" pat))) (while (setq p (string-match PC-delim-regex pat p)) @@ -466,7 +440,11 @@ of `minibuffer-completion-table' and the minibuffer contents.") (setq basestr (substring str incname) dirname (substring str 0 incname)) (setq basestr (file-name-nondirectory str) - dirname (file-name-directory 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 @@ -499,6 +477,12 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;;(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 (if (not (setq p (string-match (concat PC-delim-regex (if filename "\\|\\*" "")) @@ -506,15 +490,18 @@ of `minibuffer-completion-table' and the minibuffer contents.") (+ (length dirname) offset)))) ;; Minibuffer contains no hyphens -- simple case! - (setq poss (all-completions str + (setq poss (all-completions (if env-on + basestr str) table pred)) ;; Use all-completions to do an initial cull. This is a big win, ;; since all-completions is written in C! - (let ((compl (all-completions (substring str 0 p) - table - pred))) + (let ((compl (all-completions (if env-on + (file-name-nondirectory (substring str 0 p)) + (substring str 0 p)) + table + pred))) (setq p compl) (while p (and (string-match regex (car p)) @@ -561,10 +548,12 @@ of `minibuffer-completion-table' and the minibuffer contents.") "\\|") "\\)\\'"))) - ;; Check if there are any without an ignored extension + ;; 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))) @@ -652,7 +641,7 @@ of `minibuffer-completion-table' and the minibuffer contents.") (if improved ;; We changed it... would it be complete without the space? - (if (PC-is-complete-p (buffer-substring 1 (1- end)) + (if (test-completion (buffer-substring 1 (1- end)) table pred) (delete-region (1- end) end))) @@ -660,10 +649,12 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;; We changed it... enough to be complete? (and (eq mode 'exit) - (PC-is-complete-p (buffer-string) table pred)) + (test-completion (field-string) table pred)) ;; If totally ambiguous, display a list of completions - (if (or completion-auto-help + (if (or (eq completion-auto-help t) + (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)) @@ -678,7 +669,8 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;; Only one possible completion (t - (if (equal basestr (car poss)) + (if (and (equal basestr (car poss)) + (not (and env-on filename))) (if (null mode) (PC-temp-minibuffer-message " [Sole completion]")) (delete-region beg end) @@ -688,20 +680,6 @@ of `minibuffer-completion-table' and the minibuffer contents.") (car poss))))) t))))) - -(defun PC-is-complete-p (str table pred) - (let ((res (if (listp table) - (assoc str table) - (if (vectorp table) - (or (equal str "nil") ; heh, heh, heh - (intern-soft str table)) - (funcall table str pred 'lambda))))) - (and res - (or (not pred) - (and (not (listp table)) (not (vectorp table))) - (funcall pred res)) - res))) - (defun PC-chop-word (new old) (let ((i -1) (j -1)) @@ -767,57 +745,23 @@ or properties are considered." (PC-not-minibuffer t)) (PC-do-completion nil beg end))) - -;;; Wildcards in `C-x C-f' command. This is independent from the main -;;; completion code, except for `PC-expand-many-files' which is called -;;; when "*"'s are found in the path during filename completion. (The -;;; above completion code always understands "*"'s, except in file paths, -;;; without relying on the following code.) - -(defvar PC-many-files-list nil) - -(defun PC-try-load-many-files () - (if (string-match "\\*" buffer-file-name) - (let* ((pat buffer-file-name) - (files (PC-expand-many-files pat)) - (first (car files)) - (next files)) - (kill-buffer (current-buffer)) - (or files - (error "No matching files")) - ;; Bring the other files (not the first) into buffers. - (save-window-excursion - (while (setq next (cdr next)) - (let ((buf (find-file-noselect (car next)))) - ;; Put this buffer at the front of the buffer list. - (switch-to-buffer buf)))) - ;; This modifies the `buf' variable inside find-file-noselect. - (setq buf (get-file-buffer first)) - (if buf - nil ; should do verify-visited-file-modtime stuff. - (setq filename first) - (setq buf (create-file-buffer filename)) - ;; This modified `truename' inside find-file-noselect. - (setq truename (abbreviate-file-name (file-truename filename))) - (set-buffer buf) - (erase-buffer) - (insert-file-contents filename t)) - (if (cdr files) - (setq PC-many-files-list (mapconcat - (if (string-match "\\*.*/" pat) - 'identity - 'file-name-nondirectory) - (cdr files) ", ") - find-file-hooks (cons 'PC-after-load-many-files - find-file-hooks))) - ;; This modifies the "error" variable inside find-file-noselect. - (setq error nil) - t) - nil)) - -(defun PC-after-load-many-files () - (setq find-file-hooks (delq 'PC-after-load-many-files find-file-hooks)) - (message "Also loaded %s." PC-many-files-list)) +(defun PC-complete-as-file-name () + "Perform completion on file names preceding point. + Environment vars are converted to their values." + (interactive) + (let* ((end (point)) + (beg (if (re-search-backward "[^\\][ \t\n\"\`\'][^ \t\n\"\`\']" + (point-min) t) + (+ (point) 2) + (point-min))) + (minibuffer-completion-table '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) (save-excursion @@ -835,9 +779,23 @@ or properties are considered." (delete-backward-char 1) (insert "\")") (goto-char (point-min)) - (let ((files (read (current-buffer)))) + (let ((files (read (current-buffer))) (p nil)) (kill-buffer (current-buffer)) - files)))) + (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 + (or (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' @@ -878,7 +836,7 @@ or properties are considered." (or (string-match "\\.el$" name) (setq name (concat name ".el"))))) (error "Not on an #include line")))))) - (or (string-match "\\.[a-zA-Z0-9]+$" name) + (or (string-match "\\.[[:alnum:]]+$" name) (setq name (concat name ".h"))) (if (eq punc ?\<) (let ((path (or path (PC-include-file-path)))) @@ -895,7 +853,7 @@ or properties are considered." default-directory))) (if (file-exists-p (concat dir name)) (setq name (concat dir name)) - (error "No such include file: \"%s\"" name)))) + (error "No such include file: `%s'" name)))) (setq new-buf (get-file-buffer name)) (if new-buf ;; no need to verify last-modified time for this! @@ -904,9 +862,8 @@ or properties are considered." (set-buffer new-buf) (erase-buffer) (insert-file-contents name t)) - (setq filename name - error nil - buf new-buf) + ;; Returning non-nil with the new buffer current + ;; is sufficient to tell find-file to use it. t) nil)) @@ -924,17 +881,17 @@ or properties are considered." ;;; This is adapted from lib-complete.el, by Mike Williams. (defun PC-include-file-all-completions (file search-path &optional full) "Return all completions for FILE in any directory on SEARCH-PATH. -If optional third argument FULL is non-nil, returned pathnames should be +If optional third argument FULL is non-nil, returned pathnames should be absolute rather than relative to some directory on the SEARCH-PATH." (setq search-path - (mapcar '(lambda (dir) - (if dir (file-name-as-directory dir) default-directory)) + (mapcar (lambda (dir) + (if dir (file-name-as-directory dir) default-directory)) search-path)) (if (file-name-absolute-p file) ;; It's an absolute file name, so don't need search-path (progn (setq file (expand-file-name file)) - (file-name-all-completions + (file-name-all-completions (file-name-nondirectory file) (file-name-directory file))) (let ((subdir (file-name-directory file)) (ndfile (file-name-nondirectory file)) @@ -942,7 +899,7 @@ absolute rather than relative to some directory on the SEARCH-PATH." ;; Append subdirectory part to each element of search-path (if subdir (setq search-path - (mapcar '(lambda (dir) (concat dir subdir)) + (mapcar (lambda (dir) (concat dir subdir)) search-path) file )) ;; Make list of completions in each directory on search-path @@ -952,15 +909,15 @@ absolute rather than relative to some directory on the SEARCH-PATH." (if (file-directory-p dir) (progn (setq file-lists - (cons - (mapcar '(lambda (file) (concat subdir file)) - (file-name-all-completions ndfile + (cons + (mapcar (lambda (file) (concat subdir file)) + (file-name-all-completions ndfile (car search-path))) file-lists)))) (setq search-path (cdr search-path)))) ;; Compress out duplicates while building complete list (slloooow!) (let ((sorted (sort (apply 'nconc file-lists) - '(lambda (x y) (not (string-lessp x y))))) + (lambda (x y) (not (string-lessp x y))))) compressed) (while sorted (if (equal (car sorted) (car compressed)) nil @@ -980,11 +937,11 @@ absolute rather than relative to some directory on the SEARCH-PATH." ((not completion-table) nil) ((eq action nil) (try-completion str2 completion-table nil)) ((eq action t) (all-completions str2 completion-table nil)) - ((eq action 'lambda) - (eq (try-completion str2 completion-table nil) t)))) + ((eq action 'lambda) (test-completion str2 completion-table nil)))) (funcall PC-old-read-file-name-internal string dir action))) (provide 'complete) -;;; End. +;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458 +;;; complete.el ends here