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