Commit | Line | Data |
---|---|---|
b035a678 | 1 | ;;; complete.el --- partial completion mechanism plus other goodies |
b545bfe6 | 2 | |
932fb767 | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2003, 2005 |
356b1352 | 4 | ;; Free Software Foundation, Inc. |
b545bfe6 JB |
5 | |
6 | ;; Author: Dave Gillespie <daveg@synaptics.com> | |
f5f727f8 | 7 | ;; Keywords: abbrev convenience |
b545bfe6 JB |
8 | ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
59243403 RS |
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
b545bfe6 | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
b545bfe6 | 21 | |
59243403 | 22 | ;; You should have received a copy of the GNU General Public License |
b578f267 EN |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
b545bfe6 | 26 | |
07b3798c | 27 | ;;; Commentary: |
b545bfe6 JB |
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 | ||
7117761b | 50 | ;; Usage: M-x partial-completion-mode. During completable minibuffer entry, |
b545bfe6 JB |
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 | ;; | |
7117761b | 65 | ;; (partial-completion-mode t) |
b545bfe6 JB |
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 | ||
b545bfe6 JB |
81 | ;; In addition, this package includes a feature for accessing include |
82 | ;; files. For example, `C-x C-f <sys/time.h> RET' reads the file | |
83 | ;; /usr/include/sys/time.h. The variable PC-include-file-path is a | |
84 | ;; list of directories in which to search for include files. Completion | |
85 | ;; is supported in include file names. | |
86 | ||
87 | ||
07b3798c | 88 | ;;; Code: |
b545bfe6 | 89 | |
92677e25 SM |
90 | (defgroup partial-completion nil |
91 | "Partial Completion of items." | |
92 | :prefix "pc-" | |
f5f727f8 DN |
93 | :group 'minibuffer |
94 | :group 'convenience) | |
92677e25 | 95 | |
92677e25 SM |
96 | (defcustom PC-first-char 'find-file |
97 | "*Control how the first character of a string is to be interpreted. | |
98 | If nil, the first character of a string is not taken literally if it is a word | |
99 | delimiter, so that \".e\" matches \"*.e*\". | |
100 | If t, the first character of a string is always taken literally even if it is a | |
101 | word delimiter, so that \".e\" matches \".e*\". | |
102 | If non-nil and non-t, the first character is taken literally only for file name | |
103 | completion." | |
104 | :type '(choice (const :tag "delimiter" nil) | |
105 | (const :tag "literal" t) | |
45200424 | 106 | (other :tag "find-file" find-file)) |
92677e25 SM |
107 | :group 'partial-completion) |
108 | ||
109 | (defcustom PC-meta-flag t | |
110 | "*If non-nil, TAB means PC completion and M-TAB means normal completion. | |
111 | Otherwise, TAB means normal completion and M-TAB means Partial Completion." | |
112 | :type 'boolean | |
113 | :group 'partial-completion) | |
114 | ||
115 | (defcustom PC-word-delimiters "-_. " | |
116 | "*A string of characters treated as word delimiters for completion. | |
117 | Some arcane rules: | |
118 | If `]' is in this string, it must come first. | |
119 | If `^' is in this string, it must not come first. | |
120 | If `-' is in this string, it must come first or right after `]'. | |
932fb767 | 121 | In other words, if S is this string, then `[S]' must be a valid Emacs regular |
92677e25 SM |
122 | expression (not containing character ranges like `a-z')." |
123 | :type 'string | |
124 | :group 'partial-completion) | |
125 | ||
126 | (defcustom PC-include-file-path '("/usr/include" "/usr/local/include") | |
127 | "*A list of directories in which to look for include files. | |
128 | If nil, means use the colon-separated path in the variable $INCPATH instead." | |
129 | :type '(repeat directory) | |
130 | :group 'partial-completion) | |
131 | ||
92677e25 SM |
132 | (defcustom PC-disable-includes nil |
133 | "*If non-nil, include-file support in \\[find-file] is disabled." | |
134 | :type 'boolean | |
135 | :group 'partial-completion) | |
b545bfe6 JB |
136 | |
137 | (defvar PC-default-bindings t | |
92677e25 | 138 | "If non-nil, default partial completion key bindings are suppressed.") |
356b1352 GM |
139 | |
140 | (defvar PC-env-vars-alist nil | |
141 | "A list of the environment variable names and values.") | |
142 | ||
92677e25 SM |
143 | \f |
144 | (defvar PC-old-read-file-name-internal nil) | |
b545bfe6 | 145 | |
92677e25 SM |
146 | (defun PC-bindings (bind) |
147 | (let ((completion-map minibuffer-local-completion-map) | |
148 | (must-match-map minibuffer-local-must-match-map)) | |
149 | (cond ((not bind) | |
150 | ;; These bindings are the default bindings. It would be better to | |
151 | ;; restore the previous bindings. | |
152 | (define-key completion-map "\t" 'minibuffer-complete) | |
153 | (define-key completion-map " " 'minibuffer-complete-word) | |
154 | (define-key completion-map "?" 'minibuffer-completion-help) | |
155 | ||
156 | (define-key must-match-map "\t" 'minibuffer-complete) | |
157 | (define-key must-match-map " " 'minibuffer-complete-word) | |
158 | (define-key must-match-map "\r" 'minibuffer-complete-and-exit) | |
159 | (define-key must-match-map "\n" 'minibuffer-complete-and-exit) | |
160 | (define-key must-match-map "?" 'minibuffer-completion-help) | |
161 | ||
162 | (define-key global-map "\e\t" 'complete-symbol)) | |
163 | (PC-default-bindings | |
164 | (define-key completion-map "\t" 'PC-complete) | |
165 | (define-key completion-map " " 'PC-complete-word) | |
166 | (define-key completion-map "?" 'PC-completion-help) | |
167 | ||
168 | (define-key completion-map "\e\t" 'PC-complete) | |
169 | (define-key completion-map "\e " 'PC-complete-word) | |
170 | (define-key completion-map "\e\r" 'PC-force-complete-and-exit) | |
171 | (define-key completion-map "\e\n" 'PC-force-complete-and-exit) | |
172 | (define-key completion-map "\e?" 'PC-completion-help) | |
173 | ||
174 | (define-key must-match-map "\t" 'PC-complete) | |
175 | (define-key must-match-map " " 'PC-complete-word) | |
176 | (define-key must-match-map "\r" 'PC-complete-and-exit) | |
177 | (define-key must-match-map "\n" 'PC-complete-and-exit) | |
178 | (define-key must-match-map "?" 'PC-completion-help) | |
179 | ||
180 | (define-key must-match-map "\e\t" 'PC-complete) | |
181 | (define-key must-match-map "\e " 'PC-complete-word) | |
182 | (define-key must-match-map "\e\r" 'PC-complete-and-exit) | |
183 | (define-key must-match-map "\e\n" 'PC-complete-and-exit) | |
184 | (define-key must-match-map "\e?" 'PC-completion-help) | |
185 | ||
186 | (define-key global-map "\e\t" 'PC-lisp-complete-symbol))))) | |
187 | ||
cc7e4da0 SM |
188 | ;;;###autoload |
189 | (define-minor-mode partial-completion-mode | |
190 | "Toggle Partial Completion mode. | |
191 | With prefix ARG, turn Partial Completion mode on if ARG is positive. | |
192 | ||
193 | When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is | |
194 | nil) is enhanced so that if some string is divided into words and each word is | |
195 | delimited by a character in `PC-word-delimiters', partial words are completed | |
196 | as much as possible and `*' characters are treated likewise in file names. | |
197 | ||
198 | For example, M-x p-c-m expands to M-x partial-completion-mode since no other | |
199 | command begins with that sequence of characters, and | |
200 | \\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no | |
201 | other file in that directory begin with that sequence of characters. | |
202 | ||
2ad432ab | 203 | Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted |
cc7e4da0 | 204 | specially in \\[find-file]. For example, |
2ad432ab | 205 | \\[find-file] <sys/time.h> RET finds the file `/usr/include/sys/time.h'. |
cc7e4da0 | 206 | See also the variable `PC-include-file-path'." |
00089cad | 207 | :global t :group 'partial-completion |
cc7e4da0 SM |
208 | ;; Deal with key bindings... |
209 | (PC-bindings partial-completion-mode) | |
210 | ;; Deal with include file feature... | |
211 | (cond ((not partial-completion-mode) | |
212 | (remove-hook 'find-file-not-found-hooks 'PC-look-for-include-file)) | |
213 | ((not PC-disable-includes) | |
214 | (add-hook 'find-file-not-found-hooks 'PC-look-for-include-file))) | |
215 | ;; ... with some underhand redefining. | |
216 | (cond ((and (not partial-completion-mode) | |
217 | (functionp PC-old-read-file-name-internal)) | |
218 | (fset 'read-file-name-internal PC-old-read-file-name-internal)) | |
219 | ((and (not PC-disable-includes) (not PC-old-read-file-name-internal)) | |
220 | (setq PC-old-read-file-name-internal | |
221 | (symbol-function 'read-file-name-internal)) | |
222 | (fset 'read-file-name-internal | |
223 | 'PC-read-include-file-name-internal))) | |
224 | (when (and partial-completion-mode (null PC-env-vars-alist)) | |
225 | (setq PC-env-vars-alist | |
226 | (mapcar (lambda (string) | |
227 | (let ((d (string-match "=" string))) | |
228 | (cons (concat "$" (substring string 0 d)) | |
229 | (and d (substring string (1+ d)))))) | |
230 | process-environment)))) | |
231 | ||
92677e25 | 232 | \f |
b545bfe6 JB |
233 | (defun PC-complete () |
234 | "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. | |
235 | For example, \"M-x b--di\" would match `byte-recompile-directory', or any | |
236 | name which consists of three or more words, the first beginning with \"b\" | |
237 | and the third beginning with \"di\". | |
238 | ||
239 | The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and | |
240 | `beginning-of-defun', so this would produce a list of completions | |
241 | just like when normal Emacs completions are ambiguous. | |
242 | ||
243 | Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", | |
244 | \".\", and SPC." | |
245 | (interactive) | |
246 | (if (PC-was-meta-key) | |
247 | (minibuffer-complete) | |
95c0d3a7 RS |
248 | ;; If the previous command was not this one, |
249 | ;; never scroll, always retry completion. | |
250 | (or (eq last-command this-command) | |
251 | (setq minibuffer-scroll-window nil)) | |
252 | (let ((window minibuffer-scroll-window)) | |
253 | ;; If there's a fresh completion window with a live buffer, | |
254 | ;; and this command is repeated, scroll that window. | |
255 | (if (and window (window-buffer window) | |
256 | (buffer-name (window-buffer window))) | |
257 | (save-excursion | |
258 | (set-buffer (window-buffer window)) | |
259 | (if (pos-visible-in-window-p (point-max) window) | |
260 | (set-window-start window (point-min) nil) | |
261 | (scroll-other-window))) | |
262 | (PC-do-completion nil))))) | |
b545bfe6 JB |
263 | |
264 | ||
265 | (defun PC-complete-word () | |
266 | "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. | |
267 | See `PC-complete' for details. | |
268 | This can be bound to other keys, like `-' and `.', if you wish." | |
269 | (interactive) | |
270 | (if (eq (PC-was-meta-key) PC-meta-flag) | |
271 | (if (eq last-command-char ? ) | |
272 | (minibuffer-complete-word) | |
273 | (self-insert-command 1)) | |
274 | (self-insert-command 1) | |
275 | (if (eobp) | |
276 | (PC-do-completion 'word)))) | |
277 | ||
278 | ||
279 | (defun PC-complete-space () | |
280 | "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. | |
281 | See `PC-complete' for details. | |
282 | This is suitable for binding to other keys which should act just like SPC." | |
283 | (interactive) | |
284 | (if (eq (PC-was-meta-key) PC-meta-flag) | |
285 | (minibuffer-complete-word) | |
286 | (insert " ") | |
287 | (if (eobp) | |
288 | (PC-do-completion 'word)))) | |
289 | ||
290 | ||
291 | (defun PC-complete-and-exit () | |
292 | "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. | |
293 | See `PC-complete' for details." | |
294 | (interactive) | |
295 | (if (eq (PC-was-meta-key) PC-meta-flag) | |
296 | (minibuffer-complete-and-exit) | |
297 | (PC-do-complete-and-exit))) | |
298 | ||
299 | (defun PC-force-complete-and-exit () | |
300 | "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. | |
301 | See `PC-complete' for details." | |
302 | (interactive) | |
303 | (let ((minibuffer-completion-confirm nil)) | |
304 | (PC-do-complete-and-exit))) | |
305 | ||
306 | (defun PC-do-complete-and-exit () | |
d7a0208b | 307 | (if (= (point-max) (minibuffer-prompt-end)) ; Duplicate the "bug" that Info-menu relies on... |
b545bfe6 JB |
308 | (exit-minibuffer) |
309 | (let ((flag (PC-do-completion 'exit))) | |
310 | (and flag | |
311 | (if (or (eq flag 'complete) | |
312 | (not minibuffer-completion-confirm)) | |
313 | (exit-minibuffer) | |
80f14e53 | 314 | (PC-temp-minibuffer-message " [Confirm]")))))) |
b545bfe6 JB |
315 | |
316 | ||
317 | (defun PC-completion-help () | |
318 | "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. | |
319 | See `PC-complete' for details." | |
320 | (interactive) | |
321 | (if (eq (PC-was-meta-key) PC-meta-flag) | |
322 | (minibuffer-completion-help) | |
323 | (PC-do-completion 'help))) | |
324 | ||
325 | (defun PC-was-meta-key () | |
326 | (or (/= (length (this-command-keys)) 1) | |
327 | (let ((key (aref (this-command-keys) 0))) | |
328 | (if (integerp key) | |
329 | (>= key 128) | |
330 | (not (null (memq 'meta (event-modifiers key)))))))) | |
331 | ||
332 | ||
333 | (defvar PC-ignored-extensions 'empty-cache) | |
334 | (defvar PC-delims 'empty-cache) | |
335 | (defvar PC-ignored-regexp nil) | |
336 | (defvar PC-word-failed-flag nil) | |
337 | (defvar PC-delim-regex nil) | |
338 | (defvar PC-ndelims-regex nil) | |
339 | (defvar PC-delims-list nil) | |
340 | ||
249f7eeb RS |
341 | (defvar PC-completion-as-file-name-predicate |
342 | (function | |
343 | (lambda () | |
344 | (memq minibuffer-completion-table | |
345 | '(read-file-name-internal read-directory-name-internal)))) | |
346 | "A function testing whether a minibuffer completion now will work filename-style. | |
347 | The function takes no arguments, and typically looks at the value | |
348 | of `minibuffer-completion-table' and the minibuffer contents.") | |
3985c790 | 349 | |
b545bfe6 | 350 | (defun PC-do-completion (&optional mode beg end) |
f08d8594 | 351 | (or beg (setq beg (minibuffer-prompt-end))) |
b545bfe6 JB |
352 | (or end (setq end (point-max))) |
353 | (let* ((table minibuffer-completion-table) | |
354 | (pred minibuffer-completion-predicate) | |
249f7eeb | 355 | (filename (funcall PC-completion-as-file-name-predicate)) |
b545bfe6 | 356 | (dirname nil) |
356b1352 | 357 | (dirlength 0) |
b545bfe6 JB |
358 | (str (buffer-substring beg end)) |
359 | (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) | |
360 | (ambig nil) | |
361 | basestr | |
356b1352 | 362 | env-on |
b545bfe6 JB |
363 | regex |
364 | p offset | |
365 | (poss nil) | |
366 | helpposs | |
367 | (case-fold-search completion-ignore-case)) | |
368 | ||
369 | ;; Check if buffer contents can already be considered complete | |
370 | (if (and (eq mode 'exit) | |
1b368e31 | 371 | (test-completion str table pred)) |
b545bfe6 JB |
372 | 'complete |
373 | ||
374 | ;; Do substitutions in directory names | |
375 | (and filename | |
356b1352 GM |
376 | (setq basestr (or (file-name-directory str) "")) |
377 | (setq dirlength (length basestr)) | |
378 | ;; Do substitutions in directory names | |
379 | (setq p (substitute-in-file-name basestr)) | |
380 | (not (string-equal basestr p)) | |
381 | (setq str (concat p (file-name-nondirectory str))) | |
382 | (progn | |
b545bfe6 | 383 | (delete-region beg end) |
356b1352 GM |
384 | (insert str) |
385 | (setq end (+ beg (length str))))) | |
8e28519a | 386 | |
b545bfe6 JB |
387 | ;; Prepare various delimiter strings |
388 | (or (equal PC-word-delimiters PC-delims) | |
389 | (setq PC-delims PC-word-delimiters | |
390 | PC-delim-regex (concat "[" PC-delims "]") | |
391 | PC-ndelims-regex (concat "[^" PC-delims "]*") | |
392 | PC-delims-list (append PC-delims nil))) | |
393 | ||
c2801b50 | 394 | ;; Add wildcards if necessary |
8e28519a NF |
395 | (and filename |
396 | (let ((dir (file-name-directory str)) | |
93f4fe7a SM |
397 | (file (file-name-nondirectory str)) |
398 | ;; The base dir for file-completion is passed in `predicate'. | |
399 | (default-directory (expand-file-name pred))) | |
8e28519a NF |
400 | (while (and (stringp dir) (not (file-directory-p dir))) |
401 | (setq dir (directory-file-name dir)) | |
402 | (setq file (concat (replace-regexp-in-string | |
403 | PC-delim-regex "*\\&" | |
404 | (file-name-nondirectory dir)) | |
405 | "*/" file)) | |
406 | (setq dir (file-name-directory dir))) | |
407 | (setq str (concat dir file)))) | |
408 | ||
b545bfe6 JB |
409 | ;; Look for wildcard expansions in directory name |
410 | (and filename | |
411 | (string-match "\\*.*/" str) | |
412 | (let ((pat str) | |
93f4fe7a SM |
413 | ;; The base dir for file-completion is passed in `predicate'. |
414 | (default-directory (expand-file-name pred)) | |
b545bfe6 JB |
415 | files) |
416 | (setq p (1+ (string-match "/[^/]*\\'" pat))) | |
417 | (while (setq p (string-match PC-delim-regex pat p)) | |
418 | (setq pat (concat (substring pat 0 p) | |
419 | "*" | |
420 | (substring pat p)) | |
421 | p (+ p 2))) | |
422 | (setq files (PC-expand-many-files (concat pat "*"))) | |
423 | (if files | |
424 | (let ((dir (file-name-directory (car files))) | |
425 | (p files)) | |
426 | (while (and (setq p (cdr p)) | |
427 | (equal dir (file-name-directory (car p))))) | |
428 | (if p | |
429 | (setq filename nil table nil pred nil | |
430 | ambig t) | |
431 | (delete-region beg end) | |
432 | (setq str (concat dir (file-name-nondirectory str))) | |
433 | (insert str) | |
434 | (setq end (+ beg (length str))))) | |
435 | (setq filename nil table nil pred nil)))) | |
436 | ||
437 | ;; Strip directory name if appropriate | |
438 | (if filename | |
439 | (if incname | |
440 | (setq basestr (substring str incname) | |
441 | dirname (substring str 0 incname)) | |
442 | (setq basestr (file-name-nondirectory str) | |
b38d1cc7 EZ |
443 | dirname (file-name-directory str)) |
444 | ;; Make sure str is consistent with its directory and basename | |
445 | ;; parts. This is important on DOZe'NT systems when str only | |
446 | ;; includes a drive letter, like in "d:". | |
447 | (setq str (concat dirname basestr))) | |
b545bfe6 JB |
448 | (setq basestr str)) |
449 | ||
450 | ;; Convert search pattern to a standard regular expression | |
451 | (setq regex (regexp-quote basestr) | |
452 | offset (if (and (> (length regex) 0) | |
453 | (not (eq (aref basestr 0) ?\*)) | |
454 | (or (eq PC-first-char t) | |
455 | (and PC-first-char filename))) 1 0) | |
456 | p offset) | |
457 | (while (setq p (string-match PC-delim-regex regex p)) | |
458 | (if (eq (aref regex p) ? ) | |
459 | (setq regex (concat (substring regex 0 p) | |
460 | PC-ndelims-regex | |
461 | PC-delim-regex | |
462 | (substring regex (1+ p))) | |
463 | p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) | |
464 | (let ((bump (if (memq (aref regex p) | |
465 | '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) | |
466 | -1 0))) | |
467 | (setq regex (concat (substring regex 0 (+ p bump)) | |
468 | PC-ndelims-regex | |
469 | (substring regex (+ p bump))) | |
470 | p (+ p (length PC-ndelims-regex) 1))))) | |
471 | (setq p 0) | |
472 | (if filename | |
473 | (while (setq p (string-match "\\\\\\*" regex p)) | |
474 | (setq regex (concat (substring regex 0 p) | |
475 | "[^/]*" | |
476 | (substring regex (+ p 2)))))) | |
477 | ;;(setq the-regex regex) | |
478 | (setq regex (concat "\\`" regex)) | |
479 | ||
356b1352 GM |
480 | (and (> (length basestr) 0) |
481 | (= (aref basestr 0) ?$) | |
482 | (setq env-on t | |
483 | table PC-env-vars-alist | |
484 | pred nil)) | |
485 | ||
b545bfe6 JB |
486 | ;; Find an initial list of possible completions |
487 | (if (not (setq p (string-match (concat PC-delim-regex | |
488 | (if filename "\\|\\*" "")) | |
489 | str | |
490 | (+ (length dirname) offset)))) | |
491 | ||
492 | ;; Minibuffer contains no hyphens -- simple case! | |
356b1352 GM |
493 | (setq poss (all-completions (if env-on |
494 | basestr str) | |
b545bfe6 JB |
495 | table |
496 | pred)) | |
497 | ||
498 | ;; Use all-completions to do an initial cull. This is a big win, | |
499 | ;; since all-completions is written in C! | |
356b1352 GM |
500 | (let ((compl (all-completions (if env-on |
501 | (file-name-nondirectory (substring str 0 p)) | |
502 | (substring str 0 p)) | |
503 | table | |
504 | pred))) | |
b545bfe6 JB |
505 | (setq p compl) |
506 | (while p | |
507 | (and (string-match regex (car p)) | |
fc21ed03 KH |
508 | (progn |
509 | (set-text-properties 0 (length (car p)) '() (car p)) | |
510 | (setq poss (cons (car p) poss)))) | |
b545bfe6 JB |
511 | (setq p (cdr p))))) |
512 | ||
513 | ;; Now we have a list of possible completions | |
514 | (cond | |
515 | ||
516 | ;; No valid completions found | |
517 | ((null poss) | |
518 | (if (and (eq mode 'word) | |
519 | (not PC-word-failed-flag)) | |
520 | (let ((PC-word-failed-flag t)) | |
521 | (delete-backward-char 1) | |
522 | (PC-do-completion 'word)) | |
523 | (beep) | |
524 | (PC-temp-minibuffer-message (if ambig | |
80f14e53 | 525 | " [Ambiguous dir name]" |
b545bfe6 | 526 | (if (eq mode 'help) |
80f14e53 RS |
527 | " [No completions]" |
528 | " [No match]"))) | |
b545bfe6 JB |
529 | nil)) |
530 | ||
531 | ;; More than one valid completion found | |
532 | ((or (cdr (setq helpposs poss)) | |
533 | (memq mode '(help word))) | |
534 | ||
535 | ;; Handle completion-ignored-extensions | |
536 | (and filename | |
537 | (not (eq mode 'help)) | |
538 | (let ((p2 poss)) | |
539 | ||
540 | ;; Build a regular expression representing the extensions list | |
541 | (or (equal completion-ignored-extensions PC-ignored-extensions) | |
542 | (setq PC-ignored-regexp | |
543 | (concat "\\(" | |
544 | (mapconcat | |
545 | 'regexp-quote | |
546 | (setq PC-ignored-extensions | |
547 | completion-ignored-extensions) | |
548 | "\\|") | |
549 | "\\)\\'"))) | |
550 | ||
06cab6db RS |
551 | ;; Check if there are any without an ignored extension. |
552 | ;; Also ignore `.' and `..'. | |
b545bfe6 JB |
553 | (setq p nil) |
554 | (while p2 | |
555 | (or (string-match PC-ignored-regexp (car p2)) | |
06cab6db | 556 | (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2)) |
b545bfe6 JB |
557 | (setq p (cons (car p2) p))) |
558 | (setq p2 (cdr p2))) | |
559 | ||
560 | ;; If there are "good" names, use them | |
561 | (and p (setq poss p)))) | |
562 | ||
563 | ;; Is the actual string one of the possible completions? | |
564 | (setq p (and (not (eq mode 'help)) poss)) | |
565 | (while (and p | |
fc21ed03 | 566 | (not (string-equal (car p) basestr))) |
b545bfe6 | 567 | (setq p (cdr p))) |
80f14e53 RS |
568 | (and p (null mode) |
569 | (PC-temp-minibuffer-message " [Complete, but not unique]")) | |
570 | (if (and p | |
571 | (not (and (null mode) | |
572 | (eq this-command last-command)))) | |
573 | t | |
b545bfe6 JB |
574 | |
575 | ;; If ambiguous, try for a partial completion | |
576 | (let ((improved nil) | |
577 | prefix | |
578 | (pt nil) | |
579 | (skip "\\`")) | |
580 | ||
581 | ;; Check if next few letters are the same in all cases | |
582 | (if (and (not (eq mode 'help)) | |
583 | (setq prefix (try-completion "" (mapcar 'list poss)))) | |
584 | (let ((first t) i) | |
585 | (if (eq mode 'word) | |
586 | (setq prefix (PC-chop-word prefix basestr))) | |
587 | (goto-char (+ beg (length dirname))) | |
588 | (while (and (progn | |
589 | (setq i 0) | |
590 | (while (< i (length prefix)) | |
591 | (if (and (< (point) end) | |
592 | (eq (aref prefix i) | |
593 | (following-char))) | |
594 | (forward-char 1) | |
595 | (if (and (< (point) end) | |
596 | (or (and (looking-at " ") | |
597 | (memq (aref prefix i) | |
598 | PC-delims-list)) | |
599 | (eq (downcase (aref prefix i)) | |
600 | (downcase | |
601 | (following-char))))) | |
602 | (progn | |
603 | (delete-char 1) | |
604 | (setq end (1- end))) | |
605 | (and filename (looking-at "\\*") | |
606 | (progn | |
607 | (delete-char 1) | |
608 | (setq end (1- end)))) | |
609 | (setq improved t)) | |
fc21ed03 | 610 | (insert (substring prefix i (1+ i))) |
b545bfe6 JB |
611 | (setq end (1+ end))) |
612 | (setq i (1+ i))) | |
613 | (or pt (equal (point) beg) | |
614 | (setq pt (point))) | |
615 | (looking-at PC-delim-regex)) | |
616 | (setq skip (concat skip | |
617 | (regexp-quote prefix) | |
618 | PC-ndelims-regex) | |
619 | prefix (try-completion | |
620 | "" | |
621 | (mapcar | |
622 | (function | |
623 | (lambda (x) | |
624 | (list | |
625 | (and (string-match skip x) | |
626 | (substring | |
627 | x | |
628 | (match-end 0)))))) | |
629 | poss))) | |
630 | (or (> i 0) (> (length prefix) 0)) | |
631 | (or (not (eq mode 'word)) | |
632 | (and first (> (length prefix) 0) | |
633 | (setq first nil | |
634 | prefix (substring prefix 0 1)))))) | |
635 | (goto-char (if (eq mode 'word) end | |
636 | (or pt beg))))) | |
637 | ||
638 | (if (and (eq mode 'word) | |
639 | (not PC-word-failed-flag)) | |
640 | ||
641 | (if improved | |
642 | ||
643 | ;; We changed it... would it be complete without the space? | |
1b368e31 | 644 | (if (test-completion (buffer-substring 1 (1- end)) |
b545bfe6 JB |
645 | table pred) |
646 | (delete-region (1- end) end))) | |
647 | ||
648 | (if improved | |
649 | ||
650 | ;; We changed it... enough to be complete? | |
651 | (and (eq mode 'exit) | |
1b368e31 | 652 | (test-completion (field-string) table pred)) |
b545bfe6 JB |
653 | |
654 | ;; If totally ambiguous, display a list of completions | |
cc7e4da0 SM |
655 | (if (or (eq completion-auto-help t) |
656 | (and completion-auto-help | |
657 | (eq last-command this-command)) | |
b545bfe6 | 658 | (eq mode 'help)) |
67698633 | 659 | (with-output-to-temp-buffer "*Completions*" |
78b19c2c RS |
660 | (display-completion-list (sort helpposs 'string-lessp)) |
661 | (save-excursion | |
662 | (set-buffer standard-output) | |
663 | ;; Record which part of the buffer we are completing | |
664 | ;; so that choosing a completion from the list | |
665 | ;; knows how much old text to replace. | |
666 | (setq completion-base-size dirlength))) | |
80f14e53 | 667 | (PC-temp-minibuffer-message " [Next char not unique]")) |
b545bfe6 JB |
668 | nil))))) |
669 | ||
670 | ;; Only one possible completion | |
671 | (t | |
356b1352 GM |
672 | (if (and (equal basestr (car poss)) |
673 | (not (and env-on filename))) | |
b545bfe6 | 674 | (if (null mode) |
80f14e53 | 675 | (PC-temp-minibuffer-message " [Sole completion]")) |
b545bfe6 | 676 | (delete-region beg end) |
e5fd2822 RS |
677 | (insert (format "%s" |
678 | (if filename | |
679 | (substitute-in-file-name (concat dirname (car poss))) | |
680 | (car poss))))) | |
b545bfe6 JB |
681 | t))))) |
682 | ||
b545bfe6 JB |
683 | (defun PC-chop-word (new old) |
684 | (let ((i -1) | |
685 | (j -1)) | |
686 | (while (and (setq i (string-match PC-delim-regex old (1+ i))) | |
687 | (setq j (string-match PC-delim-regex new (1+ j))))) | |
688 | (if (and j | |
689 | (or (not PC-word-failed-flag) | |
690 | (setq j (string-match PC-delim-regex new (1+ j))))) | |
691 | (substring new 0 (1+ j)) | |
692 | new))) | |
693 | ||
694 | (defvar PC-not-minibuffer nil) | |
695 | ||
92677e25 | 696 | (defun PC-temp-minibuffer-message (message) |
b545bfe6 | 697 | "A Lisp version of `temp_minibuffer_message' from minibuf.c." |
92677e25 SM |
698 | (cond (PC-not-minibuffer |
699 | (message message) | |
700 | (sit-for 2) | |
701 | (message "")) | |
702 | ((fboundp 'temp-minibuffer-message) | |
703 | (temp-minibuffer-message message)) | |
704 | (t | |
705 | (let ((point-max (point-max))) | |
706 | (save-excursion | |
707 | (goto-char point-max) | |
708 | (insert message)) | |
709 | (let ((inhibit-quit t)) | |
710 | (sit-for 2) | |
711 | (delete-region point-max (point-max)) | |
712 | (when quit-flag | |
713 | (setq quit-flag nil | |
714 | unread-command-events '(7)))))))) | |
b545bfe6 JB |
715 | |
716 | ||
717 | (defun PC-lisp-complete-symbol () | |
718 | "Perform completion on Lisp symbol preceding point. | |
719 | That symbol is compared against the symbols that exist | |
720 | and any additional characters determined by what is there | |
721 | are inserted. | |
722 | If the symbol starts just after an open-parenthesis, | |
723 | only symbols with function definitions are considered. | |
724 | Otherwise, all symbols with function definitions, values | |
725 | or properties are considered." | |
726 | (interactive) | |
727 | (let* ((end (point)) | |
728 | (buffer-syntax (syntax-table)) | |
729 | (beg (unwind-protect | |
730 | (save-excursion | |
731 | (if lisp-mode-syntax-table | |
732 | (set-syntax-table lisp-mode-syntax-table)) | |
733 | (backward-sexp 1) | |
734 | (while (= (char-syntax (following-char)) ?\') | |
735 | (forward-char 1)) | |
736 | (point)) | |
737 | (set-syntax-table buffer-syntax))) | |
738 | (minibuffer-completion-table obarray) | |
739 | (minibuffer-completion-predicate | |
740 | (if (eq (char-after (1- beg)) ?\() | |
741 | 'fboundp | |
742 | (function (lambda (sym) | |
743 | (or (boundp sym) (fboundp sym) | |
744 | (symbol-plist sym)))))) | |
745 | (PC-not-minibuffer t)) | |
746 | (PC-do-completion nil beg end))) | |
747 | ||
356b1352 GM |
748 | (defun PC-complete-as-file-name () |
749 | "Perform completion on file names preceding point. | |
750 | Environment vars are converted to their values." | |
751 | (interactive) | |
752 | (let* ((end (point)) | |
753 | (beg (if (re-search-backward "[^\\][ \t\n\"\`\'][^ \t\n\"\`\']" | |
754 | (point-min) t) | |
755 | (+ (point) 2) | |
756 | (point-min))) | |
757 | (minibuffer-completion-table 'read-file-name-internal) | |
758 | (minibuffer-completion-predicate "") | |
759 | (PC-not-minibuffer t)) | |
760 | (goto-char end) | |
761 | (PC-do-completion nil beg end))) | |
762 | ||
5b0f8cbc KH |
763 | ;;; Use the shell to do globbing. |
764 | ;;; This could now use file-expand-wildcards instead. | |
b545bfe6 JB |
765 | |
766 | (defun PC-expand-many-files (name) | |
767 | (save-excursion | |
768 | (set-buffer (generate-new-buffer " *Glob Output*")) | |
769 | (erase-buffer) | |
770 | (shell-command (concat "echo " name) t) | |
771 | (goto-char (point-min)) | |
772 | (if (looking-at ".*No match") | |
773 | nil | |
774 | (insert "(\"") | |
775 | (while (search-forward " " nil t) | |
776 | (delete-backward-char 1) | |
777 | (insert "\" \"")) | |
778 | (goto-char (point-max)) | |
779 | (delete-backward-char 1) | |
780 | (insert "\")") | |
781 | (goto-char (point-min)) | |
68a8818d | 782 | (let ((files (read (current-buffer))) (p nil)) |
b545bfe6 | 783 | (kill-buffer (current-buffer)) |
68a8818d KH |
784 | (or (equal completion-ignored-extensions PC-ignored-extensions) |
785 | (setq PC-ignored-regexp | |
786 | (concat "\\(" | |
787 | (mapconcat | |
788 | 'regexp-quote | |
789 | (setq PC-ignored-extensions | |
790 | completion-ignored-extensions) | |
791 | "\\|") | |
792 | "\\)\\'"))) | |
793 | (setq p nil) | |
794 | (while files | |
795 | (or (string-match PC-ignored-regexp (car files)) | |
796 | (setq p (cons (car files) p))) | |
797 | (setq files (cdr files))) | |
798 | p)))) | |
b545bfe6 | 799 | |
b545bfe6 JB |
800 | ;;; Facilities for loading C header files. This is independent from the |
801 | ;;; main completion code. See also the variable `PC-include-file-path' | |
802 | ;;; at top of this file. | |
803 | ||
804 | (defun PC-look-for-include-file () | |
805 | (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) | |
806 | (let ((name (substring (buffer-file-name) | |
807 | (match-beginning 1) (match-end 1))) | |
808 | (punc (aref (buffer-file-name) (match-beginning 0))) | |
809 | (path nil) | |
810 | new-buf) | |
811 | (kill-buffer (current-buffer)) | |
812 | (if (equal name "") | |
813 | (save-excursion | |
814 | (set-buffer (car (buffer-list))) | |
815 | (save-excursion | |
816 | (beginning-of-line) | |
817 | (if (looking-at | |
818 | "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") | |
819 | (setq name (buffer-substring (match-beginning 1) | |
820 | (match-end 1)) | |
821 | punc (char-after (1- (match-beginning 1)))) | |
822 | ;; Suggested by Frank Siebenlist: | |
823 | (if (or (looking-at | |
824 | "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") | |
825 | (looking-at | |
826 | "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") | |
827 | (looking-at | |
828 | "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) | |
829 | (progn | |
830 | (setq name (buffer-substring (match-beginning 1) | |
831 | (match-end 1)) | |
832 | punc ?\< | |
833 | path load-path) | |
834 | (if (string-match "\\.elc$" name) | |
835 | (setq name (substring name 0 -1)) | |
836 | (or (string-match "\\.el$" name) | |
837 | (setq name (concat name ".el"))))) | |
838 | (error "Not on an #include line")))))) | |
5f34457e | 839 | (or (string-match "\\.[[:alnum:]]+$" name) |
b545bfe6 JB |
840 | (setq name (concat name ".h"))) |
841 | (if (eq punc ?\<) | |
842 | (let ((path (or path (PC-include-file-path)))) | |
843 | (while (and path | |
844 | (not (file-exists-p | |
845 | (concat (file-name-as-directory (car path)) | |
846 | name)))) | |
847 | (setq path (cdr path))) | |
848 | (if path | |
849 | (setq name (concat (file-name-as-directory (car path)) name)) | |
850 | (error "No such include file: <%s>" name))) | |
851 | (let ((dir (save-excursion | |
852 | (set-buffer (car (buffer-list))) | |
853 | default-directory))) | |
854 | (if (file-exists-p (concat dir name)) | |
855 | (setq name (concat dir name)) | |
5b0f8cbc | 856 | (error "No such include file: `%s'" name)))) |
b545bfe6 JB |
857 | (setq new-buf (get-file-buffer name)) |
858 | (if new-buf | |
859 | ;; no need to verify last-modified time for this! | |
860 | (set-buffer new-buf) | |
861 | (setq new-buf (create-file-buffer name)) | |
862 | (set-buffer new-buf) | |
863 | (erase-buffer) | |
864 | (insert-file-contents name t)) | |
5b0f8cbc KH |
865 | ;; Returning non-nil with the new buffer current |
866 | ;; is sufficient to tell find-file to use it. | |
b545bfe6 JB |
867 | t) |
868 | nil)) | |
869 | ||
870 | (defun PC-include-file-path () | |
871 | (or PC-include-file-path | |
872 | (let ((env (getenv "INCPATH")) | |
873 | (path nil) | |
874 | pos) | |
875 | (or env (error "No include file path specified")) | |
876 | (while (setq pos (string-match ":[^:]+$" env)) | |
877 | (setq path (cons (substring env (1+ pos)) path) | |
878 | env (substring env 0 pos))) | |
879 | path))) | |
880 | ||
881 | ;;; This is adapted from lib-complete.el, by Mike Williams. | |
882 | (defun PC-include-file-all-completions (file search-path &optional full) | |
883 | "Return all completions for FILE in any directory on SEARCH-PATH. | |
8e28519a | 884 | If optional third argument FULL is non-nil, returned pathnames should be |
b545bfe6 JB |
885 | absolute rather than relative to some directory on the SEARCH-PATH." |
886 | (setq search-path | |
cc7e4da0 SM |
887 | (mapcar (lambda (dir) |
888 | (if dir (file-name-as-directory dir) default-directory)) | |
b545bfe6 JB |
889 | search-path)) |
890 | (if (file-name-absolute-p file) | |
891 | ;; It's an absolute file name, so don't need search-path | |
892 | (progn | |
893 | (setq file (expand-file-name file)) | |
8e28519a | 894 | (file-name-all-completions |
b545bfe6 JB |
895 | (file-name-nondirectory file) (file-name-directory file))) |
896 | (let ((subdir (file-name-directory file)) | |
897 | (ndfile (file-name-nondirectory file)) | |
898 | file-lists) | |
899 | ;; Append subdirectory part to each element of search-path | |
900 | (if subdir | |
901 | (setq search-path | |
cc7e4da0 | 902 | (mapcar (lambda (dir) (concat dir subdir)) |
b545bfe6 JB |
903 | search-path) |
904 | file )) | |
905 | ;; Make list of completions in each directory on search-path | |
906 | (while search-path | |
907 | (let* ((dir (car search-path)) | |
908 | (subdir (if full dir subdir))) | |
909 | (if (file-directory-p dir) | |
910 | (progn | |
911 | (setq file-lists | |
8e28519a | 912 | (cons |
cc7e4da0 | 913 | (mapcar (lambda (file) (concat subdir file)) |
8e28519a | 914 | (file-name-all-completions ndfile |
b545bfe6 JB |
915 | (car search-path))) |
916 | file-lists)))) | |
917 | (setq search-path (cdr search-path)))) | |
918 | ;; Compress out duplicates while building complete list (slloooow!) | |
919 | (let ((sorted (sort (apply 'nconc file-lists) | |
cc7e4da0 | 920 | (lambda (x y) (not (string-lessp x y))))) |
b545bfe6 JB |
921 | compressed) |
922 | (while sorted | |
923 | (if (equal (car sorted) (car compressed)) nil | |
924 | (setq compressed (cons (car sorted) compressed))) | |
925 | (setq sorted (cdr sorted))) | |
926 | compressed)))) | |
927 | ||
b545bfe6 JB |
928 | (defun PC-read-include-file-name-internal (string dir action) |
929 | (if (string-match "<\\([^\"<>]*\\)>?$" string) | |
930 | (let* ((name (substring string (match-beginning 1) (match-end 1))) | |
931 | (str2 (substring string (match-beginning 0))) | |
932 | (completion-table | |
933 | (mapcar (function (lambda (x) (list (format "<%s>" x)))) | |
934 | (PC-include-file-all-completions | |
935 | name (PC-include-file-path))))) | |
936 | (cond | |
937 | ((not completion-table) nil) | |
938 | ((eq action nil) (try-completion str2 completion-table nil)) | |
939 | ((eq action t) (all-completions str2 completion-table nil)) | |
a7ad0079 | 940 | ((eq action 'lambda) (test-completion str2 completion-table nil)))) |
b545bfe6 | 941 | (funcall PC-old-read-file-name-internal string dir action))) |
b545bfe6 | 942 | \f |
92677e25 | 943 | |
b545bfe6 JB |
944 | (provide 'complete) |
945 | ||
a7ad0079 | 946 | ;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458 |
e8af40ee | 947 | ;;; complete.el ends here |