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