mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-23 07:19:15 +00:00
1175 lines
45 KiB
EmacsLisp
1175 lines
45 KiB
EmacsLisp
;;; 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.
|
||
|
||
;; Author: Dave Gillespie <daveg@synaptics.com>
|
||
;; Keywords: abbrev convenience
|
||
;; Special thanks to Hallvard Furuseth for his many ideas and contributions.
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; 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 3, or (at your option)
|
||
;; any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; 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., 51 Franklin Street, Fifth Floor,
|
||
;; Boston, MA 02110-1301, USA.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Extended completion for the Emacs minibuffer.
|
||
;;
|
||
;; The basic idea is that the command name or other completable text is
|
||
;; divided into words and each word is completed separately, so that
|
||
;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous
|
||
;; each word is completed as much as possible and then the cursor is
|
||
;; left at the first position where typing another letter will resolve
|
||
;; the ambiguity.
|
||
;;
|
||
;; Word separators for this purpose are hyphen, space, and period.
|
||
;; These would most likely occur in command names, Info menu items,
|
||
;; and file names, respectively. But all word separators are treated
|
||
;; alike at all times.
|
||
;;
|
||
;; This completion package replaces the old-style completer's key
|
||
;; bindings for TAB, SPC, RET, and `?'. The old completer is still
|
||
;; available on the Meta versions of those keys. If you set
|
||
;; PC-meta-flag to nil, the old completion keys will be left alone
|
||
;; and the partial completer will use the Meta versions of the keys.
|
||
|
||
|
||
;; 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;
|
||
;; RET means to do a partial complete-and-exit;
|
||
;; ? means to do a partial completion-help.
|
||
;;
|
||
;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform
|
||
;; original Emacs completions, and M-TAB etc. do partial completion.
|
||
;; To do this, put the command,
|
||
;;
|
||
;; (setq PC-meta-flag nil)
|
||
;;
|
||
;; in your .emacs file. To load partial completion automatically, put
|
||
;;
|
||
;; (partial-completion-mode t)
|
||
;;
|
||
;; in your .emacs file, too. Things will be faster if you byte-compile
|
||
;; this file when you install it.
|
||
;;
|
||
;; As an extra feature, in cases where RET would not normally
|
||
;; complete (such as `C-x b'), the M-RET key will always do a partial
|
||
;; complete-and-exit. Thus `C-x b f.c RET' will select or create a
|
||
;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing
|
||
;; buffer whose name matches that pattern (perhaps "filing.c").
|
||
;; (PC-meta-flag does not affect this behavior; M-RET used to be
|
||
;; undefined in this situation.)
|
||
;;
|
||
;; The regular M-TAB (lisp-complete-symbol) command also supports
|
||
;; partial completion in this package.
|
||
|
||
;; 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
|
||
;; list of directories in which to search for include files. Completion
|
||
;; is supported in include file names.
|
||
|
||
|
||
;;; Code:
|
||
|
||
(defgroup partial-completion nil
|
||
"Partial Completion of items."
|
||
:prefix "pc-"
|
||
:group 'minibuffer
|
||
:group 'convenience)
|
||
|
||
(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
|
||
delimiter, so that \".e\" matches \"*.e*\".
|
||
If t, the first character of a string is always taken literally even if it is a
|
||
word delimiter, so that \".e\" matches \".e*\".
|
||
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)
|
||
(other :tag "find-file" find-file))
|
||
:group 'partial-completion)
|
||
|
||
(defcustom PC-meta-flag t
|
||
"If non-nil, TAB means PC completion and M-TAB means normal completion.
|
||
Otherwise, TAB means normal completion and M-TAB means Partial Completion."
|
||
:type 'boolean
|
||
:group 'partial-completion)
|
||
|
||
(defcustom PC-word-delimiters "-_. "
|
||
"A string of characters treated as word delimiters for completion.
|
||
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 valid Emacs regular
|
||
expression (not containing character ranges like `a-z')."
|
||
:type 'string
|
||
:group 'partial-completion)
|
||
|
||
(defcustom PC-include-file-path '("/usr/include" "/usr/local/include")
|
||
"A list of directories in which to look for include files.
|
||
If nil, means use the colon-separated path in the variable $INCPATH instead."
|
||
:type '(repeat directory)
|
||
:group 'partial-completion)
|
||
|
||
(defcustom PC-disable-includes nil
|
||
"If non-nil, include-file support in \\[find-file] is disabled."
|
||
:type 'boolean
|
||
:group 'partial-completion)
|
||
|
||
(defvar PC-default-bindings t
|
||
"If non-nil, default partial completion key bindings are suppressed.")
|
||
|
||
(defvar PC-env-vars-alist nil
|
||
"A list of the environment variable names and values.")
|
||
|
||
|
||
(defun PC-bindings (bind)
|
||
(let ((completion-map minibuffer-local-completion-map)
|
||
(must-match-map minibuffer-local-must-match-map))
|
||
(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 "\r" 'minibuffer-complete-and-exit)
|
||
(define-key must-match-map "\n" 'minibuffer-complete-and-exit)
|
||
|
||
(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\t" 'PC-complete)
|
||
(define-key completion-map "\e " 'PC-complete-word)
|
||
(define-key completion-map "\e\r" 'PC-force-complete-and-exit)
|
||
(define-key completion-map "\e\n" 'PC-force-complete-and-exit)
|
||
(define-key completion-map "\e?" 'PC-completion-help)
|
||
|
||
(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 "\e\r" 'PC-complete-and-exit)
|
||
(define-key must-match-map "\e\n" 'PC-complete-and-exit)
|
||
|
||
(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.
|
||
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 begins 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'.
|
||
|
||
Partial Completion mode extends the meaning of `completion-auto-help' (which
|
||
see), so that if it is neither nil nor t, Emacs shows the `*Completions*'
|
||
buffer only on the second attempt to complete. That is, if TAB finds nothing
|
||
to complete, the first TAB just says \"Next char not unique\" and the
|
||
second TAB brings up the `*Completions*' buffer."
|
||
: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-functions 'PC-look-for-include-file))
|
||
((not PC-disable-includes)
|
||
(add-hook 'find-file-not-found-functions 'PC-look-for-include-file)))
|
||
;; 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
|
||
;; Emacs-22). In contrast we use the whole text and we even sometimes
|
||
;; move point to a place before EOB, to indicate the first position where
|
||
;; there's a difference, so when the user uses choose-completion, we have
|
||
;; to trick choose-completion into replacing the whole minibuffer text
|
||
;; rather than only the text before point. --Stef
|
||
(funcall
|
||
(if partial-completion-mode 'add-hook 'remove-hook)
|
||
'choose-completion-string-functions
|
||
(lambda (choice buffer mini-p base-size)
|
||
;; 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))
|
||
(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.
|
||
For example, \"M-x b--di\" would match `byte-recompile-directory', or any
|
||
name which consists of three or more words, the first beginning with \"b\"
|
||
and the third beginning with \"di\".
|
||
|
||
The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and
|
||
`beginning-of-defun', so this would produce a list of completions
|
||
just like when normal Emacs completions are ambiguous.
|
||
|
||
Word-delimiters for the purposes of Partial Completion are \"-\", \"_\",
|
||
\".\", and SPC."
|
||
(interactive)
|
||
(if (PC-was-meta-key)
|
||
(minibuffer-complete)
|
||
;; If the previous command was not this one,
|
||
;; never scroll, always retry completion.
|
||
(or (eq last-command this-command)
|
||
(setq minibuffer-scroll-window nil))
|
||
(let ((window minibuffer-scroll-window))
|
||
;; If there's a fresh completion window with a live buffer,
|
||
;; and this command is repeated, scroll that window.
|
||
(if (and window (window-buffer window)
|
||
(buffer-name (window-buffer window)))
|
||
(with-current-buffer (window-buffer window)
|
||
(if (pos-visible-in-window-p (point-max) window)
|
||
(set-window-start window (point-min) nil)
|
||
(scroll-other-window)))
|
||
(PC-do-completion nil)))))
|
||
|
||
|
||
(defun PC-complete-word ()
|
||
"Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations.
|
||
See `PC-complete' for details.
|
||
This can be bound to other keys, like `-' and `.', if you wish."
|
||
(interactive)
|
||
(if (eq (PC-was-meta-key) PC-meta-flag)
|
||
(if (eq last-command-char ? )
|
||
(minibuffer-complete-word)
|
||
(self-insert-command 1))
|
||
(self-insert-command 1)
|
||
(if (eobp)
|
||
(PC-do-completion 'word))))
|
||
|
||
|
||
(defun PC-complete-space ()
|
||
"Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations.
|
||
See `PC-complete' for details.
|
||
This is suitable for binding to other keys which should act just like SPC."
|
||
(interactive)
|
||
(if (eq (PC-was-meta-key) PC-meta-flag)
|
||
(minibuffer-complete-word)
|
||
(insert " ")
|
||
(if (eobp)
|
||
(PC-do-completion 'word))))
|
||
|
||
|
||
(defun PC-complete-and-exit ()
|
||
"Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations.
|
||
See `PC-complete' for details."
|
||
(interactive)
|
||
(if (eq (PC-was-meta-key) PC-meta-flag)
|
||
(minibuffer-complete-and-exit)
|
||
(PC-do-complete-and-exit)))
|
||
|
||
(defun PC-force-complete-and-exit ()
|
||
"Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations.
|
||
See `PC-complete' for details."
|
||
(interactive)
|
||
(let ((minibuffer-completion-confirm nil))
|
||
(PC-do-complete-and-exit)))
|
||
|
||
(defun PC-do-complete-and-exit ()
|
||
(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]")))))))
|
||
|
||
|
||
(defun PC-completion-help ()
|
||
"Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations.
|
||
See `PC-complete' for details."
|
||
(interactive)
|
||
(if (eq (PC-was-meta-key) PC-meta-flag)
|
||
(minibuffer-completion-help)
|
||
(PC-do-completion 'help)))
|
||
|
||
(defun PC-was-meta-key ()
|
||
(or (/= (length (this-command-keys)) 1)
|
||
(let ((key (aref (this-command-keys) 0)))
|
||
(if (integerp key)
|
||
(>= key 128)
|
||
(not (null (memq 'meta (event-modifiers key))))))))
|
||
|
||
|
||
(defvar PC-ignored-extensions 'empty-cache)
|
||
(defvar PC-delims 'empty-cache)
|
||
(defvar PC-ignored-regexp nil)
|
||
(defvar PC-word-failed-flag nil)
|
||
(defvar PC-delim-regex nil)
|
||
(defvar PC-ndelims-regex nil)
|
||
(defvar PC-delims-list nil)
|
||
|
||
(defvar PC-completion-as-file-name-predicate
|
||
(lambda () minibuffer-completing-file-name)
|
||
"A function testing whether a minibuffer completion now will work filename-style.
|
||
The function takes no arguments, and typically looks at the value
|
||
of `minibuffer-completion-table' and the minibuffer contents.")
|
||
|
||
;; 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 ((result (substring string (match-end 0))))
|
||
;; result may contain multiple chunks
|
||
(if (string-match PC-delim-regex result)
|
||
(setq result (substring result 0 (match-beginning 0))))
|
||
result))
|
||
|
||
(defun test-completion-ignore-case (str table pred)
|
||
"Like `test-completion', but ignores case when possible."
|
||
;; Binding completion-ignore-case to nil ensures, for compatibility with
|
||
;; standard completion, that the return value is exactly one of the
|
||
;; possibilities. Do this binding only if pred is nil, out of paranoia;
|
||
;; perhaps it is safe even if pred is non-nil.
|
||
(if pred
|
||
(test-completion str table pred)
|
||
(let ((completion-ignore-case nil))
|
||
(test-completion str table pred))))
|
||
|
||
;; 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 (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))
|
||
(progn
|
||
;; If completion-ignore-case is non-nil, insert the
|
||
;; completion string since that may have a different case.
|
||
(when completion-ignore-case
|
||
(setq str (PC-try-completion str table pred))
|
||
(delete-region beg end)
|
||
(insert str))
|
||
'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 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 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 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 pat (concat (substring pat 0 p)
|
||
"*"
|
||
(substring pat p))
|
||
p (+ p 2)))
|
||
(setq files (PC-expand-many-files (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 nil
|
||
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 nil)))))
|
||
|
||
;; 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-match "\\\\\\*" 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 (PC-expand-many-files
|
||
(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
|
||
(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-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]"
|
||
(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)
|
||
;; Retain capitalization of user input even if
|
||
;; completion-ignore-case is set.
|
||
(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)
|
||
(eq (downcase (aref prefix i))
|
||
(downcase (following-char))))
|
||
;; same char (modulo case); no action
|
||
(forward-char 1)
|
||
(if (and (< (point) end)
|
||
(and (looking-at " ")
|
||
(memq (aref prefix i)
|
||
PC-delims-list)))
|
||
;; replace " " by the actual delimiter
|
||
(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 1 (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.
|
||
(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)))))
|
||
|
||
(defun PC-chop-word (new old)
|
||
(let ((i -1)
|
||
(j -1))
|
||
(while (and (setq i (string-match PC-delim-regex old (1+ i)))
|
||
(setq j (string-match PC-delim-regex new (1+ j)))))
|
||
(if (and j
|
||
(or (not PC-word-failed-flag)
|
||
(setq j (string-match PC-delim-regex new (1+ j)))))
|
||
(substring new 0 (1+ j))
|
||
new)))
|
||
|
||
(defvar PC-not-minibuffer nil)
|
||
|
||
(defun PC-temp-minibuffer-message (message)
|
||
"A Lisp version of `temp_minibuffer_message' from minibuf.c."
|
||
(cond (PC-not-minibuffer
|
||
(message message)
|
||
(sit-for 2)
|
||
(message ""))
|
||
((fboundp 'temp-minibuffer-message)
|
||
(temp-minibuffer-message message))
|
||
(t
|
||
(let ((point-max (point-max)))
|
||
(save-excursion
|
||
(goto-char point-max)
|
||
(insert message))
|
||
(let ((inhibit-quit t))
|
||
(sit-for 2)
|
||
(delete-region point-max (point-max))
|
||
(when quit-flag
|
||
(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.
|
||
That symbol is compared against the symbols that exist
|
||
and any additional characters determined by what is there
|
||
are inserted.
|
||
If the symbol starts just after an open-parenthesis,
|
||
only symbols with function definitions are considered.
|
||
Otherwise, all symbols with function definitions, values
|
||
or properties are considered."
|
||
(interactive)
|
||
(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)
|
||
(while (= (char-syntax (following-char)) ?\')
|
||
(forward-char 1))
|
||
(point))))
|
||
(minibuffer-completion-table obarray)
|
||
(minibuffer-completion-predicate
|
||
(if (eq (char-after (1- beg)) ?\()
|
||
'fboundp
|
||
(function (lambda (sym)
|
||
(or (boundp sym) (fboundp sym)
|
||
(symbol-plist sym))))))
|
||
(PC-not-minibuffer t))
|
||
;; 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.
|
||
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 '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.
|
||
|
||
(defun PC-look-for-include-file ()
|
||
(if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name))
|
||
(let ((name (substring (buffer-file-name)
|
||
(match-beginning 1) (match-end 1)))
|
||
(punc (aref (buffer-file-name) (match-beginning 0)))
|
||
(path nil)
|
||
new-buf)
|
||
(kill-buffer (current-buffer))
|
||
(if (equal name "")
|
||
(with-current-buffer (car (buffer-list))
|
||
(save-excursion
|
||
(beginning-of-line)
|
||
(if (looking-at
|
||
"[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]")
|
||
(setq name (buffer-substring (match-beginning 1)
|
||
(match-end 1))
|
||
punc (char-after (1- (match-beginning 1))))
|
||
;; Suggested by Frank Siebenlist:
|
||
(if (or (looking-at
|
||
"[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"")
|
||
(looking-at
|
||
"[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"")
|
||
(looking-at
|
||
"[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]"))
|
||
(progn
|
||
(setq name (buffer-substring (match-beginning 1)
|
||
(match-end 1))
|
||
punc ?\<
|
||
path load-path)
|
||
(if (string-match "\\.elc$" name)
|
||
(setq name (substring name 0 -1))
|
||
(or (string-match "\\.el$" name)
|
||
(setq name (concat name ".el")))))
|
||
(error "Not on an #include line"))))))
|
||
(or (string-match "\\.[[:alnum:]]+$" name)
|
||
(setq name (concat name ".h")))
|
||
(if (eq punc ?\<)
|
||
(let ((path (or path (PC-include-file-path))))
|
||
(while (and path
|
||
(not (file-exists-p
|
||
(concat (file-name-as-directory (car path))
|
||
name))))
|
||
(setq path (cdr path)))
|
||
(if path
|
||
(setq name (concat (file-name-as-directory (car path)) name))
|
||
(error "No such include file: <%s>" name)))
|
||
(let ((dir (with-current-buffer (car (buffer-list))
|
||
default-directory)))
|
||
(if (file-exists-p (concat dir name))
|
||
(setq name (concat dir 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)
|
||
(set-buffer (create-file-buffer name))
|
||
(erase-buffer)
|
||
(insert-file-contents name t))
|
||
;; Returning non-nil with the new buffer current
|
||
;; is sufficient to tell find-file to use it.
|
||
t)
|
||
nil))
|
||
|
||
(defun PC-include-file-path ()
|
||
(or PC-include-file-path
|
||
(let ((env (getenv "INCPATH"))
|
||
(path nil)
|
||
pos)
|
||
(or env (error "No include file path specified"))
|
||
(while (setq pos (string-match ":[^:]+$" env))
|
||
(setq path (cons (substring env (1+ pos)) path)
|
||
env (substring env 0 pos)))
|
||
path)))
|
||
|
||
;; 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
|
||
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))
|
||
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-nondirectory file) (file-name-directory file)))
|
||
(let ((subdir (file-name-directory file))
|
||
(ndfile (file-name-nondirectory file))
|
||
file-lists)
|
||
;; Append subdirectory part to each element of search-path
|
||
(if subdir
|
||
(setq search-path
|
||
(mapcar (lambda (dir) (concat dir subdir))
|
||
search-path)
|
||
file ))
|
||
;; Make list of completions in each directory on search-path
|
||
(while search-path
|
||
(let* ((dir (car search-path))
|
||
(subdir (if full dir subdir)))
|
||
(if (file-directory-p dir)
|
||
(progn
|
||
(setq file-lists
|
||
(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)))))
|
||
compressed)
|
||
(while sorted
|
||
(if (equal (car sorted) (car compressed)) nil
|
||
(setq compressed (cons (car sorted) compressed)))
|
||
(setq sorted (cdr sorted)))
|
||
compressed))))
|
||
|
||
(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 (if (string-match "/\\'" x) "<%s" "<%s>") x))
|
||
(PC-include-file-all-completions
|
||
name (PC-include-file-path)))))
|
||
(cond
|
||
((not completion-table) nil)
|
||
((eq action 'lambda) (test-completion str2 completion-table nil))
|
||
((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)))
|
||
|
||
|
||
(provide 'complete)
|
||
|
||
;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458
|
||
;;; complete.el ends here
|