;;; 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, 2003, 2005
+;; Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: abbrev convenience
-;; Version: 2.03
;; Special thanks to Hallvard Furuseth for his many ideas and contributions.
;; This file is part of GNU Emacs.
;; 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 <sys/time.h> RET' reads the file
;; /usr/include/sys/time.h. The variable PC-include-file-path is a
:group 'minibuffer
:group 'convenience)
-(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)
-
(defcustom PC-first-char 'find-file
"*Control how the first character of a string is to be interpreted.
If nil, the first character of a string is not taken literally if it is a word
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
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)
: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
(defvar PC-default-bindings t
"If non-nil, default partial completion key bindings are suppressed.")
-\f
-(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] <sys/time.h> 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)))
+\f
+(defvar PC-old-read-file-name-internal nil)
(defun PC-bindings (bind)
(let ((completion-map minibuffer-local-completion-map)
(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] <sys/time.h> 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))))
+
\f
(defun PC-complete ()
"Like minibuffer-complete, but allows \"b--di\"-style abbreviations.
(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
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)
;; 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)
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))
(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
;;(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 "\\|\\*" ""))
(+ (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))
"\\|")
"\\)\\'")))
- ;; 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)))
(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)))
;; 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))
;; 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)
(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))
(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 (reverse (cdr files))))
- (kill-buffer (current-buffer))
- (or files
- (error "No matching files"))
- ;; Bring the other files (not the first) into buffers.
- (save-window-excursion
- (while next
- (let ((buf (find-file-noselect (car next))))
- ;; Put this buffer at the front of the buffer list.
- (switch-to-buffer buf))
- (setq next (cdr next))))
- ;; 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
(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))))
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!
(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))
;;; 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))
;; 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
(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
((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)))
\f
(provide 'complete)
-;;; End.
+;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458
+;;; complete.el ends here
HCoop / bpt / emacs.git / blobdiff