summaryrefslogtreecommitdiff
path: root/lisp/pcomplete.el
diff options
context:
space:
mode:
authorGerd Moellmann <gerd@gnu.org>2000-06-23 05:24:10 +0000
committerGerd Moellmann <gerd@gnu.org>2000-06-23 05:24:10 +0000
commitaffbf6477576c38d98111b55fbb1eb5b13d1a735 (patch)
treee7cccedd38944fc20cf2d20a3949246d8d558bf7 /lisp/pcomplete.el
parent022499fab948938bb763c2a33a8c5ba0c5969fcd (diff)
downloademacs-affbf6477576c38d98111b55fbb1eb5b13d1a735.tar.gz
*** empty log message ***
Diffstat (limited to 'lisp/pcomplete.el')
-rw-r--r--lisp/pcomplete.el1189
1 files changed, 1189 insertions, 0 deletions
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
new file mode 100644
index 00000000000..2b66b1d45b9
--- /dev/null
+++ b/lisp/pcomplete.el
@@ -0,0 +1,1189 @@
+;;; pcomplete --- programmable completion
+
+;; Copyright (C) 1999, 2000 Free Sofware Foundation
+
+;; Author: John Wiegley <johnw@gnu.org>
+;; Keywords: processes
+;; X-URL: http://www.emacs.org/~johnw/emacs.html
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module provides a programmable completion facility using
+;; "completion functions". Each completion function is responsible
+;; for producing a list of possible completions relevant to the current
+;; argument position.
+;;
+;; To use pcomplete with shell-mode, for example, you will need the
+;; following in your .emacs file:
+;;
+;; (load "pcmpl-auto")
+;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
+;;
+;; Most of the code below simply provides support mechanisms for
+;; writing completion functions. Completion functions themselves are
+;; very easy to write. They have few requirements beyond those of
+;; regular Lisp functions.
+;;
+;; Consider the following example, which will complete against
+;; filenames for the first two arguments, and directories for all
+;; remaining arguments:
+;;
+;; (defun pcomplete/my-command ()
+;; (pcomplete-here (pcomplete-entries))
+;; (pcomplete-here (pcomplete-entries))
+;; (while (pcomplete-here (pcomplete-dirs))))
+;;
+;; Here are the requirements for completion functions:
+;;
+;; @ They must be called "pcomplete/MAJOR-MODE/NAME", or
+;; "pcomplete/NAME". This is how they are looked up, using the NAME
+;; specified in the command argument (the argument in first
+;; position).
+;;
+;; @ They must be callable with no arguments.
+;;
+;; @ Their return value is ignored. If they actually return normally,
+;; it means no completions were available.
+;;
+;; @ In order to provide completions, they must throw the tag
+;; `pcomplete-completions'. The value must be the list of possible
+;; completions for the final argument.
+;;
+;; @ To simplify completion function logic, the tag `pcompleted' may
+;; be thrown with a value of nil in order to abort the function. It
+;; means that there were no completions available.
+;;
+;; When a completion function is called, the variable `pcomplete-args'
+;; is in scope, and contains all of the arguments specified on the
+;; command line. The variable `pcomplete-last' is the index of the
+;; last argument in that list.
+;;
+;; The variable `pcomplete-index' is used by the completion code to
+;; know which argument the completion function is currently examining.
+;; It always begins at 1, meaning the first argument after the command
+;; name.
+;;
+;; To facilitate writing completion logic, a special macro,
+;; `pcomplete-here', has been provided which does several things:
+;;
+;; 1. It will throw `pcompleted' (with a value of nil) whenever
+;; `pcomplete-index' exceeds `pcomplete-last'.
+;;
+;; 2. It will increment `pcomplete-index' if the final argument has
+;; not been reached yet.
+;;
+;; 3. It will evaluate the form passed to it, and throw the result
+;; using the `pcomplete-completions' tag, if it is called when
+;; `pcomplete-index' is pointing to the final argument.
+;;
+;; Sometimes a completion function will want to vary the possible
+;; completions for an argument based on the previous one. To
+;; facilitate tests like this, the function `pcomplete-test' and
+;; `pcomplete-match' are provided. Called with one argument, they
+;; test the value of the previous command argument. Otherwise, a
+;; relative index may be given as an optional second argument, where 0
+;; refers to the current argument, 1 the previous, 2 the one before
+;; that, etc. The symbols `first' and `last' specify absolute
+;; offsets.
+;;
+;; Here is an example which will only complete against directories for
+;; the second argument if the first argument is also a directory:
+;;
+;; (defun pcomplete/example ()
+;; (pcomplete-here (pcomplete-entries))
+;; (if (pcomplete-test 'file-directory-p)
+;; (pcomplete-here (pcomplete-dirs))
+;; (pcomplete-here (pcomplete-entries))))
+;;
+;; For generating completion lists based on directory contents, see
+;; the functions `pcomplete-entries', `pcomplete-dirs',
+;; `pcomplete-executables' and `pcomplete-all-entries'.
+;;
+;; Consult the documentation for `pcomplete-here' for information
+;; about its other arguments.
+
+;;; Code:
+
+(provide 'pcomplete)
+
+(defgroup pcomplete nil
+ "Programmable completion."
+ :group 'processes)
+
+;;; User Variables:
+
+(defcustom pcomplete-file-ignore nil
+ "*A regexp of filenames to be disregarded during file completion."
+ :type 'regexp
+ :group 'pcomplete)
+
+(defcustom pcomplete-dir-ignore nil
+ "*A regexp of names to be disregarded during directory completion."
+ :type 'regexp
+ :group 'pcomplete)
+
+(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt))
+ "*If non-nil, ignore case when doing filename completion."
+ :type 'boolean
+ :group 'pcomplete)
+
+(defcustom pcomplete-autolist nil
+ "*If non-nil, automatically list possibilities on partial completion.
+This mirrors the optional behavior of tcsh."
+ :type 'boolean
+ :group 'pcomplete)
+
+(defcustom pcomplete-suffix-list (list directory-sep-char ?:)
+ "*A list of characters which constitute a proper suffix."
+ :type '(repeat character)
+ :group 'pcomplete)
+
+(defcustom pcomplete-recexact nil
+ "*If non-nil, use shortest completion if characters cannot be added.
+This mirrors the optional behavior of tcsh.
+
+A non-nil value is useful if `pcomplete-autolist' is non-nil too."
+ :type 'boolean
+ :group 'pcomplete)
+
+(defcustom pcomplete-arg-quote-list nil
+ "*List of characters to quote when completing an argument."
+ :type '(choice (repeat character)
+ (const :tag "Don't quote" nil))
+ :group 'pcomplete)
+
+(defcustom pcomplete-quote-arg-hook nil
+ "*A hook which is run to quote a character within a filename.
+Each function is passed both the filename to be quoted, and the index
+to be considered. If the function wishes to provide an alternate
+quoted form, it need only return the replacement string. If no
+function provides a replacement, quoting shall proceed as normal,
+using a backslash to quote any character which is a member of
+`pcomplete-arg-quote-list'."
+ :type 'hook
+ :group 'pcomplete)
+
+(defcustom pcomplete-man-function 'man
+ "*A function to that will be called to display a manual page.
+It will be passed the name of the command to document."
+ :type 'function
+ :group 'pcomplete)
+
+(defcustom pcomplete-compare-entry-function 'string-lessp
+ "*This function is used to order file entries for completion.
+The behavior of most all shells is to sort alphabetically."
+ :type '(radio (function-item string-lessp)
+ (function-item file-newer-than-file-p)
+ (function :tag "Other"))
+ :group 'pcomplete)
+
+(defcustom pcomplete-help nil
+ "*A string or function (or nil) used for context-sensitive help.
+If a string, it should name an Info node that will be jumped to.
+If non-nil, it must a sexp that will be evaluated, and whose
+result will be shown in the minibuffer.
+If nil, the function `pcomplete-man-function' will be called with the
+current command argument."
+ :type '(choice string sexp (const :tag "Use man page" nil))
+ :group 'pcomplete)
+
+(defcustom pcomplete-expand-before-complete nil
+ "*If non-nil, expand the current argument before completing it.
+This means that typing something such as '$HOME/bi' followed by
+\\[pcomplete-argument] will cause the variable reference to be
+resolved first, and the resultant value that will be completed against
+to be inserted in the buffer. Note that exactly what gets expanded
+and how is entirely up to the behavior of the
+`pcomplete-parse-arguments-function'."
+ :type 'boolean
+ :group 'pcomplete)
+
+(defcustom pcomplete-parse-arguments-function
+ 'pcomplete-parse-buffer-arguments
+ "*A function to call to parse the current line's arguments.
+It should be called with no parameters, and with point at the position
+of the argument that is to be completed.
+
+It must either return nil, or a cons cell of the form:
+
+ ((ARG...) (BEG-POS...))
+
+The two lists must be identical in length. The first gives the final
+value of each command line argument (which need not match the textual
+representation of that argument), and BEG-POS gives the beginning
+position of each argument, as it is seen by the user. The establishes
+a relationship between the fully resolved value of the argument, and
+the textual representation of the argument."
+ :type 'function
+ :group 'pcomplete)
+
+(defcustom pcomplete-cycle-completions t
+ "*If non-nil, hitting the TAB key cycles through the completion list.
+Typical Emacs behavior is to complete as much as possible, then pause
+waiting for further input. Then if TAB is hit again, show a list of
+possible completions. When `pcomplete-cycle-completions' is non-nil,
+it acts more like zsh or 4nt, showing the first maximal match first,
+followed by any further matches on each subsequent pressing of the TAB
+key. \\[pcomplete-list] is the key to press if the user wants to see
+the list of possible completions."
+ :type 'boolean
+ :group 'pcomplete)
+
+(defcustom pcomplete-cycle-cutoff-length 5
+ "*If the number of completions is greater than this, don't cycle.
+This variable is a compromise between the traditional Emacs style of
+completion, and the \"cycling\" style. Basically, if there are more
+than this number of completions possible, don't automatically pick the
+first one and then expect the user to press TAB to cycle through them.
+Typically, when there are a large number of completion possibilities,
+the user wants to see them in a list buffer so that they can know what
+options are available. But if the list is small, it means the user
+has already entered enough input to disambiguate most of the
+possibilities, and therefore they are probably most interested in
+cycling through the candidates. Set this value to nil if you want
+cycling to always be enabled."
+ :type '(choice integer (const :tag "Always cycle" nil))
+ :group 'pcomplete)
+
+(defcustom pcomplete-restore-window-delay 1
+ "*The number of seconds to wait before restoring completion windows.
+Once the completion window has been displayed, if the user then goes
+on to type something else, that completion window will be removed from
+the display (actually, the original window configuration before it was
+displayed will be restored), after this many seconds of idle time. If
+set to nil, completion windows will be left on second until the user
+removes them manually. If set to 0, they will disappear immediately
+after the user enters a key other than TAB."
+ :type '(choice integer (const :tag "Never restore" nil))
+ :group 'pcomplete)
+
+(defcustom pcomplete-try-first-hook nil
+ "*A list of functions which are called before completing an argument.
+This can be used, for example, for completing things which might apply
+to all arguments, such as variable names after a $."
+ :type 'hook
+ :group 'pcomplete)
+
+(defcustom pcomplete-command-completion-function
+ (function
+ (lambda ()
+ (pcomplete-here (pcomplete-executables))))
+ "*Function called for completing the initial command argument."
+ :type 'function
+ :group 'pcomplete)
+
+(defcustom pcomplete-command-name-function 'pcomplete-command-name
+ "*Function called for determining the current command name."
+ :type 'function
+ :group 'pcomplete)
+
+(defcustom pcomplete-default-completion-function
+ (function
+ (lambda ()
+ (while (pcomplete-here (pcomplete-entries)))))
+ "*Function called when no completion rule can be found.
+This function is used to generate completions for every argument."
+ :type 'function
+ :group 'pcomplete)
+
+;;; Internal Variables:
+
+;; for cycling completion support
+(defvar pcomplete-current-completions nil)
+(defvar pcomplete-last-completion-length)
+(defvar pcomplete-last-completion-stub)
+(defvar pcomplete-last-completion-raw)
+(defvar pcomplete-last-window-config nil)
+(defvar pcomplete-window-restore-timer nil)
+
+(make-variable-buffer-local 'pcomplete-current-completions)
+(make-variable-buffer-local 'pcomplete-last-completion-length)
+(make-variable-buffer-local 'pcomplete-last-completion-stub)
+(make-variable-buffer-local 'pcomplete-last-completion-raw)
+(make-variable-buffer-local 'pcomplete-last-window-config)
+(make-variable-buffer-local 'pcomplete-window-restore-timer)
+
+;; used for altering pcomplete's behavior. These global variables
+;; should always be nil.
+(defvar pcomplete-show-help nil)
+(defvar pcomplete-show-list nil)
+(defvar pcomplete-expand-only-p nil)
+
+;;; User Functions:
+
+;;;###autoload
+(defun pcomplete ()
+ "Support extensible programmable completion.
+To use this function, just bind the TAB key to it, or add it to your
+completion functions list (it should occur fairly early in the list)."
+ (interactive)
+ (if (and (interactive-p)
+ pcomplete-cycle-completions
+ pcomplete-current-completions
+ (memq last-command '(pcomplete
+ pcomplete-expand-and-complete
+ pcomplete-reverse)))
+ (progn
+ (delete-backward-char pcomplete-last-completion-length)
+ (if (eq this-command 'pcomplete-reverse)
+ (progn
+ (setq pcomplete-current-completions
+ (cons (car (last pcomplete-current-completions))
+ pcomplete-current-completions))
+ (setcdr (last pcomplete-current-completions 2) nil))
+ (nconc pcomplete-current-completions
+ (list (car pcomplete-current-completions)))
+ (setq pcomplete-current-completions
+ (cdr pcomplete-current-completions)))
+ (pcomplete-insert-entry pcomplete-last-completion-stub
+ (car pcomplete-current-completions)
+ nil pcomplete-last-completion-raw))
+ (setq pcomplete-current-completions nil
+ pcomplete-last-completion-raw nil)
+ (catch 'pcompleted
+ (let* ((pcomplete-stub)
+ pcomplete-seen pcomplete-norm-func
+ pcomplete-args pcomplete-last pcomplete-index
+ (pcomplete-autolist pcomplete-autolist)
+ (pcomplete-suffix-list pcomplete-suffix-list)
+ (completions (pcomplete-completions))
+ (result (pcomplete-do-complete pcomplete-stub completions)))
+ (and result
+ (not (eq (car result) 'listed))
+ (cdr result)
+ (pcomplete-insert-entry pcomplete-stub (cdr result)
+ (memq (car result)
+ '(sole shortest))
+ pcomplete-last-completion-raw))))))
+
+;;;###autoload
+(defun pcomplete-reverse ()
+ "If cycling completion is in use, cycle backwards."
+ (interactive)
+ (call-interactively 'pcomplete))
+
+;;;###autoload
+(defun pcomplete-expand-and-complete ()
+ "Expand the textual value of the current argument.
+This will modify the current buffer."
+ (interactive)
+ (let ((pcomplete-expand-before-complete t))
+ (pcomplete)))
+
+;;;###autoload
+(defun pcomplete-continue ()
+ "Complete without reference to any cycling completions."
+ (interactive)
+ (setq pcomplete-current-completions nil
+ pcomplete-last-completion-raw nil)
+ (call-interactively 'pcomplete))
+
+;;;###autoload
+(defun pcomplete-expand ()
+ "Expand the textual value of the current argument.
+This will modify the current buffer."
+ (interactive)
+ (let ((pcomplete-expand-before-complete t)
+ (pcomplete-expand-only-p t))
+ (pcomplete)
+ (when (and pcomplete-current-completions
+ (> (length pcomplete-current-completions) 0))
+ (delete-backward-char pcomplete-last-completion-length)
+ (while pcomplete-current-completions
+ (unless (pcomplete-insert-entry
+ "" (car pcomplete-current-completions) t
+ pcomplete-last-completion-raw)
+ (insert-and-inherit " "))
+ (setq pcomplete-current-completions
+ (cdr pcomplete-current-completions))))))
+
+;;;###autoload
+(defun pcomplete-help ()
+ "Display any help information relative to the current argument."
+ (interactive)
+ (let ((pcomplete-show-help t))
+ (pcomplete)))
+
+;;;###autoload
+(defun pcomplete-list ()
+ "Show the list of possible completions for the current argument."
+ (interactive)
+ (when (and pcomplete-cycle-completions
+ pcomplete-current-completions
+ (eq last-command 'pcomplete-argument))
+ (delete-backward-char pcomplete-last-completion-length)
+ (setq pcomplete-current-completions nil
+ pcomplete-last-completion-raw nil))
+ (let ((pcomplete-show-list t))
+ (pcomplete)))
+
+;;; Internal Functions:
+
+;; argument handling
+
+;; for the sake of the bye-compiler, when compiling other files that
+;; contain completion functions
+(defvar pcomplete-args nil)
+(defvar pcomplete-begins nil)
+(defvar pcomplete-last nil)
+(defvar pcomplete-index nil)
+(defvar pcomplete-stub nil)
+(defvar pcomplete-seen nil)
+(defvar pcomplete-norm-func nil)
+
+(defun pcomplete-arg (&optional index offset)
+ "Return the textual content of the INDEXth argument.
+INDEX is based from the current processing position. If INDEX is
+positive, values returned are closer to the command argument; if
+negative, they are closer to the last argument. If the INDEX is
+outside of the argument list, nil is returned. The default value for
+INDEX is 0, meaning the current argument being examined.
+
+The special indices `first' and `last' may be used to access those
+parts of the list.
+
+The OFFSET argument is added to/taken away from the index that will be
+used. This is really only useful with `first' and `last', for
+accessing absolute argument positions."
+ (setq index
+ (if (eq index 'first)
+ 0
+ (if (eq index 'last)
+ pcomplete-last
+ (- pcomplete-index (or index 0)))))
+ (if offset
+ (setq index (+ index offset)))
+ (nth index pcomplete-args))
+
+(defun pcomplete-begin (&optional index offset)
+ "Return the beginning position of the INDEXth argument.
+See the documentation for `pcomplete-arg'."
+ (setq index
+ (if (eq index 'first)
+ 0
+ (if (eq index 'last)
+ pcomplete-last
+ (- pcomplete-index (or index 0)))))
+ (if offset
+ (setq index (+ index offset)))
+ (nth index pcomplete-begins))
+
+(defsubst pcomplete-actual-arg (&optional index offset)
+ "Return the actual text representation of the last argument.
+This different from `pcomplete-arg', which returns the textual value
+that the last argument evaluated to. This function returns what the
+user actually typed in."
+ (buffer-substring (pcomplete-begin index offset) (point)))
+
+(defsubst pcomplete-next-arg ()
+ "Move the various pointers to the next argument."
+ (setq pcomplete-index (1+ pcomplete-index)
+ pcomplete-stub (pcomplete-arg))
+ (if (> pcomplete-index pcomplete-last)
+ (progn
+ (message "No completions")
+ (throw 'pcompleted nil))))
+
+(defun pcomplete-command-name ()
+ "Return the command name of the first argument."
+ (file-name-nondirectory (pcomplete-arg 'first)))
+
+(defun pcomplete-match (regexp &optional index offset start)
+ "Like `string-match', but on the current completion argument."
+ (let ((arg (pcomplete-arg (or index 1) offset)))
+ (if arg
+ (string-match regexp arg start)
+ (throw 'pcompleted nil))))
+
+(defun pcomplete-match-string (which &optional index offset)
+ "Like `string-match', but on the current completion argument."
+ (let ((arg (pcomplete-arg (or index 1) offset)))
+ (if arg
+ (match-string which arg)
+ (throw 'pcompleted nil))))
+
+(defalias 'pcomplete-match-beginning 'match-beginning)
+(defalias 'pcomplete-match-end 'match-end)
+
+(defsubst pcomplete--test (pred arg)
+ "Perform a programmable completion predicate match."
+ (and pred
+ (cond ((eq pred t) t)
+ ((functionp pred)
+ (funcall pred arg))
+ ((stringp pred)
+ (string-match (concat "^" pred "$") arg)))
+ pred))
+
+(defun pcomplete-test (predicates &optional index offset)
+ "Predicates to test the current programmable argument with."
+ (let ((arg (pcomplete-arg (or index 1) offset)))
+ (unless (null predicates)
+ (if (not (listp predicates))
+ (pcomplete--test predicates arg)
+ (let ((pred predicates)
+ found)
+ (while (and pred (not found))
+ (setq found (pcomplete--test (car pred) arg)
+ pred (cdr pred)))
+ found)))))
+
+(defun pcomplete-parse-buffer-arguments ()
+ "Parse whitespace separated arguments in the current region."
+ (let ((begin (point-min))
+ (end (point-max))
+ begins args)
+ (save-excursion
+ (goto-char begin)
+ (while (< (point) end)
+ (skip-chars-forward " \t\n")
+ (setq begins (cons (point) begins))
+ (skip-chars-forward "^ \t\n")
+ (setq args (cons (buffer-substring-no-properties
+ (car begins) (point))
+ args)))
+ (cons (reverse args) (reverse begins)))))
+
+;;;###autoload
+(defun pcomplete-comint-setup (completef-sym)
+ "Setup a comint buffer to use pcomplete.
+COMPLETEF-SYM should be the symbol where the
+dynamic-complete-functions are kept. For comint mode itself, this is
+`comint-dynamic-complete-functions'."
+ (set (make-local-variable 'pcomplete-parse-arguments-function)
+ 'pcomplete-parse-comint-arguments)
+ (make-local-variable completef-sym)
+ (let ((elem (memq 'comint-dynamic-complete-filename
+ (symbol-value completef-sym))))
+ (if elem
+ (setcar elem 'pcomplete)
+ (nconc (symbol-value completef-sym)
+ (list 'pcomplete)))))
+
+;;;###autoload
+(defun pcomplete-shell-setup ()
+ "Setup shell-mode to use pcomplete."
+ (pcomplete-comint-setup 'shell-dynamic-complete-functions))
+
+(defun pcomplete-parse-comint-arguments ()
+ "Parse whitespace separated arguments in the current region."
+ (let ((begin (save-excursion (comint-bol nil) (point)))
+ (end (point))
+ begins args)
+ (save-excursion
+ (goto-char begin)
+ (while (< (point) end)
+ (skip-chars-forward " \t\n")
+ (setq begins (cons (point) begins))
+ (let ((skip t))
+ (while skip
+ (skip-chars-forward "^ \t\n")
+ (if (eq (char-before) ?\\)
+ (skip-chars-forward " \t\n")
+ (setq skip nil))))
+ (setq args (cons (buffer-substring-no-properties
+ (car begins) (point))
+ args)))
+ (cons (reverse args) (reverse begins)))))
+
+(defun pcomplete-parse-arguments (&optional expand-p)
+ "Parse the command line arguments. Most completions need this info."
+ (let ((results (funcall pcomplete-parse-arguments-function)))
+ (when results
+ (setq pcomplete-args (or (car results) (list ""))
+ pcomplete-begins (or (cdr results) (list (point)))
+ pcomplete-last (1- (length pcomplete-args))
+ pcomplete-index 0
+ pcomplete-stub (pcomplete-arg 'last))
+ (let ((begin (pcomplete-begin 'last)))
+ (if (and pcomplete-cycle-completions
+ (listp pcomplete-stub)
+ (not pcomplete-expand-only-p))
+ (let* ((completions pcomplete-stub)
+ (common-stub (car completions))
+ (c completions)
+ (len (length common-stub)))
+ (while (and c (> len 0))
+ (while (and (> len 0)
+ (not (string=
+ (substring common-stub 0 len)
+ (substring (car c) 0
+ (min (length (car c))
+ len)))))
+ (setq len (1- len)))
+ (setq c (cdr c)))
+ (setq pcomplete-stub (substring common-stub 0 len)
+ pcomplete-autolist t)
+ (when (and begin (not pcomplete-show-list))
+ (delete-region begin (point))
+ (pcomplete-insert-entry "" pcomplete-stub))
+ (throw 'pcomplete-completions completions))
+ (when expand-p
+ (if (stringp pcomplete-stub)
+ (when begin
+ (delete-region begin (point))
+ (insert-and-inherit pcomplete-stub))
+ (if (and (listp pcomplete-stub)
+ pcomplete-expand-only-p)
+ ;; this is for the benefit of `pcomplete-expand'
+ (setq pcomplete-last-completion-length (- (point) begin)
+ pcomplete-current-completions pcomplete-stub)
+ (error "Cannot expand argument"))))
+ (if pcomplete-expand-only-p
+ (throw 'pcompleted t)
+ pcomplete-args))))))
+
+(defun pcomplete-quote-argument (filename)
+ "Return FILENAME with magic characters quoted.
+Magic characters are those in `pcomplete-arg-quote-list'."
+ (if (null pcomplete-arg-quote-list)
+ filename
+ (let ((len (length filename))
+ (index 0)
+ (result "")
+ replacement char)
+ (while (< index len)
+ (setq replacement (run-hook-with-args-until-success
+ 'pcomplete-quote-arg-hook filename index))
+ (cond
+ (replacement
+ (setq result (concat result replacement)))
+ ((and (setq char (aref filename index))
+ (memq char pcomplete-arg-quote-list))
+ (setq result (concat result "\\" (char-to-string char))))
+ (t
+ (setq result (concat result (char-to-string char)))))
+ (setq index (1+ index)))
+ result)))
+
+;; file-system completion lists
+
+(defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
+ "Return either directories, or qualified entries."
+ (append (let ((pcomplete-stub pcomplete-stub))
+ (pcomplete-entries regexp predicate))
+ (pcomplete-entries nil 'file-directory-p)))
+
+(defun pcomplete-entries (&optional regexp predicate)
+ "Complete against a list of directory candidates.
+This function always uses the last argument as the basis for
+completion.
+If REGEXP is non-nil, it is a regular expression used to refine the
+match (files not matching the REGEXP will be excluded).
+If PREDICATE is non-nil, it will also be used to refine the match
+\(files for which the PREDICATE returns nil will be excluded).
+If PATH is non-nil, it will be used for completion instead of
+consulting the last argument."
+ (let* ((name pcomplete-stub)
+ (default-directory (expand-file-name
+ (or (file-name-directory name)
+ default-directory)))
+ above-cutoff)
+ (setq name (file-name-nondirectory name)
+ pcomplete-stub name)
+ (let ((completions
+ (file-name-all-completions name default-directory)))
+ (if regexp
+ (setq completions
+ (pcomplete-pare-list
+ completions nil
+ (function
+ (lambda (file)
+ (not (string-match regexp file)))))))
+ (if predicate
+ (setq completions
+ (pcomplete-pare-list
+ completions nil
+ (function
+ (lambda (file)
+ (not (funcall predicate file)))))))
+ (if (or pcomplete-file-ignore pcomplete-dir-ignore)
+ (setq completions
+ (pcomplete-pare-list
+ completions nil
+ (function
+ (lambda (file)
+ (if (eq (aref file (1- (length file)))
+ directory-sep-char)
+ (and pcomplete-dir-ignore
+ (string-match pcomplete-dir-ignore file))
+ (and pcomplete-file-ignore
+ (string-match pcomplete-file-ignore file))))))))
+ (setq above-cutoff (> (length completions)
+ pcomplete-cycle-cutoff-length))
+ (sort completions
+ (function
+ (lambda (l r)
+ ;; for the purposes of comparison, remove the
+ ;; trailing slash from directory names.
+ ;; Otherwise, "foo.old/" will come before "foo/",
+ ;; since . is earlier in the ASCII alphabet than
+ ;; /
+ (let ((left (if (eq (aref l (1- (length l)))
+ directory-sep-char)
+ (substring l 0 (1- (length l)))
+ l))
+ (right (if (eq (aref r (1- (length r)))
+ directory-sep-char)
+ (substring r 0 (1- (length r)))
+ r)))
+ (if above-cutoff
+ (string-lessp left right)
+ (funcall pcomplete-compare-entry-function
+ left right)))))))))
+
+(defsubst pcomplete-all-entries (&optional regexp predicate)
+ "Like `pcomplete-entries', but doesn't ignore any entries."
+ (let (pcomplete-file-ignore
+ pcomplete-dir-ignore)
+ (pcomplete-entries regexp predicate)))
+
+(defsubst pcomplete-dirs (&optional regexp)
+ "Complete amongst a list of directories."
+ (pcomplete-entries regexp 'file-directory-p))
+
+(defsubst pcomplete-executables (&optional regexp)
+ "Complete amongst a list of directories and executables."
+ (pcomplete-entries regexp 'file-executable-p))
+
+;; generation of completion lists
+
+(defun pcomplete-find-completion-function (command)
+ "Find the completion function to call for the given COMMAND."
+ (let ((sym (intern-soft
+ (concat "pcomplete/" (symbol-name major-mode) "/" command))))
+ (unless sym
+ (setq sym (intern-soft (concat "pcomplete/" command))))
+ (and sym (fboundp sym) sym)))
+
+(defun pcomplete-completions ()
+ "Return a list of completions for the current argument position."
+ (catch 'pcomplete-completions
+ (when (pcomplete-parse-arguments pcomplete-expand-before-complete)
+ (if (= pcomplete-index pcomplete-last)
+ (funcall pcomplete-command-completion-function)
+ (let ((sym (or (pcomplete-find-completion-function
+ (funcall pcomplete-command-name-function))
+ pcomplete-default-completion-function)))
+ (ignore
+ (pcomplete-next-arg)
+ (funcall sym)))))))
+
+(defun pcomplete-opt (options &optional prefix no-ganging args-follow)
+ "Complete a set of OPTIONS, each beginning with PREFIX (?- by default).
+PREFIX may be t, in which case no PREFIX character is necessary.
+If REQUIRED is non-nil, the options must be present.
+If NO-GANGING is non-nil, each option is separate. -xy is not allowed.
+If ARGS-FOLLOW is non-nil, then options which arguments which take may
+have the argument appear after a ganged set of options. This is how
+tar behaves, for example."
+ (if (and (= pcomplete-index pcomplete-last)
+ (string= (pcomplete-arg) "-"))
+ (let ((len (length options))
+ (index 0)
+ char choices)
+ (while (< index len)
+ (setq char (aref options index))
+ (if (eq char ?\()
+ (let ((result (read-from-string options index)))
+ (setq index (cdr result)))
+ (unless (memq char '(?/ ?* ?? ?.))
+ (setq choices (cons (char-to-string char) choices)))
+ (setq index (1+ index))))
+ (throw 'pcomplete-completions
+ (mapcar
+ (function
+ (lambda (opt)
+ (concat "-" opt)))
+ (pcomplete-uniqify-list choices))))
+ (let ((arg (pcomplete-arg)))
+ (when (and (> (length arg) 1)
+ (stringp arg)
+ (eq (aref arg 0) (or prefix ?-)))
+ (pcomplete-next-arg)
+ (let ((char (aref arg 1))
+ (len (length options))
+ (index 0)
+ opt-char arg-char result)
+ (while (< (1+ index) len)
+ (setq opt-char (aref options index)
+ arg-char (aref options (1+ index)))
+ (if (eq arg-char ?\()
+ (setq result
+ (read-from-string options (1+ index))
+ index (cdr result)
+ result (car result))
+ (setq result nil))
+ (when (and (eq char opt-char)
+ (memq arg-char '(?\( ?/ ?* ?? ?.)))
+ (if (< pcomplete-index pcomplete-last)
+ (pcomplete-next-arg)
+ (throw 'pcomplete-completions
+ (cond ((eq arg-char ?/) (pcomplete-dirs))
+ ((eq arg-char ?*) (pcomplete-executables))
+ ((eq arg-char ??) nil)
+ ((eq arg-char ?.) (pcomplete-entries))
+ ((eq arg-char ?\() (eval result))))))
+ (setq index (1+ index))))))))
+
+(defun pcomplete--here (&optional form stub paring form-only)
+ "Complete aganst the current argument, if at the end.
+See the documentation for `pcomplete-here'."
+ (if (< pcomplete-index pcomplete-last)
+ (progn
+ (if (eq paring 0)
+ (setq pcomplete-seen nil)
+ (unless (eq paring t)
+ (let ((arg (pcomplete-arg)))
+ (unless (not (stringp arg))
+ (setq pcomplete-seen
+ (cons (if paring
+ (funcall paring arg)
+ (file-truename arg))
+ pcomplete-seen))))))
+ (pcomplete-next-arg)
+ t)
+ (when pcomplete-show-help
+ (pcomplete--help)
+ (throw 'pcompleted t))
+ (if stub
+ (setq pcomplete-stub stub))
+ (if (or (eq paring t) (eq paring 0))
+ (setq pcomplete-seen nil)
+ (setq pcomplete-norm-func (or paring 'file-truename)))
+ (unless form-only
+ (run-hooks 'pcomplete-try-first-hook))
+ (throw 'pcomplete-completions (eval form))))
+
+(defmacro pcomplete-here (&optional form stub paring form-only)
+ "Complete aganst the current argument, if at the end.
+If completion is to be done here, evaluate FORM to generate the list
+of strings which will be used for completion purposes. If STUB is a
+string, use it as the completion stub instead of the default (which is
+the entire text of the current argument).
+
+For an example of when you might want to use STUB: if the current
+argument text is 'long-path-name/', you don't want the completions
+list display to be cluttered by 'long-path-name/' appearing at the
+beginning of every alternative. Not only does this make things less
+intelligle, but it is also inefficient. Yet, if the completion list
+does not begin with this string for every entry, the current argument
+won't complete correctly.
+
+The solution is to specify a relative stub. It allows you to
+substitute a different argument from the current argument, almost
+always for the sake of efficiency.
+
+If PARING is nil, this argument will be pared against previous
+arguments using the function `file-truename' to normalize them.
+PARING may be a function, in which case that function is for
+normalization. If PARING is the value t, the argument dealt with by
+this call will not participate in argument paring. If it the integer
+0, all previous arguments that have been seen will be cleared.
+
+If FORM-ONLY is non-nil, only the result of FORM will be used to
+generate the completions list. This means that the hook
+`pcomplete-try-first-hook' will not be run."
+ `(pcomplete--here (quote ,form) ,stub ,paring ,form-only))
+
+(defmacro pcomplete-here* (&optional form stub form-only)
+ "An alternate form which does not participate in argument paring."
+ `(pcomplete-here ,form ,stub t ,form-only))
+
+;; display support
+
+(defun pcomplete-restore-windows ()
+ "If the only window change was due to Completions, restore things."
+ (if pcomplete-last-window-config
+ (let* ((cbuf (get-buffer "*Completions*"))
+ (cwin (and cbuf (get-buffer-window cbuf))))
+ (when (and cwin (window-live-p cwin))
+ (bury-buffer cbuf)
+ (set-window-configuration pcomplete-last-window-config))))
+ (setq pcomplete-last-window-config nil
+ pcomplete-window-restore-timer nil))
+
+;; Abstractions so that the code below will work for both Emacs 20 and
+;; XEmacs 21
+
+(unless (fboundp 'event-matches-key-specifier-p)
+ (defalias 'event-matches-key-specifier-p 'eq))
+
+(unless (fboundp 'read-event)
+ (defsubst read-event (&optional prompt)
+ (aref (read-key-sequence prompt) 0)))
+
+(unless (fboundp 'event-basic-type)
+ (defalias 'event-basic-type 'event-key))
+
+(defun pcomplete-show-completions (completions)
+ "List in help buffer sorted COMPLETIONS.
+Typing SPC flushes the help buffer."
+ (let* ((curbuf (current-buffer)))
+ (when pcomplete-window-restore-timer
+ (cancel-timer pcomplete-window-restore-timer)
+ (setq pcomplete-window-restore-timer nil))
+ (unless pcomplete-last-window-config
+ (setq pcomplete-last-window-config (current-window-configuration)))
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list completions))
+ (message "Hit space to flush")
+ (let (event)
+ (prog1
+ (catch 'done
+ (while (with-current-buffer (get-buffer "*Completions*")
+ (setq event (read-event)))
+ (cond
+ ((event-matches-key-specifier-p event ? )
+ (set-window-configuration pcomplete-last-window-config)
+ (setq pcomplete-last-window-config nil)
+ (throw 'done nil))
+ ((event-matches-key-specifier-p event 'tab)
+ (save-selected-window
+ (select-window (get-buffer-window "*Completions*"))
+ (if (pos-visible-in-window-p (point-max))
+ (goto-char (point-min))
+ (scroll-up)))
+ (message ""))
+ (t
+ (setq unread-command-events (list event))
+ (throw 'done nil)))))
+ (if (and pcomplete-last-window-config
+ pcomplete-restore-window-delay)
+ (setq pcomplete-window-restore-timer
+ (run-with-timer pcomplete-restore-window-delay nil
+ 'pcomplete-restore-windows)))))))
+
+;; insert completion at point
+
+(defun pcomplete-insert-entry (stub entry &optional addsuffix raw-p)
+ "Insert a completion entry at point.
+Returns non-nil if a space was appended at the end."
+ (let ((here (point)))
+ (if (not pcomplete-ignore-case)
+ (insert-and-inherit (if raw-p
+ (substring entry (length stub))
+ (pcomplete-quote-argument
+ (substring entry (length stub)))))
+ ;; the stub is not quoted at this time, so to determine the
+ ;; length of what should be in the buffer, we must quote it
+ (delete-backward-char (length (pcomplete-quote-argument stub)))
+ ;; if there is already a backslash present to handle the first
+ ;; character, don't bother quoting it
+ (when (eq (char-before) ?\\)
+ (insert-and-inherit (substring entry 0 1))
+ (setq entry (substring entry 1)))
+ (insert-and-inherit (if raw-p
+ entry
+ (pcomplete-quote-argument entry))))
+ (let (space-added)
+ (when (and (not (memq (char-before) pcomplete-suffix-list))
+ addsuffix)
+ (insert-and-inherit " ")
+ (setq space-added t))
+ (setq pcomplete-last-completion-length (- (point) here)
+ pcomplete-last-completion-stub stub)
+ space-added)))
+
+;; selection of completions
+
+(defun pcomplete-do-complete (stub completions)
+ "Dynamically complete at point using STUB and COMPLETIONS.
+This is basically just a wrapper for `pcomplete-stub' which does some
+extra checking, and munging of the COMPLETIONS list."
+ (unless (stringp stub)
+ (message "Cannot complete argument")
+ (throw 'pcompleted nil))
+ (if (null completions)
+ (ignore
+ (if (and stub (> (length stub) 0))
+ (message "No completions of %s" stub)
+ (message "No completions")))
+ ;; pare it down, if applicable
+ (if pcomplete-seen
+ (let* ((arg (pcomplete-arg))
+ (prefix
+ (file-name-as-directory
+ (funcall pcomplete-norm-func
+ (substring arg 0 (- (length arg)
+ (length pcomplete-stub)))))))
+ (setq pcomplete-seen
+ (mapcar 'directory-file-name pcomplete-seen))
+ (let ((p pcomplete-seen))
+ (while p
+ (add-to-list 'pcomplete-seen
+ (funcall pcomplete-norm-func (car p)))
+ (setq p (cdr p))))
+ (setq completions
+ (mapcar
+ (function
+ (lambda (elem)
+ (file-relative-name elem prefix)))
+ (pcomplete-pare-list
+ (mapcar
+ (function
+ (lambda (elem)
+ (expand-file-name elem prefix)))
+ completions)
+ pcomplete-seen
+ (function
+ (lambda (elem)
+ (member (directory-file-name
+ (funcall pcomplete-norm-func elem))
+ pcomplete-seen))))))))
+ ;; OK, we've got a list of completions.
+ (if pcomplete-show-list
+ (pcomplete-show-completions completions)
+ (pcomplete-stub stub completions))))
+
+(defun pcomplete-stub (stub candidates &optional cycle-p)
+ "Dynamically complete STUB from CANDIDATES list.
+This function inserts completion characters at point by completing
+STUB from the strings in CANDIDATES. A completions listing may be
+shown in a help buffer if completion is ambiguous.
+
+Returns nil if no completion was inserted.
+Returns `sole' if completed with the only completion match.
+Returns `shortest' if completed with the shortest of the matches.
+Returns `partial' if completed as far as possible with the matches.
+Returns `listed' if a completion listing was shown.
+
+See also `pcomplete-filename'."
+ (let* ((completion-ignore-case pcomplete-ignore-case)
+ (candidates (mapcar 'list candidates))
+ (completions (all-completions stub candidates)))
+ (let (result entry)
+ (cond
+ ((null completions)
+ (if (and stub (> (length stub) 0))
+ (message "No completions of %s" stub)
+ (message "No completions")))
+ ((= 1 (length completions))
+ (setq entry (car completions))
+ (if (string-equal entry stub)
+ (message "Sole completion"))
+ (setq result 'sole))
+ ((and pcomplete-cycle-completions
+ (or cycle-p
+ (not pcomplete-cycle-cutoff-length)
+ (<= (length completions)
+ pcomplete-cycle-cutoff-length)))
+ (setq entry (car completions)
+ pcomplete-current-completions completions))
+ (t ; There's no unique completion; use longest substring
+ (setq entry (try-completion stub candidates))
+ (cond ((and pcomplete-recexact
+ (string-equal stub entry)
+ (member entry completions))
+ ;; It's not unique, but user wants shortest match.
+ (message "Completed shortest")
+ (setq result 'shortest))
+ ((or pcomplete-autolist
+ (string-equal stub entry))
+ ;; It's not unique, list possible completions.
+ (pcomplete-show-completions completions)
+ (setq result 'listed))
+ (t
+ (message "Partially completed")
+ (setq result 'partial)))))
+ (cons result entry))))
+
+;; context sensitive help
+
+(defun pcomplete--help ()
+ "Produce context-sensitive help for the current argument.
+If specific documentation can't be given, be generic.
+INFODOC specifies the Info node to goto. DOCUMENTATION is a sexp
+which will produce documentation for the argument (it is responsible
+for displaying in its own buffer)."
+ (if (and pcomplete-help
+ (or (and (stringp pcomplete-help)
+ (fboundp 'Info-goto-node))
+ (listp pcomplete-help)))
+ (if (listp pcomplete-help)
+ (message (eval pcomplete-help))
+ (save-window-excursion (info))
+ (switch-to-buffer-other-window "*info*")
+ (funcall (symbol-function 'Info-goto-node) pcomplete-help))
+ (if pcomplete-man-function
+ (let ((cmd (funcall pcomplete-command-name-function)))
+ (if (and cmd (> (length cmd) 0))
+ (funcall pcomplete-man-function cmd)))
+ (message "No context-sensitive help available"))))
+
+;; general utilities
+
+(defsubst pcomplete-time-less-p (t1 t2)
+ "Say whether time T1 is less than time T2."
+ (or (< (car t1) (car t2))
+ (and (= (car t1) (car t2))
+ (< (nth 1 t1) (nth 1 t2)))))
+
+(defun pcomplete-pare-list (l r &optional pred)
+ "Destructively remove from list L all elements matching any in list R.
+Test is done using `equal'.
+If PRED is non-nil, it is a function used for further removal.
+Returns the resultant list."
+ (while (and l (or (and r (member (car l) r))
+ (and pred
+ (funcall pred (car l)))))
+ (setq l (cdr l)))
+ (let ((m l))
+ (while m
+ (while (and (cdr m)
+ (or (and r (member (cadr m) r))
+ (and pred
+ (funcall pred (cadr m)))))
+ (setcdr m (cddr m)))
+ (setq m (cdr m))))
+ l)
+
+(defun pcomplete-uniqify-list (l)
+ "Sort and remove multiples in L."
+ (setq l (sort l 'string-lessp))
+ (let ((m l))
+ (while m
+ (while (and (cdr m)
+ (string= (car m)
+ (cadr m)))
+ (setcdr m (cddr m)))
+ (setq m (cdr m))))
+ l)
+
+(defun pcomplete-process-result (cmd &rest args)
+ "Call CMD using `call-process' and return the simplest result."
+ (with-temp-buffer
+ (apply 'call-process cmd nil t nil args)
+ (skip-chars-backward "\n")
+ (buffer-substring (point-min) (point))))
+
+;; create a set of aliases which allow completion functions to be not
+;; quite so verbose
+
+;; jww (1999-10-20): are these a good idea?
+; (defalias 'pc-here 'pcomplete-here)
+; (defalias 'pc-test 'pcomplete-test)
+; (defalias 'pc-opt 'pcomplete-opt)
+; (defalias 'pc-match 'pcomplete-match)
+; (defalias 'pc-match-string 'pcomplete-match-string)
+; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
+; (defalias 'pc-match-end 'pcomplete-match-end)
+
+;;; pcomplete.el ends here