LCOV - code coverage report
Current view: top level - lisp - pcomplete.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 1 553 0.2 %
Date: 2017-08-27 09:44:50 Functions: 1 60 1.7 %

          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

Generated by: LCOV version 1.12