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