|
3725
|
1 ;; complete.el -- partial completion mechanism plus other goodies.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Author: Dave Gillespie <daveg@synaptics.com>
|
|
|
6 ;; Version: 2.02
|
|
|
7 ;; Special thanks to Hallvard Furuseth for his many ideas and contributions.
|
|
|
8
|
|
|
9 ;; This file is part of GNU Emacs.
|
|
|
10
|
|
|
11 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
12 ;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
|
13 ;; accepts responsibility to anyone for the consequences of using it
|
|
|
14 ;; or for whether it serves any particular purpose or works at all,
|
|
|
15 ;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
|
16 ;; License for full details.
|
|
|
17
|
|
|
18 ;; Everyone is granted permission to copy, modify and redistribute
|
|
|
19 ;; GNU Emacs, but only under the conditions described in the
|
|
|
20 ;; GNU Emacs General Public License. A copy of this license is
|
|
|
21 ;; supposed to have been given to you along with GNU Emacs so you
|
|
|
22 ;; can know your rights and responsibilities. It should be in a
|
|
|
23 ;; file named COPYING. Among other things, the copyright notice
|
|
|
24 ;; and this notice must be preserved on all copies.
|
|
|
25
|
|
|
26
|
|
|
27 ;; Commentary:
|
|
|
28
|
|
|
29 ;; Extended completion for the Emacs minibuffer.
|
|
|
30 ;;
|
|
|
31 ;; The basic idea is that the command name or other completable text is
|
|
|
32 ;; divided into words and each word is completed separately, so that
|
|
|
33 ;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous
|
|
|
34 ;; each word is completed as much as possible and then the cursor is
|
|
|
35 ;; left at the first position where typing another letter will resolve
|
|
|
36 ;; the ambiguity.
|
|
|
37 ;;
|
|
|
38 ;; Word separators for this purpose are hyphen, space, and period.
|
|
|
39 ;; These would most likely occur in command names, Info menu items,
|
|
|
40 ;; and file names, respectively. But all word separators are treated
|
|
|
41 ;; alike at all times.
|
|
|
42 ;;
|
|
|
43 ;; This completion package replaces the old-style completer's key
|
|
|
44 ;; bindings for TAB, SPC, RET, and `?'. The old completer is still
|
|
|
45 ;; available on the Meta versions of those keys. If you set
|
|
|
46 ;; PC-meta-flag to nil, the old completion keys will be left alone
|
|
|
47 ;; and the partial completer will use the Meta versions of the keys.
|
|
|
48
|
|
|
49
|
|
|
50 ;; Usage: Load this file. Now, during completable minibuffer entry,
|
|
|
51 ;;
|
|
|
52 ;; TAB means to do a partial completion;
|
|
|
53 ;; SPC means to do a partial complete-word;
|
|
|
54 ;; RET means to do a partial complete-and-exit;
|
|
|
55 ;; ? means to do a partial completion-help.
|
|
|
56 ;;
|
|
|
57 ;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform
|
|
|
58 ;; original Emacs completions, and M-TAB etc. do partial completion.
|
|
|
59 ;; To do this, put the command,
|
|
|
60 ;;
|
|
|
61 ;; (setq PC-meta-flag nil)
|
|
|
62 ;;
|
|
|
63 ;; in your .emacs file. To load partial completion automatically, put
|
|
|
64 ;;
|
|
|
65 ;; (load "complete")
|
|
|
66 ;;
|
|
|
67 ;; in your .emacs file, too. Things will be faster if you byte-compile
|
|
|
68 ;; this file when you install it.
|
|
|
69 ;;
|
|
|
70 ;; As an extra feature, in cases where RET would not normally
|
|
|
71 ;; complete (such as `C-x b'), the M-RET key will always do a partial
|
|
|
72 ;; complete-and-exit. Thus `C-x b f.c RET' will select or create a
|
|
|
73 ;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing
|
|
|
74 ;; buffer whose name matches that pattern (perhaps "filing.c").
|
|
|
75 ;; (PC-meta-flag does not affect this behavior; M-RET used to be
|
|
|
76 ;; undefined in this situation.)
|
|
|
77 ;;
|
|
|
78 ;; The regular M-TAB (lisp-complete-symbol) command also supports
|
|
|
79 ;; partial completion in this package.
|
|
|
80
|
|
|
81 ;; This package also contains a wildcard feature for C-x C-f (find-file).
|
|
|
82 ;; For example, `C-x C-f *.c RET' loads all .c files at once, exactly
|
|
|
83 ;; as if you had typed C-x C-f separately for each file. Completion
|
|
|
84 ;; is supported in connection with wildcards. Currently only the `*'
|
|
|
85 ;; wildcard character works.
|
|
|
86
|
|
|
87 ;; File name completion does not do partial completion of directories
|
|
|
88 ;; on the path, e.g., "/u/b/f" will not complete to "/usr/bin/foo",
|
|
|
89 ;; but you can put *'s in the path to accomplish this: "/u*/b*/f".
|
|
|
90 ;; Stars are required for performance reasons.
|
|
|
91
|
|
|
92 ;; In addition, this package includes a feature for accessing include
|
|
|
93 ;; files. For example, `C-x C-f <sys/time.h> RET' reads the file
|
|
|
94 ;; /usr/include/sys/time.h. The variable PC-include-file-path is a
|
|
|
95 ;; list of directories in which to search for include files. Completion
|
|
|
96 ;; is supported in include file names.
|
|
|
97
|
|
|
98
|
|
|
99 ;; Code:
|
|
|
100
|
|
|
101 (defvar PC-meta-flag t
|
|
|
102 "*If nil, TAB does normal Emacs completion and M-TAB does Partial Completion.
|
|
|
103 If t, TAB does Partial Completion and M-TAB does normal completion.")
|
|
|
104
|
|
|
105
|
|
|
106 (defvar PC-word-delimiters "-_. "
|
|
|
107 "*A string of characters which are to be treated as word delimiters
|
|
|
108 by the Partial Completion system.
|
|
|
109
|
|
|
110 Some arcane rules: If `]' is in this string it must come first.
|
|
|
111 If `^' is in this string it must NOT come first. If `-' is in this
|
|
|
112 string, it must come first or right after `]'. In other words, if
|
|
|
113 S is this string, then `[S]' must be a legal Emacs regular expression
|
|
|
114 (not containing character ranges like `a-z').")
|
|
|
115
|
|
|
116
|
|
|
117 (defvar PC-first-char 'x
|
|
|
118 "*If t, first character of a string to be completed is always taken literally.
|
|
|
119 If nil, word delimiters are handled even if they appear as first character.
|
|
|
120 This controls whether \".e\" matches \".e*\" (t) or \"*.e*\" (nil).
|
|
|
121 If neither nil nor t, first char is literal only for filename completion.")
|
|
|
122
|
|
|
123
|
|
|
124 (defvar PC-include-file-path '("/usr/include")
|
|
|
125 "*List of directories in which to look for include files.
|
|
|
126 If this is nil, uses the colon-separated path in $INCPATH instead.")
|
|
|
127
|
|
|
128
|
|
|
129 (defvar PC-disable-wildcards nil
|
|
|
130 "Set this to non-nil to disable wildcard support in \\[find-file].")
|
|
|
131
|
|
|
132 (defvar PC-disable-includes nil
|
|
|
133 "Set this to non-nil to disable include-file support in \\[find-file].")
|
|
|
134
|
|
|
135
|
|
|
136 (defvar PC-default-bindings t
|
|
|
137 "Set this to nil to suppress the default partial completion key bindings.")
|
|
|
138
|
|
|
139 (if PC-default-bindings (progn
|
|
|
140 (define-key minibuffer-local-completion-map "\t" 'PC-complete)
|
|
|
141 (define-key minibuffer-local-completion-map " " 'PC-complete-word)
|
|
|
142 (define-key minibuffer-local-completion-map "?" 'PC-completion-help)
|
|
|
143
|
|
|
144 (define-key minibuffer-local-completion-map "\e\t" 'PC-complete)
|
|
|
145 (define-key minibuffer-local-completion-map "\e " 'PC-complete-word)
|
|
|
146 (define-key minibuffer-local-completion-map "\e\r" 'PC-force-complete-and-exit)
|
|
|
147 (define-key minibuffer-local-completion-map "\e\n" 'PC-force-complete-and-exit)
|
|
|
148 (define-key minibuffer-local-completion-map "\e?" 'PC-completion-help)
|
|
|
149
|
|
|
150 (define-key minibuffer-local-must-match-map "\t" 'PC-complete)
|
|
|
151 (define-key minibuffer-local-must-match-map " " 'PC-complete-word)
|
|
|
152 (define-key minibuffer-local-must-match-map "\r" 'PC-complete-and-exit)
|
|
|
153 (define-key minibuffer-local-must-match-map "\n" 'PC-complete-and-exit)
|
|
|
154 (define-key minibuffer-local-must-match-map "?" 'PC-completion-help)
|
|
|
155
|
|
|
156 (define-key minibuffer-local-must-match-map "\e\t" 'PC-complete)
|
|
|
157 (define-key minibuffer-local-must-match-map "\e " 'PC-complete-word)
|
|
|
158 (define-key minibuffer-local-must-match-map "\e\r" 'PC-complete-and-exit)
|
|
|
159 (define-key minibuffer-local-must-match-map "\e\n" 'PC-complete-and-exit)
|
|
|
160 (define-key minibuffer-local-must-match-map "\e?" 'PC-completion-help)
|
|
|
161
|
|
|
162 (define-key global-map "\e\t" 'PC-lisp-complete-symbol)
|
|
|
163 ))
|
|
|
164
|
|
|
165
|
|
|
166 (defun PC-complete ()
|
|
|
167 "Like minibuffer-complete, but allows \"b--di\"-style abbreviations.
|
|
|
168 For example, \"M-x b--di\" would match `byte-recompile-directory', or any
|
|
|
169 name which consists of three or more words, the first beginning with \"b\"
|
|
|
170 and the third beginning with \"di\".
|
|
|
171
|
|
|
172 The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and
|
|
|
173 `beginning-of-defun', so this would produce a list of completions
|
|
|
174 just like when normal Emacs completions are ambiguous.
|
|
|
175
|
|
|
176 Word-delimiters for the purposes of Partial Completion are \"-\", \"_\",
|
|
|
177 \".\", and SPC."
|
|
|
178 (interactive)
|
|
|
179 (if (PC-was-meta-key)
|
|
|
180 (minibuffer-complete)
|
|
|
181 (PC-do-completion nil)))
|
|
|
182
|
|
|
183
|
|
|
184 (defun PC-complete-word ()
|
|
|
185 "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations.
|
|
|
186 See `PC-complete' for details.
|
|
|
187 This can be bound to other keys, like `-' and `.', if you wish."
|
|
|
188 (interactive)
|
|
|
189 (if (eq (PC-was-meta-key) PC-meta-flag)
|
|
|
190 (if (eq last-command-char ? )
|
|
|
191 (minibuffer-complete-word)
|
|
|
192 (self-insert-command 1))
|
|
|
193 (self-insert-command 1)
|
|
|
194 (if (eobp)
|
|
|
195 (PC-do-completion 'word))))
|
|
|
196
|
|
|
197
|
|
|
198 (defun PC-complete-space ()
|
|
|
199 "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations.
|
|
|
200 See `PC-complete' for details.
|
|
|
201 This is suitable for binding to other keys which should act just like SPC."
|
|
|
202 (interactive)
|
|
|
203 (if (eq (PC-was-meta-key) PC-meta-flag)
|
|
|
204 (minibuffer-complete-word)
|
|
|
205 (insert " ")
|
|
|
206 (if (eobp)
|
|
|
207 (PC-do-completion 'word))))
|
|
|
208
|
|
|
209
|
|
|
210 (defun PC-complete-and-exit ()
|
|
|
211 "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations.
|
|
|
212 See `PC-complete' for details."
|
|
|
213 (interactive)
|
|
|
214 (if (eq (PC-was-meta-key) PC-meta-flag)
|
|
|
215 (minibuffer-complete-and-exit)
|
|
|
216 (PC-do-complete-and-exit)))
|
|
|
217
|
|
|
218 (defun PC-force-complete-and-exit ()
|
|
|
219 "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations.
|
|
|
220 See `PC-complete' for details."
|
|
|
221 (interactive)
|
|
|
222 (let ((minibuffer-completion-confirm nil))
|
|
|
223 (PC-do-complete-and-exit)))
|
|
|
224
|
|
|
225 (defun PC-do-complete-and-exit ()
|
|
|
226 (if (= (buffer-size) 0) ; Duplicate the "bug" that Info-menu relies on...
|
|
|
227 (exit-minibuffer)
|
|
|
228 (let ((flag (PC-do-completion 'exit)))
|
|
|
229 (and flag
|
|
|
230 (if (or (eq flag 'complete)
|
|
|
231 (not minibuffer-completion-confirm))
|
|
|
232 (exit-minibuffer)
|
|
|
233 (PC-temp-minibuffer-message " (Confirm)"))))))
|
|
|
234
|
|
|
235
|
|
|
236 (defun PC-completion-help ()
|
|
|
237 "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations.
|
|
|
238 See `PC-complete' for details."
|
|
|
239 (interactive)
|
|
|
240 (if (eq (PC-was-meta-key) PC-meta-flag)
|
|
|
241 (minibuffer-completion-help)
|
|
|
242 (PC-do-completion 'help)))
|
|
|
243
|
|
|
244 (defun PC-was-meta-key ()
|
|
|
245 (or (/= (length (this-command-keys)) 1)
|
|
|
246 (let ((key (aref (this-command-keys) 0)))
|
|
|
247 (if (integerp key)
|
|
|
248 (>= key 128)
|
|
|
249 (not (null (memq 'meta (event-modifiers key))))))))
|
|
|
250
|
|
|
251
|
|
|
252 (defvar PC-ignored-extensions 'empty-cache)
|
|
|
253 (defvar PC-delims 'empty-cache)
|
|
|
254 (defvar PC-ignored-regexp nil)
|
|
|
255 (defvar PC-word-failed-flag nil)
|
|
|
256 (defvar PC-delim-regex nil)
|
|
|
257 (defvar PC-ndelims-regex nil)
|
|
|
258 (defvar PC-delims-list nil)
|
|
|
259
|
|
|
260 (defun PC-do-completion (&optional mode beg end)
|
|
|
261 (or beg (setq beg (point-min)))
|
|
|
262 (or end (setq end (point-max)))
|
|
|
263 (let* ((table minibuffer-completion-table)
|
|
|
264 (pred minibuffer-completion-predicate)
|
|
|
265 (filename (memq table '(read-file-name-internal
|
|
|
266 read-directory-name-internal)))
|
|
|
267 (dirname nil)
|
|
|
268 (str (buffer-substring beg end))
|
|
|
269 (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str)))
|
|
|
270 (ambig nil)
|
|
|
271 basestr
|
|
|
272 regex
|
|
|
273 p offset
|
|
|
274 (poss nil)
|
|
|
275 helpposs
|
|
|
276 (case-fold-search completion-ignore-case))
|
|
|
277
|
|
|
278 ;; Check if buffer contents can already be considered complete
|
|
|
279 (if (and (eq mode 'exit)
|
|
|
280 (PC-is-complete-p str table pred))
|
|
|
281 'complete
|
|
|
282
|
|
|
283 ;; Do substitutions in directory names
|
|
|
284 (and filename
|
|
|
285 (not (equal str (setq p (substitute-in-file-name str))))
|
|
|
286 (progn
|
|
|
287 (delete-region beg end)
|
|
|
288 (insert p)
|
|
|
289 (setq str p end (+ beg (length str)))))
|
|
|
290
|
|
|
291 ;; Prepare various delimiter strings
|
|
|
292 (or (equal PC-word-delimiters PC-delims)
|
|
|
293 (setq PC-delims PC-word-delimiters
|
|
|
294 PC-delim-regex (concat "[" PC-delims "]")
|
|
|
295 PC-ndelims-regex (concat "[^" PC-delims "]*")
|
|
|
296 PC-delims-list (append PC-delims nil)))
|
|
|
297
|
|
|
298 ;; Look for wildcard expansions in directory name
|
|
|
299 (and filename
|
|
|
300 (string-match "\\*.*/" str)
|
|
|
301 (let ((pat str)
|
|
|
302 files)
|
|
|
303 (setq p (1+ (string-match "/[^/]*\\'" pat)))
|
|
|
304 (while (setq p (string-match PC-delim-regex pat p))
|
|
|
305 (setq pat (concat (substring pat 0 p)
|
|
|
306 "*"
|
|
|
307 (substring pat p))
|
|
|
308 p (+ p 2)))
|
|
|
309 (setq files (PC-expand-many-files (concat pat "*")))
|
|
|
310 (if files
|
|
|
311 (let ((dir (file-name-directory (car files)))
|
|
|
312 (p files))
|
|
|
313 (while (and (setq p (cdr p))
|
|
|
314 (equal dir (file-name-directory (car p)))))
|
|
|
315 (if p
|
|
|
316 (setq filename nil table nil pred nil
|
|
|
317 ambig t)
|
|
|
318 (delete-region beg end)
|
|
|
319 (setq str (concat dir (file-name-nondirectory str)))
|
|
|
320 (insert str)
|
|
|
321 (setq end (+ beg (length str)))))
|
|
|
322 (setq filename nil table nil pred nil))))
|
|
|
323
|
|
|
324 ;; Strip directory name if appropriate
|
|
|
325 (if filename
|
|
|
326 (if incname
|
|
|
327 (setq basestr (substring str incname)
|
|
|
328 dirname (substring str 0 incname))
|
|
|
329 (setq basestr (file-name-nondirectory str)
|
|
|
330 dirname (file-name-directory str)))
|
|
|
331 (setq basestr str))
|
|
|
332
|
|
|
333 ;; Convert search pattern to a standard regular expression
|
|
|
334 (setq regex (regexp-quote basestr)
|
|
|
335 offset (if (and (> (length regex) 0)
|
|
|
336 (not (eq (aref basestr 0) ?\*))
|
|
|
337 (or (eq PC-first-char t)
|
|
|
338 (and PC-first-char filename))) 1 0)
|
|
|
339 p offset)
|
|
|
340 (while (setq p (string-match PC-delim-regex regex p))
|
|
|
341 (if (eq (aref regex p) ? )
|
|
|
342 (setq regex (concat (substring regex 0 p)
|
|
|
343 PC-ndelims-regex
|
|
|
344 PC-delim-regex
|
|
|
345 (substring regex (1+ p)))
|
|
|
346 p (+ p (length PC-ndelims-regex) (length PC-delim-regex)))
|
|
|
347 (let ((bump (if (memq (aref regex p)
|
|
|
348 '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\))
|
|
|
349 -1 0)))
|
|
|
350 (setq regex (concat (substring regex 0 (+ p bump))
|
|
|
351 PC-ndelims-regex
|
|
|
352 (substring regex (+ p bump)))
|
|
|
353 p (+ p (length PC-ndelims-regex) 1)))))
|
|
|
354 (setq p 0)
|
|
|
355 (if filename
|
|
|
356 (while (setq p (string-match "\\\\\\*" regex p))
|
|
|
357 (setq regex (concat (substring regex 0 p)
|
|
|
358 "[^/]*"
|
|
|
359 (substring regex (+ p 2))))))
|
|
|
360 ;;(setq the-regex regex)
|
|
|
361 (setq regex (concat "\\`" regex))
|
|
|
362
|
|
|
363 ;; Find an initial list of possible completions
|
|
|
364 (if (not (setq p (string-match (concat PC-delim-regex
|
|
|
365 (if filename "\\|\\*" ""))
|
|
|
366 str
|
|
|
367 (+ (length dirname) offset))))
|
|
|
368
|
|
|
369 ;; Minibuffer contains no hyphens -- simple case!
|
|
|
370 (setq poss (all-completions str
|
|
|
371 table
|
|
|
372 pred))
|
|
|
373
|
|
|
374 ;; Use all-completions to do an initial cull. This is a big win,
|
|
|
375 ;; since all-completions is written in C!
|
|
|
376 (let ((compl (all-completions (substring str 0 p)
|
|
|
377 table
|
|
|
378 pred)))
|
|
|
379 (setq p compl)
|
|
|
380 (while p
|
|
|
381 (and (string-match regex (car p))
|
|
|
382 (setq poss (cons (car p) poss)))
|
|
|
383 (setq p (cdr p)))))
|
|
|
384
|
|
|
385 ;; Now we have a list of possible completions
|
|
|
386 (cond
|
|
|
387
|
|
|
388 ;; No valid completions found
|
|
|
389 ((null poss)
|
|
|
390 (if (and (eq mode 'word)
|
|
|
391 (not PC-word-failed-flag))
|
|
|
392 (let ((PC-word-failed-flag t))
|
|
|
393 (delete-backward-char 1)
|
|
|
394 (PC-do-completion 'word))
|
|
|
395 (beep)
|
|
|
396 (PC-temp-minibuffer-message (if ambig
|
|
|
397 " (Ambiguous dir name)"
|
|
|
398 (if (eq mode 'help)
|
|
|
399 " (No completions)"
|
|
|
400 " (No match)")))
|
|
|
401 nil))
|
|
|
402
|
|
|
403 ;; More than one valid completion found
|
|
|
404 ((or (cdr (setq helpposs poss))
|
|
|
405 (memq mode '(help word)))
|
|
|
406
|
|
|
407 ;; Handle completion-ignored-extensions
|
|
|
408 (and filename
|
|
|
409 (not (eq mode 'help))
|
|
|
410 (let ((p2 poss))
|
|
|
411
|
|
|
412 ;; Build a regular expression representing the extensions list
|
|
|
413 (or (equal completion-ignored-extensions PC-ignored-extensions)
|
|
|
414 (setq PC-ignored-regexp
|
|
|
415 (concat "\\("
|
|
|
416 (mapconcat
|
|
|
417 'regexp-quote
|
|
|
418 (setq PC-ignored-extensions
|
|
|
419 completion-ignored-extensions)
|
|
|
420 "\\|")
|
|
|
421 "\\)\\'")))
|
|
|
422
|
|
|
423 ;; Check if there are any without an ignored extension
|
|
|
424 (setq p nil)
|
|
|
425 (while p2
|
|
|
426 (or (string-match PC-ignored-regexp (car p2))
|
|
|
427 (setq p (cons (car p2) p)))
|
|
|
428 (setq p2 (cdr p2)))
|
|
|
429
|
|
|
430 ;; If there are "good" names, use them
|
|
|
431 (and p (setq poss p))))
|
|
|
432
|
|
|
433 ;; Is the actual string one of the possible completions?
|
|
|
434 (setq p (and (not (eq mode 'help)) poss))
|
|
|
435 (while (and p
|
|
|
436 (not (equal (car p) basestr)))
|
|
|
437 (setq p (cdr p)))
|
|
|
438 (if p
|
|
|
439
|
|
|
440 (progn
|
|
|
441 (if (null mode)
|
|
|
442 (PC-temp-minibuffer-message " (Complete, but not unique)"))
|
|
|
443 t)
|
|
|
444
|
|
|
445 ;; If ambiguous, try for a partial completion
|
|
|
446 (let ((improved nil)
|
|
|
447 prefix
|
|
|
448 (pt nil)
|
|
|
449 (skip "\\`"))
|
|
|
450
|
|
|
451 ;; Check if next few letters are the same in all cases
|
|
|
452 (if (and (not (eq mode 'help))
|
|
|
453 (setq prefix (try-completion "" (mapcar 'list poss))))
|
|
|
454 (let ((first t) i)
|
|
|
455 (if (eq mode 'word)
|
|
|
456 (setq prefix (PC-chop-word prefix basestr)))
|
|
|
457 (goto-char (+ beg (length dirname)))
|
|
|
458 (while (and (progn
|
|
|
459 (setq i 0)
|
|
|
460 (while (< i (length prefix))
|
|
|
461 (if (and (< (point) end)
|
|
|
462 (eq (aref prefix i)
|
|
|
463 (following-char)))
|
|
|
464 (forward-char 1)
|
|
|
465 (if (and (< (point) end)
|
|
|
466 (or (and (looking-at " ")
|
|
|
467 (memq (aref prefix i)
|
|
|
468 PC-delims-list))
|
|
|
469 (eq (downcase (aref prefix i))
|
|
|
470 (downcase
|
|
|
471 (following-char)))))
|
|
|
472 (progn
|
|
|
473 (delete-char 1)
|
|
|
474 (setq end (1- end)))
|
|
|
475 (and filename (looking-at "\\*")
|
|
|
476 (progn
|
|
|
477 (delete-char 1)
|
|
|
478 (setq end (1- end))))
|
|
|
479 (setq improved t))
|
|
|
480 (insert (substring prefix i (1+ i)))
|
|
|
481 (setq end (1+ end)))
|
|
|
482 (setq i (1+ i)))
|
|
|
483 (or pt (equal (point) beg)
|
|
|
484 (setq pt (point)))
|
|
|
485 (looking-at PC-delim-regex))
|
|
|
486 (setq skip (concat skip
|
|
|
487 (regexp-quote prefix)
|
|
|
488 PC-ndelims-regex)
|
|
|
489 prefix (try-completion
|
|
|
490 ""
|
|
|
491 (mapcar
|
|
|
492 (function
|
|
|
493 (lambda (x)
|
|
|
494 (list
|
|
|
495 (and (string-match skip x)
|
|
|
496 (substring
|
|
|
497 x
|
|
|
498 (match-end 0))))))
|
|
|
499 poss)))
|
|
|
500 (or (> i 0) (> (length prefix) 0))
|
|
|
501 (or (not (eq mode 'word))
|
|
|
502 (and first (> (length prefix) 0)
|
|
|
503 (setq first nil
|
|
|
504 prefix (substring prefix 0 1))))))
|
|
|
505 (goto-char (if (eq mode 'word) end
|
|
|
506 (or pt beg)))))
|
|
|
507
|
|
|
508 (if (and (eq mode 'word)
|
|
|
509 (not PC-word-failed-flag))
|
|
|
510
|
|
|
511 (if improved
|
|
|
512
|
|
|
513 ;; We changed it... would it be complete without the space?
|
|
|
514 (if (PC-is-complete-p (buffer-substring 1 (1- end))
|
|
|
515 table pred)
|
|
|
516 (delete-region (1- end) end)))
|
|
|
517
|
|
|
518 (if improved
|
|
|
519
|
|
|
520 ;; We changed it... enough to be complete?
|
|
|
521 (and (eq mode 'exit)
|
|
|
522 (PC-is-complete-p (buffer-string) table pred))
|
|
|
523
|
|
|
524 ;; If totally ambiguous, display a list of completions
|
|
|
525 (if (or completion-auto-help
|
|
|
526 (eq mode 'help))
|
|
|
527 (with-output-to-temp-buffer " *Completions*"
|
|
|
528 (display-completion-list (sort helpposs 'string-lessp)))
|
|
|
529 (PC-temp-minibuffer-message " (Next char not unique)"))
|
|
|
530 nil)))))
|
|
|
531
|
|
|
532 ;; Only one possible completion
|
|
|
533 (t
|
|
|
534 (if (equal basestr (car poss))
|
|
|
535 (if (null mode)
|
|
|
536 (PC-temp-minibuffer-message " (Sole completion)"))
|
|
|
537 (delete-region beg end)
|
|
|
538 (insert (if filename
|
|
|
539 (substitute-in-file-name (concat dirname (car poss)))
|
|
|
540 (car poss))))
|
|
|
541 t)))))
|
|
|
542
|
|
|
543
|
|
|
544 (defun PC-is-complete-p (str table pred)
|
|
|
545 (let ((res (if (listp table)
|
|
|
546 (assoc str table)
|
|
|
547 (if (vectorp table)
|
|
|
548 (or (equal str "nil") ; heh, heh, heh
|
|
|
549 (intern-soft str table))
|
|
|
550 (funcall table str pred 'lambda)))))
|
|
|
551 (and res
|
|
|
552 (or (not pred)
|
|
|
553 (and (not (listp table)) (not (vectorp table)))
|
|
|
554 (funcall pred res))
|
|
|
555 res)))
|
|
|
556
|
|
|
557 (defun PC-chop-word (new old)
|
|
|
558 (let ((i -1)
|
|
|
559 (j -1))
|
|
|
560 (while (and (setq i (string-match PC-delim-regex old (1+ i)))
|
|
|
561 (setq j (string-match PC-delim-regex new (1+ j)))))
|
|
|
562 (if (and j
|
|
|
563 (or (not PC-word-failed-flag)
|
|
|
564 (setq j (string-match PC-delim-regex new (1+ j)))))
|
|
|
565 (substring new 0 (1+ j))
|
|
|
566 new)))
|
|
|
567
|
|
|
568 (defvar PC-not-minibuffer nil)
|
|
|
569
|
|
|
570 (defun PC-temp-minibuffer-message (m)
|
|
|
571 "A Lisp version of `temp_minibuffer_message' from minibuf.c."
|
|
|
572 (if PC-not-minibuffer
|
|
|
573 (progn
|
|
|
574 (message m)
|
|
|
575 (sit-for 2)
|
|
|
576 (message ""))
|
|
|
577 (if (fboundp 'temp-minibuffer-message)
|
|
|
578 (temp-minibuffer-message m)
|
|
|
579 (let ((savemax (point-max)))
|
|
|
580 (save-excursion
|
|
|
581 (goto-char (point-max))
|
|
|
582 (insert m))
|
|
|
583 (let ((inhibit-quit t))
|
|
|
584 (sit-for 2)
|
|
|
585 (delete-region savemax (point-max))
|
|
|
586 (if quit-flag
|
|
|
587 (setq quit-flag nil
|
|
|
588 unread-command-char 7)))))))
|
|
|
589
|
|
|
590
|
|
|
591 (defun PC-lisp-complete-symbol ()
|
|
|
592 "Perform completion on Lisp symbol preceding point.
|
|
|
593 That symbol is compared against the symbols that exist
|
|
|
594 and any additional characters determined by what is there
|
|
|
595 are inserted.
|
|
|
596 If the symbol starts just after an open-parenthesis,
|
|
|
597 only symbols with function definitions are considered.
|
|
|
598 Otherwise, all symbols with function definitions, values
|
|
|
599 or properties are considered."
|
|
|
600 (interactive)
|
|
|
601 (let* ((end (point))
|
|
|
602 (buffer-syntax (syntax-table))
|
|
|
603 (beg (unwind-protect
|
|
|
604 (save-excursion
|
|
|
605 (if lisp-mode-syntax-table
|
|
|
606 (set-syntax-table lisp-mode-syntax-table))
|
|
|
607 (backward-sexp 1)
|
|
|
608 (while (= (char-syntax (following-char)) ?\')
|
|
|
609 (forward-char 1))
|
|
|
610 (point))
|
|
|
611 (set-syntax-table buffer-syntax)))
|
|
|
612 (minibuffer-completion-table obarray)
|
|
|
613 (minibuffer-completion-predicate
|
|
|
614 (if (eq (char-after (1- beg)) ?\()
|
|
|
615 'fboundp
|
|
|
616 (function (lambda (sym)
|
|
|
617 (or (boundp sym) (fboundp sym)
|
|
|
618 (symbol-plist sym))))))
|
|
|
619 (PC-not-minibuffer t))
|
|
|
620 (PC-do-completion nil beg end)))
|
|
|
621
|
|
|
622
|
|
|
623 ;;; Wildcards in `C-x C-f' command. This is independent from the main
|
|
|
624 ;;; completion code, except for `PC-expand-many-files' which is called
|
|
|
625 ;;; when "*"'s are found in the path during filename completion. (The
|
|
|
626 ;;; above completion code always understands "*"'s, except in file paths,
|
|
|
627 ;;; without relying on the following code.)
|
|
|
628
|
|
|
629 (defvar PC-many-files-list nil)
|
|
|
630
|
|
|
631 (defun PC-try-load-many-files ()
|
|
|
632 (if (string-match "\\*" buffer-file-name)
|
|
|
633 (let* ((pat buffer-file-name)
|
|
|
634 (files (PC-expand-many-files pat))
|
|
|
635 (first (car files))
|
|
|
636 (next files))
|
|
|
637 (kill-buffer (current-buffer))
|
|
|
638 (or files
|
|
|
639 (error "No matching files"))
|
|
|
640 (save-window-excursion
|
|
|
641 (while (setq next (cdr next))
|
|
|
642 (let ((buf (find-file-noselect (car next))))
|
|
|
643 (switch-to-buffer buf))))
|
|
|
644 ;; This modifies the "buf" variable inside find-file-noselect.
|
|
|
645 (setq buf (get-file-buffer first))
|
|
|
646 (if buf
|
|
|
647 nil ; should do verify-visited-file-modtime stuff.
|
|
|
648 (setq filename first)
|
|
|
649 (setq buf (create-file-buffer filename))
|
|
|
650 (set-buffer buf)
|
|
|
651 (erase-buffer)
|
|
|
652 (insert-file-contents filename t))
|
|
|
653 (if (cdr files)
|
|
|
654 (setq PC-many-files-list (mapconcat
|
|
|
655 (if (string-match "\\*.*/" pat)
|
|
|
656 'identity
|
|
|
657 'file-name-nondirectory)
|
|
|
658 (cdr files) ", ")
|
|
|
659 find-file-hooks (cons 'PC-after-load-many-files
|
|
|
660 find-file-hooks)))
|
|
|
661 ;; This modifies the "error" variable inside find-file-noselect.
|
|
|
662 (setq error nil)
|
|
|
663 t)
|
|
|
664 nil))
|
|
|
665
|
|
|
666 (defun PC-after-load-many-files ()
|
|
|
667 (setq find-file-hooks (delq 'PC-after-load-many-files find-file-hooks))
|
|
|
668 (message "Also loaded %s." PC-many-files-list))
|
|
|
669
|
|
|
670 (defun PC-expand-many-files (name)
|
|
|
671 (save-excursion
|
|
|
672 (set-buffer (generate-new-buffer " *Glob Output*"))
|
|
|
673 (erase-buffer)
|
|
|
674 (shell-command (concat "echo " name) t)
|
|
|
675 (goto-char (point-min))
|
|
|
676 (if (looking-at ".*No match")
|
|
|
677 nil
|
|
|
678 (insert "(\"")
|
|
|
679 (while (search-forward " " nil t)
|
|
|
680 (delete-backward-char 1)
|
|
|
681 (insert "\" \""))
|
|
|
682 (goto-char (point-max))
|
|
|
683 (delete-backward-char 1)
|
|
|
684 (insert "\")")
|
|
|
685 (goto-char (point-min))
|
|
|
686 (let ((files (read (current-buffer))))
|
|
|
687 (kill-buffer (current-buffer))
|
|
|
688 files))))
|
|
|
689
|
|
|
690 (or PC-disable-wildcards
|
|
|
691 (memq 'PC-try-load-many-files find-file-not-found-hooks)
|
|
|
692 (setq find-file-not-found-hooks (cons 'PC-try-load-many-files
|
|
|
693 find-file-not-found-hooks)))
|
|
|
694
|
|
|
695
|
|
|
696
|
|
|
697 ;;; Facilities for loading C header files. This is independent from the
|
|
|
698 ;;; main completion code. See also the variable `PC-include-file-path'
|
|
|
699 ;;; at top of this file.
|
|
|
700
|
|
|
701 (defun PC-look-for-include-file ()
|
|
|
702 (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name))
|
|
|
703 (let ((name (substring (buffer-file-name)
|
|
|
704 (match-beginning 1) (match-end 1)))
|
|
|
705 (punc (aref (buffer-file-name) (match-beginning 0)))
|
|
|
706 (path nil)
|
|
|
707 new-buf)
|
|
|
708 (kill-buffer (current-buffer))
|
|
|
709 (if (equal name "")
|
|
|
710 (save-excursion
|
|
|
711 (set-buffer (car (buffer-list)))
|
|
|
712 (save-excursion
|
|
|
713 (beginning-of-line)
|
|
|
714 (if (looking-at
|
|
|
715 "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]")
|
|
|
716 (setq name (buffer-substring (match-beginning 1)
|
|
|
717 (match-end 1))
|
|
|
718 punc (char-after (1- (match-beginning 1))))
|
|
|
719 ;; Suggested by Frank Siebenlist:
|
|
|
720 (if (or (looking-at
|
|
|
721 "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"")
|
|
|
722 (looking-at
|
|
|
723 "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"")
|
|
|
724 (looking-at
|
|
|
725 "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]"))
|
|
|
726 (progn
|
|
|
727 (setq name (buffer-substring (match-beginning 1)
|
|
|
728 (match-end 1))
|
|
|
729 punc ?\<
|
|
|
730 path load-path)
|
|
|
731 (if (string-match "\\.elc$" name)
|
|
|
732 (setq name (substring name 0 -1))
|
|
|
733 (or (string-match "\\.el$" name)
|
|
|
734 (setq name (concat name ".el")))))
|
|
|
735 (error "Not on an #include line"))))))
|
|
|
736 (or (string-match "\\.[a-zA-Z0-9]+$" name)
|
|
|
737 (setq name (concat name ".h")))
|
|
|
738 (if (eq punc ?\<)
|
|
|
739 (let ((path (or path (PC-include-file-path))))
|
|
|
740 (while (and path
|
|
|
741 (not (file-exists-p
|
|
|
742 (concat (file-name-as-directory (car path))
|
|
|
743 name))))
|
|
|
744 (setq path (cdr path)))
|
|
|
745 (if path
|
|
|
746 (setq name (concat (file-name-as-directory (car path)) name))
|
|
|
747 (error "No such include file: <%s>" name)))
|
|
|
748 (let ((dir (save-excursion
|
|
|
749 (set-buffer (car (buffer-list)))
|
|
|
750 default-directory)))
|
|
|
751 (if (file-exists-p (concat dir name))
|
|
|
752 (setq name (concat dir name))
|
|
|
753 (error "No such include file: \"%s\"" name))))
|
|
|
754 (setq new-buf (get-file-buffer name))
|
|
|
755 (if new-buf
|
|
|
756 ;; no need to verify last-modified time for this!
|
|
|
757 (set-buffer new-buf)
|
|
|
758 (setq new-buf (create-file-buffer name))
|
|
|
759 (set-buffer new-buf)
|
|
|
760 (erase-buffer)
|
|
|
761 (insert-file-contents name t))
|
|
|
762 (setq filename name
|
|
|
763 error nil
|
|
|
764 buf new-buf)
|
|
|
765 t)
|
|
|
766 nil))
|
|
|
767
|
|
|
768 (defun PC-include-file-path ()
|
|
|
769 (or PC-include-file-path
|
|
|
770 (let ((env (getenv "INCPATH"))
|
|
|
771 (path nil)
|
|
|
772 pos)
|
|
|
773 (or env (error "No include file path specified"))
|
|
|
774 (while (setq pos (string-match ":[^:]+$" env))
|
|
|
775 (setq path (cons (substring env (1+ pos)) path)
|
|
|
776 env (substring env 0 pos)))
|
|
|
777 path)))
|
|
|
778
|
|
|
779 ;;; This is adapted from lib-complete.el, by Mike Williams.
|
|
|
780 (defun PC-include-file-all-completions (file search-path &optional full)
|
|
|
781 "Return all completions for FILE in any directory on SEARCH-PATH.
|
|
|
782 If optional third argument FULL is non-nil, returned pathnames should be
|
|
|
783 absolute rather than relative to some directory on the SEARCH-PATH."
|
|
|
784 (setq search-path
|
|
|
785 (mapcar '(lambda (dir)
|
|
|
786 (if dir (file-name-as-directory dir) default-directory))
|
|
|
787 search-path))
|
|
|
788 (if (file-name-absolute-p file)
|
|
|
789 ;; It's an absolute file name, so don't need search-path
|
|
|
790 (progn
|
|
|
791 (setq file (expand-file-name file))
|
|
|
792 (file-name-all-completions
|
|
|
793 (file-name-nondirectory file) (file-name-directory file)))
|
|
|
794 (let ((subdir (file-name-directory file))
|
|
|
795 (ndfile (file-name-nondirectory file))
|
|
|
796 file-lists)
|
|
|
797 ;; Append subdirectory part to each element of search-path
|
|
|
798 (if subdir
|
|
|
799 (setq search-path
|
|
|
800 (mapcar '(lambda (dir) (concat dir subdir))
|
|
|
801 search-path)
|
|
|
802 file ))
|
|
|
803 ;; Make list of completions in each directory on search-path
|
|
|
804 (while search-path
|
|
|
805 (let* ((dir (car search-path))
|
|
|
806 (subdir (if full dir subdir)))
|
|
|
807 (if (file-directory-p dir)
|
|
|
808 (progn
|
|
|
809 (setq file-lists
|
|
|
810 (cons
|
|
|
811 (mapcar '(lambda (file) (concat subdir file))
|
|
|
812 (file-name-all-completions ndfile
|
|
|
813 (car search-path)))
|
|
|
814 file-lists))))
|
|
|
815 (setq search-path (cdr search-path))))
|
|
|
816 ;; Compress out duplicates while building complete list (slloooow!)
|
|
|
817 (let ((sorted (sort (apply 'nconc file-lists)
|
|
|
818 '(lambda (x y) (not (string-lessp x y)))))
|
|
|
819 compressed)
|
|
|
820 (while sorted
|
|
|
821 (if (equal (car sorted) (car compressed)) nil
|
|
|
822 (setq compressed (cons (car sorted) compressed)))
|
|
|
823 (setq sorted (cdr sorted)))
|
|
|
824 compressed))))
|
|
|
825
|
|
|
826 (defvar PC-old-read-file-name-internal nil)
|
|
|
827
|
|
|
828 (defun PC-read-include-file-name-internal (string dir action)
|
|
|
829 (if (string-match "<\\([^\"<>]*\\)>?$" string)
|
|
|
830 (let* ((name (substring string (match-beginning 1) (match-end 1)))
|
|
|
831 (str2 (substring string (match-beginning 0)))
|
|
|
832 (completion-table
|
|
|
833 (mapcar (function (lambda (x) (list (format "<%s>" x))))
|
|
|
834 (PC-include-file-all-completions
|
|
|
835 name (PC-include-file-path)))))
|
|
|
836 (cond
|
|
|
837 ((not completion-table) nil)
|
|
|
838 ((eq action nil) (try-completion str2 completion-table nil))
|
|
|
839 ((eq action t) (all-completions str2 completion-table nil))
|
|
|
840 ((eq action 'lambda)
|
|
|
841 (eq (try-completion str2 completion-table nil) t))))
|
|
|
842 (funcall PC-old-read-file-name-internal string dir action)))
|
|
|
843
|
|
|
844 (or PC-disable-includes
|
|
|
845 (memq 'PC-look-for-include-file find-file-not-found-hooks)
|
|
|
846 (setq find-file-not-found-hooks (cons 'PC-look-for-include-file
|
|
|
847 find-file-not-found-hooks)))
|
|
|
848
|
|
|
849 (or PC-disable-includes
|
|
|
850 PC-old-read-file-name-internal
|
|
|
851 (progn
|
|
|
852 (setq PC-old-read-file-name-internal
|
|
|
853 (symbol-function 'read-file-name-internal))
|
|
|
854 (fset 'read-file-name-internal 'PC-read-include-file-name-internal)))
|
|
|
855
|
|
|
856
|
|
|
857 (provide 'complete)
|
|
|
858
|
|
|
859 ;;; End.
|
