Line data Source code
1 : ;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: John Wiegley <johnw@gnu.org>
6 : ;; Keywords: processes abbrev
7 :
8 : ;; This file is part of GNU Emacs.
9 :
10 : ;; GNU Emacs is free software: you can redistribute it and/or modify
11 : ;; it under the terms of the GNU General Public License as published by
12 : ;; the Free Software Foundation, either version 3 of the License, or
13 : ;; (at your option) any later version.
14 :
15 : ;; GNU Emacs is distributed in the hope that it will be useful,
16 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 : ;; GNU General Public License for more details.
19 :
20 : ;; You should have received a copy of the GNU General Public License
21 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22 :
23 : ;;; Commentary:
24 :
25 : ;; This module provides a programmable completion facility using
26 : ;; "completion functions". Each completion function is responsible
27 : ;; for producing a list of possible completions relevant to the current
28 : ;; argument position.
29 : ;;
30 : ;; To use pcomplete with shell-mode, for example, you will need the
31 : ;; following in your init file:
32 : ;;
33 : ;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
34 : ;;
35 : ;; Most of the code below simply provides support mechanisms for
36 : ;; writing completion functions. Completion functions themselves are
37 : ;; very easy to write. They have few requirements beyond those of
38 : ;; regular Lisp functions.
39 : ;;
40 : ;; Consider the following example, which will complete against
41 : ;; filenames for the first two arguments, and directories for all
42 : ;; remaining arguments:
43 : ;;
44 : ;; (defun pcomplete/my-command ()
45 : ;; (pcomplete-here (pcomplete-entries))
46 : ;; (pcomplete-here (pcomplete-entries))
47 : ;; (while (pcomplete-here (pcomplete-dirs))))
48 : ;;
49 : ;; Here are the requirements for completion functions:
50 : ;;
51 : ;; @ They must be called "pcomplete/MAJOR-MODE/NAME", or
52 : ;; "pcomplete/NAME". This is how they are looked up, using the NAME
53 : ;; specified in the command argument (the argument in first
54 : ;; position).
55 : ;;
56 : ;; @ They must be callable with no arguments.
57 : ;;
58 : ;; @ Their return value is ignored. If they actually return normally,
59 : ;; it means no completions were available.
60 : ;;
61 : ;; @ In order to provide completions, they must throw the tag
62 : ;; `pcomplete-completions'. The value must be a completion table
63 : ;; (i.e. a table that can be passed to try-completion and friends)
64 : ;; for the final argument.
65 : ;;
66 : ;; @ To simplify completion function logic, the tag `pcompleted' may
67 : ;; be thrown with a value of nil in order to abort the function. It
68 : ;; means that there were no completions available.
69 : ;;
70 : ;; When a completion function is called, the variable `pcomplete-args'
71 : ;; is in scope, and contains all of the arguments specified on the
72 : ;; command line. The variable `pcomplete-last' is the index of the
73 : ;; last argument in that list.
74 : ;;
75 : ;; The variable `pcomplete-index' is used by the completion code to
76 : ;; know which argument the completion function is currently examining.
77 : ;; It always begins at 1, meaning the first argument after the command
78 : ;; name.
79 : ;;
80 : ;; To facilitate writing completion logic, a special macro,
81 : ;; `pcomplete-here', has been provided which does several things:
82 : ;;
83 : ;; 1. It will throw `pcompleted' (with a value of nil) whenever
84 : ;; `pcomplete-index' exceeds `pcomplete-last'.
85 : ;;
86 : ;; 2. It will increment `pcomplete-index' if the final argument has
87 : ;; not been reached yet.
88 : ;;
89 : ;; 3. It will evaluate the form passed to it, and throw the result
90 : ;; using the `pcomplete-completions' tag, if it is called when
91 : ;; `pcomplete-index' is pointing to the final argument.
92 : ;;
93 : ;; Sometimes a completion function will want to vary the possible
94 : ;; completions for an argument based on the previous one. To
95 : ;; facilitate tests like this, the function `pcomplete-test' and
96 : ;; `pcomplete-match' are provided. Called with one argument, they
97 : ;; test the value of the previous command argument. Otherwise, a
98 : ;; relative index may be given as an optional second argument, where 0
99 : ;; refers to the current argument, 1 the previous, 2 the one before
100 : ;; that, etc. The symbols `first' and `last' specify absolute
101 : ;; offsets.
102 : ;;
103 : ;; Here is an example which will only complete against directories for
104 : ;; the second argument if the first argument is also a directory:
105 : ;;
106 : ;; (defun pcomplete/example ()
107 : ;; (pcomplete-here (pcomplete-entries))
108 : ;; (if (pcomplete-test 'file-directory-p)
109 : ;; (pcomplete-here (pcomplete-dirs))
110 : ;; (pcomplete-here (pcomplete-entries))))
111 : ;;
112 : ;; For generating completion lists based on directory contents, see
113 : ;; the functions `pcomplete-entries', `pcomplete-dirs',
114 : ;; `pcomplete-executables' and `pcomplete-all-entries'.
115 : ;;
116 : ;; Consult the documentation for `pcomplete-here' for information
117 : ;; about its other arguments.
118 :
119 : ;;; Code:
120 :
121 : (require 'comint)
122 :
123 : (defgroup pcomplete nil
124 : "Programmable completion."
125 : :version "21.1"
126 : :group 'processes)
127 :
128 : ;;; User Variables:
129 :
130 : (defcustom pcomplete-file-ignore nil
131 : "A regexp of filenames to be disregarded during file completion."
132 : :type '(choice regexp (const :tag "None" nil))
133 : :group 'pcomplete)
134 :
135 : (defcustom pcomplete-dir-ignore nil
136 : "A regexp of names to be disregarded during directory completion."
137 : :type '(choice regexp (const :tag "None" nil))
138 : :group 'pcomplete)
139 :
140 : (defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
141 : ;; FIXME: the doc mentions file-name completion, but the code
142 : ;; seems to apply it to all completions.
143 : "If non-nil, ignore case when doing filename completion."
144 : :type 'boolean
145 : :group 'pcomplete)
146 :
147 : (defcustom pcomplete-autolist nil
148 : "If non-nil, automatically list possibilities on partial completion.
149 : This mirrors the optional behavior of tcsh."
150 : :type 'boolean
151 : :group 'pcomplete)
152 :
153 : (defcustom pcomplete-suffix-list (list ?/ ?:)
154 : "A list of characters which constitute a proper suffix."
155 : :type '(repeat character)
156 : :group 'pcomplete)
157 : (make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
158 :
159 : (defcustom pcomplete-recexact nil
160 : "If non-nil, use shortest completion if characters cannot be added.
161 : This mirrors the optional behavior of tcsh.
162 :
163 : A non-nil value is useful if `pcomplete-autolist' is non-nil too."
164 : :type 'boolean
165 : :group 'pcomplete)
166 :
167 : (define-obsolete-variable-alias
168 : 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3")
169 :
170 : (defcustom pcomplete-man-function 'man
171 : "A function to that will be called to display a manual page.
172 : It will be passed the name of the command to document."
173 : :type 'function
174 : :group 'pcomplete)
175 :
176 : (defcustom pcomplete-compare-entry-function 'string-lessp
177 : "This function is used to order file entries for completion.
178 : The behavior of most all shells is to sort alphabetically."
179 : :type '(radio (function-item string-lessp)
180 : (function-item file-newer-than-file-p)
181 : (function :tag "Other"))
182 : :group 'pcomplete)
183 :
184 : (defcustom pcomplete-help nil
185 : "A string or function (or nil) used for context-sensitive help.
186 : If a string, it should name an Info node that will be jumped to.
187 : If non-nil, it must a sexp that will be evaluated, and whose
188 : result will be shown in the minibuffer.
189 : If nil, the function `pcomplete-man-function' will be called with the
190 : current command argument."
191 : :type '(choice string sexp (const :tag "Use man page" nil))
192 : :group 'pcomplete)
193 :
194 : (defcustom pcomplete-expand-before-complete nil
195 : "If non-nil, expand the current argument before completing it.
196 : This means that typing something such as `$HOME/bi' followed by
197 : \\[pcomplete-argument] will cause the variable reference to be
198 : resolved first, and the resultant value that will be completed against
199 : to be inserted in the buffer. Note that exactly what gets expanded
200 : and how is entirely up to the behavior of the
201 : `pcomplete-parse-arguments-function'."
202 : :type 'boolean
203 : :group 'pcomplete)
204 :
205 : (defcustom pcomplete-parse-arguments-function
206 : 'pcomplete-parse-buffer-arguments
207 : "A function to call to parse the current line's arguments.
208 : It should be called with no parameters, and with point at the position
209 : of the argument that is to be completed.
210 :
211 : It must either return nil, or a cons cell of the form:
212 :
213 : ((ARG...) (BEG-POS...))
214 :
215 : The two lists must be identical in length. The first gives the final
216 : value of each command line argument (which need not match the textual
217 : representation of that argument), and BEG-POS gives the beginning
218 : position of each argument, as it is seen by the user. The establishes
219 : a relationship between the fully resolved value of the argument, and
220 : the textual representation of the argument."
221 : :type 'function
222 : :group 'pcomplete)
223 :
224 : (defcustom pcomplete-cycle-completions t
225 : "If non-nil, hitting the TAB key cycles through the completion list.
226 : Typical Emacs behavior is to complete as much as possible, then pause
227 : waiting for further input. Then if TAB is hit again, show a list of
228 : possible completions. When `pcomplete-cycle-completions' is non-nil,
229 : it acts more like zsh or 4nt, showing the first maximal match first,
230 : followed by any further matches on each subsequent pressing of the TAB
231 : key. \\[pcomplete-list] is the key to press if the user wants to see
232 : the list of possible completions."
233 : :type 'boolean
234 : :group 'pcomplete)
235 :
236 : (defcustom pcomplete-cycle-cutoff-length 5
237 : "If the number of completions is greater than this, don't cycle.
238 : This variable is a compromise between the traditional Emacs style of
239 : completion, and the \"cycling\" style. Basically, if there are more
240 : than this number of completions possible, don't automatically pick the
241 : first one and then expect the user to press TAB to cycle through them.
242 : Typically, when there are a large number of completion possibilities,
243 : the user wants to see them in a list buffer so that they can know what
244 : options are available. But if the list is small, it means the user
245 : has already entered enough input to disambiguate most of the
246 : possibilities, and therefore they are probably most interested in
247 : cycling through the candidates. Set this value to nil if you want
248 : cycling to always be enabled."
249 : :type '(choice integer (const :tag "Always cycle" nil))
250 : :group 'pcomplete)
251 :
252 : (defcustom pcomplete-restore-window-delay 1
253 : "The number of seconds to wait before restoring completion windows.
254 : Once the completion window has been displayed, if the user then goes
255 : on to type something else, that completion window will be removed from
256 : the display (actually, the original window configuration before it was
257 : displayed will be restored), after this many seconds of idle time. If
258 : set to nil, completion windows will be left on second until the user
259 : removes them manually. If set to 0, they will disappear immediately
260 : after the user enters a key other than TAB."
261 : :type '(choice integer (const :tag "Never restore" nil))
262 : :group 'pcomplete)
263 :
264 : (defcustom pcomplete-try-first-hook nil
265 : "A list of functions which are called before completing an argument.
266 : This can be used, for example, for completing things which might apply
267 : to all arguments, such as variable names after a $."
268 : :type 'hook
269 : :group 'pcomplete)
270 :
271 : (defsubst pcomplete-executables (&optional regexp)
272 : "Complete amongst a list of directories and executables."
273 0 : (pcomplete-entries regexp 'file-executable-p))
274 :
275 : (defcustom pcomplete-command-completion-function
276 : (function
277 : (lambda ()
278 : (pcomplete-here (pcomplete-executables))))
279 : "Function called for completing the initial command argument."
280 : :type 'function
281 : :group 'pcomplete)
282 :
283 : (defcustom pcomplete-command-name-function 'pcomplete-command-name
284 : "Function called for determining the current command name."
285 : :type 'function
286 : :group 'pcomplete)
287 :
288 : (defcustom pcomplete-default-completion-function
289 : (function
290 : (lambda ()
291 : (while (pcomplete-here (pcomplete-entries)))))
292 : "Function called when no completion rule can be found.
293 : This function is used to generate completions for every argument."
294 : :type 'function
295 : :group 'pcomplete)
296 :
297 : (defcustom pcomplete-use-paring t
298 : "If t, pare alternatives that have already been used.
299 : If nil, you will always see the completion set of possible options, no
300 : matter which of those options have already been used in previous
301 : command arguments."
302 : :type 'boolean
303 : :group 'pcomplete)
304 :
305 : (defcustom pcomplete-termination-string " "
306 : "A string that is inserted after any completion or expansion.
307 : This is usually a space character, useful when completing lists of
308 : words separated by spaces. However, if your list uses a different
309 : separator character, or if the completion occurs in a word that is
310 : already terminated by a character, this variable should be locally
311 : modified to be an empty string, or the desired separation string."
312 : :type 'string
313 : :group 'pcomplete)
314 :
315 : ;;; Internal Variables:
316 :
317 : ;; for cycling completion support
318 : (defvar pcomplete-current-completions nil)
319 : (defvar pcomplete-last-completion-length)
320 : (defvar pcomplete-last-completion-stub)
321 : (defvar pcomplete-last-completion-raw)
322 : (defvar pcomplete-last-window-config nil)
323 : (defvar pcomplete-window-restore-timer nil)
324 :
325 : (make-variable-buffer-local 'pcomplete-current-completions)
326 : (make-variable-buffer-local 'pcomplete-last-completion-length)
327 : (make-variable-buffer-local 'pcomplete-last-completion-stub)
328 : (make-variable-buffer-local 'pcomplete-last-completion-raw)
329 : (make-variable-buffer-local 'pcomplete-last-window-config)
330 : (make-variable-buffer-local 'pcomplete-window-restore-timer)
331 :
332 : ;; used for altering pcomplete's behavior. These global variables
333 : ;; should always be nil.
334 : (defvar pcomplete-show-help nil)
335 : (defvar pcomplete-show-list nil)
336 : (defvar pcomplete-expand-only-p nil)
337 :
338 : ;; for the sake of the bye-compiler, when compiling other files that
339 : ;; contain completion functions
340 : (defvar pcomplete-args nil)
341 : (defvar pcomplete-begins nil)
342 : (defvar pcomplete-last nil)
343 : (defvar pcomplete-index nil)
344 : (defvar pcomplete-stub nil)
345 : (defvar pcomplete-seen nil)
346 : (defvar pcomplete-norm-func nil)
347 :
348 : ;;; User Functions:
349 :
350 : ;;; Alternative front-end using the standard completion facilities.
351 :
352 : ;; The way pcomplete-parse-arguments, pcomplete-stub, and
353 : ;; pcomplete-quote-argument work only works because of some deep
354 : ;; hypothesis about the way the completion work. Basically, it makes
355 : ;; it pretty much impossible to have completion other than
356 : ;; prefix-completion.
357 : ;;
358 : ;; pcomplete--common-suffix and completion-table-subvert try to work around
359 : ;; this difficulty with heuristics, but it's really a hack.
360 :
361 : (defvar pcomplete-unquote-argument-function #'comint--unquote-argument)
362 :
363 : (defsubst pcomplete-unquote-argument (s)
364 0 : (funcall pcomplete-unquote-argument-function s))
365 :
366 : (defvar pcomplete-requote-argument-function #'comint--requote-argument)
367 :
368 : (defun pcomplete--common-suffix (s1 s2)
369 : ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
370 : ;; there shouldn't be any case difference, even if the completion is
371 : ;; case-insensitive.
372 0 : (let ((case-fold-search nil))
373 0 : (string-match
374 : ;; \x3FFF7F is just an arbitrary char among the ones Emacs accepts
375 : ;; that hopefully will never appear in normal text.
376 : "\\(?:.\\|\n\\)*?\\(\\(?:.\\|\n\\)*\\)\x3FFF7F\\(?:.\\|\n\\)*\\1\\'"
377 0 : (concat s1 "\x3FFF7F" s2))
378 0 : (- (match-end 1) (match-beginning 1))))
379 :
380 : (defun pcomplete-completions-at-point ()
381 : "Provide standard completion using pcomplete's completion tables.
382 : Same as `pcomplete' but using the standard completion UI."
383 : ;; FIXME: it only completes the text before point, whereas the
384 : ;; standard UI may also consider text after point.
385 : ;; FIXME: the `pcomplete' UI may be used internally during
386 : ;; pcomplete-completions and then throw to `pcompleted', thus
387 : ;; imposing the pcomplete UI over the standard UI.
388 0 : (catch 'pcompleted
389 0 : (let* ((pcomplete-stub)
390 : pcomplete-seen pcomplete-norm-func
391 : pcomplete-args pcomplete-last pcomplete-index
392 0 : (pcomplete-autolist pcomplete-autolist)
393 0 : (pcomplete-suffix-list pcomplete-suffix-list)
394 : ;; Apparently the vars above are global vars modified by
395 : ;; side-effects, whereas pcomplete-completions is the core
396 : ;; function that finds the chunk of text to complete
397 : ;; (returned indirectly in pcomplete-stub) and the set of
398 : ;; possible completions.
399 0 : (completions (pcomplete-completions))
400 : ;; Usually there's some close connection between pcomplete-stub
401 : ;; and the text before point. But depending on what
402 : ;; pcomplete-parse-arguments-function does, that connection
403 : ;; might not be that close. E.g. in eshell,
404 : ;; pcomplete-parse-arguments-function expands envvars.
405 : ;;
406 : ;; Since we use minibuffer-complete, which doesn't know
407 : ;; pcomplete-stub and works from the buffer's text instead,
408 : ;; we need to trick minibuffer-complete, into using
409 : ;; pcomplete-stub without its knowledge. To that end, we
410 : ;; use completion-table-subvert to construct a completion
411 : ;; table which expects strings using a prefix from the
412 : ;; buffer's text but internally uses the corresponding
413 : ;; prefix from pcomplete-stub.
414 0 : (beg (max (- (point) (length pcomplete-stub))
415 0 : (pcomplete-begin)))
416 0 : (buftext (pcomplete-unquote-argument
417 0 : (buffer-substring beg (point)))))
418 0 : (when completions
419 0 : (let ((table
420 0 : (completion-table-with-quoting
421 0 : (if (equal pcomplete-stub buftext)
422 0 : completions
423 : ;; This may not always be strictly right, but given the lack
424 : ;; of any other info, it's about as good as it gets, and in
425 : ;; practice it should work just fine (fingers crossed).
426 0 : (let ((suf-len (pcomplete--common-suffix
427 0 : pcomplete-stub buftext)))
428 0 : (completion-table-subvert
429 0 : completions
430 0 : (substring buftext 0 (- (length buftext) suf-len))
431 0 : (substring pcomplete-stub 0
432 0 : (- (length pcomplete-stub) suf-len)))))
433 0 : pcomplete-unquote-argument-function
434 0 : pcomplete-requote-argument-function))
435 : (pred
436 : ;; Pare it down, if applicable.
437 0 : (when (and pcomplete-use-paring pcomplete-seen)
438 : ;; Capture the dynbound values for later use.
439 0 : (let ((norm-func pcomplete-norm-func)
440 : (seen
441 0 : (mapcar (lambda (f)
442 0 : (funcall pcomplete-norm-func
443 0 : (directory-file-name f)))
444 0 : pcomplete-seen)))
445 : (lambda (f)
446 0 : (not (member
447 0 : (funcall norm-func (directory-file-name f))
448 0 : seen)))))))
449 0 : (when pcomplete-ignore-case
450 0 : (setq table (completion-table-case-fold table)))
451 0 : (list beg (point) table
452 0 : :predicate pred
453 : :exit-function
454 : ;; If completion is finished, add a terminating space.
455 : ;; We used to also do this if STATUS is `sole', but
456 : ;; that does not work right when completion cycling.
457 0 : (unless (zerop (length pcomplete-termination-string))
458 : (lambda (_s status)
459 0 : (when (eq status 'finished)
460 0 : (if (looking-at
461 0 : (regexp-quote pcomplete-termination-string))
462 0 : (goto-char (match-end 0))
463 0 : (insert pcomplete-termination-string)))))))))))
464 :
465 : ;; I don't think such commands are usable before first setting up buffer-local
466 : ;; variables to parse args, so there's no point autoloading it.
467 : ;; ;;;###autoload
468 : (defun pcomplete-std-complete ()
469 0 : (let ((data (pcomplete-completions-at-point)))
470 0 : (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
471 0 : (plist-get :predicate (nthcdr 3 data)))))
472 :
473 : ;;; Pcomplete's native UI.
474 :
475 : ;;;###autoload
476 : (defun pcomplete (&optional interactively)
477 : "Support extensible programmable completion.
478 : To use this function, just bind the TAB key to it, or add it to your
479 : completion functions list (it should occur fairly early in the list)."
480 : (interactive "p")
481 0 : (if (and interactively
482 0 : pcomplete-cycle-completions
483 0 : pcomplete-current-completions
484 0 : (memq last-command '(pcomplete
485 : pcomplete-expand-and-complete
486 0 : pcomplete-reverse)))
487 0 : (progn
488 0 : (delete-char (- pcomplete-last-completion-length))
489 0 : (if (eq this-command 'pcomplete-reverse)
490 0 : (progn
491 0 : (push (car (last pcomplete-current-completions))
492 0 : pcomplete-current-completions)
493 0 : (setcdr (last pcomplete-current-completions 2) nil))
494 0 : (nconc pcomplete-current-completions
495 0 : (list (car pcomplete-current-completions)))
496 0 : (setq pcomplete-current-completions
497 0 : (cdr pcomplete-current-completions)))
498 0 : (pcomplete-insert-entry pcomplete-last-completion-stub
499 0 : (car pcomplete-current-completions)
500 0 : nil pcomplete-last-completion-raw))
501 0 : (setq pcomplete-current-completions nil
502 0 : pcomplete-last-completion-raw nil)
503 0 : (catch 'pcompleted
504 0 : (let* ((pcomplete-stub)
505 : pcomplete-seen pcomplete-norm-func
506 : pcomplete-args pcomplete-last pcomplete-index
507 0 : (pcomplete-autolist pcomplete-autolist)
508 0 : (pcomplete-suffix-list pcomplete-suffix-list)
509 0 : (completions (pcomplete-completions))
510 0 : (result (pcomplete-do-complete pcomplete-stub completions)))
511 0 : (and result
512 0 : (not (eq (car result) 'listed))
513 0 : (cdr result)
514 0 : (pcomplete-insert-entry pcomplete-stub (cdr result)
515 0 : (memq (car result)
516 0 : '(sole shortest))
517 0 : pcomplete-last-completion-raw))))))
518 :
519 : ;;;###autoload
520 : (defun pcomplete-reverse ()
521 : "If cycling completion is in use, cycle backwards."
522 : (interactive)
523 0 : (call-interactively 'pcomplete))
524 :
525 : ;;;###autoload
526 : (defun pcomplete-expand-and-complete ()
527 : "Expand the textual value of the current argument.
528 : This will modify the current buffer."
529 : (interactive)
530 0 : (let ((pcomplete-expand-before-complete t))
531 0 : (pcomplete)))
532 :
533 : ;;;###autoload
534 : (defun pcomplete-continue ()
535 : "Complete without reference to any cycling completions."
536 : (interactive)
537 0 : (setq pcomplete-current-completions nil
538 0 : pcomplete-last-completion-raw nil)
539 0 : (call-interactively 'pcomplete))
540 :
541 : ;;;###autoload
542 : (defun pcomplete-expand ()
543 : "Expand the textual value of the current argument.
544 : This will modify the current buffer."
545 : (interactive)
546 0 : (let ((pcomplete-expand-before-complete t)
547 : (pcomplete-expand-only-p t))
548 0 : (pcomplete)
549 0 : (when (and pcomplete-current-completions
550 0 : (> (length pcomplete-current-completions) 0)) ;??
551 0 : (delete-char (- pcomplete-last-completion-length))
552 0 : (while pcomplete-current-completions
553 0 : (unless (pcomplete-insert-entry
554 0 : "" (car pcomplete-current-completions) t
555 0 : pcomplete-last-completion-raw)
556 0 : (insert-and-inherit pcomplete-termination-string))
557 0 : (setq pcomplete-current-completions
558 0 : (cdr pcomplete-current-completions))))))
559 :
560 : ;;;###autoload
561 : (defun pcomplete-help ()
562 : "Display any help information relative to the current argument."
563 : (interactive)
564 0 : (let ((pcomplete-show-help t))
565 0 : (pcomplete)))
566 :
567 : ;;;###autoload
568 : (defun pcomplete-list ()
569 : "Show the list of possible completions for the current argument."
570 : (interactive)
571 0 : (when (and pcomplete-cycle-completions
572 0 : pcomplete-current-completions
573 0 : (eq last-command 'pcomplete-argument))
574 0 : (delete-char (- pcomplete-last-completion-length))
575 0 : (setq pcomplete-current-completions nil
576 0 : pcomplete-last-completion-raw nil))
577 0 : (let ((pcomplete-show-list t))
578 0 : (pcomplete)))
579 :
580 : ;;; Internal Functions:
581 :
582 : ;; argument handling
583 : (defun pcomplete-arg (&optional index offset)
584 : "Return the textual content of the INDEXth argument.
585 : INDEX is based from the current processing position. If INDEX is
586 : positive, values returned are closer to the command argument; if
587 : negative, they are closer to the last argument. If the INDEX is
588 : outside of the argument list, nil is returned. The default value for
589 : INDEX is 0, meaning the current argument being examined.
590 :
591 : The special indices `first' and `last' may be used to access those
592 : parts of the list.
593 :
594 : The OFFSET argument is added to/taken away from the index that will be
595 : used. This is really only useful with `first' and `last', for
596 : accessing absolute argument positions."
597 0 : (setq index
598 0 : (if (eq index 'first)
599 : 0
600 0 : (if (eq index 'last)
601 0 : pcomplete-last
602 0 : (- pcomplete-index (or index 0)))))
603 0 : (if offset
604 0 : (setq index (+ index offset)))
605 0 : (nth index pcomplete-args))
606 :
607 : (defun pcomplete-begin (&optional index offset)
608 : "Return the beginning position of the INDEXth argument.
609 : See the documentation for `pcomplete-arg'."
610 0 : (setq index
611 0 : (if (eq index 'first)
612 : 0
613 0 : (if (eq index 'last)
614 0 : pcomplete-last
615 0 : (- pcomplete-index (or index 0)))))
616 0 : (if offset
617 0 : (setq index (+ index offset)))
618 0 : (nth index pcomplete-begins))
619 :
620 : (defsubst pcomplete-actual-arg (&optional index offset)
621 : "Return the actual text representation of the last argument.
622 : This is different from `pcomplete-arg', which returns the textual value
623 : that the last argument evaluated to. This function returns what the
624 : user actually typed in."
625 0 : (buffer-substring (pcomplete-begin index offset) (point)))
626 :
627 : (defsubst pcomplete-next-arg ()
628 : "Move the various pointers to the next argument."
629 0 : (setq pcomplete-index (1+ pcomplete-index)
630 0 : pcomplete-stub (pcomplete-arg))
631 0 : (if (> pcomplete-index pcomplete-last)
632 0 : (progn
633 0 : (message "No completions")
634 0 : (throw 'pcompleted nil))))
635 :
636 : (defun pcomplete-command-name ()
637 : "Return the command name of the first argument."
638 0 : (file-name-nondirectory (pcomplete-arg 'first)))
639 :
640 : (defun pcomplete-match (regexp &optional index offset start)
641 : "Like `string-match', but on the current completion argument."
642 0 : (let ((arg (pcomplete-arg (or index 1) offset)))
643 0 : (if arg
644 0 : (string-match regexp arg start)
645 0 : (throw 'pcompleted nil))))
646 :
647 : (defun pcomplete-match-string (which &optional index offset)
648 : "Like `match-string', but on the current completion argument."
649 0 : (let ((arg (pcomplete-arg (or index 1) offset)))
650 0 : (if arg
651 0 : (match-string which arg)
652 0 : (throw 'pcompleted nil))))
653 :
654 : (defalias 'pcomplete-match-beginning 'match-beginning)
655 : (defalias 'pcomplete-match-end 'match-end)
656 :
657 : (defsubst pcomplete--test (pred arg)
658 : "Perform a programmable completion predicate match."
659 0 : (and pred
660 0 : (cond ((eq pred t) t)
661 0 : ((functionp pred)
662 0 : (funcall pred arg))
663 0 : ((stringp pred)
664 0 : (string-match (concat "^" pred "$") arg)))
665 0 : pred))
666 :
667 : (defun pcomplete-test (predicates &optional index offset)
668 : "Predicates to test the current programmable argument with."
669 0 : (let ((arg (pcomplete-arg (or index 1) offset)))
670 0 : (unless (null predicates)
671 0 : (if (not (listp predicates))
672 0 : (pcomplete--test predicates arg)
673 0 : (let ((pred predicates)
674 : found)
675 0 : (while (and pred (not found))
676 0 : (setq found (pcomplete--test (car pred) arg)
677 0 : pred (cdr pred)))
678 0 : found)))))
679 :
680 : (defun pcomplete-parse-buffer-arguments ()
681 : "Parse whitespace separated arguments in the current region."
682 0 : (let ((begin (point-min))
683 0 : (end (point-max))
684 : begins args)
685 0 : (save-excursion
686 0 : (goto-char begin)
687 0 : (while (< (point) end)
688 0 : (skip-chars-forward " \t\n")
689 0 : (push (point) begins)
690 0 : (skip-chars-forward "^ \t\n")
691 0 : (push (buffer-substring-no-properties
692 0 : (car begins) (point))
693 0 : args))
694 0 : (cons (nreverse args) (nreverse begins)))))
695 :
696 : ;;;###autoload
697 : (defun pcomplete-comint-setup (completef-sym)
698 : "Setup a comint buffer to use pcomplete.
699 : COMPLETEF-SYM should be the symbol where the
700 : dynamic-complete-functions are kept. For comint mode itself,
701 : this is `comint-dynamic-complete-functions'."
702 0 : (set (make-local-variable 'pcomplete-parse-arguments-function)
703 0 : 'pcomplete-parse-comint-arguments)
704 0 : (add-hook 'completion-at-point-functions
705 0 : 'pcomplete-completions-at-point nil 'local)
706 0 : (set (make-local-variable completef-sym)
707 0 : (copy-sequence (symbol-value completef-sym)))
708 0 : (let* ((funs (symbol-value completef-sym))
709 0 : (elem (or (memq 'comint-filename-completion funs)
710 0 : (memq 'shell-filename-completion funs)
711 0 : (memq 'shell-dynamic-complete-filename funs)
712 0 : (memq 'comint-dynamic-complete-filename funs))))
713 0 : (if elem
714 0 : (setcar elem 'pcomplete)
715 0 : (add-to-list completef-sym 'pcomplete))))
716 :
717 : ;;;###autoload
718 : (defun pcomplete-shell-setup ()
719 : "Setup `shell-mode' to use pcomplete."
720 : ;; FIXME: insufficient
721 0 : (pcomplete-comint-setup 'comint-dynamic-complete-functions))
722 :
723 : (declare-function comint-bol "comint" (&optional arg))
724 :
725 : (defun pcomplete-parse-comint-arguments ()
726 : "Parse whitespace separated arguments in the current region."
727 : (declare (obsolete comint-parse-pcomplete-arguments "24.1"))
728 0 : (let ((begin (save-excursion (comint-bol nil) (point)))
729 0 : (end (point))
730 : begins args)
731 0 : (save-excursion
732 0 : (goto-char begin)
733 0 : (while (< (point) end)
734 0 : (skip-chars-forward " \t\n")
735 0 : (push (point) begins)
736 0 : (while
737 0 : (progn
738 0 : (skip-chars-forward "^ \t\n\\")
739 0 : (when (eq (char-after) ?\\)
740 0 : (forward-char 1)
741 0 : (unless (eolp)
742 0 : (forward-char 1)
743 0 : t))))
744 0 : (push (buffer-substring-no-properties (car begins) (point))
745 0 : args))
746 0 : (cons (nreverse args) (nreverse begins)))))
747 :
748 : (defun pcomplete-parse-arguments (&optional expand-p)
749 : "Parse the command line arguments. Most completions need this info."
750 0 : (let ((results (funcall pcomplete-parse-arguments-function)))
751 0 : (when results
752 0 : (setq pcomplete-args (or (car results) (list ""))
753 0 : pcomplete-begins (or (cdr results) (list (point)))
754 0 : pcomplete-last (1- (length pcomplete-args))
755 : pcomplete-index 0
756 0 : pcomplete-stub (pcomplete-arg 'last))
757 0 : (let ((begin (pcomplete-begin 'last)))
758 0 : (if (and (listp pcomplete-stub) ;??
759 0 : (not pcomplete-expand-only-p))
760 0 : (let* ((completions pcomplete-stub) ;??
761 0 : (common-stub (car completions))
762 0 : (c completions)
763 0 : (len (length common-stub)))
764 0 : (while (and c (> len 0))
765 0 : (while (and (> len 0)
766 0 : (not (string=
767 0 : (substring common-stub 0 len)
768 0 : (substring (car c) 0
769 0 : (min (length (car c))
770 0 : len)))))
771 0 : (setq len (1- len)))
772 0 : (setq c (cdr c)))
773 0 : (setq pcomplete-stub (substring common-stub 0 len)
774 0 : pcomplete-autolist t)
775 0 : (when (and begin (not pcomplete-show-list))
776 0 : (delete-region begin (point))
777 0 : (pcomplete-insert-entry "" pcomplete-stub))
778 0 : (throw 'pcomplete-completions completions))
779 0 : (when expand-p
780 0 : (if (stringp pcomplete-stub)
781 0 : (when begin
782 0 : (delete-region begin (point))
783 0 : (insert-and-inherit pcomplete-stub))
784 0 : (if (and (listp pcomplete-stub)
785 0 : pcomplete-expand-only-p)
786 : ;; this is for the benefit of `pcomplete-expand'
787 0 : (setq pcomplete-last-completion-length (- (point) begin)
788 0 : pcomplete-current-completions pcomplete-stub)
789 0 : (error "Cannot expand argument"))))
790 0 : (if pcomplete-expand-only-p
791 0 : (throw 'pcompleted t)
792 0 : pcomplete-args))))))
793 :
794 : (define-obsolete-function-alias
795 : 'pcomplete-quote-argument #'comint-quote-filename "24.3")
796 :
797 : ;; file-system completion lists
798 :
799 : (defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
800 : "Return either directories, or qualified entries."
801 0 : (pcomplete-entries
802 : nil
803 : (lambda (f)
804 0 : (or (file-directory-p f)
805 0 : (and (or (null regexp) (string-match regexp f))
806 0 : (or (null predicate) (funcall predicate f)))))))
807 :
808 : (defun pcomplete--entries (&optional regexp predicate)
809 : "Like `pcomplete-entries' but without env-var handling."
810 0 : (let* ((ign-pred
811 0 : (when (or pcomplete-file-ignore pcomplete-dir-ignore)
812 : ;; Capture the dynbound value for later use.
813 0 : (let ((file-ignore pcomplete-file-ignore)
814 0 : (dir-ignore pcomplete-dir-ignore))
815 : (lambda (file)
816 0 : (not
817 0 : (if (eq (aref file (1- (length file))) ?/)
818 0 : (and dir-ignore (string-match dir-ignore file))
819 0 : (and file-ignore (string-match file-ignore file))))))))
820 0 : (reg-pred (if regexp (lambda (file) (string-match regexp file))))
821 0 : (pred (cond
822 0 : ((null (or ign-pred reg-pred)) predicate)
823 0 : ((null (or ign-pred predicate)) reg-pred)
824 0 : ((null (or reg-pred predicate)) ign-pred)
825 : (t (lambda (f)
826 0 : (and (or (null reg-pred) (funcall reg-pred f))
827 0 : (or (null ign-pred) (funcall ign-pred f))
828 0 : (or (null predicate) (funcall predicate f))))))))
829 : (lambda (s p a)
830 0 : (if (and (eq a 'metadata) pcomplete-compare-entry-function)
831 0 : `(metadata (cycle-sort-function
832 : . ,(lambda (comps)
833 0 : (sort comps pcomplete-compare-entry-function)))
834 0 : ,@(cdr (completion-file-name-table s p a)))
835 0 : (let ((completion-ignored-extensions nil)
836 0 : (completion-ignore-case pcomplete-ignore-case))
837 0 : (completion-table-with-predicate
838 0 : #'comint-completion-file-name-table pred 'strict s p a))))))
839 :
840 : (defconst pcomplete--env-regexp
841 : "\\(?:\\`\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(\\$\\(?:{\\([^}]+\\)}\\|\\(?2:[[:alnum:]_]+\\)\\)\\)")
842 :
843 : (defun pcomplete-entries (&optional regexp predicate)
844 : "Complete against a list of directory candidates.
845 : If REGEXP is non-nil, it is a regular expression used to refine the
846 : match (files not matching the REGEXP will be excluded).
847 : If PREDICATE is non-nil, it will also be used to refine the match
848 : \(files for which the PREDICATE returns nil will be excluded).
849 : If no directory information can be extracted from the completed
850 : component, `default-directory' is used as the basis for completion."
851 : ;; FIXME: The old code did env-var expansion here, so we reproduce this
852 : ;; behavior for now, but really env-var handling should be performed globally
853 : ;; rather than here since it also applies to non-file arguments.
854 0 : (let ((table (pcomplete--entries regexp predicate)))
855 : (lambda (string pred action)
856 0 : (let ((strings nil)
857 0 : (orig-length (length string)))
858 : ;; Perform env-var expansion.
859 0 : (while (string-match pcomplete--env-regexp string)
860 0 : (push (substring string 0 (match-beginning 1)) strings)
861 0 : (push (getenv (match-string 2 string)) strings)
862 0 : (setq string (substring string (match-end 1))))
863 0 : (if (not (and strings
864 0 : (or (eq action t)
865 0 : (eq (car-safe action) 'boundaries))))
866 0 : (let ((newstring
867 0 : (mapconcat 'identity (nreverse (cons string strings)) "")))
868 : ;; FIXME: We could also try to return unexpanded envvars.
869 0 : (complete-with-action action table newstring pred))
870 0 : (let* ((envpos (apply #'+ (mapcar #' length strings)))
871 : (newstring
872 0 : (mapconcat 'identity (nreverse (cons string strings)) ""))
873 0 : (bounds (completion-boundaries newstring table pred
874 0 : (or (cdr-safe action) ""))))
875 0 : (if (>= (car bounds) envpos)
876 : ;; The env-var is "out of bounds".
877 0 : (if (eq action t)
878 0 : (complete-with-action action table newstring pred)
879 0 : `(boundaries
880 0 : ,(+ (car bounds) (- orig-length (length newstring)))
881 0 : . ,(cdr bounds)))
882 : ;; The env-var is in the file bounds.
883 0 : (if (eq action t)
884 0 : (let ((comps (complete-with-action
885 0 : action table newstring pred))
886 0 : (len (- envpos (car bounds))))
887 : ;; Strip the part of each completion that's actually
888 : ;; coming from the env-var.
889 0 : (mapcar (lambda (s) (substring s len)) comps))
890 0 : `(boundaries
891 0 : ,(+ envpos (- orig-length (length newstring)))
892 0 : . ,(cdr bounds))))))))))
893 :
894 : (defsubst pcomplete-all-entries (&optional regexp predicate)
895 : "Like `pcomplete-entries', but doesn't ignore any entries."
896 0 : (let (pcomplete-file-ignore
897 : pcomplete-dir-ignore)
898 0 : (pcomplete-entries regexp predicate)))
899 :
900 : (defsubst pcomplete-dirs (&optional regexp)
901 : "Complete amongst a list of directories."
902 0 : (pcomplete-entries regexp 'file-directory-p))
903 :
904 : ;; generation of completion lists
905 :
906 : (defun pcomplete-find-completion-function (command)
907 : "Find the completion function to call for the given COMMAND."
908 0 : (let ((sym (intern-soft
909 0 : (concat "pcomplete/" (symbol-name major-mode) "/" command))))
910 0 : (unless sym
911 0 : (setq sym (intern-soft (concat "pcomplete/" command))))
912 0 : (and sym (fboundp sym) sym)))
913 :
914 : (defun pcomplete-completions ()
915 : "Return a list of completions for the current argument position."
916 0 : (catch 'pcomplete-completions
917 0 : (when (pcomplete-parse-arguments pcomplete-expand-before-complete)
918 0 : (if (= pcomplete-index pcomplete-last)
919 0 : (funcall pcomplete-command-completion-function)
920 0 : (let ((sym (or (pcomplete-find-completion-function
921 0 : (funcall pcomplete-command-name-function))
922 0 : pcomplete-default-completion-function)))
923 0 : (ignore
924 0 : (pcomplete-next-arg)
925 0 : (funcall sym)))))))
926 :
927 : (defun pcomplete-opt (options &optional prefix _no-ganging _args-follow)
928 : "Complete a set of OPTIONS, each beginning with PREFIX (?- by default).
929 : PREFIX may be t, in which case no PREFIX character is necessary.
930 : If NO-GANGING is non-nil, each option is separate (-xy is not allowed).
931 : If ARGS-FOLLOW is non-nil, then options which take arguments may have
932 : the argument appear after a ganged set of options. This is how tar
933 : behaves, for example.
934 : Arguments NO-GANGING and ARGS-FOLLOW are currently ignored."
935 0 : (if (and (= pcomplete-index pcomplete-last)
936 0 : (string= (pcomplete-arg) "-"))
937 0 : (let ((len (length options))
938 : (index 0)
939 : char choices)
940 0 : (while (< index len)
941 0 : (setq char (aref options index))
942 0 : (if (eq char ?\()
943 0 : (let ((result (read-from-string options index)))
944 0 : (setq index (cdr result)))
945 0 : (unless (memq char '(?/ ?* ?? ?.))
946 0 : (push (char-to-string char) choices))
947 0 : (setq index (1+ index))))
948 0 : (throw 'pcomplete-completions
949 0 : (mapcar
950 0 : (function
951 : (lambda (opt)
952 0 : (concat "-" opt)))
953 0 : (pcomplete-uniqify-list choices))))
954 0 : (let ((arg (pcomplete-arg)))
955 0 : (when (and (> (length arg) 1)
956 0 : (stringp arg)
957 0 : (eq (aref arg 0) (or prefix ?-)))
958 0 : (pcomplete-next-arg)
959 0 : (let ((char (aref arg 1))
960 0 : (len (length options))
961 : (index 0)
962 : opt-char arg-char result)
963 0 : (while (< (1+ index) len)
964 0 : (setq opt-char (aref options index)
965 0 : arg-char (aref options (1+ index)))
966 0 : (if (eq arg-char ?\()
967 0 : (setq result
968 0 : (read-from-string options (1+ index))
969 0 : index (cdr result)
970 0 : result (car result))
971 0 : (setq result nil))
972 0 : (when (and (eq char opt-char)
973 0 : (memq arg-char '(?\( ?/ ?* ?? ?.)))
974 0 : (if (< pcomplete-index pcomplete-last)
975 0 : (pcomplete-next-arg)
976 0 : (throw 'pcomplete-completions
977 0 : (cond ((eq arg-char ?/) (pcomplete-dirs))
978 0 : ((eq arg-char ?*) (pcomplete-executables))
979 0 : ((eq arg-char ??) nil)
980 0 : ((eq arg-char ?.) (pcomplete-entries))
981 0 : ((eq arg-char ?\() (eval result))))))
982 0 : (setq index (1+ index))))))))
983 :
984 : (defun pcomplete--here (&optional form stub paring form-only)
985 : "Complete against the current argument, if at the end.
986 : See the documentation for `pcomplete-here'."
987 0 : (if (< pcomplete-index pcomplete-last)
988 0 : (progn
989 0 : (if (eq paring 0)
990 0 : (setq pcomplete-seen nil)
991 0 : (unless (eq paring t)
992 0 : (let ((arg (pcomplete-arg)))
993 0 : (when (stringp arg)
994 0 : (push (if paring
995 0 : (funcall paring arg)
996 0 : (file-truename arg))
997 0 : pcomplete-seen)))))
998 0 : (pcomplete-next-arg)
999 0 : t)
1000 0 : (when pcomplete-show-help
1001 0 : (pcomplete--help)
1002 0 : (throw 'pcompleted t))
1003 0 : (if stub
1004 0 : (setq pcomplete-stub stub))
1005 0 : (if (or (eq paring t) (eq paring 0))
1006 0 : (setq pcomplete-seen nil)
1007 0 : (setq pcomplete-norm-func (or paring 'file-truename)))
1008 0 : (unless form-only
1009 0 : (run-hooks 'pcomplete-try-first-hook))
1010 0 : (throw 'pcomplete-completions
1011 0 : (if (functionp form)
1012 0 : (funcall form)
1013 : ;; Old calling convention, might still be used by files
1014 : ;; byte-compiled with the older code.
1015 0 : (eval form)))))
1016 :
1017 : (defmacro pcomplete-here (&optional form stub paring form-only)
1018 : "Complete against the current argument, if at the end.
1019 : If completion is to be done here, evaluate FORM to generate the completion
1020 : table which will be used for completion purposes. If STUB is a
1021 : string, use it as the completion stub instead of the default (which is
1022 : the entire text of the current argument).
1023 :
1024 : For an example of when you might want to use STUB: if the current
1025 : argument text is `long-path-name/', you don't want the completions
1026 : list display to be cluttered by `long-path-name/' appearing at the
1027 : beginning of every alternative. Not only does this make things less
1028 : intelligible, but it is also inefficient. Yet, if the completion list
1029 : does not begin with this string for every entry, the current argument
1030 : won't complete correctly.
1031 :
1032 : The solution is to specify a relative stub. It allows you to
1033 : substitute a different argument from the current argument, almost
1034 : always for the sake of efficiency.
1035 :
1036 : If PARING is nil, this argument will be pared against previous
1037 : arguments using the function `file-truename' to normalize them.
1038 : PARING may be a function, in which case that function is used for
1039 : normalization. If PARING is t, the argument dealt with by this
1040 : call will not participate in argument paring. If it is the
1041 : integer 0, all previous arguments that have been seen will be
1042 : cleared.
1043 :
1044 : If FORM-ONLY is non-nil, only the result of FORM will be used to
1045 : generate the completions list. This means that the hook
1046 : `pcomplete-try-first-hook' will not be run."
1047 : (declare (debug t))
1048 1 : `(pcomplete--here (lambda () ,form) ,stub ,paring ,form-only))
1049 :
1050 :
1051 : (defmacro pcomplete-here* (&optional form stub form-only)
1052 : "An alternate form which does not participate in argument paring."
1053 : (declare (debug t))
1054 0 : `(pcomplete-here ,form ,stub t ,form-only))
1055 :
1056 : ;; display support
1057 :
1058 : (defun pcomplete-restore-windows ()
1059 : "If the only window change was due to Completions, restore things."
1060 0 : (if pcomplete-last-window-config
1061 0 : (let* ((cbuf (get-buffer "*Completions*"))
1062 0 : (cwin (and cbuf (get-buffer-window cbuf))))
1063 0 : (when (window-live-p cwin)
1064 0 : (bury-buffer cbuf)
1065 0 : (set-window-configuration pcomplete-last-window-config))))
1066 0 : (setq pcomplete-last-window-config nil
1067 0 : pcomplete-window-restore-timer nil))
1068 :
1069 : ;; Abstractions so that the code below will work for both Emacs 20 and
1070 : ;; XEmacs 21
1071 :
1072 : (defalias 'pcomplete-event-matches-key-specifier-p
1073 : (if (featurep 'xemacs)
1074 : 'event-matches-key-specifier-p
1075 : 'eq))
1076 :
1077 : (defun pcomplete-read-event (&optional prompt)
1078 0 : (if (fboundp 'read-event)
1079 0 : (read-event prompt)
1080 0 : (aref (read-key-sequence prompt) 0)))
1081 :
1082 : (defun pcomplete-show-completions (completions)
1083 : "List in help buffer sorted COMPLETIONS.
1084 : Typing SPC flushes the help buffer."
1085 0 : (when pcomplete-window-restore-timer
1086 0 : (cancel-timer pcomplete-window-restore-timer)
1087 0 : (setq pcomplete-window-restore-timer nil))
1088 0 : (unless pcomplete-last-window-config
1089 0 : (setq pcomplete-last-window-config (current-window-configuration)))
1090 0 : (with-output-to-temp-buffer "*Completions*"
1091 0 : (display-completion-list completions))
1092 0 : (minibuffer-message "Hit space to flush")
1093 0 : (let (event)
1094 0 : (prog1
1095 0 : (catch 'done
1096 0 : (while (with-current-buffer (get-buffer "*Completions*")
1097 0 : (setq event (pcomplete-read-event)))
1098 0 : (cond
1099 0 : ((pcomplete-event-matches-key-specifier-p event ?\s)
1100 0 : (set-window-configuration pcomplete-last-window-config)
1101 0 : (setq pcomplete-last-window-config nil)
1102 0 : (throw 'done nil))
1103 0 : ((or (pcomplete-event-matches-key-specifier-p event 'tab)
1104 : ;; Needed on a terminal
1105 0 : (pcomplete-event-matches-key-specifier-p event 9))
1106 0 : (let ((win (or (get-buffer-window "*Completions*" 0)
1107 0 : (display-buffer "*Completions*"
1108 0 : 'not-this-window))))
1109 0 : (with-selected-window win
1110 0 : (if (pos-visible-in-window-p (point-max))
1111 0 : (goto-char (point-min))
1112 0 : (scroll-up))))
1113 0 : (message ""))
1114 : (t
1115 0 : (push event unread-command-events)
1116 0 : (throw 'done nil)))))
1117 0 : (if (and pcomplete-last-window-config
1118 0 : pcomplete-restore-window-delay)
1119 0 : (setq pcomplete-window-restore-timer
1120 0 : (run-with-timer pcomplete-restore-window-delay nil
1121 0 : 'pcomplete-restore-windows))))))
1122 :
1123 : ;; insert completion at point
1124 :
1125 : (defun pcomplete-insert-entry (stub entry &optional addsuffix raw-p)
1126 : "Insert a completion entry at point.
1127 : Returns non-nil if a space was appended at the end."
1128 0 : (let ((here (point)))
1129 0 : (if (not pcomplete-ignore-case)
1130 0 : (insert-and-inherit (if raw-p
1131 0 : (substring entry (length stub))
1132 0 : (comint-quote-filename
1133 0 : (substring entry (length stub)))))
1134 : ;; the stub is not quoted at this time, so to determine the
1135 : ;; length of what should be in the buffer, we must quote it
1136 : ;; FIXME: Here we presume that quoting `stub' gives us the exact
1137 : ;; text in the buffer before point, which is not guaranteed;
1138 : ;; e.g. it is not the case in eshell when completing ${FOO}tm[TAB].
1139 0 : (delete-char (- (length (comint-quote-filename stub))))
1140 : ;; if there is already a backslash present to handle the first
1141 : ;; character, don't bother quoting it
1142 0 : (when (eq (char-before) ?\\)
1143 0 : (insert-and-inherit (substring entry 0 1))
1144 0 : (setq entry (substring entry 1)))
1145 0 : (insert-and-inherit (if raw-p
1146 0 : entry
1147 0 : (comint-quote-filename entry))))
1148 0 : (let (space-added)
1149 0 : (when (and (not (memq (char-before) pcomplete-suffix-list))
1150 0 : addsuffix)
1151 0 : (insert-and-inherit pcomplete-termination-string)
1152 0 : (setq space-added t))
1153 0 : (setq pcomplete-last-completion-length (- (point) here)
1154 0 : pcomplete-last-completion-stub stub)
1155 0 : space-added)))
1156 :
1157 : ;; Selection of completions.
1158 :
1159 : (defun pcomplete-do-complete (stub completions)
1160 : "Dynamically complete at point using STUB and COMPLETIONS.
1161 : This is basically just a wrapper for `pcomplete-stub' which does some
1162 : extra checking, and munging of the COMPLETIONS list."
1163 0 : (unless (stringp stub)
1164 0 : (message "Cannot complete argument")
1165 0 : (throw 'pcompleted nil))
1166 0 : (if (null completions)
1167 0 : (ignore
1168 0 : (if (and stub (> (length stub) 0))
1169 0 : (message "No completions of %s" stub)
1170 0 : (message "No completions")))
1171 : ;; pare it down, if applicable
1172 0 : (when (and pcomplete-use-paring pcomplete-seen)
1173 0 : (setq pcomplete-seen
1174 0 : (mapcar 'directory-file-name pcomplete-seen))
1175 0 : (dolist (p pcomplete-seen)
1176 0 : (add-to-list 'pcomplete-seen
1177 0 : (funcall pcomplete-norm-func p)))
1178 0 : (setq completions
1179 0 : (apply-partially 'completion-table-with-predicate
1180 0 : completions
1181 0 : (when pcomplete-seen
1182 : (lambda (f)
1183 0 : (not (member
1184 0 : (funcall pcomplete-norm-func
1185 0 : (directory-file-name f))
1186 0 : pcomplete-seen))))
1187 0 : 'strict)))
1188 : ;; OK, we've got a list of completions.
1189 0 : (if pcomplete-show-list
1190 : ;; FIXME: pay attention to boundaries.
1191 0 : (pcomplete-show-completions (all-completions stub completions))
1192 0 : (pcomplete-stub stub completions))))
1193 :
1194 : (defun pcomplete-stub (stub candidates &optional cycle-p)
1195 : "Dynamically complete STUB from CANDIDATES list.
1196 : This function inserts completion characters at point by completing
1197 : STUB from the strings in CANDIDATES. A completions listing may be
1198 : shown in a help buffer if completion is ambiguous.
1199 :
1200 : Returns nil if no completion was inserted.
1201 : Returns `sole' if completed with the only completion match.
1202 : Returns `shortest' if completed with the shortest of the matches.
1203 : Returns `partial' if completed as far as possible with the matches.
1204 : Returns `listed' if a completion listing was shown.
1205 :
1206 : See also `pcomplete-filename'."
1207 0 : (let* ((completion-ignore-case pcomplete-ignore-case)
1208 0 : (completions (all-completions stub candidates))
1209 0 : (entry (try-completion stub candidates))
1210 : result)
1211 0 : (cond
1212 0 : ((null entry)
1213 0 : (if (and stub (> (length stub) 0))
1214 0 : (message "No completions of %s" stub)
1215 0 : (message "No completions")))
1216 0 : ((eq entry t)
1217 0 : (setq entry stub)
1218 0 : (message "Sole completion")
1219 0 : (setq result 'sole))
1220 0 : ((= 1 (length completions))
1221 0 : (setq result 'sole))
1222 0 : ((and pcomplete-cycle-completions
1223 0 : (or cycle-p
1224 0 : (not pcomplete-cycle-cutoff-length)
1225 0 : (<= (length completions)
1226 0 : pcomplete-cycle-cutoff-length)))
1227 0 : (let ((bound (car (completion-boundaries stub candidates nil ""))))
1228 0 : (unless (zerop bound)
1229 0 : (setq completions (mapcar (lambda (c) (concat (substring stub 0 bound) c))
1230 0 : completions)))
1231 0 : (setq entry (car completions)
1232 0 : pcomplete-current-completions completions)))
1233 0 : ((and pcomplete-recexact
1234 0 : (string-equal stub entry)
1235 0 : (member entry completions))
1236 : ;; It's not unique, but user wants shortest match.
1237 0 : (message "Completed shortest")
1238 0 : (setq result 'shortest))
1239 0 : ((or pcomplete-autolist
1240 0 : (string-equal stub entry))
1241 : ;; It's not unique, list possible completions.
1242 : ;; FIXME: pay attention to boundaries.
1243 0 : (pcomplete-show-completions completions)
1244 0 : (setq result 'listed))
1245 : (t
1246 0 : (message "Partially completed")
1247 0 : (setq result 'partial)))
1248 0 : (cons result entry)))
1249 :
1250 : ;; context sensitive help
1251 :
1252 : (defun pcomplete--help ()
1253 : "Produce context-sensitive help for the current argument.
1254 : If specific documentation can't be given, be generic."
1255 0 : (if (and pcomplete-help
1256 0 : (or (and (stringp pcomplete-help)
1257 0 : (fboundp 'Info-goto-node))
1258 0 : (listp pcomplete-help)))
1259 0 : (if (listp pcomplete-help)
1260 0 : (message "%s" (eval pcomplete-help))
1261 0 : (save-window-excursion (info))
1262 0 : (switch-to-buffer-other-window "*info*")
1263 0 : (funcall (symbol-function 'Info-goto-node) pcomplete-help))
1264 0 : (if pcomplete-man-function
1265 0 : (let ((cmd (funcall pcomplete-command-name-function)))
1266 0 : (if (and cmd (> (length cmd) 0))
1267 0 : (funcall pcomplete-man-function cmd)))
1268 0 : (message "No context-sensitive help available"))))
1269 :
1270 : ;; general utilities
1271 :
1272 : (defun pcomplete-uniqify-list (l)
1273 : "Sort and remove multiples in L."
1274 0 : (setq l (sort l 'string-lessp))
1275 0 : (let ((m l))
1276 0 : (while m
1277 0 : (while (and (cdr m)
1278 0 : (string= (car m)
1279 0 : (cadr m)))
1280 0 : (setcdr m (cddr m)))
1281 0 : (setq m (cdr m))))
1282 0 : l)
1283 :
1284 : (defun pcomplete-process-result (cmd &rest args)
1285 : "Call CMD using `call-process' and return the simplest result."
1286 0 : (with-temp-buffer
1287 0 : (apply 'call-process cmd nil t nil args)
1288 0 : (skip-chars-backward "\n")
1289 0 : (buffer-substring (point-min) (point))))
1290 :
1291 : ;; create a set of aliases which allow completion functions to be not
1292 : ;; quite so verbose
1293 :
1294 : ;;; jww (1999-10-20): are these a good idea?
1295 : ;; (defalias 'pc-here 'pcomplete-here)
1296 : ;; (defalias 'pc-test 'pcomplete-test)
1297 : ;; (defalias 'pc-opt 'pcomplete-opt)
1298 : ;; (defalias 'pc-match 'pcomplete-match)
1299 : ;; (defalias 'pc-match-string 'pcomplete-match-string)
1300 : ;; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
1301 : ;; (defalias 'pc-match-end 'pcomplete-match-end)
1302 :
1303 : (provide 'pcomplete)
1304 :
1305 : ;;; pcomplete.el ends here
|