| 1 | ;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*- |
| 2 | |
| 3 | ;; Copyright (C) 1999-2013 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 | (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 | (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 | (let ((case-fold-search nil)) |
| 373 | (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 | (concat s1 "\x3FFF7F" s2)) |
| 378 | (- (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 | (catch 'pcompleted |
| 389 | (let* ((pcomplete-stub) |
| 390 | pcomplete-seen pcomplete-norm-func |
| 391 | pcomplete-args pcomplete-last pcomplete-index |
| 392 | (pcomplete-autolist pcomplete-autolist) |
| 393 | (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 | (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 | (beg (max (- (point) (length pcomplete-stub)) |
| 415 | (pcomplete-begin))) |
| 416 | (buftext (pcomplete-unquote-argument |
| 417 | (buffer-substring beg (point))))) |
| 418 | (when completions |
| 419 | (let ((table |
| 420 | (completion-table-with-quoting |
| 421 | (if (equal pcomplete-stub buftext) |
| 422 | 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 | (let ((suf-len (pcomplete--common-suffix |
| 427 | pcomplete-stub buftext))) |
| 428 | (completion-table-subvert |
| 429 | completions |
| 430 | (substring buftext 0 (- (length buftext) suf-len)) |
| 431 | (substring pcomplete-stub 0 |
| 432 | (- (length pcomplete-stub) suf-len))))) |
| 433 | pcomplete-unquote-argument-function |
| 434 | pcomplete-requote-argument-function)) |
| 435 | (pred |
| 436 | ;; Pare it down, if applicable. |
| 437 | (when (and pcomplete-use-paring pcomplete-seen) |
| 438 | ;; Capture the dynbound values for later use. |
| 439 | (let ((norm-func pcomplete-norm-func) |
| 440 | (seen |
| 441 | (mapcar (lambda (f) |
| 442 | (funcall pcomplete-norm-func |
| 443 | (directory-file-name f))) |
| 444 | pcomplete-seen))) |
| 445 | (lambda (f) |
| 446 | (not (member |
| 447 | (funcall norm-func (directory-file-name f)) |
| 448 | seen))))))) |
| 449 | (when pcomplete-ignore-case |
| 450 | (setq table (completion-table-case-fold table))) |
| 451 | (list beg (point) table |
| 452 | :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 | (unless (zerop (length pcomplete-termination-string)) |
| 458 | (lambda (_s status) |
| 459 | (when (eq status 'finished) |
| 460 | (if (looking-at |
| 461 | (regexp-quote pcomplete-termination-string)) |
| 462 | (goto-char (match-end 0)) |
| 463 | (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 | (let ((data (pcomplete-completions-at-point))) |
| 470 | (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) |
| 471 | (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 | (if (and interactively |
| 482 | pcomplete-cycle-completions |
| 483 | pcomplete-current-completions |
| 484 | (memq last-command '(pcomplete |
| 485 | pcomplete-expand-and-complete |
| 486 | pcomplete-reverse))) |
| 487 | (progn |
| 488 | (delete-char (- pcomplete-last-completion-length)) |
| 489 | (if (eq this-command 'pcomplete-reverse) |
| 490 | (progn |
| 491 | (push (car (last pcomplete-current-completions)) |
| 492 | pcomplete-current-completions) |
| 493 | (setcdr (last pcomplete-current-completions 2) nil)) |
| 494 | (nconc pcomplete-current-completions |
| 495 | (list (car pcomplete-current-completions))) |
| 496 | (setq pcomplete-current-completions |
| 497 | (cdr pcomplete-current-completions))) |
| 498 | (pcomplete-insert-entry pcomplete-last-completion-stub |
| 499 | (car pcomplete-current-completions) |
| 500 | nil pcomplete-last-completion-raw)) |
| 501 | (setq pcomplete-current-completions nil |
| 502 | pcomplete-last-completion-raw nil) |
| 503 | (catch 'pcompleted |
| 504 | (let* ((pcomplete-stub) |
| 505 | pcomplete-seen pcomplete-norm-func |
| 506 | pcomplete-args pcomplete-last pcomplete-index |
| 507 | (pcomplete-autolist pcomplete-autolist) |
| 508 | (pcomplete-suffix-list pcomplete-suffix-list) |
| 509 | (completions (pcomplete-completions)) |
| 510 | (result (pcomplete-do-complete pcomplete-stub completions))) |
| 511 | (and result |
| 512 | (not (eq (car result) 'listed)) |
| 513 | (cdr result) |
| 514 | (pcomplete-insert-entry pcomplete-stub (cdr result) |
| 515 | (memq (car result) |
| 516 | '(sole shortest)) |
| 517 | pcomplete-last-completion-raw)))))) |
| 518 | |
| 519 | ;;;###autoload |
| 520 | (defun pcomplete-reverse () |
| 521 | "If cycling completion is in use, cycle backwards." |
| 522 | (interactive) |
| 523 | (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 | (let ((pcomplete-expand-before-complete t)) |
| 531 | (pcomplete))) |
| 532 | |
| 533 | ;;;###autoload |
| 534 | (defun pcomplete-continue () |
| 535 | "Complete without reference to any cycling completions." |
| 536 | (interactive) |
| 537 | (setq pcomplete-current-completions nil |
| 538 | pcomplete-last-completion-raw nil) |
| 539 | (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 | (let ((pcomplete-expand-before-complete t) |
| 547 | (pcomplete-expand-only-p t)) |
| 548 | (pcomplete) |
| 549 | (when (and pcomplete-current-completions |
| 550 | (> (length pcomplete-current-completions) 0)) ;?? |
| 551 | (delete-char (- pcomplete-last-completion-length)) |
| 552 | (while pcomplete-current-completions |
| 553 | (unless (pcomplete-insert-entry |
| 554 | "" (car pcomplete-current-completions) t |
| 555 | pcomplete-last-completion-raw) |
| 556 | (insert-and-inherit pcomplete-termination-string)) |
| 557 | (setq pcomplete-current-completions |
| 558 | (cdr pcomplete-current-completions)))))) |
| 559 | |
| 560 | ;;;###autoload |
| 561 | (defun pcomplete-help () |
| 562 | "Display any help information relative to the current argument." |
| 563 | (interactive) |
| 564 | (let ((pcomplete-show-help t)) |
| 565 | (pcomplete))) |
| 566 | |
| 567 | ;;;###autoload |
| 568 | (defun pcomplete-list () |
| 569 | "Show the list of possible completions for the current argument." |
| 570 | (interactive) |
| 571 | (when (and pcomplete-cycle-completions |
| 572 | pcomplete-current-completions |
| 573 | (eq last-command 'pcomplete-argument)) |
| 574 | (delete-char (- pcomplete-last-completion-length)) |
| 575 | (setq pcomplete-current-completions nil |
| 576 | pcomplete-last-completion-raw nil)) |
| 577 | (let ((pcomplete-show-list t)) |
| 578 | (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 | (setq index |
| 598 | (if (eq index 'first) |
| 599 | 0 |
| 600 | (if (eq index 'last) |
| 601 | pcomplete-last |
| 602 | (- pcomplete-index (or index 0))))) |
| 603 | (if offset |
| 604 | (setq index (+ index offset))) |
| 605 | (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 | (setq index |
| 611 | (if (eq index 'first) |
| 612 | 0 |
| 613 | (if (eq index 'last) |
| 614 | pcomplete-last |
| 615 | (- pcomplete-index (or index 0))))) |
| 616 | (if offset |
| 617 | (setq index (+ index offset))) |
| 618 | (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 | (buffer-substring (pcomplete-begin index offset) (point))) |
| 626 | |
| 627 | (defsubst pcomplete-next-arg () |
| 628 | "Move the various pointers to the next argument." |
| 629 | (setq pcomplete-index (1+ pcomplete-index) |
| 630 | pcomplete-stub (pcomplete-arg)) |
| 631 | (if (> pcomplete-index pcomplete-last) |
| 632 | (progn |
| 633 | (message "No completions") |
| 634 | (throw 'pcompleted nil)))) |
| 635 | |
| 636 | (defun pcomplete-command-name () |
| 637 | "Return the command name of the first argument." |
| 638 | (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 | (let ((arg (pcomplete-arg (or index 1) offset))) |
| 643 | (if arg |
| 644 | (string-match regexp arg start) |
| 645 | (throw 'pcompleted nil)))) |
| 646 | |
| 647 | (defun pcomplete-match-string (which &optional index offset) |
| 648 | "Like `match-string', but on the current completion argument." |
| 649 | (let ((arg (pcomplete-arg (or index 1) offset))) |
| 650 | (if arg |
| 651 | (match-string which arg) |
| 652 | (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 | (and pred |
| 660 | (cond ((eq pred t) t) |
| 661 | ((functionp pred) |
| 662 | (funcall pred arg)) |
| 663 | ((stringp pred) |
| 664 | (string-match (concat "^" pred "$") arg))) |
| 665 | pred)) |
| 666 | |
| 667 | (defun pcomplete-test (predicates &optional index offset) |
| 668 | "Predicates to test the current programmable argument with." |
| 669 | (let ((arg (pcomplete-arg (or index 1) offset))) |
| 670 | (unless (null predicates) |
| 671 | (if (not (listp predicates)) |
| 672 | (pcomplete--test predicates arg) |
| 673 | (let ((pred predicates) |
| 674 | found) |
| 675 | (while (and pred (not found)) |
| 676 | (setq found (pcomplete--test (car pred) arg) |
| 677 | pred (cdr pred))) |
| 678 | found))))) |
| 679 | |
| 680 | (defun pcomplete-parse-buffer-arguments () |
| 681 | "Parse whitespace separated arguments in the current region." |
| 682 | (let ((begin (point-min)) |
| 683 | (end (point-max)) |
| 684 | begins args) |
| 685 | (save-excursion |
| 686 | (goto-char begin) |
| 687 | (while (< (point) end) |
| 688 | (skip-chars-forward " \t\n") |
| 689 | (push (point) begins) |
| 690 | (skip-chars-forward "^ \t\n") |
| 691 | (push (buffer-substring-no-properties |
| 692 | (car begins) (point)) |
| 693 | args)) |
| 694 | (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 | (set (make-local-variable 'pcomplete-parse-arguments-function) |
| 703 | 'pcomplete-parse-comint-arguments) |
| 704 | (add-hook 'completion-at-point-functions |
| 705 | 'pcomplete-completions-at-point nil 'local) |
| 706 | (set (make-local-variable completef-sym) |
| 707 | (copy-sequence (symbol-value completef-sym))) |
| 708 | (let* ((funs (symbol-value completef-sym)) |
| 709 | (elem (or (memq 'comint-filename-completion funs) |
| 710 | (memq 'shell-filename-completion funs) |
| 711 | (memq 'shell-dynamic-complete-filename funs) |
| 712 | (memq 'comint-dynamic-complete-filename funs)))) |
| 713 | (if elem |
| 714 | (setcar elem 'pcomplete) |
| 715 | (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 | (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 | (let ((begin (save-excursion (comint-bol nil) (point))) |
| 729 | (end (point)) |
| 730 | begins args) |
| 731 | (save-excursion |
| 732 | (goto-char begin) |
| 733 | (while (< (point) end) |
| 734 | (skip-chars-forward " \t\n") |
| 735 | (push (point) begins) |
| 736 | (while |
| 737 | (progn |
| 738 | (skip-chars-forward "^ \t\n\\") |
| 739 | (when (eq (char-after) ?\\) |
| 740 | (forward-char 1) |
| 741 | (unless (eolp) |
| 742 | (forward-char 1) |
| 743 | t)))) |
| 744 | (push (buffer-substring-no-properties (car begins) (point)) |
| 745 | args)) |
| 746 | (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 | (let ((results (funcall pcomplete-parse-arguments-function))) |
| 751 | (when results |
| 752 | (setq pcomplete-args (or (car results) (list "")) |
| 753 | pcomplete-begins (or (cdr results) (list (point))) |
| 754 | pcomplete-last (1- (length pcomplete-args)) |
| 755 | pcomplete-index 0 |
| 756 | pcomplete-stub (pcomplete-arg 'last)) |
| 757 | (let ((begin (pcomplete-begin 'last))) |
| 758 | (if (and pcomplete-cycle-completions |
| 759 | (listp pcomplete-stub) ;?? |
| 760 | (not pcomplete-expand-only-p)) |
| 761 | (let* ((completions pcomplete-stub) ;?? |
| 762 | (common-stub (car completions)) |
| 763 | (c completions) |
| 764 | (len (length common-stub))) |
| 765 | (while (and c (> len 0)) |
| 766 | (while (and (> len 0) |
| 767 | (not (string= |
| 768 | (substring common-stub 0 len) |
| 769 | (substring (car c) 0 |
| 770 | (min (length (car c)) |
| 771 | len))))) |
| 772 | (setq len (1- len))) |
| 773 | (setq c (cdr c))) |
| 774 | (setq pcomplete-stub (substring common-stub 0 len) |
| 775 | pcomplete-autolist t) |
| 776 | (when (and begin (not pcomplete-show-list)) |
| 777 | (delete-region begin (point)) |
| 778 | (pcomplete-insert-entry "" pcomplete-stub)) |
| 779 | (throw 'pcomplete-completions completions)) |
| 780 | (when expand-p |
| 781 | (if (stringp pcomplete-stub) |
| 782 | (when begin |
| 783 | (delete-region begin (point)) |
| 784 | (insert-and-inherit pcomplete-stub)) |
| 785 | (if (and (listp pcomplete-stub) |
| 786 | pcomplete-expand-only-p) |
| 787 | ;; this is for the benefit of `pcomplete-expand' |
| 788 | (setq pcomplete-last-completion-length (- (point) begin) |
| 789 | pcomplete-current-completions pcomplete-stub) |
| 790 | (error "Cannot expand argument")))) |
| 791 | (if pcomplete-expand-only-p |
| 792 | (throw 'pcompleted t) |
| 793 | pcomplete-args)))))) |
| 794 | |
| 795 | (define-obsolete-function-alias |
| 796 | 'pcomplete-quote-argument #'comint-quote-filename "24.3") |
| 797 | |
| 798 | ;; file-system completion lists |
| 799 | |
| 800 | (defsubst pcomplete-dirs-or-entries (&optional regexp predicate) |
| 801 | "Return either directories, or qualified entries." |
| 802 | (pcomplete-entries |
| 803 | nil |
| 804 | (lambda (f) |
| 805 | (or (file-directory-p f) |
| 806 | (and (or (null regexp) (string-match regexp f)) |
| 807 | (or (null predicate) (funcall predicate f))))))) |
| 808 | |
| 809 | (defun pcomplete--entries (&optional regexp predicate) |
| 810 | "Like `pcomplete-entries' but without env-var handling." |
| 811 | (let* ((ign-pred |
| 812 | (when (or pcomplete-file-ignore pcomplete-dir-ignore) |
| 813 | ;; Capture the dynbound value for later use. |
| 814 | (let ((file-ignore pcomplete-file-ignore) |
| 815 | (dir-ignore pcomplete-dir-ignore)) |
| 816 | (lambda (file) |
| 817 | (not |
| 818 | (if (eq (aref file (1- (length file))) ?/) |
| 819 | (and dir-ignore (string-match dir-ignore file)) |
| 820 | (and file-ignore (string-match file-ignore file)))))))) |
| 821 | (reg-pred (if regexp (lambda (file) (string-match regexp file)))) |
| 822 | (pred (cond |
| 823 | ((null (or ign-pred reg-pred)) predicate) |
| 824 | ((null (or ign-pred predicate)) reg-pred) |
| 825 | ((null (or reg-pred predicate)) ign-pred) |
| 826 | (t (lambda (f) |
| 827 | (and (or (null reg-pred) (funcall reg-pred f)) |
| 828 | (or (null ign-pred) (funcall ign-pred f)) |
| 829 | (or (null predicate) (funcall predicate f)))))))) |
| 830 | (lambda (s p a) |
| 831 | (if (and (eq a 'metadata) pcomplete-compare-entry-function) |
| 832 | `(metadata (cycle-sort-function |
| 833 | . ,(lambda (comps) |
| 834 | (sort comps pcomplete-compare-entry-function))) |
| 835 | ,@(cdr (completion-file-name-table s p a))) |
| 836 | (let ((completion-ignored-extensions nil) |
| 837 | (completion-ignore-case pcomplete-ignore-case)) |
| 838 | (completion-table-with-predicate |
| 839 | #'comint-completion-file-name-table pred 'strict s p a)))))) |
| 840 | |
| 841 | (defconst pcomplete--env-regexp |
| 842 | "\\(?:\\`\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(\\$\\(?:{\\([^}]+\\)}\\|\\(?2:[[:alnum:]_]+\\)\\)\\)") |
| 843 | |
| 844 | (defun pcomplete-entries (&optional regexp predicate) |
| 845 | "Complete against a list of directory candidates. |
| 846 | If REGEXP is non-nil, it is a regular expression used to refine the |
| 847 | match (files not matching the REGEXP will be excluded). |
| 848 | If PREDICATE is non-nil, it will also be used to refine the match |
| 849 | \(files for which the PREDICATE returns nil will be excluded). |
| 850 | If no directory information can be extracted from the completed |
| 851 | component, `default-directory' is used as the basis for completion." |
| 852 | ;; FIXME: The old code did env-var expansion here, so we reproduce this |
| 853 | ;; behavior for now, but really env-var handling should be performed globally |
| 854 | ;; rather than here since it also applies to non-file arguments. |
| 855 | (let ((table (pcomplete--entries regexp predicate))) |
| 856 | (lambda (string pred action) |
| 857 | (let ((strings nil) |
| 858 | (orig-length (length string))) |
| 859 | ;; Perform env-var expansion. |
| 860 | (while (string-match pcomplete--env-regexp string) |
| 861 | (push (substring string 0 (match-beginning 1)) strings) |
| 862 | (push (getenv (match-string 2 string)) strings) |
| 863 | (setq string (substring string (match-end 1)))) |
| 864 | (if (not (and strings |
| 865 | (or (eq action t) |
| 866 | (eq (car-safe action) 'boundaries)))) |
| 867 | (let ((newstring |
| 868 | (mapconcat 'identity (nreverse (cons string strings)) ""))) |
| 869 | ;; FIXME: We could also try to return unexpanded envvars. |
| 870 | (complete-with-action action table newstring pred)) |
| 871 | (let* ((envpos (apply #'+ (mapcar #' length strings))) |
| 872 | (newstring |
| 873 | (mapconcat 'identity (nreverse (cons string strings)) "")) |
| 874 | (bounds (completion-boundaries newstring table pred |
| 875 | (or (cdr-safe action) "")))) |
| 876 | (if (>= (car bounds) envpos) |
| 877 | ;; The env-var is "out of bounds". |
| 878 | (if (eq action t) |
| 879 | (complete-with-action action table newstring pred) |
| 880 | `(boundaries |
| 881 | ,(+ (car bounds) (- orig-length (length newstring))) |
| 882 | . ,(cdr bounds))) |
| 883 | ;; The env-var is in the file bounds. |
| 884 | (if (eq action t) |
| 885 | (let ((comps (complete-with-action |
| 886 | action table newstring pred)) |
| 887 | (len (- envpos (car bounds)))) |
| 888 | ;; Strip the part of each completion that's actually |
| 889 | ;; coming from the env-var. |
| 890 | (mapcar (lambda (s) (substring s len)) comps)) |
| 891 | `(boundaries |
| 892 | ,(+ envpos (- orig-length (length newstring))) |
| 893 | . ,(cdr bounds)))))))))) |
| 894 | |
| 895 | (defsubst pcomplete-all-entries (&optional regexp predicate) |
| 896 | "Like `pcomplete-entries', but doesn't ignore any entries." |
| 897 | (let (pcomplete-file-ignore |
| 898 | pcomplete-dir-ignore) |
| 899 | (pcomplete-entries regexp predicate))) |
| 900 | |
| 901 | (defsubst pcomplete-dirs (&optional regexp) |
| 902 | "Complete amongst a list of directories." |
| 903 | (pcomplete-entries regexp 'file-directory-p)) |
| 904 | |
| 905 | ;; generation of completion lists |
| 906 | |
| 907 | (defun pcomplete-find-completion-function (command) |
| 908 | "Find the completion function to call for the given COMMAND." |
| 909 | (let ((sym (intern-soft |
| 910 | (concat "pcomplete/" (symbol-name major-mode) "/" command)))) |
| 911 | (unless sym |
| 912 | (setq sym (intern-soft (concat "pcomplete/" command)))) |
| 913 | (and sym (fboundp sym) sym))) |
| 914 | |
| 915 | (defun pcomplete-completions () |
| 916 | "Return a list of completions for the current argument position." |
| 917 | (catch 'pcomplete-completions |
| 918 | (when (pcomplete-parse-arguments pcomplete-expand-before-complete) |
| 919 | (if (= pcomplete-index pcomplete-last) |
| 920 | (funcall pcomplete-command-completion-function) |
| 921 | (let ((sym (or (pcomplete-find-completion-function |
| 922 | (funcall pcomplete-command-name-function)) |
| 923 | pcomplete-default-completion-function))) |
| 924 | (ignore |
| 925 | (pcomplete-next-arg) |
| 926 | (funcall sym))))))) |
| 927 | |
| 928 | (defun pcomplete-opt (options &optional prefix _no-ganging _args-follow) |
| 929 | "Complete a set of OPTIONS, each beginning with PREFIX (?- by default). |
| 930 | PREFIX may be t, in which case no PREFIX character is necessary. |
| 931 | If NO-GANGING is non-nil, each option is separate (-xy is not allowed). |
| 932 | If ARGS-FOLLOW is non-nil, then options which take arguments may have |
| 933 | the argument appear after a ganged set of options. This is how tar |
| 934 | behaves, for example. |
| 935 | Arguments NO-GANGING and ARGS-FOLLOW are currently ignored." |
| 936 | (if (and (= pcomplete-index pcomplete-last) |
| 937 | (string= (pcomplete-arg) "-")) |
| 938 | (let ((len (length options)) |
| 939 | (index 0) |
| 940 | char choices) |
| 941 | (while (< index len) |
| 942 | (setq char (aref options index)) |
| 943 | (if (eq char ?\() |
| 944 | (let ((result (read-from-string options index))) |
| 945 | (setq index (cdr result))) |
| 946 | (unless (memq char '(?/ ?* ?? ?.)) |
| 947 | (push (char-to-string char) choices)) |
| 948 | (setq index (1+ index)))) |
| 949 | (throw 'pcomplete-completions |
| 950 | (mapcar |
| 951 | (function |
| 952 | (lambda (opt) |
| 953 | (concat "-" opt))) |
| 954 | (pcomplete-uniqify-list choices)))) |
| 955 | (let ((arg (pcomplete-arg))) |
| 956 | (when (and (> (length arg) 1) |
| 957 | (stringp arg) |
| 958 | (eq (aref arg 0) (or prefix ?-))) |
| 959 | (pcomplete-next-arg) |
| 960 | (let ((char (aref arg 1)) |
| 961 | (len (length options)) |
| 962 | (index 0) |
| 963 | opt-char arg-char result) |
| 964 | (while (< (1+ index) len) |
| 965 | (setq opt-char (aref options index) |
| 966 | arg-char (aref options (1+ index))) |
| 967 | (if (eq arg-char ?\() |
| 968 | (setq result |
| 969 | (read-from-string options (1+ index)) |
| 970 | index (cdr result) |
| 971 | result (car result)) |
| 972 | (setq result nil)) |
| 973 | (when (and (eq char opt-char) |
| 974 | (memq arg-char '(?\( ?/ ?* ?? ?.))) |
| 975 | (if (< pcomplete-index pcomplete-last) |
| 976 | (pcomplete-next-arg) |
| 977 | (throw 'pcomplete-completions |
| 978 | (cond ((eq arg-char ?/) (pcomplete-dirs)) |
| 979 | ((eq arg-char ?*) (pcomplete-executables)) |
| 980 | ((eq arg-char ??) nil) |
| 981 | ((eq arg-char ?.) (pcomplete-entries)) |
| 982 | ((eq arg-char ?\() (eval result)))))) |
| 983 | (setq index (1+ index)))))))) |
| 984 | |
| 985 | (defun pcomplete--here (&optional form stub paring form-only) |
| 986 | "Complete against the current argument, if at the end. |
| 987 | See the documentation for `pcomplete-here'." |
| 988 | (if (< pcomplete-index pcomplete-last) |
| 989 | (progn |
| 990 | (if (eq paring 0) |
| 991 | (setq pcomplete-seen nil) |
| 992 | (unless (eq paring t) |
| 993 | (let ((arg (pcomplete-arg))) |
| 994 | (when (stringp arg) |
| 995 | (push (if paring |
| 996 | (funcall paring arg) |
| 997 | (file-truename arg)) |
| 998 | pcomplete-seen))))) |
| 999 | (pcomplete-next-arg) |
| 1000 | t) |
| 1001 | (when pcomplete-show-help |
| 1002 | (pcomplete--help) |
| 1003 | (throw 'pcompleted t)) |
| 1004 | (if stub |
| 1005 | (setq pcomplete-stub stub)) |
| 1006 | (if (or (eq paring t) (eq paring 0)) |
| 1007 | (setq pcomplete-seen nil) |
| 1008 | (setq pcomplete-norm-func (or paring 'file-truename))) |
| 1009 | (unless form-only |
| 1010 | (run-hooks 'pcomplete-try-first-hook)) |
| 1011 | (throw 'pcomplete-completions |
| 1012 | (if (functionp form) |
| 1013 | (funcall form) |
| 1014 | ;; Old calling convention, might still be used by files |
| 1015 | ;; byte-compiled with the older code. |
| 1016 | (eval form))))) |
| 1017 | |
| 1018 | (defmacro pcomplete-here (&optional form stub paring form-only) |
| 1019 | "Complete against the current argument, if at the end. |
| 1020 | If completion is to be done here, evaluate FORM to generate the completion |
| 1021 | table which will be used for completion purposes. If STUB is a |
| 1022 | string, use it as the completion stub instead of the default (which is |
| 1023 | the entire text of the current argument). |
| 1024 | |
| 1025 | For an example of when you might want to use STUB: if the current |
| 1026 | argument text is 'long-path-name/', you don't want the completions |
| 1027 | list display to be cluttered by 'long-path-name/' appearing at the |
| 1028 | beginning of every alternative. Not only does this make things less |
| 1029 | intelligible, but it is also inefficient. Yet, if the completion list |
| 1030 | does not begin with this string for every entry, the current argument |
| 1031 | won't complete correctly. |
| 1032 | |
| 1033 | The solution is to specify a relative stub. It allows you to |
| 1034 | substitute a different argument from the current argument, almost |
| 1035 | always for the sake of efficiency. |
| 1036 | |
| 1037 | If PARING is nil, this argument will be pared against previous |
| 1038 | arguments using the function `file-truename' to normalize them. |
| 1039 | PARING may be a function, in which case that function is used for |
| 1040 | normalization. If PARING is t, the argument dealt with by this |
| 1041 | call will not participate in argument paring. If it is the |
| 1042 | integer 0, all previous arguments that have been seen will be |
| 1043 | cleared. |
| 1044 | |
| 1045 | If FORM-ONLY is non-nil, only the result of FORM will be used to |
| 1046 | generate the completions list. This means that the hook |
| 1047 | `pcomplete-try-first-hook' will not be run." |
| 1048 | (declare (debug t)) |
| 1049 | `(pcomplete--here (lambda () ,form) ,stub ,paring ,form-only)) |
| 1050 | |
| 1051 | |
| 1052 | (defmacro pcomplete-here* (&optional form stub form-only) |
| 1053 | "An alternate form which does not participate in argument paring." |
| 1054 | (declare (debug t)) |
| 1055 | `(pcomplete-here ,form ,stub t ,form-only)) |
| 1056 | |
| 1057 | ;; display support |
| 1058 | |
| 1059 | (defun pcomplete-restore-windows () |
| 1060 | "If the only window change was due to Completions, restore things." |
| 1061 | (if pcomplete-last-window-config |
| 1062 | (let* ((cbuf (get-buffer "*Completions*")) |
| 1063 | (cwin (and cbuf (get-buffer-window cbuf)))) |
| 1064 | (when (window-live-p cwin) |
| 1065 | (bury-buffer cbuf) |
| 1066 | (set-window-configuration pcomplete-last-window-config)))) |
| 1067 | (setq pcomplete-last-window-config nil |
| 1068 | pcomplete-window-restore-timer nil)) |
| 1069 | |
| 1070 | ;; Abstractions so that the code below will work for both Emacs 20 and |
| 1071 | ;; XEmacs 21 |
| 1072 | |
| 1073 | (defalias 'pcomplete-event-matches-key-specifier-p |
| 1074 | (if (featurep 'xemacs) |
| 1075 | 'event-matches-key-specifier-p |
| 1076 | 'eq)) |
| 1077 | |
| 1078 | (defun pcomplete-read-event (&optional prompt) |
| 1079 | (if (fboundp 'read-event) |
| 1080 | (read-event prompt) |
| 1081 | (aref (read-key-sequence prompt) 0))) |
| 1082 | |
| 1083 | (defun pcomplete-show-completions (completions) |
| 1084 | "List in help buffer sorted COMPLETIONS. |
| 1085 | Typing SPC flushes the help buffer." |
| 1086 | (when pcomplete-window-restore-timer |
| 1087 | (cancel-timer pcomplete-window-restore-timer) |
| 1088 | (setq pcomplete-window-restore-timer nil)) |
| 1089 | (unless pcomplete-last-window-config |
| 1090 | (setq pcomplete-last-window-config (current-window-configuration))) |
| 1091 | (with-output-to-temp-buffer "*Completions*" |
| 1092 | (display-completion-list completions)) |
| 1093 | (minibuffer-message "Hit space to flush") |
| 1094 | (let (event) |
| 1095 | (prog1 |
| 1096 | (catch 'done |
| 1097 | (while (with-current-buffer (get-buffer "*Completions*") |
| 1098 | (setq event (pcomplete-read-event))) |
| 1099 | (cond |
| 1100 | ((pcomplete-event-matches-key-specifier-p event ?\s) |
| 1101 | (set-window-configuration pcomplete-last-window-config) |
| 1102 | (setq pcomplete-last-window-config nil) |
| 1103 | (throw 'done nil)) |
| 1104 | ((or (pcomplete-event-matches-key-specifier-p event 'tab) |
| 1105 | ;; Needed on a terminal |
| 1106 | (pcomplete-event-matches-key-specifier-p event 9)) |
| 1107 | (let ((win (or (get-buffer-window "*Completions*" 0) |
| 1108 | (display-buffer "*Completions*" |
| 1109 | 'not-this-window)))) |
| 1110 | (with-selected-window win |
| 1111 | (if (pos-visible-in-window-p (point-max)) |
| 1112 | (goto-char (point-min)) |
| 1113 | (scroll-up)))) |
| 1114 | (message "")) |
| 1115 | (t |
| 1116 | (setq unread-command-events (list event)) |
| 1117 | (throw 'done nil))))) |
| 1118 | (if (and pcomplete-last-window-config |
| 1119 | pcomplete-restore-window-delay) |
| 1120 | (setq pcomplete-window-restore-timer |
| 1121 | (run-with-timer pcomplete-restore-window-delay nil |
| 1122 | 'pcomplete-restore-windows)))))) |
| 1123 | |
| 1124 | ;; insert completion at point |
| 1125 | |
| 1126 | (defun pcomplete-insert-entry (stub entry &optional addsuffix raw-p) |
| 1127 | "Insert a completion entry at point. |
| 1128 | Returns non-nil if a space was appended at the end." |
| 1129 | (let ((here (point))) |
| 1130 | (if (not pcomplete-ignore-case) |
| 1131 | (insert-and-inherit (if raw-p |
| 1132 | (substring entry (length stub)) |
| 1133 | (comint-quote-filename |
| 1134 | (substring entry (length stub))))) |
| 1135 | ;; the stub is not quoted at this time, so to determine the |
| 1136 | ;; length of what should be in the buffer, we must quote it |
| 1137 | ;; FIXME: Here we presume that quoting `stub' gives us the exact |
| 1138 | ;; text in the buffer before point, which is not guaranteed; |
| 1139 | ;; e.g. it is not the case in eshell when completing ${FOO}tm[TAB]. |
| 1140 | (delete-char (- (length (comint-quote-filename stub)))) |
| 1141 | ;; if there is already a backslash present to handle the first |
| 1142 | ;; character, don't bother quoting it |
| 1143 | (when (eq (char-before) ?\\) |
| 1144 | (insert-and-inherit (substring entry 0 1)) |
| 1145 | (setq entry (substring entry 1))) |
| 1146 | (insert-and-inherit (if raw-p |
| 1147 | entry |
| 1148 | (comint-quote-filename entry)))) |
| 1149 | (let (space-added) |
| 1150 | (when (and (not (memq (char-before) pcomplete-suffix-list)) |
| 1151 | addsuffix) |
| 1152 | (insert-and-inherit pcomplete-termination-string) |
| 1153 | (setq space-added t)) |
| 1154 | (setq pcomplete-last-completion-length (- (point) here) |
| 1155 | pcomplete-last-completion-stub stub) |
| 1156 | space-added))) |
| 1157 | |
| 1158 | ;; Selection of completions. |
| 1159 | |
| 1160 | (defun pcomplete-do-complete (stub completions) |
| 1161 | "Dynamically complete at point using STUB and COMPLETIONS. |
| 1162 | This is basically just a wrapper for `pcomplete-stub' which does some |
| 1163 | extra checking, and munging of the COMPLETIONS list." |
| 1164 | (unless (stringp stub) |
| 1165 | (message "Cannot complete argument") |
| 1166 | (throw 'pcompleted nil)) |
| 1167 | (if (null completions) |
| 1168 | (ignore |
| 1169 | (if (and stub (> (length stub) 0)) |
| 1170 | (message "No completions of %s" stub) |
| 1171 | (message "No completions"))) |
| 1172 | ;; pare it down, if applicable |
| 1173 | (when (and pcomplete-use-paring pcomplete-seen) |
| 1174 | (setq pcomplete-seen |
| 1175 | (mapcar 'directory-file-name pcomplete-seen)) |
| 1176 | (dolist (p pcomplete-seen) |
| 1177 | (add-to-list 'pcomplete-seen |
| 1178 | (funcall pcomplete-norm-func p))) |
| 1179 | (setq completions |
| 1180 | (apply-partially 'completion-table-with-predicate |
| 1181 | completions |
| 1182 | (when pcomplete-seen |
| 1183 | (lambda (f) |
| 1184 | (not (member |
| 1185 | (funcall pcomplete-norm-func |
| 1186 | (directory-file-name f)) |
| 1187 | pcomplete-seen)))) |
| 1188 | 'strict))) |
| 1189 | ;; OK, we've got a list of completions. |
| 1190 | (if pcomplete-show-list |
| 1191 | ;; FIXME: pay attention to boundaries. |
| 1192 | (pcomplete-show-completions (all-completions stub completions)) |
| 1193 | (pcomplete-stub stub completions)))) |
| 1194 | |
| 1195 | (defun pcomplete-stub (stub candidates &optional cycle-p) |
| 1196 | "Dynamically complete STUB from CANDIDATES list. |
| 1197 | This function inserts completion characters at point by completing |
| 1198 | STUB from the strings in CANDIDATES. A completions listing may be |
| 1199 | shown in a help buffer if completion is ambiguous. |
| 1200 | |
| 1201 | Returns nil if no completion was inserted. |
| 1202 | Returns `sole' if completed with the only completion match. |
| 1203 | Returns `shortest' if completed with the shortest of the matches. |
| 1204 | Returns `partial' if completed as far as possible with the matches. |
| 1205 | Returns `listed' if a completion listing was shown. |
| 1206 | |
| 1207 | See also `pcomplete-filename'." |
| 1208 | (let* ((completion-ignore-case pcomplete-ignore-case) |
| 1209 | (completions (all-completions stub candidates)) |
| 1210 | (entry (try-completion stub candidates)) |
| 1211 | result) |
| 1212 | (cond |
| 1213 | ((null entry) |
| 1214 | (if (and stub (> (length stub) 0)) |
| 1215 | (message "No completions of %s" stub) |
| 1216 | (message "No completions"))) |
| 1217 | ((eq entry t) |
| 1218 | (setq entry stub) |
| 1219 | (message "Sole completion") |
| 1220 | (setq result 'sole)) |
| 1221 | ((= 1 (length completions)) |
| 1222 | (setq result 'sole)) |
| 1223 | ((and pcomplete-cycle-completions |
| 1224 | (or cycle-p |
| 1225 | (not pcomplete-cycle-cutoff-length) |
| 1226 | (<= (length completions) |
| 1227 | pcomplete-cycle-cutoff-length))) |
| 1228 | (let ((bound (car (completion-boundaries stub candidates nil "")))) |
| 1229 | (unless (zerop bound) |
| 1230 | (setq completions (mapcar (lambda (c) (concat (substring stub 0 bound) c)) |
| 1231 | completions))) |
| 1232 | (setq entry (car completions) |
| 1233 | pcomplete-current-completions completions))) |
| 1234 | ((and pcomplete-recexact |
| 1235 | (string-equal stub entry) |
| 1236 | (member entry completions)) |
| 1237 | ;; It's not unique, but user wants shortest match. |
| 1238 | (message "Completed shortest") |
| 1239 | (setq result 'shortest)) |
| 1240 | ((or pcomplete-autolist |
| 1241 | (string-equal stub entry)) |
| 1242 | ;; It's not unique, list possible completions. |
| 1243 | ;; FIXME: pay attention to boundaries. |
| 1244 | (pcomplete-show-completions completions) |
| 1245 | (setq result 'listed)) |
| 1246 | (t |
| 1247 | (message "Partially completed") |
| 1248 | (setq result 'partial))) |
| 1249 | (cons result entry))) |
| 1250 | |
| 1251 | ;; context sensitive help |
| 1252 | |
| 1253 | (defun pcomplete--help () |
| 1254 | "Produce context-sensitive help for the current argument. |
| 1255 | If specific documentation can't be given, be generic." |
| 1256 | (if (and pcomplete-help |
| 1257 | (or (and (stringp pcomplete-help) |
| 1258 | (fboundp 'Info-goto-node)) |
| 1259 | (listp pcomplete-help))) |
| 1260 | (if (listp pcomplete-help) |
| 1261 | (message "%s" (eval pcomplete-help)) |
| 1262 | (save-window-excursion (info)) |
| 1263 | (switch-to-buffer-other-window "*info*") |
| 1264 | (funcall (symbol-function 'Info-goto-node) pcomplete-help)) |
| 1265 | (if pcomplete-man-function |
| 1266 | (let ((cmd (funcall pcomplete-command-name-function))) |
| 1267 | (if (and cmd (> (length cmd) 0)) |
| 1268 | (funcall pcomplete-man-function cmd))) |
| 1269 | (message "No context-sensitive help available")))) |
| 1270 | |
| 1271 | ;; general utilities |
| 1272 | |
| 1273 | (defun pcomplete-uniqify-list (l) |
| 1274 | "Sort and remove multiples in L." |
| 1275 | (setq l (sort l 'string-lessp)) |
| 1276 | (let ((m l)) |
| 1277 | (while m |
| 1278 | (while (and (cdr m) |
| 1279 | (string= (car m) |
| 1280 | (cadr m))) |
| 1281 | (setcdr m (cddr m))) |
| 1282 | (setq m (cdr m)))) |
| 1283 | l) |
| 1284 | |
| 1285 | (defun pcomplete-process-result (cmd &rest args) |
| 1286 | "Call CMD using `call-process' and return the simplest result." |
| 1287 | (with-temp-buffer |
| 1288 | (apply 'call-process cmd nil t nil args) |
| 1289 | (skip-chars-backward "\n") |
| 1290 | (buffer-substring (point-min) (point)))) |
| 1291 | |
| 1292 | ;; create a set of aliases which allow completion functions to be not |
| 1293 | ;; quite so verbose |
| 1294 | |
| 1295 | ;;; jww (1999-10-20): are these a good idea? |
| 1296 | ;; (defalias 'pc-here 'pcomplete-here) |
| 1297 | ;; (defalias 'pc-test 'pcomplete-test) |
| 1298 | ;; (defalias 'pc-opt 'pcomplete-opt) |
| 1299 | ;; (defalias 'pc-match 'pcomplete-match) |
| 1300 | ;; (defalias 'pc-match-string 'pcomplete-match-string) |
| 1301 | ;; (defalias 'pc-match-beginning 'pcomplete-match-beginning) |
| 1302 | ;; (defalias 'pc-match-end 'pcomplete-match-end) |
| 1303 | |
| 1304 | (provide 'pcomplete) |
| 1305 | |
| 1306 | ;;; pcomplete.el ends here |