*** empty log message ***
[emacs.git] / lisp / pcomplete.el
blob0f970c5191a94e5b0d2feba0fdd4fc46fb78fbe8
1 ;;; pcomplete.el --- programmable completion
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004
4 ;; 2005, 2006 Free Software Foundation, Inc.
6 ;; Author: John Wiegley <johnw@gnu.org>
7 ;; Keywords: processes abbrev
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
26 ;;; Commentary:
28 ;; This module provides a programmable completion facility using
29 ;; "completion functions". Each completion function is responsible
30 ;; for producing a list of possible completions relevant to the current
31 ;; argument position.
33 ;; To use pcomplete with shell-mode, for example, you will need the
34 ;; following in your .emacs file:
36 ;; (load "pcmpl-auto")
37 ;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
39 ;; Most of the code below simply provides support mechanisms for
40 ;; writing completion functions. Completion functions themselves are
41 ;; very easy to write. They have few requirements beyond those of
42 ;; regular Lisp functions.
44 ;; Consider the following example, which will complete against
45 ;; filenames for the first two arguments, and directories for all
46 ;; remaining arguments:
48 ;; (defun pcomplete/my-command ()
49 ;; (pcomplete-here (pcomplete-entries))
50 ;; (pcomplete-here (pcomplete-entries))
51 ;; (while (pcomplete-here (pcomplete-dirs))))
53 ;; Here are the requirements for completion functions:
55 ;; @ They must be called "pcomplete/MAJOR-MODE/NAME", or
56 ;; "pcomplete/NAME". This is how they are looked up, using the NAME
57 ;; specified in the command argument (the argument in first
58 ;; position).
60 ;; @ They must be callable with no arguments.
62 ;; @ Their return value is ignored. If they actually return normally,
63 ;; it means no completions were available.
65 ;; @ In order to provide completions, they must throw the tag
66 ;; `pcomplete-completions'. The value must be the list of possible
67 ;; completions for the final argument.
69 ;; @ To simplify completion function logic, the tag `pcompleted' may
70 ;; be thrown with a value of nil in order to abort the function. It
71 ;; means that there were no completions available.
73 ;; When a completion function is called, the variable `pcomplete-args'
74 ;; is in scope, and contains all of the arguments specified on the
75 ;; command line. The variable `pcomplete-last' is the index of the
76 ;; last argument in that list.
78 ;; The variable `pcomplete-index' is used by the completion code to
79 ;; know which argument the completion function is currently examining.
80 ;; It always begins at 1, meaning the first argument after the command
81 ;; name.
83 ;; To facilitate writing completion logic, a special macro,
84 ;; `pcomplete-here', has been provided which does several things:
86 ;; 1. It will throw `pcompleted' (with a value of nil) whenever
87 ;; `pcomplete-index' exceeds `pcomplete-last'.
89 ;; 2. It will increment `pcomplete-index' if the final argument has
90 ;; not been reached yet.
92 ;; 3. It will evaluate the form passed to it, and throw the result
93 ;; using the `pcomplete-completions' tag, if it is called when
94 ;; `pcomplete-index' is pointing to the final argument.
96 ;; Sometimes a completion function will want to vary the possible
97 ;; completions for an argument based on the previous one. To
98 ;; facilitate tests like this, the function `pcomplete-test' and
99 ;; `pcomplete-match' are provided. Called with one argument, they
100 ;; test the value of the previous command argument. Otherwise, a
101 ;; relative index may be given as an optional second argument, where 0
102 ;; refers to the current argument, 1 the previous, 2 the one before
103 ;; that, etc. The symbols `first' and `last' specify absolute
104 ;; offsets.
106 ;; Here is an example which will only complete against directories for
107 ;; the second argument if the first argument is also a directory:
109 ;; (defun pcomplete/example ()
110 ;; (pcomplete-here (pcomplete-entries))
111 ;; (if (pcomplete-test 'file-directory-p)
112 ;; (pcomplete-here (pcomplete-dirs))
113 ;; (pcomplete-here (pcomplete-entries))))
115 ;; For generating completion lists based on directory contents, see
116 ;; the functions `pcomplete-entries', `pcomplete-dirs',
117 ;; `pcomplete-executables' and `pcomplete-all-entries'.
119 ;; Consult the documentation for `pcomplete-here' for information
120 ;; about its other arguments.
122 ;;; Code:
124 (provide 'pcomplete)
126 (defgroup pcomplete nil
127 "Programmable completion."
128 :version "21.1"
129 :group 'processes)
131 ;;; User Variables:
133 (defcustom pcomplete-file-ignore nil
134 "*A regexp of filenames to be disregarded during file completion."
135 :type '(choice regexp (const :tag "None" nil))
136 :group 'pcomplete)
138 (defcustom pcomplete-dir-ignore nil
139 "*A regexp of names to be disregarded during directory completion."
140 :type '(choice regexp (const :tag "None" nil))
141 :group 'pcomplete)
143 (defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
144 "*If non-nil, ignore case when doing filename completion."
145 :type 'boolean
146 :group 'pcomplete)
148 (defcustom pcomplete-autolist nil
149 "*If non-nil, automatically list possibilities on partial completion.
150 This mirrors the optional behavior of tcsh."
151 :type 'boolean
152 :group 'pcomplete)
154 (defcustom pcomplete-suffix-list (list ?/ ?:)
155 "*A list of characters which constitute a proper suffix."
156 :type '(repeat character)
157 :group 'pcomplete)
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.
163 A non-nil value is useful if `pcomplete-autolist' is non-nil too."
164 :type 'boolean
165 :group 'pcomplete)
167 (defcustom pcomplete-arg-quote-list nil
168 "*List of characters to quote when completing an argument."
169 :type '(choice (repeat character)
170 (const :tag "Don't quote" nil))
171 :group 'pcomplete)
173 (defcustom pcomplete-quote-arg-hook nil
174 "*A hook which is run to quote a character within a filename.
175 Each function is passed both the filename to be quoted, and the index
176 to be considered. If the function wishes to provide an alternate
177 quoted form, it need only return the replacement string. If no
178 function provides a replacement, quoting shall proceed as normal,
179 using a backslash to quote any character which is a member of
180 `pcomplete-arg-quote-list'."
181 :type 'hook
182 :group 'pcomplete)
184 (defcustom pcomplete-man-function 'man
185 "*A function to that will be called to display a manual page.
186 It will be passed the name of the command to document."
187 :type 'function
188 :group 'pcomplete)
190 (defcustom pcomplete-compare-entry-function 'string-lessp
191 "*This function is used to order file entries for completion.
192 The behavior of most all shells is to sort alphabetically."
193 :type '(radio (function-item string-lessp)
194 (function-item file-newer-than-file-p)
195 (function :tag "Other"))
196 :group 'pcomplete)
198 (defcustom pcomplete-help nil
199 "*A string or function (or nil) used for context-sensitive help.
200 If a string, it should name an Info node that will be jumped to.
201 If non-nil, it must a sexp that will be evaluated, and whose
202 result will be shown in the minibuffer.
203 If nil, the function `pcomplete-man-function' will be called with the
204 current command argument."
205 :type '(choice string sexp (const :tag "Use man page" nil))
206 :group 'pcomplete)
208 (defcustom pcomplete-expand-before-complete nil
209 "*If non-nil, expand the current argument before completing it.
210 This means that typing something such as '$HOME/bi' followed by
211 \\[pcomplete-argument] will cause the variable reference to be
212 resolved first, and the resultant value that will be completed against
213 to be inserted in the buffer. Note that exactly what gets expanded
214 and how is entirely up to the behavior of the
215 `pcomplete-parse-arguments-function'."
216 :type 'boolean
217 :group 'pcomplete)
219 (defcustom pcomplete-parse-arguments-function
220 'pcomplete-parse-buffer-arguments
221 "*A function to call to parse the current line's arguments.
222 It should be called with no parameters, and with point at the position
223 of the argument that is to be completed.
225 It must either return nil, or a cons cell of the form:
227 ((ARG...) (BEG-POS...))
229 The two lists must be identical in length. The first gives the final
230 value of each command line argument (which need not match the textual
231 representation of that argument), and BEG-POS gives the beginning
232 position of each argument, as it is seen by the user. The establishes
233 a relationship between the fully resolved value of the argument, and
234 the textual representation of the argument."
235 :type 'function
236 :group 'pcomplete)
238 (defcustom pcomplete-cycle-completions t
239 "*If non-nil, hitting the TAB key cycles through the completion list.
240 Typical Emacs behavior is to complete as much as possible, then pause
241 waiting for further input. Then if TAB is hit again, show a list of
242 possible completions. When `pcomplete-cycle-completions' is non-nil,
243 it acts more like zsh or 4nt, showing the first maximal match first,
244 followed by any further matches on each subsequent pressing of the TAB
245 key. \\[pcomplete-list] is the key to press if the user wants to see
246 the list of possible completions."
247 :type 'boolean
248 :group 'pcomplete)
250 (defcustom pcomplete-cycle-cutoff-length 5
251 "*If the number of completions is greater than this, don't cycle.
252 This variable is a compromise between the traditional Emacs style of
253 completion, and the \"cycling\" style. Basically, if there are more
254 than this number of completions possible, don't automatically pick the
255 first one and then expect the user to press TAB to cycle through them.
256 Typically, when there are a large number of completion possibilities,
257 the user wants to see them in a list buffer so that they can know what
258 options are available. But if the list is small, it means the user
259 has already entered enough input to disambiguate most of the
260 possibilities, and therefore they are probably most interested in
261 cycling through the candidates. Set this value to nil if you want
262 cycling to always be enabled."
263 :type '(choice integer (const :tag "Always cycle" nil))
264 :group 'pcomplete)
266 (defcustom pcomplete-restore-window-delay 1
267 "*The number of seconds to wait before restoring completion windows.
268 Once the completion window has been displayed, if the user then goes
269 on to type something else, that completion window will be removed from
270 the display (actually, the original window configuration before it was
271 displayed will be restored), after this many seconds of idle time. If
272 set to nil, completion windows will be left on second until the user
273 removes them manually. If set to 0, they will disappear immediately
274 after the user enters a key other than TAB."
275 :type '(choice integer (const :tag "Never restore" nil))
276 :group 'pcomplete)
278 (defcustom pcomplete-try-first-hook nil
279 "*A list of functions which are called before completing an argument.
280 This can be used, for example, for completing things which might apply
281 to all arguments, such as variable names after a $."
282 :type 'hook
283 :group 'pcomplete)
285 (defcustom pcomplete-command-completion-function
286 (function
287 (lambda ()
288 (pcomplete-here (pcomplete-executables))))
289 "*Function called for completing the initial command argument."
290 :type 'function
291 :group 'pcomplete)
293 (defcustom pcomplete-command-name-function 'pcomplete-command-name
294 "*Function called for determining the current command name."
295 :type 'function
296 :group 'pcomplete)
298 (defcustom pcomplete-default-completion-function
299 (function
300 (lambda ()
301 (while (pcomplete-here (pcomplete-entries)))))
302 "*Function called when no completion rule can be found.
303 This function is used to generate completions for every argument."
304 :type 'function
305 :group 'pcomplete)
307 (defcustom pcomplete-use-paring t
308 "*If t, pare alternatives that have already been used.
309 If nil, you will always see the completion set of possible options, no
310 matter which of those options have already been used in previous
311 command arguments."
312 :type 'boolean
313 :group 'pcomplete)
315 (defcustom pcomplete-termination-string " "
316 "*A string that is inserted after any completion or expansion.
317 This is usually a space character, useful when completing lists of
318 words separated by spaces. However, if your list uses a different
319 separator character, or if the completion occurs in a word that is
320 already terminated by a character, this variable should be locally
321 modified to be an empty string, or the desired separation string."
322 :type 'string
323 :group 'pcomplete)
325 ;;; Internal Variables:
327 ;; for cycling completion support
328 (defvar pcomplete-current-completions nil)
329 (defvar pcomplete-last-completion-length)
330 (defvar pcomplete-last-completion-stub)
331 (defvar pcomplete-last-completion-raw)
332 (defvar pcomplete-last-window-config nil)
333 (defvar pcomplete-window-restore-timer nil)
335 (make-variable-buffer-local 'pcomplete-current-completions)
336 (make-variable-buffer-local 'pcomplete-last-completion-length)
337 (make-variable-buffer-local 'pcomplete-last-completion-stub)
338 (make-variable-buffer-local 'pcomplete-last-completion-raw)
339 (make-variable-buffer-local 'pcomplete-last-window-config)
340 (make-variable-buffer-local 'pcomplete-window-restore-timer)
342 ;; used for altering pcomplete's behavior. These global variables
343 ;; should always be nil.
344 (defvar pcomplete-show-help nil)
345 (defvar pcomplete-show-list nil)
346 (defvar pcomplete-expand-only-p nil)
348 ;;; User Functions:
350 ;;;###autoload
351 (defun pcomplete (&optional interactively)
352 "Support extensible programmable completion.
353 To use this function, just bind the TAB key to it, or add it to your
354 completion functions list (it should occur fairly early in the list)."
355 (interactive "p")
356 (if (and interactively
357 pcomplete-cycle-completions
358 pcomplete-current-completions
359 (memq last-command '(pcomplete
360 pcomplete-expand-and-complete
361 pcomplete-reverse)))
362 (progn
363 (delete-backward-char pcomplete-last-completion-length)
364 (if (eq this-command 'pcomplete-reverse)
365 (progn
366 (setq pcomplete-current-completions
367 (cons (car (last pcomplete-current-completions))
368 pcomplete-current-completions))
369 (setcdr (last pcomplete-current-completions 2) nil))
370 (nconc pcomplete-current-completions
371 (list (car pcomplete-current-completions)))
372 (setq pcomplete-current-completions
373 (cdr pcomplete-current-completions)))
374 (pcomplete-insert-entry pcomplete-last-completion-stub
375 (car pcomplete-current-completions)
376 nil pcomplete-last-completion-raw))
377 (setq pcomplete-current-completions nil
378 pcomplete-last-completion-raw nil)
379 (catch 'pcompleted
380 (let* ((pcomplete-stub)
381 pcomplete-seen pcomplete-norm-func
382 pcomplete-args pcomplete-last pcomplete-index
383 (pcomplete-autolist pcomplete-autolist)
384 (pcomplete-suffix-list pcomplete-suffix-list)
385 (completions (pcomplete-completions))
386 (result (pcomplete-do-complete pcomplete-stub completions)))
387 (and result
388 (not (eq (car result) 'listed))
389 (cdr result)
390 (pcomplete-insert-entry pcomplete-stub (cdr result)
391 (memq (car result)
392 '(sole shortest))
393 pcomplete-last-completion-raw))))))
395 ;;;###autoload
396 (defun pcomplete-reverse ()
397 "If cycling completion is in use, cycle backwards."
398 (interactive)
399 (call-interactively 'pcomplete))
401 ;;;###autoload
402 (defun pcomplete-expand-and-complete ()
403 "Expand the textual value of the current argument.
404 This will modify the current buffer."
405 (interactive)
406 (let ((pcomplete-expand-before-complete t))
407 (pcomplete)))
409 ;;;###autoload
410 (defun pcomplete-continue ()
411 "Complete without reference to any cycling completions."
412 (interactive)
413 (setq pcomplete-current-completions nil
414 pcomplete-last-completion-raw nil)
415 (call-interactively 'pcomplete))
417 ;;;###autoload
418 (defun pcomplete-expand ()
419 "Expand the textual value of the current argument.
420 This will modify the current buffer."
421 (interactive)
422 (let ((pcomplete-expand-before-complete t)
423 (pcomplete-expand-only-p t))
424 (pcomplete)
425 (when (and pcomplete-current-completions
426 (> (length pcomplete-current-completions) 0))
427 (delete-backward-char pcomplete-last-completion-length)
428 (while pcomplete-current-completions
429 (unless (pcomplete-insert-entry
430 "" (car pcomplete-current-completions) t
431 pcomplete-last-completion-raw)
432 (insert-and-inherit pcomplete-termination-string))
433 (setq pcomplete-current-completions
434 (cdr pcomplete-current-completions))))))
436 ;;;###autoload
437 (defun pcomplete-help ()
438 "Display any help information relative to the current argument."
439 (interactive)
440 (let ((pcomplete-show-help t))
441 (pcomplete)))
443 ;;;###autoload
444 (defun pcomplete-list ()
445 "Show the list of possible completions for the current argument."
446 (interactive)
447 (when (and pcomplete-cycle-completions
448 pcomplete-current-completions
449 (eq last-command 'pcomplete-argument))
450 (delete-backward-char pcomplete-last-completion-length)
451 (setq pcomplete-current-completions nil
452 pcomplete-last-completion-raw nil))
453 (let ((pcomplete-show-list t))
454 (pcomplete)))
456 ;;; Internal Functions:
458 ;; argument handling
460 ;; for the sake of the bye-compiler, when compiling other files that
461 ;; contain completion functions
462 (defvar pcomplete-args nil)
463 (defvar pcomplete-begins nil)
464 (defvar pcomplete-last nil)
465 (defvar pcomplete-index nil)
466 (defvar pcomplete-stub nil)
467 (defvar pcomplete-seen nil)
468 (defvar pcomplete-norm-func nil)
470 (defun pcomplete-arg (&optional index offset)
471 "Return the textual content of the INDEXth argument.
472 INDEX is based from the current processing position. If INDEX is
473 positive, values returned are closer to the command argument; if
474 negative, they are closer to the last argument. If the INDEX is
475 outside of the argument list, nil is returned. The default value for
476 INDEX is 0, meaning the current argument being examined.
478 The special indices `first' and `last' may be used to access those
479 parts of the list.
481 The OFFSET argument is added to/taken away from the index that will be
482 used. This is really only useful with `first' and `last', for
483 accessing absolute argument positions."
484 (setq index
485 (if (eq index 'first)
487 (if (eq index 'last)
488 pcomplete-last
489 (- pcomplete-index (or index 0)))))
490 (if offset
491 (setq index (+ index offset)))
492 (nth index pcomplete-args))
494 (defun pcomplete-begin (&optional index offset)
495 "Return the beginning position of the INDEXth argument.
496 See the documentation for `pcomplete-arg'."
497 (setq index
498 (if (eq index 'first)
500 (if (eq index 'last)
501 pcomplete-last
502 (- pcomplete-index (or index 0)))))
503 (if offset
504 (setq index (+ index offset)))
505 (nth index pcomplete-begins))
507 (defsubst pcomplete-actual-arg (&optional index offset)
508 "Return the actual text representation of the last argument.
509 This is different from `pcomplete-arg', which returns the textual value
510 that the last argument evaluated to. This function returns what the
511 user actually typed in."
512 (buffer-substring (pcomplete-begin index offset) (point)))
514 (defsubst pcomplete-next-arg ()
515 "Move the various pointers to the next argument."
516 (setq pcomplete-index (1+ pcomplete-index)
517 pcomplete-stub (pcomplete-arg))
518 (if (> pcomplete-index pcomplete-last)
519 (progn
520 (message "No completions")
521 (throw 'pcompleted nil))))
523 (defun pcomplete-command-name ()
524 "Return the command name of the first argument."
525 (file-name-nondirectory (pcomplete-arg 'first)))
527 (defun pcomplete-match (regexp &optional index offset start)
528 "Like `string-match', but on the current completion argument."
529 (let ((arg (pcomplete-arg (or index 1) offset)))
530 (if arg
531 (string-match regexp arg start)
532 (throw 'pcompleted nil))))
534 (defun pcomplete-match-string (which &optional index offset)
535 "Like `match-string', but on the current completion argument."
536 (let ((arg (pcomplete-arg (or index 1) offset)))
537 (if arg
538 (match-string which arg)
539 (throw 'pcompleted nil))))
541 (defalias 'pcomplete-match-beginning 'match-beginning)
542 (defalias 'pcomplete-match-end 'match-end)
544 (defsubst pcomplete--test (pred arg)
545 "Perform a programmable completion predicate match."
546 (and pred
547 (cond ((eq pred t) t)
548 ((functionp pred)
549 (funcall pred arg))
550 ((stringp pred)
551 (string-match (concat "^" pred "$") arg)))
552 pred))
554 (defun pcomplete-test (predicates &optional index offset)
555 "Predicates to test the current programmable argument with."
556 (let ((arg (pcomplete-arg (or index 1) offset)))
557 (unless (null predicates)
558 (if (not (listp predicates))
559 (pcomplete--test predicates arg)
560 (let ((pred predicates)
561 found)
562 (while (and pred (not found))
563 (setq found (pcomplete--test (car pred) arg)
564 pred (cdr pred)))
565 found)))))
567 (defun pcomplete-parse-buffer-arguments ()
568 "Parse whitespace separated arguments in the current region."
569 (let ((begin (point-min))
570 (end (point-max))
571 begins args)
572 (save-excursion
573 (goto-char begin)
574 (while (< (point) end)
575 (skip-chars-forward " \t\n")
576 (setq begins (cons (point) begins))
577 (skip-chars-forward "^ \t\n")
578 (setq args (cons (buffer-substring-no-properties
579 (car begins) (point))
580 args)))
581 (cons (reverse args) (reverse begins)))))
583 ;;;###autoload
584 (defun pcomplete-comint-setup (completef-sym)
585 "Setup a comint buffer to use pcomplete.
586 COMPLETEF-SYM should be the symbol where the
587 dynamic-complete-functions are kept. For comint mode itself,
588 this is `comint-dynamic-complete-functions'."
589 (set (make-local-variable 'pcomplete-parse-arguments-function)
590 'pcomplete-parse-comint-arguments)
591 (make-local-variable completef-sym)
592 (let ((elem (memq 'comint-dynamic-complete-filename
593 (symbol-value completef-sym))))
594 (if elem
595 (setcar elem 'pcomplete)
596 (add-to-list completef-sym 'pcomplete))))
598 ;;;###autoload
599 (defun pcomplete-shell-setup ()
600 "Setup shell-mode to use pcomplete."
601 (pcomplete-comint-setup 'shell-dynamic-complete-functions))
603 (defun pcomplete-parse-comint-arguments ()
604 "Parse whitespace separated arguments in the current region."
605 (let ((begin (save-excursion (comint-bol nil) (point)))
606 (end (point))
607 begins args)
608 (save-excursion
609 (goto-char begin)
610 (while (< (point) end)
611 (skip-chars-forward " \t\n")
612 (setq begins (cons (point) begins))
613 (let ((skip t))
614 (while skip
615 (skip-chars-forward "^ \t\n")
616 (if (eq (char-before) ?\\)
617 (skip-chars-forward " \t\n")
618 (setq skip nil))))
619 (setq args (cons (buffer-substring-no-properties
620 (car begins) (point))
621 args)))
622 (cons (reverse args) (reverse begins)))))
624 (defun pcomplete-parse-arguments (&optional expand-p)
625 "Parse the command line arguments. Most completions need this info."
626 (let ((results (funcall pcomplete-parse-arguments-function)))
627 (when results
628 (setq pcomplete-args (or (car results) (list ""))
629 pcomplete-begins (or (cdr results) (list (point)))
630 pcomplete-last (1- (length pcomplete-args))
631 pcomplete-index 0
632 pcomplete-stub (pcomplete-arg 'last))
633 (let ((begin (pcomplete-begin 'last)))
634 (if (and pcomplete-cycle-completions
635 (listp pcomplete-stub)
636 (not pcomplete-expand-only-p))
637 (let* ((completions pcomplete-stub)
638 (common-stub (car completions))
639 (c completions)
640 (len (length common-stub)))
641 (while (and c (> len 0))
642 (while (and (> len 0)
643 (not (string=
644 (substring common-stub 0 len)
645 (substring (car c) 0
646 (min (length (car c))
647 len)))))
648 (setq len (1- len)))
649 (setq c (cdr c)))
650 (setq pcomplete-stub (substring common-stub 0 len)
651 pcomplete-autolist t)
652 (when (and begin (not pcomplete-show-list))
653 (delete-region begin (point))
654 (pcomplete-insert-entry "" pcomplete-stub))
655 (throw 'pcomplete-completions completions))
656 (when expand-p
657 (if (stringp pcomplete-stub)
658 (when begin
659 (delete-region begin (point))
660 (insert-and-inherit pcomplete-stub))
661 (if (and (listp pcomplete-stub)
662 pcomplete-expand-only-p)
663 ;; this is for the benefit of `pcomplete-expand'
664 (setq pcomplete-last-completion-length (- (point) begin)
665 pcomplete-current-completions pcomplete-stub)
666 (error "Cannot expand argument"))))
667 (if pcomplete-expand-only-p
668 (throw 'pcompleted t)
669 pcomplete-args))))))
671 (defun pcomplete-quote-argument (filename)
672 "Return FILENAME with magic characters quoted.
673 Magic characters are those in `pcomplete-arg-quote-list'."
674 (if (null pcomplete-arg-quote-list)
675 filename
676 (let ((len (length filename))
677 (index 0)
678 (result "")
679 replacement char)
680 (while (< index len)
681 (setq replacement (run-hook-with-args-until-success
682 'pcomplete-quote-arg-hook filename index))
683 (cond
684 (replacement
685 (setq result (concat result replacement)))
686 ((and (setq char (aref filename index))
687 (memq char pcomplete-arg-quote-list))
688 (setq result (concat result "\\" (char-to-string char))))
690 (setq result (concat result (char-to-string char)))))
691 (setq index (1+ index)))
692 result)))
694 ;; file-system completion lists
696 (defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
697 "Return either directories, or qualified entries."
698 (append (let ((pcomplete-stub pcomplete-stub))
699 (pcomplete-entries
700 regexp (or predicate
701 (function
702 (lambda (path)
703 (not (file-directory-p path)))))))
704 (pcomplete-entries nil 'file-directory-p)))
706 (defun pcomplete-entries (&optional regexp predicate)
707 "Complete against a list of directory candidates.
708 If REGEXP is non-nil, it is a regular expression used to refine the
709 match (files not matching the REGEXP will be excluded).
710 If PREDICATE is non-nil, it will also be used to refine the match
711 \(files for which the PREDICATE returns nil will be excluded).
712 If no directory information can be extracted from the completed
713 component, `default-directory' is used as the basis for completion."
714 (let* ((name (substitute-env-vars pcomplete-stub))
715 (default-directory (expand-file-name
716 (or (file-name-directory name)
717 default-directory)))
718 above-cutoff)
719 (setq name (file-name-nondirectory name)
720 pcomplete-stub name)
721 (let ((completions
722 (file-name-all-completions name default-directory)))
723 (if regexp
724 (setq completions
725 (pcomplete-pare-list
726 completions nil
727 (function
728 (lambda (file)
729 (not (string-match regexp file)))))))
730 (if predicate
731 (setq completions
732 (pcomplete-pare-list
733 completions nil
734 (function
735 (lambda (file)
736 (not (funcall predicate file)))))))
737 (if (or pcomplete-file-ignore pcomplete-dir-ignore)
738 (setq completions
739 (pcomplete-pare-list
740 completions nil
741 (function
742 (lambda (file)
743 (if (eq (aref file (1- (length file)))
745 (and pcomplete-dir-ignore
746 (string-match pcomplete-dir-ignore file))
747 (and pcomplete-file-ignore
748 (string-match pcomplete-file-ignore file))))))))
749 (setq above-cutoff (and pcomplete-cycle-cutoff-length
750 (> (length completions)
751 pcomplete-cycle-cutoff-length)))
752 (sort completions
753 (function
754 (lambda (l r)
755 ;; for the purposes of comparison, remove the
756 ;; trailing slash from directory names.
757 ;; Otherwise, "foo.old/" will come before "foo/",
758 ;; since . is earlier in the ASCII alphabet than
759 ;; /
760 (let ((left (if (eq (aref l (1- (length l)))
762 (substring l 0 (1- (length l)))
764 (right (if (eq (aref r (1- (length r)))
766 (substring r 0 (1- (length r)))
767 r)))
768 (if above-cutoff
769 (string-lessp left right)
770 (funcall pcomplete-compare-entry-function
771 left right)))))))))
773 (defsubst pcomplete-all-entries (&optional regexp predicate)
774 "Like `pcomplete-entries', but doesn't ignore any entries."
775 (let (pcomplete-file-ignore
776 pcomplete-dir-ignore)
777 (pcomplete-entries regexp predicate)))
779 (defsubst pcomplete-dirs (&optional regexp)
780 "Complete amongst a list of directories."
781 (pcomplete-entries regexp 'file-directory-p))
783 (defsubst pcomplete-executables (&optional regexp)
784 "Complete amongst a list of directories and executables."
785 (pcomplete-entries regexp 'file-executable-p))
787 ;; generation of completion lists
789 (defun pcomplete-find-completion-function (command)
790 "Find the completion function to call for the given COMMAND."
791 (let ((sym (intern-soft
792 (concat "pcomplete/" (symbol-name major-mode) "/" command))))
793 (unless sym
794 (setq sym (intern-soft (concat "pcomplete/" command))))
795 (and sym (fboundp sym) sym)))
797 (defun pcomplete-completions ()
798 "Return a list of completions for the current argument position."
799 (catch 'pcomplete-completions
800 (when (pcomplete-parse-arguments pcomplete-expand-before-complete)
801 (if (= pcomplete-index pcomplete-last)
802 (funcall pcomplete-command-completion-function)
803 (let ((sym (or (pcomplete-find-completion-function
804 (funcall pcomplete-command-name-function))
805 pcomplete-default-completion-function)))
806 (ignore
807 (pcomplete-next-arg)
808 (funcall sym)))))))
810 (defun pcomplete-opt (options &optional prefix no-ganging args-follow)
811 "Complete a set of OPTIONS, each beginning with PREFIX (?- by default).
812 PREFIX may be t, in which case no PREFIX character is necessary.
813 If NO-GANGING is non-nil, each option is separate (-xy is not allowed).
814 If ARGS-FOLLOW is non-nil, then options which take arguments may have
815 the argument appear after a ganged set of options. This is how tar
816 behaves, for example."
817 (if (and (= pcomplete-index pcomplete-last)
818 (string= (pcomplete-arg) "-"))
819 (let ((len (length options))
820 (index 0)
821 char choices)
822 (while (< index len)
823 (setq char (aref options index))
824 (if (eq char ?\()
825 (let ((result (read-from-string options index)))
826 (setq index (cdr result)))
827 (unless (memq char '(?/ ?* ?? ?.))
828 (setq choices (cons (char-to-string char) choices)))
829 (setq index (1+ index))))
830 (throw 'pcomplete-completions
831 (mapcar
832 (function
833 (lambda (opt)
834 (concat "-" opt)))
835 (pcomplete-uniqify-list choices))))
836 (let ((arg (pcomplete-arg)))
837 (when (and (> (length arg) 1)
838 (stringp arg)
839 (eq (aref arg 0) (or prefix ?-)))
840 (pcomplete-next-arg)
841 (let ((char (aref arg 1))
842 (len (length options))
843 (index 0)
844 opt-char arg-char result)
845 (while (< (1+ index) len)
846 (setq opt-char (aref options index)
847 arg-char (aref options (1+ index)))
848 (if (eq arg-char ?\()
849 (setq result
850 (read-from-string options (1+ index))
851 index (cdr result)
852 result (car result))
853 (setq result nil))
854 (when (and (eq char opt-char)
855 (memq arg-char '(?\( ?/ ?* ?? ?.)))
856 (if (< pcomplete-index pcomplete-last)
857 (pcomplete-next-arg)
858 (throw 'pcomplete-completions
859 (cond ((eq arg-char ?/) (pcomplete-dirs))
860 ((eq arg-char ?*) (pcomplete-executables))
861 ((eq arg-char ??) nil)
862 ((eq arg-char ?.) (pcomplete-entries))
863 ((eq arg-char ?\() (eval result))))))
864 (setq index (1+ index))))))))
866 (defun pcomplete--here (&optional form stub paring form-only)
867 "Complete against the current argument, if at the end.
868 See the documentation for `pcomplete-here'."
869 (if (< pcomplete-index pcomplete-last)
870 (progn
871 (if (eq paring 0)
872 (setq pcomplete-seen nil)
873 (unless (eq paring t)
874 (let ((arg (pcomplete-arg)))
875 (unless (not (stringp arg))
876 (setq pcomplete-seen
877 (cons (if paring
878 (funcall paring arg)
879 (file-truename arg))
880 pcomplete-seen))))))
881 (pcomplete-next-arg)
883 (when pcomplete-show-help
884 (pcomplete--help)
885 (throw 'pcompleted t))
886 (if stub
887 (setq pcomplete-stub stub))
888 (if (or (eq paring t) (eq paring 0))
889 (setq pcomplete-seen nil)
890 (setq pcomplete-norm-func (or paring 'file-truename)))
891 (unless form-only
892 (run-hooks 'pcomplete-try-first-hook))
893 (throw 'pcomplete-completions (eval form))))
895 (defmacro pcomplete-here (&optional form stub paring form-only)
896 "Complete against the current argument, if at the end.
897 If completion is to be done here, evaluate FORM to generate the list
898 of strings which will be used for completion purposes. If STUB is a
899 string, use it as the completion stub instead of the default (which is
900 the entire text of the current argument).
902 For an example of when you might want to use STUB: if the current
903 argument text is 'long-path-name/', you don't want the completions
904 list display to be cluttered by 'long-path-name/' appearing at the
905 beginning of every alternative. Not only does this make things less
906 intelligle, but it is also inefficient. Yet, if the completion list
907 does not begin with this string for every entry, the current argument
908 won't complete correctly.
910 The solution is to specify a relative stub. It allows you to
911 substitute a different argument from the current argument, almost
912 always for the sake of efficiency.
914 If PARING is nil, this argument will be pared against previous
915 arguments using the function `file-truename' to normalize them.
916 PARING may be a function, in which case that function is used for
917 normalization. If PARING is t, the argument dealt with by this
918 call will not participate in argument paring. If it is the
919 integer 0, all previous arguments that have been seen will be
920 cleared.
922 If FORM-ONLY is non-nil, only the result of FORM will be used to
923 generate the completions list. This means that the hook
924 `pcomplete-try-first-hook' will not be run."
925 `(pcomplete--here (quote ,form) ,stub ,paring ,form-only))
927 (defmacro pcomplete-here* (&optional form stub form-only)
928 "An alternate form which does not participate in argument paring."
929 `(pcomplete-here ,form ,stub t ,form-only))
931 ;; display support
933 (defun pcomplete-restore-windows ()
934 "If the only window change was due to Completions, restore things."
935 (if pcomplete-last-window-config
936 (let* ((cbuf (get-buffer "*Completions*"))
937 (cwin (and cbuf (get-buffer-window cbuf))))
938 (when (and cwin (window-live-p cwin))
939 (bury-buffer cbuf)
940 (set-window-configuration pcomplete-last-window-config))))
941 (setq pcomplete-last-window-config nil
942 pcomplete-window-restore-timer nil))
944 ;; Abstractions so that the code below will work for both Emacs 20 and
945 ;; XEmacs 21
947 (unless (fboundp 'event-matches-key-specifier-p)
948 (defalias 'event-matches-key-specifier-p 'eq))
950 (if (fboundp 'read-event)
951 (defsubst pcomplete-read-event (&optional prompt)
952 (read-event prompt))
953 (defsubst pcomplete-read-event (&optional prompt)
954 (aref (read-key-sequence prompt) 0)))
956 (unless (fboundp 'event-basic-type)
957 (defalias 'event-basic-type 'event-key))
959 (defun pcomplete-show-completions (completions)
960 "List in help buffer sorted COMPLETIONS.
961 Typing SPC flushes the help buffer."
962 (let* ((curbuf (current-buffer)))
963 (when pcomplete-window-restore-timer
964 (cancel-timer pcomplete-window-restore-timer)
965 (setq pcomplete-window-restore-timer nil))
966 (unless pcomplete-last-window-config
967 (setq pcomplete-last-window-config (current-window-configuration)))
968 (with-output-to-temp-buffer "*Completions*"
969 (display-completion-list completions))
970 (message "Hit space to flush")
971 (let (event)
972 (prog1
973 (catch 'done
974 (while (with-current-buffer (get-buffer "*Completions*")
975 (setq event (pcomplete-read-event)))
976 (cond
977 ((event-matches-key-specifier-p event ? )
978 (set-window-configuration pcomplete-last-window-config)
979 (setq pcomplete-last-window-config nil)
980 (throw 'done nil))
981 ((or (event-matches-key-specifier-p event 'tab)
982 ;; Needed on a terminal
983 (event-matches-key-specifier-p event 9))
984 (save-selected-window
985 (select-window (get-buffer-window "*Completions*"))
986 (if (pos-visible-in-window-p (point-max))
987 (goto-char (point-min))
988 (scroll-up)))
989 (message ""))
991 (setq unread-command-events (list event))
992 (throw 'done nil)))))
993 (if (and pcomplete-last-window-config
994 pcomplete-restore-window-delay)
995 (setq pcomplete-window-restore-timer
996 (run-with-timer pcomplete-restore-window-delay nil
997 'pcomplete-restore-windows)))))))
999 ;; insert completion at point
1001 (defun pcomplete-insert-entry (stub entry &optional addsuffix raw-p)
1002 "Insert a completion entry at point.
1003 Returns non-nil if a space was appended at the end."
1004 (let ((here (point)))
1005 (if (not pcomplete-ignore-case)
1006 (insert-and-inherit (if raw-p
1007 (substring entry (length stub))
1008 (pcomplete-quote-argument
1009 (substring entry (length stub)))))
1010 ;; the stub is not quoted at this time, so to determine the
1011 ;; length of what should be in the buffer, we must quote it
1012 (delete-backward-char (length (pcomplete-quote-argument stub)))
1013 ;; if there is already a backslash present to handle the first
1014 ;; character, don't bother quoting it
1015 (when (eq (char-before) ?\\)
1016 (insert-and-inherit (substring entry 0 1))
1017 (setq entry (substring entry 1)))
1018 (insert-and-inherit (if raw-p
1019 entry
1020 (pcomplete-quote-argument entry))))
1021 (let (space-added)
1022 (when (and (not (memq (char-before) pcomplete-suffix-list))
1023 addsuffix)
1024 (insert-and-inherit pcomplete-termination-string)
1025 (setq space-added t))
1026 (setq pcomplete-last-completion-length (- (point) here)
1027 pcomplete-last-completion-stub stub)
1028 space-added)))
1030 ;; selection of completions
1032 (defun pcomplete-do-complete (stub completions)
1033 "Dynamically complete at point using STUB and COMPLETIONS.
1034 This is basically just a wrapper for `pcomplete-stub' which does some
1035 extra checking, and munging of the COMPLETIONS list."
1036 (unless (stringp stub)
1037 (message "Cannot complete argument")
1038 (throw 'pcompleted nil))
1039 (if (null completions)
1040 (ignore
1041 (if (and stub (> (length stub) 0))
1042 (message "No completions of %s" stub)
1043 (message "No completions")))
1044 ;; pare it down, if applicable
1045 (if (and pcomplete-use-paring pcomplete-seen)
1046 (let* ((arg (pcomplete-arg))
1047 (prefix
1048 (file-name-as-directory
1049 (funcall pcomplete-norm-func
1050 (substring arg 0 (- (length arg)
1051 (length pcomplete-stub)))))))
1052 (setq pcomplete-seen
1053 (mapcar 'directory-file-name pcomplete-seen))
1054 (let ((p pcomplete-seen))
1055 (while p
1056 (add-to-list 'pcomplete-seen
1057 (funcall pcomplete-norm-func (car p)))
1058 (setq p (cdr p))))
1059 (setq completions
1060 (mapcar
1061 (function
1062 (lambda (elem)
1063 (file-relative-name elem prefix)))
1064 (pcomplete-pare-list
1065 (mapcar
1066 (function
1067 (lambda (elem)
1068 (expand-file-name elem prefix)))
1069 completions)
1070 pcomplete-seen
1071 (function
1072 (lambda (elem)
1073 (member (directory-file-name
1074 (funcall pcomplete-norm-func elem))
1075 pcomplete-seen))))))))
1076 ;; OK, we've got a list of completions.
1077 (if pcomplete-show-list
1078 (pcomplete-show-completions completions)
1079 (pcomplete-stub stub completions))))
1081 (defun pcomplete-stub (stub candidates &optional cycle-p)
1082 "Dynamically complete STUB from CANDIDATES list.
1083 This function inserts completion characters at point by completing
1084 STUB from the strings in CANDIDATES. A completions listing may be
1085 shown in a help buffer if completion is ambiguous.
1087 Returns nil if no completion was inserted.
1088 Returns `sole' if completed with the only completion match.
1089 Returns `shortest' if completed with the shortest of the matches.
1090 Returns `partial' if completed as far as possible with the matches.
1091 Returns `listed' if a completion listing was shown.
1093 See also `pcomplete-filename'."
1094 (let* ((completion-ignore-case pcomplete-ignore-case)
1095 (candidates (mapcar 'list candidates))
1096 (completions (all-completions stub candidates)))
1097 (let (result entry)
1098 (cond
1099 ((null completions)
1100 (if (and stub (> (length stub) 0))
1101 (message "No completions of %s" stub)
1102 (message "No completions")))
1103 ((= 1 (length completions))
1104 (setq entry (car completions))
1105 (if (string-equal entry stub)
1106 (message "Sole completion"))
1107 (setq result 'sole))
1108 ((and pcomplete-cycle-completions
1109 (or cycle-p
1110 (not pcomplete-cycle-cutoff-length)
1111 (<= (length completions)
1112 pcomplete-cycle-cutoff-length)))
1113 (setq entry (car completions)
1114 pcomplete-current-completions completions))
1115 (t ; There's no unique completion; use longest substring
1116 (setq entry (try-completion stub candidates))
1117 (cond ((and pcomplete-recexact
1118 (string-equal stub entry)
1119 (member entry completions))
1120 ;; It's not unique, but user wants shortest match.
1121 (message "Completed shortest")
1122 (setq result 'shortest))
1123 ((or pcomplete-autolist
1124 (string-equal stub entry))
1125 ;; It's not unique, list possible completions.
1126 (pcomplete-show-completions completions)
1127 (setq result 'listed))
1129 (message "Partially completed")
1130 (setq result 'partial)))))
1131 (cons result entry))))
1133 ;; context sensitive help
1135 (defun pcomplete--help ()
1136 "Produce context-sensitive help for the current argument.
1137 If specific documentation can't be given, be generic."
1138 (if (and pcomplete-help
1139 (or (and (stringp pcomplete-help)
1140 (fboundp 'Info-goto-node))
1141 (listp pcomplete-help)))
1142 (if (listp pcomplete-help)
1143 (message "%s" (eval pcomplete-help))
1144 (save-window-excursion (info))
1145 (switch-to-buffer-other-window "*info*")
1146 (funcall (symbol-function 'Info-goto-node) pcomplete-help))
1147 (if pcomplete-man-function
1148 (let ((cmd (funcall pcomplete-command-name-function)))
1149 (if (and cmd (> (length cmd) 0))
1150 (funcall pcomplete-man-function cmd)))
1151 (message "No context-sensitive help available"))))
1153 ;; general utilities
1155 (defun pcomplete-pare-list (l r &optional pred)
1156 "Destructively remove from list L all elements matching any in list R.
1157 Test is done using `equal'.
1158 If PRED is non-nil, it is a function used for further removal.
1159 Returns the resultant list."
1160 (while (and l (or (and r (member (car l) r))
1161 (and pred
1162 (funcall pred (car l)))))
1163 (setq l (cdr l)))
1164 (let ((m l))
1165 (while m
1166 (while (and (cdr m)
1167 (or (and r (member (cadr m) r))
1168 (and pred
1169 (funcall pred (cadr m)))))
1170 (setcdr m (cddr m)))
1171 (setq m (cdr m))))
1174 (defun pcomplete-uniqify-list (l)
1175 "Sort and remove multiples in L."
1176 (setq l (sort l 'string-lessp))
1177 (let ((m l))
1178 (while m
1179 (while (and (cdr m)
1180 (string= (car m)
1181 (cadr m)))
1182 (setcdr m (cddr m)))
1183 (setq m (cdr m))))
1186 (defun pcomplete-process-result (cmd &rest args)
1187 "Call CMD using `call-process' and return the simplest result."
1188 (with-temp-buffer
1189 (apply 'call-process cmd nil t nil args)
1190 (skip-chars-backward "\n")
1191 (buffer-substring (point-min) (point))))
1193 ;; create a set of aliases which allow completion functions to be not
1194 ;; quite so verbose
1196 ;; jww (1999-10-20): are these a good idea?
1197 ; (defalias 'pc-here 'pcomplete-here)
1198 ; (defalias 'pc-test 'pcomplete-test)
1199 ; (defalias 'pc-opt 'pcomplete-opt)
1200 ; (defalias 'pc-match 'pcomplete-match)
1201 ; (defalias 'pc-match-string 'pcomplete-match-string)
1202 ; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
1203 ; (defalias 'pc-match-end 'pcomplete-match-end)
1205 ;;; arch-tag: ae32ef2d-dbed-4244-8b0f-cf5a2a3b07a4
1206 ;;; pcomplete.el ends here