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