|
0
|
1 ;;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;%Header
|
|
|
3 ;;;
|
|
|
4 ;;; Rcs_Info: completer.el,v 3.23 1993/09/03 02:05:07 ivan Rel $
|
|
|
5 ;;;
|
|
|
6 ;;; Partial completion mechanism for GNU Emacs. Version 3.03
|
|
|
7 ;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, ccm@cs.cmu.edu.
|
|
|
8 ;;; Thanks to Bjorn Victor for suggestions, testing, and patches for
|
|
|
9 ;;; file completion.
|
|
|
10
|
|
|
11 ;;; This file is part of GNU Emacs.
|
|
|
12
|
|
|
13 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
14 ;;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
|
15 ;;; accepts responsibility to anyone for the consequences of using it
|
|
|
16 ;;; or for whether it serves any particular purpose or works at all,
|
|
|
17 ;;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
|
18 ;;; License for full details.
|
|
|
19 ;;; Everyone is granted permission to copy, modify and redistribute
|
|
|
20 ;;; GNU Emacs, but only under the conditions described in the
|
|
|
21 ;;; GNU Emacs General Public License. A copy of this license is
|
|
|
22 ;;; supposed to have been given to you along with GNU Emacs so you
|
|
|
23 ;;; can know your rights and responsibilities. It should be in a
|
|
|
24 ;;; file named COPYING. Among other things, the copyright notice
|
|
|
25 ;;; and this notice must be preserved on all copies.
|
|
|
26
|
|
|
27 ;;; When loaded, this file extends the standard completion mechanisms
|
|
|
28 ;;; so that they perform pattern matching completions. There is also
|
|
|
29 ;;; an interface that allows it to be used by other programs. The
|
|
|
30 ;;; completion rules are:
|
|
|
31 ;;;
|
|
|
32 ;;; 1) If what has been typed matches any possibility, do normal
|
|
|
33 ;;; completion.
|
|
|
34 ;;;
|
|
|
35 ;;; 2) Otherwise, generate a regular expression such that
|
|
|
36 ;;; completer-words delimit words and generate all possible matches.
|
|
|
37 ;;; The variable completer-any-delimiter can be set to a character
|
|
|
38 ;;; that matches any delimiter. If it were " ", then "by d" would be
|
|
|
39 ;;; byte-recompile-directory. If completer-use-words is T, a match is
|
|
|
40 ;;; unique if it is the only one with the same number of words. If
|
|
|
41 ;;; completer-use-words is NIL, a match is unique if it is the only
|
|
|
42 ;;; possibility. If you ask the completer to use its best guess, it
|
|
|
43 ;;; will be the shortest match of the possibilities unless
|
|
|
44 ;;; completer-exact is T.
|
|
|
45 ;;;
|
|
|
46 ;;; 3) For filenames, if completer-complete-filenames is T, each
|
|
|
47 ;;; pathname component will be individually completed, otherwise only
|
|
|
48 ;;; the final component will be completed. If you are using a
|
|
|
49 ;;; distributed file system like afs, you may want to set up a
|
|
|
50 ;;; symbolic link in your home directory or add pathname components to
|
|
|
51 ;;; completer-file-skip so that the pathname components that go across
|
|
|
52 ;;; machines do not get expanded.
|
|
|
53 ;;;
|
|
|
54 ;;; SPACE, TAB, LFD, RET, and ? do normal completion if possible
|
|
|
55 ;;; otherwise they do partial completion. In addition, C-DEL will
|
|
|
56 ;;; undo the last partial expansion or contraction. M-RET will always
|
|
|
57 ;;; complete to the current match before returning. This is useful
|
|
|
58 ;;; when any string is possible, but you want to complete to a string
|
|
|
59 ;;; as when calling find-file. The bindings can be changed by using
|
|
|
60 ;;; completer-load-hook.
|
|
|
61 ;;;
|
|
|
62 ;;; Modes that use comint-dynamic-complete (like cmushell and ilisp)
|
|
|
63 ;;; will also do partial completion as will M-tab in Emacs LISP.
|
|
|
64 ;;;
|
|
|
65 ;;; Examples:
|
|
|
66 ;;; a-f auto-fill-mode
|
|
|
67 ;;; b--d *beginning-of-defun or byte-recompile-directory
|
|
|
68 ;;; by d *byte-recompile-directory if completer-any-delimiter is " "
|
|
|
69 ;;; ~/i.e *~/ilisp.el or ~/il-el.el or ~/ilisp.elc
|
|
|
70 ;;; /u/mi/ /usr/misc/
|
|
|
71 ;;;
|
|
|
72
|
|
4
|
73
|
|
|
74 (require 'cl)
|
|
|
75
|
|
0
|
76 ;;;%Globals
|
|
|
77 ;;;%%Switches
|
|
|
78 (defvar completer-load-hook nil
|
|
|
79 "Hook called when minibuffer partial completion is loaded.")
|
|
|
80
|
|
|
81 (defvar completer-disable nil
|
|
|
82 "*If T, turn off partial completion. Use the command
|
|
|
83 \\[completer-toggle] to set this.")
|
|
|
84
|
|
|
85 (defvar completer-complete-filenames t
|
|
|
86 "*If T, then each component of a filename will be completed,
|
|
|
87 otherwise just the final component will be completed.")
|
|
|
88
|
|
|
89 (defvar completer-use-words nil ; jwz: this is HATEFUL!
|
|
|
90 "*If T, then prefer completions with the same number of words as the
|
|
|
91 pattern.")
|
|
|
92
|
|
|
93 (defvar completer-words "---. <"
|
|
|
94 "*Delimiters used in partial completions. It should be a set of
|
|
|
95 characters suitable for inclusion in a [] regular expression.")
|
|
|
96
|
|
|
97 (defvar completer-any-delimiter nil
|
|
|
98 "*If a character, then a delimiter in the pattern that matches the
|
|
|
99 character will match any delimiter in completer-words.")
|
|
|
100
|
|
|
101 (defvar completer-file-skip "^cs/$\\|@sys\\|.edu/$\\|.gov/$\\|.com/$\\|:/$"
|
|
|
102 "*Regular expression for pathname components to not complete.")
|
|
|
103
|
|
|
104 (defvar completer-exact nil
|
|
|
105 "*If T, then you must have an exact match. Otherwise, the shortest
|
|
|
106 string that matches the pattern will be used.")
|
|
|
107
|
|
|
108 (defvar completer-cache-size 100
|
|
|
109 "*Size of cache to use for partially completed pathnames.")
|
|
|
110
|
|
|
111 (defvar completer-use-cache t
|
|
|
112 "*Set to nil to disable the partially completed pathname cache.")
|
|
|
113
|
|
|
114 ;;;%%Internal
|
|
|
115 (defvar completer-last-pattern ""
|
|
|
116 "The last pattern expanded.")
|
|
|
117
|
|
|
118 (defvar completer-message nil
|
|
|
119 "T if temporary message was just displayed.")
|
|
|
120
|
|
|
121 (defvar completer-path-cache nil
|
|
|
122 "Cache of (path . choices) for completer.")
|
|
|
123
|
|
|
124 (defvar completer-string nil "Last completer string.")
|
|
|
125 (defvar completer-table nil "Last completer table.")
|
|
|
126 (defvar completer-pred nil "Last completer pred.")
|
|
|
127 (defvar completer-mode nil "Last completer mode.")
|
|
|
128 (defvar completer-result nil "Last completer result.")
|
|
|
129
|
|
4
|
130 (eval-when (eval load compile)
|
|
|
131 (if (not (fboundp 'completion-display-completion-list-function))
|
|
|
132 (setf completion-display-completion-list-function
|
|
|
133 'display-completion-list)))
|
|
|
134
|
|
|
135
|
|
0
|
136 ;;;%Utilities
|
|
|
137 (defun completer-message (message &optional point)
|
|
|
138 "Display MESSAGE at optional POINT for two seconds."
|
|
|
139 (setq point (or point (point-max))
|
|
|
140 completer-message t)
|
|
|
141 (let ((end
|
|
|
142 (save-excursion
|
|
|
143 (goto-char point)
|
|
|
144 (insert message)
|
|
|
145 (point)))
|
|
|
146 (inhibit-quit t))
|
|
|
147 (sit-for 2)
|
|
|
148 (delete-region point end)
|
|
|
149 (if (and quit-flag
|
|
|
150 ;;(not (eq 'lucid-19 ilisp-emacs-version-id))
|
|
|
151 (not (string-match "Lucid" emacs-version))
|
|
|
152 )
|
|
|
153 (setq quit-flag nil
|
|
|
154 unread-command-char 7))))
|
|
|
155
|
|
|
156 ;;;
|
|
|
157 (defun completer-deleter (regexp choices &optional keep)
|
|
|
158 "Destructively remove strings that match REGEXP in CHOICES and
|
|
|
159 return the modified list. If optional KEEP, then keep entries that
|
|
|
160 match regexp."
|
|
|
161 (let* ((choiceb choices)
|
|
|
162 choicep)
|
|
|
163 (if keep
|
|
|
164 (progn
|
|
|
165 (while (and choiceb (not (string-match regexp (car choiceb))))
|
|
|
166 (setq choiceb (cdr choiceb)))
|
|
|
167 (setq choicep choiceb)
|
|
|
168 (while (cdr choicep)
|
|
|
169 (if (string-match regexp (car (cdr choicep)))
|
|
|
170 (setq choicep (cdr choicep))
|
|
|
171 (rplacd choicep (cdr (cdr choicep))))))
|
|
|
172 (while (and choiceb (string-match regexp (car choiceb)))
|
|
|
173 (setq choiceb (cdr choiceb)))
|
|
|
174 (setq choicep choiceb)
|
|
|
175 (while (cdr choicep)
|
|
|
176 (if (string-match regexp (car (cdr choicep)))
|
|
|
177 (rplacd choicep (cdr (cdr choicep)))
|
|
|
178 (setq choicep (cdr choicep)))))
|
|
|
179 choiceb))
|
|
|
180
|
|
|
181 ;;;%%Regexp
|
|
|
182 (defun completer-regexp (string delimiters any)
|
|
|
183 "Convert STRING into a regexp with words delimited by characters in
|
|
|
184 DELIMITERS. Any delimiter in STRING that is the same as ANY will
|
|
|
185 match any delimiter."
|
|
|
186 (let* ((delimiter-reg (concat "[" delimiters "]"))
|
|
|
187 (limit (length string))
|
|
|
188 (pos 0)
|
|
|
189 (regexp "^"))
|
|
|
190 (while (and (< pos limit) (string-match delimiter-reg string pos))
|
|
|
191 (let* ((begin (match-beginning 0))
|
|
|
192 (end (match-end 0))
|
|
|
193 (delimiter (substring string begin end))
|
|
|
194 (anyp (eq (elt string begin) any)))
|
|
|
195 (setq regexp
|
|
|
196 (format "%s%s[^%s]*%s"
|
|
|
197 regexp
|
|
|
198 (regexp-quote (substring string pos begin))
|
|
|
199 (if anyp delimiters delimiter)
|
|
|
200 (if anyp delimiter-reg (regexp-quote delimiter)))
|
|
|
201 pos end)))
|
|
|
202 (if (<= pos limit)
|
|
|
203 (setq regexp (concat regexp
|
|
|
204 (regexp-quote (substring string pos limit)))))))
|
|
|
205
|
|
|
206 ;;;
|
|
|
207 (defun completer-words (regexp string &optional limit)
|
|
|
208 "Return the number of words matching REGEXP in STRING up to LIMIT."
|
|
|
209 (setq limit (or limit 1000))
|
|
|
210 (let ((count 1)
|
|
|
211 (pos 0))
|
|
|
212 (while (and (string-match regexp string pos) (<= count limit))
|
|
|
213 (setq count (1+ count)
|
|
|
214 pos (match-end 0)))
|
|
|
215 count))
|
|
|
216
|
|
|
217 ;;;%Matcher
|
|
|
218 (defun completer-matches (string choices delimiters any)
|
|
|
219 "Return STRING's matches in CHOICES using DELIMITERS and wildcard
|
|
|
220 ANY to segment the strings."
|
|
|
221 (let* ((regexp (concat "[" delimiters "]"))
|
|
|
222 (from nil)
|
|
|
223 (to 0)
|
|
|
224 (pattern nil)
|
|
|
225 (len (length string))
|
|
|
226 (matches nil)
|
|
|
227 sub sublen choice word wordlen pat)
|
|
|
228 ;; Segment pattern
|
|
|
229 (while (< (or from 0) len)
|
|
|
230 (setq to (or (string-match regexp string (if from (1+ from))) len))
|
|
|
231 (if (eq (elt string (or from 0)) completer-any-delimiter)
|
|
|
232 (setq sub (substring string (if from (1+ from) 0) to)
|
|
|
233 sublen (- (length sub)))
|
|
|
234 (setq sub (substring string (or from 0) to)
|
|
|
235 sublen (length sub)))
|
|
|
236 (setq pattern (cons (cons sub sublen) pattern)
|
|
|
237 from to))
|
|
|
238 (setq pattern (reverse pattern))
|
|
|
239 ;; Find choices that match patterns
|
|
|
240 (setq regexp (concat "[" delimiters "]"))
|
|
|
241 (while choices
|
|
|
242 (setq choice (car choices)
|
|
|
243 word pattern
|
|
|
244 from 0)
|
|
|
245 (while (and word from
|
|
|
246 (let* (begin end)
|
|
|
247 (if (< (setq wordlen (cdr (setq pat (car word)))) 0)
|
|
|
248 (setq begin (1+ from)
|
|
|
249 end (+ begin (- wordlen)))
|
|
|
250 (setq begin from
|
|
|
251 end (+ begin wordlen)))
|
|
|
252 (and (<= end (length choice))
|
|
|
253 (or (zerop wordlen)
|
|
|
254 (string-equal
|
|
|
255 (car pat)
|
|
|
256 (substring choice begin end))))))
|
|
|
257 (setq from (string-match regexp choice
|
|
|
258 (if (and (zerop from) (zerop wordlen))
|
|
|
259 from
|
|
|
260 (1+ from)))
|
|
|
261 word (cdr word)))
|
|
|
262 (if (not word) (setq matches (cons choice matches)))
|
|
|
263 (setq choices (cdr choices)))
|
|
|
264 matches))
|
|
|
265
|
|
|
266 ;;;
|
|
|
267 (defun completer-choice (string choices delimiters use-words)
|
|
|
268 "Return the best match of STRING in CHOICES with DELIMITERS between
|
|
|
269 words and T if it is unique. A match is unique if it is the only
|
|
|
270 possibility or when USE-WORDS the only possibility with the same
|
|
|
271 number of words. The shortest string of multiple possiblities will be
|
|
|
272 the best match."
|
|
|
273 (or (if (null (cdr choices)) (cons (car choices) t))
|
|
|
274 (let* ((regexp (concat "[^" delimiters "]*[" delimiters "]"))
|
|
|
275 (words (if use-words (completer-words regexp string)))
|
|
|
276 (choice choices)
|
|
|
277 (unique-p nil)
|
|
|
278 (match nil)
|
|
|
279 (match-count nil)
|
|
|
280 (match-len 1000))
|
|
|
281 (while choice
|
|
|
282 (let* ((current (car choice))
|
|
|
283 (length (length current)))
|
|
|
284 (if match-count
|
|
|
285 (if (= (completer-words regexp current words) words)
|
|
|
286 (progn
|
|
|
287 (setq unique-p nil)
|
|
|
288 (if (< length match-len)
|
|
|
289 (setq match current
|
|
|
290 match-len length))))
|
|
|
291 (if (and use-words
|
|
|
292 (= (completer-words regexp current words) words))
|
|
|
293 (setq match current
|
|
|
294 match-len length
|
|
|
295 match-count t
|
|
|
296 unique-p t)
|
|
|
297 (if (< length match-len)
|
|
|
298 (setq match current
|
|
|
299 match-len length)))))
|
|
|
300 (setq choice (cdr choice)))
|
|
|
301 (cons match unique-p))))
|
|
|
302
|
|
|
303 ;;;%Completer
|
|
|
304 ;;;%%Utilities
|
|
|
305 (defun completer-region (delimiters)
|
|
|
306 "Return the completion region bounded by characters in DELIMITERS
|
|
|
307 for the current buffer assuming that point is in it."
|
|
|
308 (cons (save-excursion (skip-chars-backward delimiters) (point))
|
|
|
309 (save-excursion (skip-chars-forward delimiters) (point))))
|
|
|
310
|
|
|
311 ;;;
|
|
|
312 (defun completer-last-component (string)
|
|
|
313 "Return the start of the last filename component in STRING."
|
|
|
314 (let ((last (1- (length string)) )
|
|
|
315 (match 0)
|
|
|
316 (end 0))
|
|
|
317 (while (and (setq match (string-match "/" string end)) (< match last))
|
|
|
318 (setq end (1+ match)))
|
|
|
319 end))
|
|
|
320
|
|
|
321 ;;;
|
|
|
322 (defun completer-match-record (string matches delimiters any dir mode)
|
|
|
323 "Return (match lcs choices unique) for STRING in MATCHES with
|
|
|
324 DELIMITERS or ANY wildcards and DIR if a filename when in MODE."
|
|
|
325 (let ((pattern (if dir
|
|
|
326 (substring string (completer-last-component string))
|
|
|
327 string))
|
|
|
328 match)
|
|
|
329 (setq matches (completer-matches pattern matches delimiters any)
|
|
|
330 match (try-completion pattern (mapcar 'list matches)))
|
|
|
331 ;; If try-completion produced an exact match for an element in 'matches',
|
|
|
332 ;; then remove any partial matches from 'matches' and set the unique
|
|
|
333 ;; match flag.
|
|
|
334 (and (stringp match) (member match matches) (setq matches (list match)))
|
|
|
335 (if (cdr matches)
|
|
|
336 (let ((lcs (concat dir (try-completion "" (mapcar 'list matches)))))
|
|
|
337 (setq match (if (not completer-exact)
|
|
|
338 (completer-choice
|
|
|
339 pattern matches delimiters completer-use-words)))
|
|
|
340 (list (if match (concat dir (car match)))
|
|
|
341 lcs
|
|
|
342 matches
|
|
|
343 (cdr match)))
|
|
|
344 (if matches
|
|
|
345 (progn (setq match (concat dir (car matches)))
|
|
|
346 (list match match matches t))
|
|
|
347 (list nil nil nil nil)))))
|
|
|
348
|
|
|
349 ;;;%%Complete file
|
|
|
350 (defun completer-extension-regexp (extensions)
|
|
|
351 "Return a regexp that matches to a string that ends with any string from EXTENSIONS list."
|
|
|
352 (concat "\\(" (mapconcat 'regexp-quote extensions "\\|") "\\)\\'"))
|
|
|
353
|
|
|
354 ;;;
|
|
|
355 (defun completer-flush ()
|
|
|
356 "Flush completer's pathname cache."
|
|
|
357 (interactive)
|
|
|
358 (setq completer-path-cache nil))
|
|
|
359
|
|
|
360 ;;;
|
|
|
361 (defun completer-cache (path pred words any mode)
|
|
|
362 "Check to see if PATH is in path cache with PRED, WORDS, ANY and
|
|
|
363 MODE."
|
|
|
364 (let* ((last nil)
|
|
|
365 (ptr completer-path-cache)
|
|
|
366 (size 0)
|
|
|
367 (result nil))
|
|
|
368 (if completer-use-cache
|
|
|
369 (while ptr
|
|
|
370 (let ((current (car (car ptr))))
|
|
|
371 (if (string-equal current path)
|
|
|
372 (progn
|
|
|
373 (if last
|
|
|
374 (progn
|
|
|
375 (rplacd last (cdr ptr))
|
|
|
376 (rplacd ptr completer-path-cache)
|
|
|
377 (setq completer-path-cache ptr)))
|
|
|
378 (setq result (cdr (car ptr))
|
|
|
379 ptr nil))
|
|
|
380 (if (cdr ptr) (setq last ptr))
|
|
|
381 (setq size (1+ size)
|
|
|
382 ptr (cdr ptr))))))
|
|
|
383 (or result
|
|
|
384 (let* ((choices
|
|
|
385 (completer path 'read-file-name-internal pred words any
|
|
|
386 mode t)))
|
|
|
387 (if (and (or (car (cdr (cdr (cdr choices))))
|
|
|
388 (string= path (car choices)))
|
|
|
389 (eq (elt (car choices) (1- (length (car choices)))) ?/))
|
|
|
390 (progn
|
|
|
391 (if (>= size completer-cache-size) (rplacd last nil))
|
|
|
392 (setq completer-path-cache
|
|
|
393 (cons (cons path choices) completer-path-cache))))
|
|
|
394 choices))))
|
|
|
395
|
|
|
396 ;;;
|
|
|
397 (defun completer-file (string pred words any mode)
|
|
|
398 "Return (match common-substring matches unique-p) for STRING using
|
|
|
399 read-file-name-internal for choices that pass PRED using WORDS to
|
|
|
400 delimit words. Optional ANY is a delimiter that matches any of the
|
|
|
401 delimiters in WORD. If optional MODE is nil or 'help then possible
|
|
|
402 matches will always be returned."
|
|
|
403 (let* ((case-fold-search completion-ignore-case)
|
|
|
404 (last (and (eq mode 'exit-ok) (completer-last-component string)))
|
|
|
405 (position
|
|
|
406 ;; Special hack for CMU RFS filenames
|
|
|
407 (if (string-match "^/\\.\\./[^/]*/" string)
|
|
|
408 (match-end 0)
|
|
|
409 (string-match "[^~/]" string)))
|
|
|
410 (new (substring string 0 position))
|
|
|
411 (user (if (string= new "~")
|
|
|
412 (setq new (file-name-directory (expand-file-name new)))))
|
|
|
413 (words (concat words "/"))
|
|
|
414 (len (length string))
|
|
|
415 (choices nil)
|
|
|
416 end
|
|
|
417 (old-choices (list nil nil nil nil)))
|
|
|
418 (while position
|
|
|
419 (let* ((begin (string-match "/" string position))
|
|
|
420 (exact-p nil))
|
|
|
421 (setq end (if begin (match-end 0))
|
|
|
422 choices
|
|
|
423 ;; Ends with a /, so check files in directory
|
|
|
424 (if (and (memq mode '(nil help)) (= position len))
|
|
|
425 (completer-match-record
|
|
|
426 ""
|
|
|
427 ;; This assumes that .. and . come at the end
|
|
|
428 (let* ((choices
|
|
|
429 (all-completions new 'read-file-name-internal))
|
|
|
430 (choicep choices))
|
|
|
431 (if (string= (car choicep) "../")
|
|
|
432 (cdr (cdr choicep))
|
|
|
433 (while (cdr choicep)
|
|
|
434 (if (string= (car (cdr choicep)) "../")
|
|
|
435 (rplacd choicep nil))
|
|
|
436 (setq choicep (cdr choicep)))
|
|
|
437 choices))
|
|
|
438 words any new mode)
|
|
|
439 (if (eq position last)
|
|
|
440 (let ((new (concat new (substring string position))))
|
|
|
441 (list new new nil t))
|
|
|
442 (let ((component (substring string position end)))
|
|
|
443 (if (and end
|
|
|
444 (string-match completer-file-skip component))
|
|
|
445 ;; Assume component is complete
|
|
|
446 (list (concat new component)
|
|
|
447 (concat new component)
|
|
|
448 nil t)
|
|
|
449 (completer-cache
|
|
|
450 (concat new component)
|
|
|
451 pred words any mode))))))
|
|
|
452 ;; Keep going if unique or we match exactly
|
|
|
453 (if (or (car (cdr (cdr (cdr choices))))
|
|
|
454 (setq exact-p
|
|
|
455 (string= (concat new (substring string position end))
|
|
|
456 (car choices))))
|
|
|
457 (setq old-choices
|
|
|
458 (let* ((lcs (car (cdr choices)))
|
|
|
459 (matches (car (cdr (cdr choices))))
|
|
|
460 (slash (and lcs (string-match "/$" lcs))))
|
|
|
461 (list nil
|
|
|
462 (if slash (substring lcs 0 slash) lcs)
|
|
|
463 (if (and (cdr matches)
|
|
|
464 (or (eq mode 'help) (not exact-p)))
|
|
|
465 matches)
|
|
|
466 nil))
|
|
|
467 new (car choices)
|
|
|
468 position end)
|
|
|
469 ;; Its ok to not match user names because they may be in
|
|
|
470 ;; different root directories
|
|
|
471 (if (and (= position 1) (= (elt string 0) ?~))
|
|
|
472 (setq new (substring string 0 end)
|
|
|
473 choices (list new new (list new) t)
|
|
|
474 user nil
|
|
|
475 position end)
|
|
|
476 (setq position nil)))))
|
|
|
477 (if (not (car choices))
|
|
|
478 (setq choices old-choices))
|
|
|
479 (if (and (car choices)
|
|
|
480 (not (eq mode 'help))
|
|
|
481 (not (car (cdr (cdr (cdr choices))))))
|
|
|
482 ;; Try removing completion ignored extensions
|
|
|
483 (let* ((extensions
|
|
|
484 (completer-extension-regexp completion-ignored-extensions))
|
|
|
485 (choiceb (car (cdr (cdr choices))))
|
|
|
486 (choicep choiceb)
|
|
|
487 (isext nil)
|
|
|
488 (noext nil))
|
|
|
489 (while choicep
|
|
|
490 (if (string-match extensions (car choicep))
|
|
|
491 (setq isext t)
|
|
|
492 (setq noext t))
|
|
|
493 (if (and isext noext)
|
|
|
494 ;; There are matches besides extensions
|
|
|
495 (setq choiceb (completer-deleter extensions choiceb)
|
|
|
496 choicep nil)
|
|
|
497 (setq choicep (cdr choicep))))
|
|
|
498 (if (and isext noext)
|
|
|
499 (setq choices
|
|
|
500 (completer-match-record
|
|
|
501 (if end (substring string end) "")
|
|
|
502 choiceb words any
|
|
|
503 (file-name-directory (car (cdr choices)))
|
|
|
504 mode)))))
|
|
|
505 (if user
|
|
|
506 (let ((match (car choices))
|
|
|
507 (lcs (car (cdr choices)))
|
|
|
508 (len (length user)))
|
|
|
509 (setq choices
|
|
|
510 (cons (if match (concat "~" (substring match len)))
|
|
|
511 (cons (if lcs (concat "~" (substring lcs len)))
|
|
|
512 (cdr (cdr choices)))))))
|
|
|
513 choices))
|
|
|
514
|
|
|
515 ;;;%Exported program interface
|
|
|
516 ;;;%%Completer
|
|
|
517 (defun completer (string table pred words
|
|
|
518 &optional any mode file-p)
|
|
|
519 "Return (match common-substring matches unique-p) for STRING in
|
|
|
520 TABLE for choices that pass PRED using WORDS to delimit words. If the
|
|
|
521 flag completer-complete-filenames is T and the table is
|
|
|
522 read-file-name-internal, then filename components will be individually
|
|
|
523 expanded. Optional ANY is a delimiter that can match any delimiter in
|
|
|
524 WORDS. Optional MODE is nil for complete, 'help for help and 'exit
|
|
|
525 for exit."
|
|
|
526 (if (and (stringp completer-string)
|
|
|
527 (string= string completer-string)
|
|
|
528 (eq table completer-table)
|
|
|
529 (eq pred completer-pred)
|
|
|
530 (not file-p)
|
|
|
531 (or (eq mode completer-mode)
|
|
|
532 (not (memq table '(read-file-name-internal
|
|
|
533 read-directory-name-internal)))))
|
|
|
534 completer-result
|
|
|
535 (setq
|
|
|
536 completer-string ""
|
|
|
537 completer-table table
|
|
|
538 completer-pred pred
|
|
|
539 completer-mode mode
|
|
|
540 completer-result
|
|
|
541 (if (and completer-complete-filenames
|
|
|
542 (not file-p) (eq table 'read-file-name-internal))
|
|
|
543 (completer-file string pred words any mode)
|
|
|
544 (let* ((file-p (or file-p (eq table 'read-file-name-internal)))
|
|
|
545 (case-fold-search completion-ignore-case)
|
|
|
546 (pattern (concat "[" words "]"))
|
|
|
547 (component (if file-p (completer-last-component string)))
|
|
|
548 (dir (if component (substring string 0 component)))
|
|
|
549 (string (if dir (substring string component) string))
|
|
|
550 (has-words (or (string-match pattern string)
|
|
|
551 (length string))))
|
|
|
552 (if (and file-p (string-match "^\\$" string))
|
|
|
553 ;; Handle environment variables
|
|
|
554 (let ((match
|
|
|
555 (getenv (substring string 1
|
|
|
556 (string-match "/" string)))))
|
|
|
557 (if match (setq match (concat match "/")))
|
|
|
558 (list match match (list match) match))
|
|
|
559 (let* ((choices
|
|
|
560 (all-completions
|
|
|
561 (concat dir (substring string 0 has-words))
|
|
|
562 table pred))
|
|
|
563 (regexp (completer-regexp string words any)))
|
|
|
564 (if choices
|
|
|
565 (completer-match-record
|
|
|
566 string
|
|
|
567 (completer-deleter regexp choices t)
|
|
|
568 words any dir mode)
|
|
|
569 (list nil nil nil nil))))))
|
|
|
570 completer-string string)
|
|
|
571 completer-result))
|
|
|
572
|
|
|
573 ;;;%%Display choices
|
|
|
574 (defun completer-display-choices (choices &optional match message end
|
|
|
575 display)
|
|
|
576 "Display the list of possible CHOICES with optional MATCH, MESSAGE,
|
|
|
577 END and DISPLAY. If MATCH is non-nil, it will be flagged as the best
|
|
|
578 guess. If there are no choices, display MESSAGE. END is where to put
|
|
|
579 temporary messages. If DISPLAY is present then it will be called on
|
|
|
580 each possible completion and should return a string."
|
|
|
581 (if choices
|
|
|
582 (with-output-to-temp-buffer "*Completions*"
|
|
|
583 (if (cdr choices)
|
|
|
584 (funcall completion-display-completion-list-function
|
|
|
585 (sort
|
|
|
586 (if display
|
|
|
587 (let ((old choices)
|
|
|
588 (new nil))
|
|
|
589 (while old
|
|
|
590 (setq new (cons (funcall display (car old)) new)
|
|
|
591 old (cdr old)))
|
|
|
592 new)
|
|
|
593 (copy-sequence choices))
|
|
|
594 (function (lambda (x y)
|
|
|
595 (string-lessp (or (car-safe x) x)
|
|
|
596 (or (car-safe y) y)))))))
|
|
|
597 (if match
|
|
|
598 (save-excursion
|
|
|
599 (set-buffer "*Completions*")
|
|
|
600 (goto-char (point-min))
|
|
|
601 (let ((buffer-read-only nil))
|
|
|
602 (insert "Guess = " match (if (cdr choices) ", " "") "\n")))))
|
|
|
603 (beep)
|
|
|
604 (completer-message (or message " (No completions)") end)))
|
|
|
605
|
|
|
606 ;;;%%Goto
|
|
|
607 (defun completer-goto (match lcs choices unique delimiters words
|
|
|
608 &optional mode display)
|
|
|
609 "MATCH is the best match, LCS is the longest common substring of all
|
|
|
610 of the matches. CHOICES is a list of the possibilities, UNIQUE
|
|
|
611 indicates if MATCH is unique. DELIMITERS are possible bounding
|
|
|
612 characters for the completion region. WORDS are the characters that
|
|
|
613 delimit the words for partial matches. Replace the region bounded by
|
|
|
614 delimiters with the match if unique and the lcs otherwise unless
|
|
|
615 optional MODE is 'help. Then go to the part of the string that
|
|
|
616 disambiguates choices using WORDS to separate words and display the
|
|
|
617 possibilities if the string was not extended. If optional DISPLAY is
|
|
|
618 present then it will be called on each possible completion and should
|
|
|
619 return a string."
|
|
|
620 (setq completer-message nil)
|
|
|
621 (let* ((region (completer-region delimiters))
|
|
|
622 (start (car region))
|
|
|
623 (end (cdr region))
|
|
|
624 (string (buffer-substring start end))
|
|
|
625 (file-p (string-match "[^ ]*\\(~\\|/\\|$\\)" string))
|
|
|
626 (no-insert (eq mode 'help))
|
|
|
627 (message t)
|
|
|
628 (new (not (string= (buffer-substring start (point)) lcs))))
|
|
|
629 (if unique
|
|
|
630 (if no-insert
|
|
|
631 (progn
|
|
|
632 (goto-char end)
|
|
|
633 (completer-display-choices choices match nil end display))
|
|
|
634 (if (string= string match)
|
|
|
635 (if (not file-p)
|
|
|
636 (progn (goto-char end)
|
|
|
637 (completer-message " (Sole completion)" end)))
|
|
|
638 (completer-insert match delimiters)))
|
|
|
639 ;;Not unique
|
|
|
640 (if lcs
|
|
|
641 (let* ((regexp
|
|
|
642 (concat "[" words (if file-p "/") "]"))
|
|
|
643 (words (completer-words regexp lcs))
|
|
|
644 point)
|
|
|
645 ;; Go to where its ambiguous
|
|
|
646 (goto-char start)
|
|
|
647 (if (not no-insert)
|
|
|
648 (progn
|
|
|
649 (insert lcs)
|
|
|
650 (setq completer-last-pattern
|
|
|
651 (list string delimiters (current-buffer) start)
|
|
|
652 start (point)
|
|
|
653 end (+ end (length lcs)))))
|
|
|
654 ;; Skip to the first delimiter in the original string
|
|
|
655 ;; beyond the ambiguous point and keep from there on
|
|
|
656 (if (re-search-forward regexp end 'move words)
|
|
|
657 (progn
|
|
|
658 (if (and (not no-insert) match)
|
|
|
659 (let ((delimiter
|
|
|
660 (progn
|
|
|
661 (string-match (regexp-quote lcs) match)
|
|
|
662 (substring match (match-end 0)
|
|
|
663 (1+ (match-end 0))))))
|
|
|
664 (if (string-match regexp delimiter)
|
|
|
665 (insert delimiter))))
|
|
|
666 (forward-char -1)))
|
|
|
667 (if (not no-insert)
|
|
|
668 (progn
|
|
|
669 (setq end (- end (- (point) start)))
|
|
|
670 (delete-region start (point))))))
|
|
|
671 (if choices
|
|
|
672 (if (or no-insert (not new))
|
|
|
673 (completer-display-choices choices match nil end display))
|
|
|
674 (if file-p
|
|
|
675 (progn
|
|
|
676 (if (not (= (point) end)) (forward-char 1))
|
|
|
677 (if (not (save-excursion (re-search-forward "/" end t)))
|
|
|
678 (goto-char end))))
|
|
|
679 (if message
|
|
|
680 (progn
|
|
|
681 (beep)
|
|
|
682 (completer-message (if no-insert
|
|
|
683 " (No completions)"
|
|
|
684 " (No match)")
|
|
|
685 end)))))))
|
|
|
686
|
|
|
687 ;;;%Exported buffer interface
|
|
|
688 ;;;%%Complete and go
|
|
|
689 (defun completer-complete-goto (delimiters words table pred
|
|
|
690 &optional no-insert display)
|
|
|
691 "Complete the string bound by DELIMITERS using WORDS to bound words
|
|
|
692 for partial matches in TABLE with PRED and then insert the longest
|
|
|
693 common substring unless optional NO-INSERT and go to the point of
|
|
|
694 ambiguity. If optional DISPLAY, it will be called on each match when
|
|
|
695 possible completions are shown and should return a string."
|
|
|
696 (let* ((region (completer-region delimiters)))
|
|
|
697 (apply 'completer-goto
|
|
|
698 (append (completer (buffer-substring (car region) (cdr region))
|
|
|
699 table pred words completer-any-delimiter
|
|
|
700 no-insert)
|
|
|
701 (list delimiters words no-insert display)))))
|
|
|
702
|
|
|
703 ;;;%%Undo
|
|
|
704 (defun completer-insert (match delimiters &optional buffer undo)
|
|
|
705 "Replace the region bounded with characters in DELIMITERS by MATCH
|
|
|
706 and save it so that it can be restored by completer-undo."
|
|
|
707 (let* ((region (completer-region delimiters))
|
|
|
708 (start (car region))
|
|
|
709 (end (cdr region)))
|
|
|
710 (if (and undo (or (not (= start undo))
|
|
|
711 (not (eq (current-buffer) buffer))))
|
|
|
712 (error "No previous pattern")
|
|
|
713 (setq completer-last-pattern (list (buffer-substring start end)
|
|
|
714 delimiters
|
|
|
715 (current-buffer)
|
|
|
716 start))
|
|
|
717 (delete-region start end)
|
|
|
718 (goto-char start)
|
|
|
719 (insert match))))
|
|
|
720
|
|
|
721 ;;;
|
|
|
722 (defun completer-undo ()
|
|
|
723 "Swap the last expansion and the last match pattern."
|
|
|
724 (interactive)
|
|
|
725 (if completer-last-pattern
|
|
|
726 (apply 'completer-insert completer-last-pattern)
|
|
|
727 (error "No previous pattern")))
|
|
|
728
|
|
|
729 ;;;%Minibuffer specific code
|
|
|
730 ;;;%%Utilities
|
|
|
731 (defun completer-minibuf-string ()
|
|
|
732 "Remove dead filename specs from the minibuffer as delimited by //
|
|
|
733 or ~ or $ and return the resulting string."
|
|
|
734 (save-excursion
|
|
|
735 (goto-char (point-max))
|
|
|
736 (if (and (eq minibuffer-completion-table 'read-file-name-internal)
|
|
|
737 (re-search-backward "//\\|/~\\|.\\$" nil t))
|
|
|
738 (delete-region (point-min) (1+ (point))))
|
|
|
739 (buffer-substring (point-min) (point-max))))
|
|
|
740
|
|
|
741 ;;;
|
|
|
742 (defun completer-minibuf-exit ()
|
|
|
743 "Exit the minibuffer and clear completer-last-pattern."
|
|
|
744 (interactive)
|
|
|
745 (setq completer-last-pattern nil)
|
|
|
746 (exit-minibuffer))
|
|
|
747
|
|
|
748 ;;;
|
|
|
749 (defun completer-new-cmd (cmd)
|
|
4
|
750 "Return T if we can't execute the old minibuffer version of CMD."
|
|
0
|
751 (if (or completer-disable
|
|
|
752 (let ((string (completer-minibuf-string)))
|
|
|
753 (or
|
|
|
754 (not (string-match
|
|
|
755 (concat "[" completer-words "/~]")
|
|
|
756 string))
|
|
|
757 (condition-case ()
|
|
|
758 (let ((completion
|
|
|
759 (try-completion string
|
|
|
760 minibuffer-completion-table
|
|
|
761 minibuffer-completion-predicate)))
|
|
|
762 (if (eq minibuffer-completion-table
|
|
|
763 'read-file-name-internal)
|
|
|
764 ;; Directories complete as themselves
|
|
|
765 (and completion
|
|
|
766 (or (not (string= string completion))
|
|
|
767 (file-exists-p completion)))
|
|
|
768 completion))
|
|
|
769 (error nil)))))
|
|
|
770 (progn
|
|
|
771 (funcall cmd)
|
|
|
772 nil)
|
|
|
773 t))
|
|
|
774
|
|
|
775 ;;;
|
|
|
776 (defun completer-minibuf (&optional mode)
|
|
|
777 "Partial completion of minibuffer expressions. Optional MODE is
|
|
|
778 'help for help and 'exit for exit.
|
|
|
779
|
|
|
780 If what has been typed so far matches any possibility normal
|
|
|
781 completion will be done. Otherwise, the string is considered to be a
|
|
|
782 pattern with words delimited by the characters in
|
|
|
783 completer-words. If completer-exact is T, the best match will be
|
|
|
784 the shortest one with the same number of words as the pattern if
|
|
|
785 possible and otherwise the shortest matching expression. If called
|
|
|
786 with a prefix, caching will be temporarily disabled.
|
|
|
787
|
|
|
788 Examples:
|
|
|
789 a-f auto-fill-mode
|
|
|
790 r-e rmail-expunge
|
|
|
791 b--d *begining-of-defun or byte-recompile-directory
|
|
|
792 by d *byte-recompile-directory if completer-any-delimiter is \" \"
|
|
|
793 ~/i.e *~/ilisp.el or ~/il-el.el or ~/ilisp.elc
|
|
|
794 /u/mi/ /usr/misc/"
|
|
|
795 (interactive)
|
|
|
796 (append
|
|
|
797 (let ((completer-use-cache (not (or (not completer-use-cache)
|
|
|
798 current-prefix-arg))))
|
|
|
799 (completer (completer-minibuf-string)
|
|
|
800 minibuffer-completion-table
|
|
|
801 minibuffer-completion-predicate
|
|
|
802 completer-words
|
|
|
803 completer-any-delimiter
|
|
|
804 mode))
|
|
|
805 (list "^" completer-words mode)))
|
|
|
806
|
|
|
807 ;;;%%Commands
|
|
|
808 (defun completer-toggle ()
|
|
|
809 "Turn partial completion on or off."
|
|
|
810 (interactive)
|
|
|
811 (setq completer-disable (not completer-disable))
|
|
|
812 (message (if completer-disable
|
|
|
813 "Partial completion OFF"
|
|
|
814 "Partial completion ON")))
|
|
|
815
|
|
|
816 ;;;
|
|
|
817 (defvar completer-old-help
|
|
|
818 (lookup-key minibuffer-local-must-match-map "?")
|
|
|
819 "Old binding of ? in minibuffer completion map.")
|
|
|
820 (defun completer-help ()
|
|
|
821 "Partial completion minibuffer-completion-help.
|
|
|
822 See completer-minibuf for more information."
|
|
|
823 (interactive)
|
|
|
824 (if (completer-new-cmd completer-old-help)
|
|
|
825 (apply 'completer-goto (completer-minibuf 'help))))
|
|
|
826
|
|
|
827 ;;;
|
|
|
828 (defvar completer-old-completer
|
|
|
829 (lookup-key minibuffer-local-must-match-map "\t")
|
|
|
830 "Old binding of TAB in minibuffer completion map.")
|
|
|
831 (defun completer-complete ()
|
|
|
832 "Partial completion minibuffer-complete.
|
|
|
833 See completer-minibuf for more information."
|
|
|
834 (interactive)
|
|
|
835 (if (completer-new-cmd completer-old-completer)
|
|
|
836 (apply 'completer-goto (completer-minibuf))))
|
|
|
837
|
|
|
838 ;;;
|
|
|
839 (defvar completer-old-word
|
|
|
840 (lookup-key minibuffer-local-must-match-map " ")
|
|
|
841 "Old binding of SPACE in minibuffer completion map.")
|
|
|
842 (defun completer-word ()
|
|
|
843 "Partial completion minibuffer-complete.
|
|
|
844 See completer-minibuf for more information."
|
|
|
845 (interactive)
|
|
|
846 (if (eq completer-any-delimiter ?\ )
|
|
|
847 (insert ?\ )
|
|
|
848 (if (completer-new-cmd completer-old-word)
|
|
|
849 (apply 'completer-goto (completer-minibuf)))))
|
|
|
850
|
|
|
851 ;;;
|
|
|
852 (defvar completer-old-exit
|
|
|
853 (lookup-key minibuffer-local-must-match-map "\n")
|
|
|
854 "Old binding of RET in minibuffer completion map.")
|
|
|
855 (defun completer-exit ()
|
|
|
856 "Partial completion minibuffer-complete-and-exit.
|
|
|
857 See completer-minibuf for more information."
|
|
|
858 (interactive)
|
|
|
859 (if (completer-new-cmd completer-old-exit)
|
|
|
860 (let* ((completions (completer-minibuf 'exit))
|
|
|
861 (match (car completions))
|
|
|
862 (unique-p (car (cdr (cdr (cdr completions))))))
|
|
|
863 (apply 'completer-goto completions)
|
|
|
864 (if unique-p
|
|
|
865 (completer-minibuf-exit)
|
|
|
866 (if match
|
|
|
867 (progn (completer-insert match "^")
|
|
|
868 (if minibuffer-completion-confirm
|
|
|
869 (completer-message " (Confirm)")
|
|
|
870 (completer-minibuf-exit)))
|
|
|
871 (if (not completer-message) (beep)))))))
|
|
|
872
|
|
|
873 ;;;
|
|
|
874 (defun completer-match-exit ()
|
|
|
875 "Exit the minibuffer with the current best match."
|
|
|
876 (interactive)
|
|
|
877 (let* ((completions (completer-minibuf 'exit))
|
|
|
878 (guess (car completions)))
|
|
|
879 (if (not guess)
|
|
|
880 ;; OK if last filename component doesn't match
|
|
|
881 (setq completions (completer-minibuf 'exit-ok)
|
|
|
882 guess (car completions)))
|
|
|
883 (if guess
|
|
|
884 (progn
|
|
|
885 (goto-char (point-min))
|
|
|
886 (insert guess)
|
|
|
887 (delete-region (point) (point-max))
|
|
|
888 (exit-minibuffer))
|
|
|
889 (apply 'completer-goto completions))))
|
|
|
890
|
|
|
891 ;;;%%Keymaps
|
|
|
892 ;this interferes with normal undo.
|
|
|
893 ;(define-key minibuffer-local-completion-map "\C-_" 'completer-undo)
|
|
|
894 (define-key minibuffer-local-completion-map "\t" 'completer-complete)
|
|
|
895 (define-key minibuffer-local-completion-map " " 'completer-word)
|
|
|
896 (define-key minibuffer-local-completion-map "?" 'completer-help)
|
|
|
897 (define-key minibuffer-local-completion-map "\n" 'completer-minibuf-exit)
|
|
|
898 (define-key minibuffer-local-completion-map "\r" 'completer-minibuf-exit)
|
|
|
899 (define-key minibuffer-local-completion-map "\M-\n" 'completer-match-exit)
|
|
|
900 (define-key minibuffer-local-completion-map "\M-\r" 'completer-match-exit)
|
|
|
901
|
|
|
902 ;this interferes with normal undo.
|
|
|
903 ;(define-key minibuffer-local-must-match-map "\C-_" 'completer-undo)
|
|
|
904 (define-key minibuffer-local-must-match-map "\t" 'completer-complete)
|
|
|
905 (define-key minibuffer-local-must-match-map " " 'completer-word)
|
|
|
906 (define-key minibuffer-local-must-match-map "\n" 'completer-exit)
|
|
|
907 (define-key minibuffer-local-must-match-map "\r" 'completer-exit)
|
|
|
908 (define-key minibuffer-local-must-match-map "?" 'completer-help)
|
|
|
909 (define-key minibuffer-local-must-match-map "\M-\n" 'completer-match-exit)
|
|
|
910 (define-key minibuffer-local-must-match-map "\M-\r" 'completer-match-exit)
|
|
|
911
|
|
|
912 ;;;%comint
|
|
|
913 (defun completer-comint-dynamic-list-completions (completions)
|
|
|
914 "List in help buffer sorted COMPLETIONS.
|
|
|
915 Typing SPC flushes the help buffer."
|
|
|
916 (completer-comint-dynamic-complete-1 nil 'help))
|
|
|
917
|
|
|
918 (defun completer-comint-dynamic-complete-filename ()
|
|
|
919 "Dynamically complete the filename at point."
|
|
|
920 (interactive)
|
|
|
921 (completer-comint-dynamic-complete-1 nil t))
|
|
|
922
|
|
|
923 ;;;
|
|
|
924 (defun completer-comint-dynamic-complete-1 (&optional undo mode)
|
|
|
925 "Complete the previous filename or display possibilities if done
|
|
|
926 twice in a row. If called with a prefix, undo the last completion."
|
|
|
927 (interactive "P")
|
|
|
928 (if undo
|
|
|
929 (completer-undo)
|
|
|
930 ;; added by jwz: don't cache completions in shell buffer!
|
|
|
931 (setq completer-string nil)
|
|
|
932 (let ((conf (current-window-configuration)));; lemacs change
|
|
|
933 (completer-complete-goto
|
|
|
934 "^ \t\n\""
|
|
|
935 completer-words
|
|
|
936 'read-file-name-internal
|
|
|
937 default-directory
|
|
|
938 mode)
|
|
|
939 ;; lemacs change
|
|
|
940 (if (eq mode 'help) (comint-restore-window-config conf))
|
|
|
941 )))
|
|
|
942 ;(fset 'comint-dynamic-complete 'completer-comint-dynamic-complete)
|
|
|
943 (fset 'comint-dynamic-complete-filename
|
|
|
944 'completer-comint-dynamic-complete-filename)
|
|
|
945 (fset 'comint-dynamic-list-completions
|
|
|
946 'completer-comint-dynamic-list-completions)
|
|
|
947
|
|
|
948 ;;; Set the functions again if comint is loaded
|
|
|
949 (setq comint-load-hook
|
|
|
950 (cons (function (lambda ()
|
|
|
951 ;; (fset 'comint-dynamic-complete
|
|
|
952 ;; 'completer-comint-dynamic-complete)
|
|
|
953 (fset 'comint-dynamic-complete-filename
|
|
|
954 'completer-comint-dynamic-complete-filename)
|
|
|
955 (fset 'comint-dynamic-list-completions
|
|
|
956 'completer-comint-dynamic-list-completions)))
|
|
|
957 (if (and (boundp 'comint-load-hook) comint-load-hook)
|
|
|
958 (if (consp comint-load-hook)
|
|
|
959 (if (eq (car comint-load-hook) 'lambda)
|
|
|
960 (list comint-load-hook)
|
|
|
961 comint-load-hook)
|
|
|
962 (list comint-load-hook)))))
|
|
|
963
|
|
|
964 ;;;%lisp-complete-symbol
|
|
|
965 (defun lisp-complete-symbol (&optional mode)
|
|
|
966 "Perform partial completion on Lisp symbol preceding point. That
|
|
|
967 symbol is compared against the symbols that exist and any additional
|
|
|
968 characters determined by what is there are inserted. If the symbol
|
|
|
969 starts just after an open-parenthesis, only symbols with function
|
|
|
970 definitions are considered. Otherwise, all symbols with function
|
|
|
971 definitions, values or properties are considered. If called with a
|
|
|
972 negative prefix, the last completion will be undone."
|
|
|
973 (interactive "P")
|
|
|
974 (if (< (prefix-numeric-value mode) 0)
|
|
|
975 (completer-undo)
|
|
|
976 (let* ((end (save-excursion (skip-chars-forward "^ \t\n)]}\"") (point)))
|
|
|
977 (beg (save-excursion
|
|
|
978 (backward-sexp 1)
|
|
|
979 (while (= (char-syntax (following-char)) ?\')
|
|
|
980 (forward-char 1))
|
|
|
981 (point)))
|
|
|
982 (pattern (buffer-substring beg end))
|
|
|
983 (predicate
|
|
|
984 (if (eq (char-after (1- beg)) ?\()
|
|
|
985 'fboundp
|
|
|
986 (function (lambda (sym)
|
|
|
987 (or (boundp sym) (fboundp sym)
|
|
|
988 (symbol-plist sym))))))
|
|
|
989 (completion (try-completion pattern obarray predicate)))
|
|
|
990 (cond ((eq completion t))
|
|
|
991 ((null completion)
|
|
|
992 (completer-complete-goto
|
|
|
993 "^ \t\n\(\)[]{}'`" completer-words
|
|
|
994 obarray predicate
|
|
|
995 nil
|
|
|
996 (if (not (eq predicate 'fboundp))
|
|
|
997 (function (lambda (choice)
|
|
|
998 (if (fboundp (intern choice))
|
|
|
999 (list choice " <f>")
|
|
|
1000 choice))))))
|
|
|
1001 ((not (string= pattern completion))
|
|
|
1002 (delete-region beg end)
|
|
|
1003 (insert completion))
|
|
|
1004 (t
|
|
|
1005 (message "Making completion list...")
|
|
|
1006 (let ((list (all-completions pattern obarray predicate)))
|
|
|
1007 (or (eq predicate 'fboundp)
|
|
|
1008 (let (new)
|
|
|
1009 (while list
|
|
|
1010 (setq new (cons (if (fboundp (intern (car list)))
|
|
|
1011 (list (car list) " <f>")
|
|
|
1012 (car list))
|
|
|
1013 new))
|
|
|
1014 (setq list (cdr list)))
|
|
|
1015 (setq list (nreverse new))))
|
|
|
1016 (with-output-to-temp-buffer "*Help*"
|
|
|
1017 (funcall completion-display-completion-list-function
|
|
|
1018 (sort list (function (lambda (x y)
|
|
|
1019 (string-lessp
|
|
|
1020 (or (car-safe x) x)
|
|
|
1021 (or (car-safe y) y))))))))
|
|
|
1022 (message "Making completion list...%s" "done"))))))
|
|
|
1023
|
|
|
1024 ;;;%Hooks
|
|
|
1025 (provide 'completer)
|
|
|
1026 (run-hooks 'completer-load-hook)
|
