Commit | Line | Data |
---|---|---|
b035a678 | 1 | ;;; complete.el --- partial completion mechanism plus other goodies |
b545bfe6 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1990-1993, 1999-2014 Free Software Foundation, Inc. |
b545bfe6 JB |
4 | |
5 | ;; Author: Dave Gillespie <daveg@synaptics.com> | |
f5f727f8 | 6 | ;; Keywords: abbrev convenience |
c1e25821 | 7 | ;; Obsolete-since: 24.1 |
88f4758e | 8 | ;; |
b545bfe6 JB |
9 | ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
eb3fa2cf | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
59243403 | 14 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
59243403 | 17 | |
b545bfe6 | 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
b545bfe6 | 22 | |
59243403 | 23 | ;; You should have received a copy of the GNU General Public License |
eb3fa2cf | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
b545bfe6 | 25 | |
07b3798c | 26 | ;;; Commentary: |
b545bfe6 JB |
27 | |
28 | ;; Extended completion for the Emacs minibuffer. | |
29 | ;; | |
30 | ;; The basic idea is that the command name or other completable text is | |
31 | ;; divided into words and each word is completed separately, so that | |
32 | ;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous | |
33 | ;; each word is completed as much as possible and then the cursor is | |
34 | ;; left at the first position where typing another letter will resolve | |
35 | ;; the ambiguity. | |
36 | ;; | |
37 | ;; Word separators for this purpose are hyphen, space, and period. | |
38 | ;; These would most likely occur in command names, Info menu items, | |
39 | ;; and file names, respectively. But all word separators are treated | |
40 | ;; alike at all times. | |
41 | ;; | |
42 | ;; This completion package replaces the old-style completer's key | |
43 | ;; bindings for TAB, SPC, RET, and `?'. The old completer is still | |
44 | ;; available on the Meta versions of those keys. If you set | |
45 | ;; PC-meta-flag to nil, the old completion keys will be left alone | |
46 | ;; and the partial completer will use the Meta versions of the keys. | |
47 | ||
48 | ||
7117761b | 49 | ;; Usage: M-x partial-completion-mode. During completable minibuffer entry, |
b545bfe6 JB |
50 | ;; |
51 | ;; TAB means to do a partial completion; | |
52 | ;; SPC means to do a partial complete-word; | |
53 | ;; RET means to do a partial complete-and-exit; | |
54 | ;; ? means to do a partial completion-help. | |
55 | ;; | |
56 | ;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform | |
57 | ;; original Emacs completions, and M-TAB etc. do partial completion. | |
58 | ;; To do this, put the command, | |
59 | ;; | |
60 | ;; (setq PC-meta-flag nil) | |
61 | ;; | |
62 | ;; in your .emacs file. To load partial completion automatically, put | |
63 | ;; | |
7117761b | 64 | ;; (partial-completion-mode t) |
b545bfe6 JB |
65 | ;; |
66 | ;; in your .emacs file, too. Things will be faster if you byte-compile | |
67 | ;; this file when you install it. | |
68 | ;; | |
69 | ;; As an extra feature, in cases where RET would not normally | |
70 | ;; complete (such as `C-x b'), the M-RET key will always do a partial | |
71 | ;; complete-and-exit. Thus `C-x b f.c RET' will select or create a | |
72 | ;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing | |
73 | ;; buffer whose name matches that pattern (perhaps "filing.c"). | |
74 | ;; (PC-meta-flag does not affect this behavior; M-RET used to be | |
75 | ;; undefined in this situation.) | |
76 | ;; | |
77 | ;; The regular M-TAB (lisp-complete-symbol) command also supports | |
78 | ;; partial completion in this package. | |
79 | ||
b545bfe6 JB |
80 | ;; In addition, this package includes a feature for accessing include |
81 | ;; files. For example, `C-x C-f <sys/time.h> RET' reads the file | |
82 | ;; /usr/include/sys/time.h. The variable PC-include-file-path is a | |
83 | ;; list of directories in which to search for include files. Completion | |
84 | ;; is supported in include file names. | |
85 | ||
86 | ||
07b3798c | 87 | ;;; Code: |
b545bfe6 | 88 | |
92677e25 SM |
89 | (defgroup partial-completion nil |
90 | "Partial Completion of items." | |
91 | :prefix "pc-" | |
f5f727f8 DN |
92 | :group 'minibuffer |
93 | :group 'convenience) | |
92677e25 | 94 | |
92677e25 | 95 | (defcustom PC-first-char 'find-file |
95983b95 | 96 | "Control how the first character of a string is to be interpreted. |
92677e25 SM |
97 | If nil, the first character of a string is not taken literally if it is a word |
98 | delimiter, so that \".e\" matches \"*.e*\". | |
99 | If t, the first character of a string is always taken literally even if it is a | |
100 | word delimiter, so that \".e\" matches \".e*\". | |
101 | If non-nil and non-t, the first character is taken literally only for file name | |
102 | completion." | |
103 | :type '(choice (const :tag "delimiter" nil) | |
104 | (const :tag "literal" t) | |
45200424 | 105 | (other :tag "find-file" find-file)) |
92677e25 SM |
106 | :group 'partial-completion) |
107 | ||
108 | (defcustom PC-meta-flag t | |
95983b95 | 109 | "If non-nil, TAB means PC completion and M-TAB means normal completion. |
92677e25 SM |
110 | Otherwise, TAB means normal completion and M-TAB means Partial Completion." |
111 | :type 'boolean | |
112 | :group 'partial-completion) | |
113 | ||
114 | (defcustom PC-word-delimiters "-_. " | |
95983b95 | 115 | "A string of characters treated as word delimiters for completion. |
92677e25 SM |
116 | Some arcane rules: |
117 | If `]' is in this string, it must come first. | |
118 | If `^' is in this string, it must not come first. | |
119 | If `-' is in this string, it must come first or right after `]'. | |
932fb767 | 120 | In other words, if S is this string, then `[S]' must be a valid Emacs regular |
92677e25 SM |
121 | expression (not containing character ranges like `a-z')." |
122 | :type 'string | |
123 | :group 'partial-completion) | |
124 | ||
125 | (defcustom PC-include-file-path '("/usr/include" "/usr/local/include") | |
95983b95 | 126 | "A list of directories in which to look for include files. |
92677e25 SM |
127 | If nil, means use the colon-separated path in the variable $INCPATH instead." |
128 | :type '(repeat directory) | |
129 | :group 'partial-completion) | |
130 | ||
92677e25 | 131 | (defcustom PC-disable-includes nil |
95983b95 | 132 | "If non-nil, include-file support in \\[find-file] is disabled." |
92677e25 SM |
133 | :type 'boolean |
134 | :group 'partial-completion) | |
b545bfe6 JB |
135 | |
136 | (defvar PC-default-bindings t | |
92677e25 | 137 | "If non-nil, default partial completion key bindings are suppressed.") |
356b1352 GM |
138 | |
139 | (defvar PC-env-vars-alist nil | |
140 | "A list of the environment variable names and values.") | |
141 | ||
92677e25 | 142 | \f |
92677e25 SM |
143 | (defun PC-bindings (bind) |
144 | (let ((completion-map minibuffer-local-completion-map) | |
145 | (must-match-map minibuffer-local-must-match-map)) | |
146 | (cond ((not bind) | |
147 | ;; These bindings are the default bindings. It would be better to | |
148 | ;; restore the previous bindings. | |
fff1a077 CY |
149 | (define-key read-expression-map "\e\t" 'lisp-complete-symbol) |
150 | ||
92677e25 SM |
151 | (define-key completion-map "\t" 'minibuffer-complete) |
152 | (define-key completion-map " " 'minibuffer-complete-word) | |
153 | (define-key completion-map "?" 'minibuffer-completion-help) | |
154 | ||
92677e25 SM |
155 | (define-key must-match-map "\r" 'minibuffer-complete-and-exit) |
156 | (define-key must-match-map "\n" 'minibuffer-complete-and-exit) | |
92677e25 | 157 | |
6e52f715 | 158 | (define-key global-map [remap lisp-complete-symbol] nil)) |
92677e25 | 159 | (PC-default-bindings |
fff1a077 CY |
160 | (define-key read-expression-map "\e\t" 'PC-lisp-complete-symbol) |
161 | ||
92677e25 SM |
162 | (define-key completion-map "\t" 'PC-complete) |
163 | (define-key completion-map " " 'PC-complete-word) | |
164 | (define-key completion-map "?" 'PC-completion-help) | |
165 | ||
166 | (define-key completion-map "\e\t" 'PC-complete) | |
167 | (define-key completion-map "\e " 'PC-complete-word) | |
168 | (define-key completion-map "\e\r" 'PC-force-complete-and-exit) | |
169 | (define-key completion-map "\e\n" 'PC-force-complete-and-exit) | |
170 | (define-key completion-map "\e?" 'PC-completion-help) | |
171 | ||
92677e25 SM |
172 | (define-key must-match-map "\r" 'PC-complete-and-exit) |
173 | (define-key must-match-map "\n" 'PC-complete-and-exit) | |
92677e25 | 174 | |
92677e25 SM |
175 | (define-key must-match-map "\e\r" 'PC-complete-and-exit) |
176 | (define-key must-match-map "\e\n" 'PC-complete-and-exit) | |
92677e25 | 177 | |
6e52f715 | 178 | (define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol))))) |
92677e25 | 179 | |
1fbd1830 GM |
180 | (defvar PC-do-completion-end nil |
181 | "Internal variable used by `PC-do-completion'.") | |
182 | ||
e00c1b9c GM |
183 | (make-variable-buffer-local 'PC-do-completion-end) |
184 | ||
d73bbb35 GM |
185 | (defvar PC-goto-end nil |
186 | "Internal variable set in `PC-do-completion', used in | |
187 | `choose-completion-string-functions'.") | |
188 | ||
e00c1b9c GM |
189 | (make-variable-buffer-local 'PC-goto-end) |
190 | ||
cc7e4da0 SM |
191 | ;;;###autoload |
192 | (define-minor-mode partial-completion-mode | |
193 | "Toggle Partial Completion mode. | |
194 | With prefix ARG, turn Partial Completion mode on if ARG is positive. | |
195 | ||
196 | When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is | |
197 | nil) is enhanced so that if some string is divided into words and each word is | |
198 | delimited by a character in `PC-word-delimiters', partial words are completed | |
199 | as much as possible and `*' characters are treated likewise in file names. | |
200 | ||
201 | For example, M-x p-c-m expands to M-x partial-completion-mode since no other | |
202 | command begins with that sequence of characters, and | |
203 | \\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no | |
08fd202a | 204 | other file in that directory begins with that sequence of characters. |
cc7e4da0 | 205 | |
2ad432ab | 206 | Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted |
cc7e4da0 | 207 | specially in \\[find-file]. For example, |
2ad432ab | 208 | \\[find-file] <sys/time.h> RET finds the file `/usr/include/sys/time.h'. |
10156852 EZ |
209 | See also the variable `PC-include-file-path'. |
210 | ||
211 | Partial Completion mode extends the meaning of `completion-auto-help' (which | |
6c76000b RS |
212 | see), so that if it is neither nil nor t, Emacs shows the `*Completions*' |
213 | buffer only on the second attempt to complete. That is, if TAB finds nothing | |
214 | to complete, the first TAB just says \"Next char not unique\" and the | |
fddf97f6 | 215 | second TAB brings up the `*Completions*' buffer." |
00089cad | 216 | :global t :group 'partial-completion |
cc7e4da0 SM |
217 | ;; Deal with key bindings... |
218 | (PC-bindings partial-completion-mode) | |
219 | ;; Deal with include file feature... | |
220 | (cond ((not partial-completion-mode) | |
f679907b | 221 | (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file)) |
cc7e4da0 | 222 | ((not PC-disable-includes) |
f679907b | 223 | (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) |
8d85a565 SM |
224 | ;; Adjust the completion selection in *Completion* buffers to the way |
225 | ;; we work. The default minibuffer completion code only completes the | |
226 | ;; text before point and leaves the text after point alone (new in | |
227 | ;; Emacs-22). In contrast we use the whole text and we even sometimes | |
228 | ;; move point to a place before EOB, to indicate the first position where | |
229 | ;; there's a difference, so when the user uses choose-completion, we have | |
230 | ;; to trick choose-completion into replacing the whole minibuffer text | |
231 | ;; rather than only the text before point. --Stef | |
232 | (funcall | |
233 | (if partial-completion-mode 'add-hook 'remove-hook) | |
234 | 'choose-completion-string-functions | |
d5e63715 | 235 | (lambda (choice buffer &rest ignored) |
d73bbb35 GM |
236 | ;; When completing M-: (lisp- ) with point before the ), it is |
237 | ;; not appropriate to go to point-max (unlike the filename case). | |
238 | (if (and (not PC-goto-end) | |
d5e63715 | 239 | (minibufferp buffer)) |
d73bbb35 | 240 | (goto-char (point-max)) |
1fbd1830 | 241 | ;; Need a similar hack for the non-minibuffer-case -- gm. |
660fd6fb GM |
242 | (when PC-do-completion-end |
243 | (goto-char PC-do-completion-end) | |
244 | (setq PC-do-completion-end nil))) | |
d73bbb35 | 245 | (setq PC-goto-end nil) |
d46104ae | 246 | nil)) |
8d85a565 SM |
247 | ;; Build the env-completion and mapping table. |
248 | (when (and partial-completion-mode (null PC-env-vars-alist)) | |
249 | (setq PC-env-vars-alist | |
250 | (mapcar (lambda (string) | |
251 | (let ((d (string-match "=" string))) | |
252 | (cons (concat "$" (substring string 0 d)) | |
253 | (and d (substring string (1+ d)))))) | |
254 | process-environment)))) | |
cc7e4da0 | 255 | |
92677e25 | 256 | \f |
b545bfe6 JB |
257 | (defun PC-complete () |
258 | "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. | |
259 | For example, \"M-x b--di\" would match `byte-recompile-directory', or any | |
260 | name which consists of three or more words, the first beginning with \"b\" | |
261 | and the third beginning with \"di\". | |
262 | ||
263 | The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and | |
264 | `beginning-of-defun', so this would produce a list of completions | |
265 | just like when normal Emacs completions are ambiguous. | |
266 | ||
267 | Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", | |
268 | \".\", and SPC." | |
269 | (interactive) | |
270 | (if (PC-was-meta-key) | |
271 | (minibuffer-complete) | |
95c0d3a7 RS |
272 | ;; If the previous command was not this one, |
273 | ;; never scroll, always retry completion. | |
274 | (or (eq last-command this-command) | |
275 | (setq minibuffer-scroll-window nil)) | |
276 | (let ((window minibuffer-scroll-window)) | |
277 | ;; If there's a fresh completion window with a live buffer, | |
278 | ;; and this command is repeated, scroll that window. | |
279 | (if (and window (window-buffer window) | |
280 | (buffer-name (window-buffer window))) | |
f679907b | 281 | (with-current-buffer (window-buffer window) |
95c0d3a7 RS |
282 | (if (pos-visible-in-window-p (point-max) window) |
283 | (set-window-start window (point-min) nil) | |
284 | (scroll-other-window))) | |
285 | (PC-do-completion nil))))) | |
b545bfe6 JB |
286 | |
287 | ||
288 | (defun PC-complete-word () | |
289 | "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. | |
290 | See `PC-complete' for details. | |
291 | This can be bound to other keys, like `-' and `.', if you wish." | |
292 | (interactive) | |
293 | (if (eq (PC-was-meta-key) PC-meta-flag) | |
8989a920 | 294 | (if (eq last-command-event ? ) |
b545bfe6 JB |
295 | (minibuffer-complete-word) |
296 | (self-insert-command 1)) | |
297 | (self-insert-command 1) | |
298 | (if (eobp) | |
299 | (PC-do-completion 'word)))) | |
300 | ||
301 | ||
302 | (defun PC-complete-space () | |
303 | "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. | |
304 | See `PC-complete' for details. | |
305 | This is suitable for binding to other keys which should act just like SPC." | |
306 | (interactive) | |
307 | (if (eq (PC-was-meta-key) PC-meta-flag) | |
308 | (minibuffer-complete-word) | |
309 | (insert " ") | |
310 | (if (eobp) | |
311 | (PC-do-completion 'word)))) | |
312 | ||
313 | ||
314 | (defun PC-complete-and-exit () | |
315 | "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. | |
316 | See `PC-complete' for details." | |
317 | (interactive) | |
318 | (if (eq (PC-was-meta-key) PC-meta-flag) | |
319 | (minibuffer-complete-and-exit) | |
320 | (PC-do-complete-and-exit))) | |
321 | ||
322 | (defun PC-force-complete-and-exit () | |
323 | "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. | |
324 | See `PC-complete' for details." | |
325 | (interactive) | |
326 | (let ((minibuffer-completion-confirm nil)) | |
327 | (PC-do-complete-and-exit))) | |
328 | ||
329 | (defun PC-do-complete-and-exit () | |
f15ca944 SM |
330 | (cond |
331 | ((= (point-max) (minibuffer-prompt-end)) | |
332 | ;; Duplicate the "bug" that Info-menu relies on... | |
333 | (exit-minibuffer)) | |
f8d106b0 | 334 | ((eq minibuffer-completion-confirm 'confirm) |
f15ca944 SM |
335 | (if (or (eq last-command this-command) |
336 | (test-completion (field-string) | |
337 | minibuffer-completion-table | |
338 | minibuffer-completion-predicate)) | |
339 | (exit-minibuffer) | |
340 | (PC-temp-minibuffer-message " [Confirm]"))) | |
f8d106b0 CY |
341 | ((eq minibuffer-completion-confirm 'confirm-after-completion) |
342 | ;; Similar to the above, but only if trying to exit immediately | |
343 | ;; after typing TAB (this catches most minibuffer typos). | |
a8851092 | 344 | (if (and (memq last-command minibuffer-confirm-exit-commands) |
f8d106b0 CY |
345 | (not (test-completion (field-string) |
346 | minibuffer-completion-table | |
347 | minibuffer-completion-predicate))) | |
348 | (PC-temp-minibuffer-message " [Confirm]") | |
349 | (exit-minibuffer))) | |
f15ca944 | 350 | (t |
b545bfe6 JB |
351 | (let ((flag (PC-do-completion 'exit))) |
352 | (and flag | |
353 | (if (or (eq flag 'complete) | |
354 | (not minibuffer-completion-confirm)) | |
355 | (exit-minibuffer) | |
f15ca944 | 356 | (PC-temp-minibuffer-message " [Confirm]"))))))) |
b545bfe6 JB |
357 | |
358 | ||
359 | (defun PC-completion-help () | |
360 | "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. | |
361 | See `PC-complete' for details." | |
362 | (interactive) | |
363 | (if (eq (PC-was-meta-key) PC-meta-flag) | |
364 | (minibuffer-completion-help) | |
365 | (PC-do-completion 'help))) | |
366 | ||
367 | (defun PC-was-meta-key () | |
368 | (or (/= (length (this-command-keys)) 1) | |
369 | (let ((key (aref (this-command-keys) 0))) | |
370 | (if (integerp key) | |
371 | (>= key 128) | |
372 | (not (null (memq 'meta (event-modifiers key)))))))) | |
373 | ||
374 | ||
375 | (defvar PC-ignored-extensions 'empty-cache) | |
376 | (defvar PC-delims 'empty-cache) | |
377 | (defvar PC-ignored-regexp nil) | |
378 | (defvar PC-word-failed-flag nil) | |
379 | (defvar PC-delim-regex nil) | |
380 | (defvar PC-ndelims-regex nil) | |
381 | (defvar PC-delims-list nil) | |
382 | ||
249f7eeb | 383 | (defvar PC-completion-as-file-name-predicate |
f679907b SM |
384 | (lambda () minibuffer-completing-file-name) |
385 | "A function testing whether a minibuffer completion now will work filename-style. | |
249f7eeb RS |
386 | The function takes no arguments, and typically looks at the value |
387 | of `minibuffer-completion-table' and the minibuffer contents.") | |
3985c790 | 388 | |
08fd202a EZ |
389 | ;; Returns the sequence of non-delimiter characters that follow regexp in string. |
390 | (defun PC-chunk-after (string regexp) | |
391 | (if (not (string-match regexp string)) | |
f6e7ec02 DG |
392 | (let ((message "String %s didn't match regexp %s")) |
393 | (message message string regexp) | |
394 | (error message string regexp))) | |
08fd202a EZ |
395 | (let ((result (substring string (match-end 0)))) |
396 | ;; result may contain multiple chunks | |
397 | (if (string-match PC-delim-regex result) | |
398 | (setq result (substring result 0 (match-beginning 0)))) | |
399 | result)) | |
400 | ||
401 | (defun test-completion-ignore-case (str table pred) | |
402 | "Like `test-completion', but ignores case when possible." | |
403 | ;; Binding completion-ignore-case to nil ensures, for compatibility with | |
404 | ;; standard completion, that the return value is exactly one of the | |
405 | ;; possibilities. Do this binding only if pred is nil, out of paranoia; | |
406 | ;; perhaps it is safe even if pred is non-nil. | |
407 | (if pred | |
408 | (test-completion str table pred) | |
409 | (let ((completion-ignore-case nil)) | |
410 | (test-completion str table pred)))) | |
411 | ||
2ef31c1c MR |
412 | ;; The following function is an attempt to work around two problems: |
413 | ||
414 | ;; (1) When complete.el was written, (try-completion "" '(("") (""))) used to | |
415 | ;; return the value "". With a change from 2002-07-07 it returns t which caused | |
416 | ;; `PC-lisp-complete-symbol' to fail with a "Wrong type argument: sequencep, t" | |
417 | ;; error. `PC-try-completion' returns STRING in this case. | |
418 | ||
419 | ;; (2) (try-completion "" '((""))) returned t before the above-mentioned change. | |
420 | ;; Since `PC-chop-word' operates on the return value of `try-completion' this | |
421 | ;; case might have provoked a similar error as in (1). `PC-try-completion' | |
422 | ;; returns "" instead. I don't know whether this is a real problem though. | |
423 | ||
424 | ;; Since `PC-try-completion' is not a guaranteed to fix these bugs reliably, you | |
425 | ;; should try to look at the following discussions when you encounter problems: | |
426 | ;; - emacs-pretest-bug ("Partial Completion" starting 2007-02-23), | |
427 | ;; - emacs-devel ("[address-of-OP: Partial completion]" starting 2007-02-24), | |
428 | ;; - emacs-devel ("[address-of-OP: EVAL and mouse selection in *Completions*]" | |
429 | ;; starting 2007-03-05). | |
430 | (defun PC-try-completion (string alist &optional predicate) | |
431 | "Like `try-completion' but return STRING instead of t." | |
432 | (let ((result (try-completion string alist predicate))) | |
433 | (if (eq result t) string result))) | |
434 | ||
d73bbb35 GM |
435 | ;; TODO document MODE magic... |
436 | (defun PC-do-completion (&optional mode beg end goto-end) | |
437 | "Internal function to do the work of partial completion. | |
438 | Text to be completed lies between BEG and END. Normally when | |
439 | replacing text in the minibuffer, this function replaces up to | |
440 | point-max (as is appropriate for completing a file name). If | |
441 | GOTO-END is non-nil, however, it instead replaces up to END." | |
f08d8594 | 442 | (or beg (setq beg (minibuffer-prompt-end))) |
b545bfe6 | 443 | (or end (setq end (point-max))) |
b1916c6e RS |
444 | (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal) |
445 | 'PC-read-file-name-internal | |
446 | minibuffer-completion-table)) | |
b545bfe6 | 447 | (pred minibuffer-completion-predicate) |
249f7eeb | 448 | (filename (funcall PC-completion-as-file-name-predicate)) |
8dbe4a8c | 449 | (dirname nil) ; non-nil only if a filename is being completed |
a7b52a1e MR |
450 | ;; The following used to be "(dirlength 0)" which caused the erasure of |
451 | ;; the entire buffer text before `point' when inserting a completion | |
452 | ;; into a buffer. | |
453 | dirlength | |
b545bfe6 JB |
454 | (str (buffer-substring beg end)) |
455 | (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) | |
456 | (ambig nil) | |
35731e3b | 457 | basestr origstr |
356b1352 | 458 | env-on |
b545bfe6 JB |
459 | regex |
460 | p offset | |
03ed845e | 461 | abbreviated |
b545bfe6 JB |
462 | (poss nil) |
463 | helpposs | |
464 | (case-fold-search completion-ignore-case)) | |
465 | ||
466 | ;; Check if buffer contents can already be considered complete | |
467 | (if (and (eq mode 'exit) | |
b89d8a77 | 468 | (test-completion str table pred)) |
1aaaf8ea | 469 | 'complete |
b545bfe6 JB |
470 | |
471 | ;; Do substitutions in directory names | |
472 | (and filename | |
356b1352 GM |
473 | (setq basestr (or (file-name-directory str) "")) |
474 | (setq dirlength (length basestr)) | |
475 | ;; Do substitutions in directory names | |
476 | (setq p (substitute-in-file-name basestr)) | |
477 | (not (string-equal basestr p)) | |
478 | (setq str (concat p (file-name-nondirectory str))) | |
479 | (progn | |
b545bfe6 | 480 | (delete-region beg end) |
356b1352 GM |
481 | (insert str) |
482 | (setq end (+ beg (length str))))) | |
8e28519a | 483 | |
b545bfe6 JB |
484 | ;; Prepare various delimiter strings |
485 | (or (equal PC-word-delimiters PC-delims) | |
486 | (setq PC-delims PC-word-delimiters | |
487 | PC-delim-regex (concat "[" PC-delims "]") | |
488 | PC-ndelims-regex (concat "[^" PC-delims "]*") | |
489 | PC-delims-list (append PC-delims nil))) | |
490 | ||
c2801b50 | 491 | ;; Add wildcards if necessary |
8e28519a NF |
492 | (and filename |
493 | (let ((dir (file-name-directory str)) | |
93f4fe7a | 494 | (file (file-name-nondirectory str)) |
2f65ac9e SM |
495 | ;; The base dir for file-completion was passed in `predicate'. |
496 | (default-directory (if (stringp pred) (expand-file-name pred) | |
497 | default-directory))) | |
8e28519a NF |
498 | (while (and (stringp dir) (not (file-directory-p dir))) |
499 | (setq dir (directory-file-name dir)) | |
500 | (setq file (concat (replace-regexp-in-string | |
501 | PC-delim-regex "*\\&" | |
502 | (file-name-nondirectory dir)) | |
503 | "*/" file)) | |
504 | (setq dir (file-name-directory dir))) | |
35731e3b | 505 | (setq origstr str str (concat dir file)))) |
8e28519a | 506 | |
b545bfe6 JB |
507 | ;; Look for wildcard expansions in directory name |
508 | (and filename | |
509 | (string-match "\\*.*/" str) | |
510 | (let ((pat str) | |
2f65ac9e SM |
511 | ;; The base dir for file-completion was passed in `predicate'. |
512 | (default-directory (if (stringp pred) (expand-file-name pred) | |
513 | default-directory)) | |
b545bfe6 JB |
514 | files) |
515 | (setq p (1+ (string-match "/[^/]*\\'" pat))) | |
516 | (while (setq p (string-match PC-delim-regex pat p)) | |
517 | (setq pat (concat (substring pat 0 p) | |
518 | "*" | |
519 | (substring pat p)) | |
520 | p (+ p 2))) | |
da3e76dc | 521 | (setq files (file-expand-wildcards (concat pat "*"))) |
b545bfe6 JB |
522 | (if files |
523 | (let ((dir (file-name-directory (car files))) | |
524 | (p files)) | |
525 | (while (and (setq p (cdr p)) | |
526 | (equal dir (file-name-directory (car p))))) | |
527 | (if p | |
2f65ac9e SM |
528 | (setq filename nil table nil |
529 | pred (if (stringp pred) nil pred) | |
b545bfe6 JB |
530 | ambig t) |
531 | (delete-region beg end) | |
532 | (setq str (concat dir (file-name-nondirectory str))) | |
533 | (insert str) | |
534 | (setq end (+ beg (length str))))) | |
35731e3b | 535 | (if origstr |
b1916c6e RS |
536 | ;; If the wildcards were introduced by us, it's |
537 | ;; possible that PC-read-file-name-internal can | |
538 | ;; still find matches for the original string | |
539 | ;; even if we couldn't, so remove the added | |
540 | ;; wildcards. | |
35731e3b | 541 | (setq str origstr) |
2f65ac9e SM |
542 | (setq filename nil table nil |
543 | pred (if (stringp pred) nil pred)))))) | |
b545bfe6 JB |
544 | |
545 | ;; Strip directory name if appropriate | |
546 | (if filename | |
547 | (if incname | |
548 | (setq basestr (substring str incname) | |
549 | dirname (substring str 0 incname)) | |
550 | (setq basestr (file-name-nondirectory str) | |
b38d1cc7 EZ |
551 | dirname (file-name-directory str)) |
552 | ;; Make sure str is consistent with its directory and basename | |
553 | ;; parts. This is important on DOZe'NT systems when str only | |
554 | ;; includes a drive letter, like in "d:". | |
555 | (setq str (concat dirname basestr))) | |
b545bfe6 JB |
556 | (setq basestr str)) |
557 | ||
558 | ;; Convert search pattern to a standard regular expression | |
559 | (setq regex (regexp-quote basestr) | |
560 | offset (if (and (> (length regex) 0) | |
561 | (not (eq (aref basestr 0) ?\*)) | |
562 | (or (eq PC-first-char t) | |
563 | (and PC-first-char filename))) 1 0) | |
564 | p offset) | |
565 | (while (setq p (string-match PC-delim-regex regex p)) | |
566 | (if (eq (aref regex p) ? ) | |
567 | (setq regex (concat (substring regex 0 p) | |
568 | PC-ndelims-regex | |
569 | PC-delim-regex | |
570 | (substring regex (1+ p))) | |
571 | p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) | |
572 | (let ((bump (if (memq (aref regex p) | |
573 | '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) | |
574 | -1 0))) | |
575 | (setq regex (concat (substring regex 0 (+ p bump)) | |
576 | PC-ndelims-regex | |
577 | (substring regex (+ p bump))) | |
578 | p (+ p (length PC-ndelims-regex) 1))))) | |
579 | (setq p 0) | |
580 | (if filename | |
581 | (while (setq p (string-match "\\\\\\*" regex p)) | |
582 | (setq regex (concat (substring regex 0 p) | |
583 | "[^/]*" | |
584 | (substring regex (+ p 2)))))) | |
585 | ;;(setq the-regex regex) | |
586 | (setq regex (concat "\\`" regex)) | |
587 | ||
356b1352 GM |
588 | (and (> (length basestr) 0) |
589 | (= (aref basestr 0) ?$) | |
590 | (setq env-on t | |
591 | table PC-env-vars-alist | |
592 | pred nil)) | |
593 | ||
b545bfe6 | 594 | ;; Find an initial list of possible completions |
03ed845e | 595 | (unless (setq p (string-match (concat PC-delim-regex |
b545bfe6 JB |
596 | (if filename "\\|\\*" "")) |
597 | str | |
03ed845e | 598 | (+ (length dirname) offset))) |
b545bfe6 JB |
599 | |
600 | ;; Minibuffer contains no hyphens -- simple case! | |
03ed845e | 601 | (setq poss (all-completions (if env-on basestr str) |
b545bfe6 JB |
602 | table |
603 | pred)) | |
9a8b3a5c | 604 | (unless (or poss (string-equal str "")) |
03ed845e | 605 | ;; Try completion as an abbreviation, e.g. "mvb" -> |
9a8b3a5c RF |
606 | ;; "m-v-b" -> "multiple-value-bind", but only for |
607 | ;; non-empty strings. | |
03ed845e RS |
608 | (setq origstr str |
609 | abbreviated t) | |
610 | (if filename | |
611 | (cond | |
612 | ;; "alpha" or "/alpha" -> expand whole path. | |
613 | ((string-match "^/?\\([A-Za-z0-9]+\\)$" str) | |
614 | (setq | |
615 | basestr "" | |
616 | p nil | |
da3e76dc | 617 | poss (file-expand-wildcards |
03ed845e RS |
618 | (concat "/" |
619 | (mapconcat #'list (match-string 1 str) "*/") | |
620 | "*")) | |
621 | beg (1- beg))) | |
622 | ;; Alphanumeric trailer -> expand trailing file | |
623 | ((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str) | |
624 | (setq regex (concat "\\`" | |
625 | (mapconcat #'list | |
626 | (match-string 2 str) | |
627 | "[A-Za-z0-9]*[^A-Za-z0-9]")) | |
628 | p (1+ (length (match-string 1 str)))))) | |
31d24a4b JB |
629 | (setq regex (concat "\\`" (mapconcat (lambda (c) |
630 | (regexp-quote (string c))) | |
631 | str "[^-]*-")) | |
632 | p 1)))) | |
03ed845e | 633 | (when p |
b545bfe6 JB |
634 | ;; Use all-completions to do an initial cull. This is a big win, |
635 | ;; since all-completions is written in C! | |
356b1352 GM |
636 | (let ((compl (all-completions (if env-on |
637 | (file-name-nondirectory (substring str 0 p)) | |
638 | (substring str 0 p)) | |
4a63ceb8 SM |
639 | table |
640 | pred))) | |
b545bfe6 | 641 | (setq p compl) |
03ed845e RS |
642 | (when (and compl abbreviated) |
643 | (if filename | |
644 | (progn | |
645 | (setq p nil) | |
646 | (dolist (x compl) | |
647 | (when (string-match regex x) | |
648 | (push x p))) | |
649 | (setq basestr (try-completion "" p))) | |
650 | (setq basestr (mapconcat 'list str "-")) | |
651 | (delete-region beg end) | |
652 | (setq end (+ beg (length basestr))) | |
653 | (insert basestr)))) | |
b545bfe6 JB |
654 | (while p |
655 | (and (string-match regex (car p)) | |
fc21ed03 KH |
656 | (progn |
657 | (set-text-properties 0 (length (car p)) '() (car p)) | |
658 | (setq poss (cons (car p) poss)))) | |
03ed845e | 659 | (setq p (cdr p)))) |
b545bfe6 | 660 | |
85066604 MC |
661 | ;; If table had duplicates, they can be here. |
662 | (delete-dups poss) | |
663 | ||
4a63ceb8 SM |
664 | ;; Handle completion-ignored-extensions |
665 | (and filename | |
666 | (not (eq mode 'help)) | |
667 | (let ((p2 poss)) | |
668 | ||
669 | ;; Build a regular expression representing the extensions list | |
670 | (or (equal completion-ignored-extensions PC-ignored-extensions) | |
671 | (setq PC-ignored-regexp | |
672 | (concat "\\(" | |
673 | (mapconcat | |
674 | 'regexp-quote | |
675 | (setq PC-ignored-extensions | |
676 | completion-ignored-extensions) | |
677 | "\\|") | |
678 | "\\)\\'"))) | |
679 | ||
680 | ;; Check if there are any without an ignored extension. | |
681 | ;; Also ignore `.' and `..'. | |
682 | (setq p nil) | |
683 | (while p2 | |
684 | (or (string-match PC-ignored-regexp (car p2)) | |
685 | (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2)) | |
686 | (setq p (cons (car p2) p))) | |
687 | (setq p2 (cdr p2))) | |
688 | ||
689 | ;; If there are "good" names, use them | |
690 | (and p (setq poss p)))) | |
691 | ||
b545bfe6 | 692 | ;; Now we have a list of possible completions |
03ed845e | 693 | |
b545bfe6 JB |
694 | (cond |
695 | ||
696 | ;; No valid completions found | |
697 | ((null poss) | |
698 | (if (and (eq mode 'word) | |
699 | (not PC-word-failed-flag)) | |
700 | (let ((PC-word-failed-flag t)) | |
d355a0b7 | 701 | (delete-char -1) |
b545bfe6 | 702 | (PC-do-completion 'word)) |
03ed845e RS |
703 | (when abbreviated |
704 | (delete-region beg end) | |
705 | (insert origstr)) | |
b545bfe6 JB |
706 | (beep) |
707 | (PC-temp-minibuffer-message (if ambig | |
80f14e53 | 708 | " [Ambiguous dir name]" |
b545bfe6 | 709 | (if (eq mode 'help) |
80f14e53 RS |
710 | " [No completions]" |
711 | " [No match]"))) | |
b545bfe6 JB |
712 | nil)) |
713 | ||
714 | ;; More than one valid completion found | |
715 | ((or (cdr (setq helpposs poss)) | |
716 | (memq mode '(help word))) | |
717 | ||
b545bfe6 JB |
718 | ;; Is the actual string one of the possible completions? |
719 | (setq p (and (not (eq mode 'help)) poss)) | |
720 | (while (and p | |
fc21ed03 | 721 | (not (string-equal (car p) basestr))) |
b545bfe6 | 722 | (setq p (cdr p))) |
80f14e53 RS |
723 | (and p (null mode) |
724 | (PC-temp-minibuffer-message " [Complete, but not unique]")) | |
725 | (if (and p | |
726 | (not (and (null mode) | |
727 | (eq this-command last-command)))) | |
728 | t | |
b545bfe6 JB |
729 | |
730 | ;; If ambiguous, try for a partial completion | |
731 | (let ((improved nil) | |
732 | prefix | |
733 | (pt nil) | |
734 | (skip "\\`")) | |
735 | ||
736 | ;; Check if next few letters are the same in all cases | |
737 | (if (and (not (eq mode 'help)) | |
2ef31c1c MR |
738 | (setq prefix (PC-try-completion |
739 | (PC-chunk-after basestr skip) poss))) | |
b545bfe6 JB |
740 | (let ((first t) i) |
741 | (if (eq mode 'word) | |
742 | (setq prefix (PC-chop-word prefix basestr))) | |
743 | (goto-char (+ beg (length dirname))) | |
744 | (while (and (progn | |
08fd202a | 745 | (setq i 0) ; index into prefix string |
b545bfe6 JB |
746 | (while (< i (length prefix)) |
747 | (if (and (< (point) end) | |
1f4e4f86 CY |
748 | (or (eq (downcase (aref prefix i)) |
749 | (downcase (following-char))) | |
750 | (and (looking-at " ") | |
751 | (memq (aref prefix i) | |
752 | PC-delims-list)))) | |
753 | ;; replace " " by the actual delimiter | |
754 | ;; or input char by prefix char | |
08fd202a | 755 | (progn |
1f4e4f86 CY |
756 | (delete-char 1) |
757 | (insert (substring prefix i (1+ i)))) | |
758 | ;; insert a new character | |
759 | (progn | |
760 | (and filename (looking-at "\\*") | |
761 | (progn | |
762 | (delete-char 1) | |
763 | (setq end (1- end)))) | |
764 | (setq improved t) | |
765 | (insert (substring prefix i (1+ i))) | |
766 | (setq end (1+ end)))) | |
b545bfe6 | 767 | (setq i (1+ i))) |
fddf97f6 | 768 | (or pt (setq pt (point))) |
b545bfe6 JB |
769 | (looking-at PC-delim-regex)) |
770 | (setq skip (concat skip | |
771 | (regexp-quote prefix) | |
772 | PC-ndelims-regex) | |
2ef31c1c | 773 | prefix (PC-try-completion |
08fd202a EZ |
774 | (PC-chunk-after |
775 | ;; not basestr, because that does | |
776 | ;; not reflect insertions | |
777 | (buffer-substring | |
778 | (+ beg (length dirname)) end) | |
779 | skip) | |
b545bfe6 | 780 | (mapcar |
4a63ceb8 SM |
781 | (lambda (x) |
782 | (when (string-match skip x) | |
783 | (substring x (match-end 0)))) | |
b545bfe6 JB |
784 | poss))) |
785 | (or (> i 0) (> (length prefix) 0)) | |
786 | (or (not (eq mode 'word)) | |
787 | (and first (> (length prefix) 0) | |
788 | (setq first nil | |
789 | prefix (substring prefix 0 1)))))) | |
790 | (goto-char (if (eq mode 'word) end | |
791 | (or pt beg))))) | |
792 | ||
793 | (if (and (eq mode 'word) | |
794 | (not PC-word-failed-flag)) | |
795 | ||
796 | (if improved | |
797 | ||
798 | ;; We changed it... would it be complete without the space? | |
da0bed93 SM |
799 | (if (test-completion (buffer-substring |
800 | (field-beginning) (1- end)) | |
8dbe4a8c | 801 | table pred) |
b545bfe6 JB |
802 | (delete-region (1- end) end))) |
803 | ||
804 | (if improved | |
805 | ||
806 | ;; We changed it... enough to be complete? | |
807 | (and (eq mode 'exit) | |
08fd202a | 808 | (test-completion-ignore-case (field-string) table pred)) |
b545bfe6 JB |
809 | |
810 | ;; If totally ambiguous, display a list of completions | |
cc7e4da0 SM |
811 | (if (or (eq completion-auto-help t) |
812 | (and completion-auto-help | |
813 | (eq last-command this-command)) | |
b545bfe6 | 814 | (eq mode 'help)) |
8dbe4a8c GM |
815 | (let ((prompt-end (minibuffer-prompt-end))) |
816 | (with-output-to-temp-buffer "*Completions*" | |
817 | (display-completion-list (sort helpposs 'string-lessp)) | |
e00c1b9c GM |
818 | (setq PC-do-completion-end end |
819 | PC-goto-end goto-end) | |
8dbe4a8c GM |
820 | (with-current-buffer standard-output |
821 | ;; Record which part of the buffer we are completing | |
822 | ;; so that choosing a completion from the list | |
823 | ;; knows how much old text to replace. | |
824 | ;; This was briefly nil in the non-dirname case. | |
825 | ;; However, if one calls PC-lisp-complete-symbol | |
826 | ;; on "(ne-f" with point on the hyphen, PC offers | |
827 | ;; all completions starting with "(ne", some of | |
828 | ;; which do not match the "-f" part (maybe it | |
829 | ;; should not, but it does). In such cases, | |
830 | ;; completion gets confused trying to figure out | |
831 | ;; how much to replace, so we tell it explicitly | |
832 | ;; (ie, the number of chars in the buffer before beg). | |
1fbd1830 GM |
833 | ;; |
834 | ;; Note that choose-completion-string-functions | |
835 | ;; plays around with point. | |
8dbe4a8c GM |
836 | (setq completion-base-size (if dirname |
837 | dirlength | |
e00c1b9c | 838 | (- beg prompt-end)))))) |
f8a3deed MC |
839 | (PC-temp-minibuffer-message " [Next char not unique]")) |
840 | ;; Expansion of filenames is not reversible, | |
841 | ;; so just keep the prefix. | |
03ed845e RS |
842 | (when (and abbreviated filename) |
843 | (delete-region (point) end)) | |
f8a3deed | 844 | nil))))) |
b545bfe6 JB |
845 | |
846 | ;; Only one possible completion | |
847 | (t | |
356b1352 | 848 | (if (and (equal basestr (car poss)) |
03ed845e RS |
849 | (not (and env-on filename)) |
850 | (not abbreviated)) | |
b545bfe6 | 851 | (if (null mode) |
80f14e53 | 852 | (PC-temp-minibuffer-message " [Sole completion]")) |
b545bfe6 | 853 | (delete-region beg end) |
e5fd2822 RS |
854 | (insert (format "%s" |
855 | (if filename | |
856 | (substitute-in-file-name (concat dirname (car poss))) | |
857 | (car poss))))) | |
b545bfe6 JB |
858 | t))))) |
859 | ||
b545bfe6 JB |
860 | (defun PC-chop-word (new old) |
861 | (let ((i -1) | |
862 | (j -1)) | |
863 | (while (and (setq i (string-match PC-delim-regex old (1+ i))) | |
864 | (setq j (string-match PC-delim-regex new (1+ j))))) | |
865 | (if (and j | |
866 | (or (not PC-word-failed-flag) | |
867 | (setq j (string-match PC-delim-regex new (1+ j))))) | |
868 | (substring new 0 (1+ j)) | |
869 | new))) | |
870 | ||
871 | (defvar PC-not-minibuffer nil) | |
872 | ||
92677e25 | 873 | (defun PC-temp-minibuffer-message (message) |
b545bfe6 | 874 | "A Lisp version of `temp_minibuffer_message' from minibuf.c." |
92677e25 | 875 | (cond (PC-not-minibuffer |
f6e7ec02 | 876 | (message "%s" message) |
92677e25 SM |
877 | (sit-for 2) |
878 | (message "")) | |
879 | ((fboundp 'temp-minibuffer-message) | |
880 | (temp-minibuffer-message message)) | |
881 | (t | |
882 | (let ((point-max (point-max))) | |
883 | (save-excursion | |
884 | (goto-char point-max) | |
885 | (insert message)) | |
886 | (let ((inhibit-quit t)) | |
887 | (sit-for 2) | |
888 | (delete-region point-max (point-max)) | |
889 | (when quit-flag | |
890 | (setq quit-flag nil | |
891 | unread-command-events '(7)))))))) | |
b545bfe6 | 892 | |
660fd6fb GM |
893 | ;; Does not need to be buffer-local (?) because only used when one |
894 | ;; PC-l-c-s immediately follows another. | |
8dbe4a8c GM |
895 | (defvar PC-lisp-complete-end nil |
896 | "Internal variable used by `PC-lisp-complete-symbol'.") | |
b545bfe6 JB |
897 | |
898 | (defun PC-lisp-complete-symbol () | |
899 | "Perform completion on Lisp symbol preceding point. | |
900 | That symbol is compared against the symbols that exist | |
901 | and any additional characters determined by what is there | |
902 | are inserted. | |
903 | If the symbol starts just after an open-parenthesis, | |
904 | only symbols with function definitions are considered. | |
905 | Otherwise, all symbols with function definitions, values | |
906 | or properties are considered." | |
907 | (interactive) | |
03ed845e RS |
908 | (let* ((end |
909 | (save-excursion | |
910 | (with-syntax-table lisp-mode-syntax-table | |
911 | (skip-syntax-forward "_w") | |
912 | (point)))) | |
f679907b SM |
913 | (beg (save-excursion |
914 | (with-syntax-table lisp-mode-syntax-table | |
915 | (backward-sexp 1) | |
916 | (while (= (char-syntax (following-char)) ?\') | |
917 | (forward-char 1)) | |
918 | (point)))) | |
b545bfe6 JB |
919 | (minibuffer-completion-table obarray) |
920 | (minibuffer-completion-predicate | |
921 | (if (eq (char-after (1- beg)) ?\() | |
922 | 'fboundp | |
923 | (function (lambda (sym) | |
924 | (or (boundp sym) (fboundp sym) | |
925 | (symbol-plist sym)))))) | |
926 | (PC-not-minibuffer t)) | |
8dbe4a8c GM |
927 | ;; http://lists.gnu.org/archive/html/emacs-devel/2007-03/msg01211.html |
928 | ;; | |
929 | ;; This deals with cases like running PC-l-c-s on "M-: (n-f". | |
930 | ;; The first call to PC-l-c-s expands this to "(ne-f", and moves | |
931 | ;; point to the hyphen [1]. If one calls PC-l-c-s immediately after, | |
932 | ;; then without the last-command check, one is offered all | |
933 | ;; completions of "(ne", which is presumably not what one wants. | |
934 | ;; | |
935 | ;; This is arguably (at least, it seems to be the existing intended | |
fffa137c | 936 | ;; behavior) what one _does_ want if point has been explicitly |
8dbe4a8c GM |
937 | ;; positioned on the hyphen. Note that if PC-do-completion (qv) binds |
938 | ;; completion-base-size to nil, then completion does not replace the | |
939 | ;; correct amount of text in such cases. | |
940 | ;; | |
941 | ;; Neither of these problems occur when using PC for filenames in the | |
942 | ;; minibuffer, because in that case PC-do-completion is called without | |
943 | ;; an explicit value for END, and so uses (point-max). This is fine for | |
944 | ;; a filename, because the end of the filename must be at the end of | |
945 | ;; the minibuffer. The same is not true for lisp symbols. | |
946 | ;; | |
947 | ;; [1] An alternate fix would be to not move point to the hyphen | |
fffa137c | 948 | ;; in such cases, but that would make the behavior different from |
8dbe4a8c GM |
949 | ;; that for filenames. It seems PC moves point to the site of the |
950 | ;; first difference between the possible completions. | |
951 | ;; | |
952 | ;; Alternatively alternatively, maybe end should be computed in | |
fffa137c | 953 | ;; the same way as beg. That would change the behavior though. |
8dbe4a8c | 954 | (if (equal last-command 'PC-lisp-complete-symbol) |
d73bbb35 | 955 | (PC-do-completion nil beg PC-lisp-complete-end t) |
660fd6fb GM |
956 | (if PC-lisp-complete-end |
957 | (move-marker PC-lisp-complete-end end) | |
958 | (setq PC-lisp-complete-end (copy-marker end t))) | |
d73bbb35 | 959 | (PC-do-completion nil beg end t)))) |
b545bfe6 | 960 | |
356b1352 GM |
961 | (defun PC-complete-as-file-name () |
962 | "Perform completion on file names preceding point. | |
963 | Environment vars are converted to their values." | |
964 | (interactive) | |
965 | (let* ((end (point)) | |
966 | (beg (if (re-search-backward "[^\\][ \t\n\"\`\'][^ \t\n\"\`\']" | |
967 | (point-min) t) | |
968 | (+ (point) 2) | |
969 | (point-min))) | |
b1916c6e | 970 | (minibuffer-completion-table 'PC-read-file-name-internal) |
c023a34f | 971 | (minibuffer-completion-predicate nil) |
356b1352 GM |
972 | (PC-not-minibuffer t)) |
973 | (goto-char end) | |
974 | (PC-do-completion nil beg end))) | |
975 | ||
f679907b SM |
976 | ;; Facilities for loading C header files. This is independent from the |
977 | ;; main completion code. See also the variable `PC-include-file-path' | |
978 | ;; at top of this file. | |
b545bfe6 JB |
979 | |
980 | (defun PC-look-for-include-file () | |
981 | (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) | |
982 | (let ((name (substring (buffer-file-name) | |
983 | (match-beginning 1) (match-end 1))) | |
984 | (punc (aref (buffer-file-name) (match-beginning 0))) | |
985 | (path nil) | |
986 | new-buf) | |
987 | (kill-buffer (current-buffer)) | |
988 | (if (equal name "") | |
f679907b | 989 | (with-current-buffer (car (buffer-list)) |
b545bfe6 JB |
990 | (save-excursion |
991 | (beginning-of-line) | |
992 | (if (looking-at | |
993 | "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") | |
994 | (setq name (buffer-substring (match-beginning 1) | |
995 | (match-end 1)) | |
996 | punc (char-after (1- (match-beginning 1)))) | |
997 | ;; Suggested by Frank Siebenlist: | |
998 | (if (or (looking-at | |
999 | "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") | |
1000 | (looking-at | |
1001 | "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") | |
1002 | (looking-at | |
1003 | "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) | |
1004 | (progn | |
1005 | (setq name (buffer-substring (match-beginning 1) | |
1006 | (match-end 1)) | |
1007 | punc ?\< | |
1008 | path load-path) | |
1009 | (if (string-match "\\.elc$" name) | |
1010 | (setq name (substring name 0 -1)) | |
1011 | (or (string-match "\\.el$" name) | |
1012 | (setq name (concat name ".el"))))) | |
1013 | (error "Not on an #include line")))))) | |
5f34457e | 1014 | (or (string-match "\\.[[:alnum:]]+$" name) |
b545bfe6 JB |
1015 | (setq name (concat name ".h"))) |
1016 | (if (eq punc ?\<) | |
1017 | (let ((path (or path (PC-include-file-path)))) | |
1018 | (while (and path | |
1019 | (not (file-exists-p | |
1020 | (concat (file-name-as-directory (car path)) | |
1021 | name)))) | |
1022 | (setq path (cdr path))) | |
1023 | (if path | |
1024 | (setq name (concat (file-name-as-directory (car path)) name)) | |
1025 | (error "No such include file: <%s>" name))) | |
f679907b | 1026 | (let ((dir (with-current-buffer (car (buffer-list)) |
b545bfe6 JB |
1027 | default-directory))) |
1028 | (if (file-exists-p (concat dir name)) | |
1029 | (setq name (concat dir name)) | |
5b0f8cbc | 1030 | (error "No such include file: `%s'" name)))) |
b545bfe6 JB |
1031 | (setq new-buf (get-file-buffer name)) |
1032 | (if new-buf | |
1033 | ;; no need to verify last-modified time for this! | |
1034 | (set-buffer new-buf) | |
f679907b | 1035 | (set-buffer (create-file-buffer name)) |
b545bfe6 JB |
1036 | (erase-buffer) |
1037 | (insert-file-contents name t)) | |
5b0f8cbc KH |
1038 | ;; Returning non-nil with the new buffer current |
1039 | ;; is sufficient to tell find-file to use it. | |
b545bfe6 JB |
1040 | t) |
1041 | nil)) | |
1042 | ||
1043 | (defun PC-include-file-path () | |
1044 | (or PC-include-file-path | |
1045 | (let ((env (getenv "INCPATH")) | |
1046 | (path nil) | |
1047 | pos) | |
1048 | (or env (error "No include file path specified")) | |
1049 | (while (setq pos (string-match ":[^:]+$" env)) | |
1050 | (setq path (cons (substring env (1+ pos)) path) | |
1051 | env (substring env 0 pos))) | |
1052 | path))) | |
1053 | ||
f679907b | 1054 | ;; This is adapted from lib-complete.el, by Mike Williams. |
b545bfe6 JB |
1055 | (defun PC-include-file-all-completions (file search-path &optional full) |
1056 | "Return all completions for FILE in any directory on SEARCH-PATH. | |
8e28519a | 1057 | If optional third argument FULL is non-nil, returned pathnames should be |
b545bfe6 JB |
1058 | absolute rather than relative to some directory on the SEARCH-PATH." |
1059 | (setq search-path | |
cc7e4da0 SM |
1060 | (mapcar (lambda (dir) |
1061 | (if dir (file-name-as-directory dir) default-directory)) | |
b545bfe6 JB |
1062 | search-path)) |
1063 | (if (file-name-absolute-p file) | |
1064 | ;; It's an absolute file name, so don't need search-path | |
1065 | (progn | |
1066 | (setq file (expand-file-name file)) | |
8e28519a | 1067 | (file-name-all-completions |
b545bfe6 JB |
1068 | (file-name-nondirectory file) (file-name-directory file))) |
1069 | (let ((subdir (file-name-directory file)) | |
1070 | (ndfile (file-name-nondirectory file)) | |
1071 | file-lists) | |
1072 | ;; Append subdirectory part to each element of search-path | |
1073 | (if subdir | |
1074 | (setq search-path | |
cc7e4da0 | 1075 | (mapcar (lambda (dir) (concat dir subdir)) |
b545bfe6 JB |
1076 | search-path) |
1077 | file )) | |
1078 | ;; Make list of completions in each directory on search-path | |
1079 | (while search-path | |
1080 | (let* ((dir (car search-path)) | |
1081 | (subdir (if full dir subdir))) | |
1082 | (if (file-directory-p dir) | |
1083 | (progn | |
1084 | (setq file-lists | |
8e28519a | 1085 | (cons |
cc7e4da0 | 1086 | (mapcar (lambda (file) (concat subdir file)) |
8e28519a | 1087 | (file-name-all-completions ndfile |
b545bfe6 JB |
1088 | (car search-path))) |
1089 | file-lists)))) | |
1090 | (setq search-path (cdr search-path)))) | |
1091 | ;; Compress out duplicates while building complete list (slloooow!) | |
1092 | (let ((sorted (sort (apply 'nconc file-lists) | |
cc7e4da0 | 1093 | (lambda (x y) (not (string-lessp x y))))) |
b545bfe6 JB |
1094 | compressed) |
1095 | (while sorted | |
1096 | (if (equal (car sorted) (car compressed)) nil | |
1097 | (setq compressed (cons (car sorted) compressed))) | |
1098 | (setq sorted (cdr sorted))) | |
1099 | compressed)))) | |
1100 | ||
c023a34f | 1101 | (defun PC-read-file-name-internal (string pred action) |
b1916c6e RS |
1102 | "Extend `read-file-name-internal' to handle include files. |
1103 | This is only used by " | |
1104 | (if (string-match "<\\([^\"<>]*\\)>?\\'" string) | |
1105 | (let* ((name (match-string 1 string)) | |
b545bfe6 JB |
1106 | (str2 (substring string (match-beginning 0))) |
1107 | (completion-table | |
414a17c9 SM |
1108 | (mapcar (lambda (x) |
1109 | (format (if (string-match "/\\'" x) "<%s" "<%s>") x)) | |
b545bfe6 JB |
1110 | (PC-include-file-all-completions |
1111 | name (PC-include-file-path))))) | |
30b775ff SM |
1112 | (cond |
1113 | ((not completion-table) nil) | |
1114 | ((eq action 'lambda) (test-completion str2 completion-table nil)) | |
1115 | ((eq action nil) (PC-try-completion str2 completion-table nil)) | |
1116 | ((eq action t) (all-completions str2 completion-table nil)))) | |
c023a34f | 1117 | (read-file-name-internal string pred action))) |
b545bfe6 | 1118 | \f |
92677e25 | 1119 | |
b545bfe6 JB |
1120 | (provide 'complete) |
1121 | ||
e8af40ee | 1122 | ;;; complete.el ends here |