X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/fd67a7000ee9e118b426df6ad779f3c86d4fe320..98cd6c18c57c031d8c0a0d13284375b8ccf60439:/lisp/pcomplete.el

diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index cd216ad8d3..46a82e3720 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1,7 +1,6 @@
-;;; pcomplete.el --- programmable completion
+;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
 
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <johnw@gnu.org>
 ;; Keywords: processes abbrev
@@ -155,6 +154,7 @@ This mirrors the optional behavior of tcsh."
   "A list of characters which constitute a proper suffix."
   :type '(repeat character)
   :group 'pcomplete)
+(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
 
 (defcustom pcomplete-recexact nil
   "If non-nil, use shortest completion if characters cannot be added.
@@ -349,6 +349,16 @@ modified to be an empty string, or the desired separation string."
 (defvar pcomplete-show-list nil)
 (defvar pcomplete-expand-only-p nil)
 
+;; for the sake of the bye-compiler, when compiling other files that
+;; contain completion functions
+(defvar pcomplete-args nil)
+(defvar pcomplete-begins nil)
+(defvar pcomplete-last nil)
+(defvar pcomplete-index nil)
+(defvar pcomplete-stub nil)
+(defvar pcomplete-seen nil)
+(defvar pcomplete-norm-func nil)
+
 ;;; User Functions:
 
 ;;; Alternative front-end using the standard completion facilities.
@@ -440,7 +450,7 @@ in the same way as TABLE completes strings of the form (concat S2 S)."
                               (if (string-match re c)
                                   (substring c (match-end 0))))
                             res))))))))))
-        
+
 ;; I don't think such commands are usable before first setting up buffer-local
 ;; variables to parse args, so there's no point autoloading it.
 ;; ;;;###autoload
@@ -469,7 +479,7 @@ Same as `pcomplete' but using the standard completion UI."
            ;; pcomplete-parse-arguments-function does, that connection
            ;; might not be that close.  E.g. in eshell,
            ;; pcomplete-parse-arguments-function expands envvars.
-           ;; 
+           ;;
            ;; Since we use minibuffer-complete, which doesn't know
            ;; pcomplete-stub and works from the buffer's text instead,
            ;; we need to trick minibuffer-complete, into using
@@ -480,63 +490,64 @@ Same as `pcomplete' but using the standard completion UI."
            ;; prefix from pcomplete-stub.
            (beg (max (- (point) (length pcomplete-stub))
                      (pcomplete-begin)))
-           (buftext (buffer-substring beg (point)))
-           (table
-            (cond
-             ((null completions) nil)
-             ((not (equal pcomplete-stub buftext))
-              ;; This isn't always strictly right (e.g. if
-              ;; FOO="toto/$FOO", then completion of /$FOO/bar may
-              ;; result in something incorrect), but given the lack of
-              ;; any other info, it's about as good as it gets, and in
-              ;; practice it should work just fine (fingers crossed).
-              (let ((prefixes (pcomplete--common-quoted-suffix
-                               pcomplete-stub buftext)))
-                (apply-partially
-                 'pcomplete--table-subvert
-                 completions
-                 (cdr prefixes) (car prefixes))))
-             (t
-              (lexical-let ((completions completions))
-                (lambda (string pred action)
-                  (let ((res (complete-with-action
-                              action completions string pred)))
-                    (if (stringp res)
-                        (pcomplete-quote-argument res)
-                      res)))))))
-           (pred
-            ;; pare it down, if applicable
-            (when (and table pcomplete-use-paring pcomplete-seen)
-              (setq pcomplete-seen
-                    (mapcar (lambda (f)
-                              (funcall pcomplete-norm-func
-                                       (directory-file-name f)))
-                            pcomplete-seen))
-              (lambda (f)
-                (not (member
-                      (funcall pcomplete-norm-func
-                               (directory-file-name f))
-                      pcomplete-seen))))))
-
-      (list
-       beg (point)
-       ;; Add a space at the end of completion.  Use a terminator-regexp
-       ;; that never matches since the terminator cannot appear
-       ;; within the completion field anyway.
-       (if (zerop (length pcomplete-termination-string))
-           table
-         (apply-partially 'completion-table-with-terminator
-                          (cons pcomplete-termination-string
-                                "\\`a\\`")
-                          table))
-       :predicate pred))))
+           (buftext (buffer-substring beg (point))))
+      (when completions
+        (let ((table
+               (cond
+                ((not (equal pcomplete-stub buftext))
+                 ;; This isn't always strictly right (e.g. if
+                 ;; FOO="toto/$FOO", then completion of /$FOO/bar may
+                 ;; result in something incorrect), but given the lack of
+                 ;; any other info, it's about as good as it gets, and in
+                 ;; practice it should work just fine (fingers crossed).
+                 (let ((prefixes (pcomplete--common-quoted-suffix
+                                  pcomplete-stub buftext)))
+                   (apply-partially #'pcomplete--table-subvert
+                                    completions
+                                    (cdr prefixes) (car prefixes))))
+                (t
+                 (lambda (string pred action)
+                   (let ((res (complete-with-action
+                               action completions string pred)))
+                     (if (stringp res)
+                         (pcomplete-quote-argument res)
+                       res))))))
+              (pred
+               ;; Pare it down, if applicable.
+               (when (and pcomplete-use-paring pcomplete-seen)
+                 (setq pcomplete-seen
+                       (mapcar (lambda (f)
+                                 (funcall pcomplete-norm-func
+                                          (directory-file-name f)))
+                               pcomplete-seen))
+                 ;; Capture the dynbound values for later use.
+                 (let ((norm-func pcomplete-norm-func)
+                       (seen pcomplete-seen))
+                   (lambda (f)
+                     (not (member
+                           (funcall norm-func (directory-file-name f))
+                           seen)))))))
+          (when pcomplete-ignore-case
+            (setq table
+                  (apply-partially #'completion-table-case-fold table)))
+          (list beg (point) table
+                :predicate pred
+                :exit-function
+                (unless (zerop (length pcomplete-termination-string))
+                  (lambda (_s finished)
+                    (when (memq finished '(sole finished))
+                      (if (looking-at
+                           (regexp-quote pcomplete-termination-string))
+                          (goto-char (match-end 0))
+                        (insert pcomplete-termination-string)))))))))))
 
  ;; I don't think such commands are usable before first setting up buffer-local
  ;; variables to parse args, so there's no point autoloading it.
  ;; ;;;###autoload
 (defun pcomplete-std-complete ()
-  (let ((completion-at-point-functions '(pcomplete-completions-at-point)))
-    (completion-at-point)))
+  (let ((data (pcomplete-completions-at-point)))
+    (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
+                          (plist-get :predicate (nthcdr 3 data)))))
 
 ;;; Pcomplete's native UI.
 
@@ -648,17 +659,6 @@ This will modify the current buffer."
 ;;; Internal Functions:
 
 ;; argument handling
-
-;; for the sake of the bye-compiler, when compiling other files that
-;; contain completion functions
-(defvar pcomplete-args nil)
-(defvar pcomplete-begins nil)
-(defvar pcomplete-last nil)
-(defvar pcomplete-index nil)
-(defvar pcomplete-stub nil)
-(defvar pcomplete-seen nil)
-(defvar pcomplete-norm-func nil)
-
 (defun pcomplete-arg (&optional index offset)
   "Return the textual content of the INDEXth argument.
 INDEX is based from the current processing position.  If INDEX is
@@ -780,10 +780,14 @@ dynamic-complete-functions are kept.  For comint mode itself,
 this is `comint-dynamic-complete-functions'."
   (set (make-local-variable 'pcomplete-parse-arguments-function)
        'pcomplete-parse-comint-arguments)
+  (add-hook 'completion-at-point-functions
+            'pcomplete-completions-at-point nil 'local)
   (set (make-local-variable completef-sym)
        (copy-sequence (symbol-value completef-sym)))
   (let* ((funs (symbol-value completef-sym))
-	 (elem (or (memq 'shell-dynamic-complete-filename funs)
+	 (elem (or (memq 'comint-filename-completion funs)
+                   (memq 'shell-filename-completion funs)
+                   (memq 'shell-dynamic-complete-filename funs)
 		   (memq 'comint-dynamic-complete-filename funs))))
     (if elem
 	(setcar elem 'pcomplete)
@@ -885,15 +889,46 @@ Magic characters are those in `pcomplete-arg-quote-list'."
 
 (defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
   "Return either directories, or qualified entries."
-  ;; FIXME: pcomplete-entries doesn't return a list any more.
   (pcomplete-entries
    nil
-   (lexical-let ((re regexp)
-                 (pred predicate))
-     (lambda (f)
-       (or (file-directory-p f)
-           (and (if (not re) t (string-match re f))
-                (if (not pred) t (funcall pred f))))))))
+   (lambda (f)
+     (or (file-directory-p f)
+         (and (or (null regexp) (string-match regexp f))
+              (or (null predicate) (funcall predicate f)))))))
+
+(defun pcomplete--entries (&optional regexp predicate)
+  "Like `pcomplete-entries' but without env-var handling."
+  (let* ((ign-pred
+          (when (or pcomplete-file-ignore pcomplete-dir-ignore)
+            ;; Capture the dynbound value for later use.
+            (let ((file-ignore pcomplete-file-ignore)
+                  (dir-ignore pcomplete-dir-ignore))
+              (lambda (file)
+                (not
+                 (if (eq (aref file (1- (length file))) ?/)
+                     (and dir-ignore (string-match dir-ignore file))
+                   (and file-ignore (string-match file-ignore file))))))))
+         (reg-pred (if regexp (lambda (file) (string-match regexp file))))
+         (pred (cond
+                ((null (or ign-pred reg-pred))  predicate)
+                ((null (or ign-pred predicate)) reg-pred)
+                ((null (or reg-pred predicate)) ign-pred)
+                (t (lambda (f)
+                     (and (or (null reg-pred)  (funcall reg-pred f))
+                          (or (null ign-pred)  (funcall ign-pred f))
+                          (or (null predicate) (funcall predicate f))))))))
+    (lambda (s p a)
+      (if (and (eq a 'metadata) pcomplete-compare-entry-function)
+          `(metadata (cycle-sort-function
+                      . ,(lambda (comps)
+                           (sort comps pcomplete-compare-entry-function)))
+                     ,@(cdr (completion-file-name-table s p a)))
+        (let ((completion-ignored-extensions nil))
+          (completion-table-with-predicate
+           'completion-file-name-table pred 'strict s p a))))))
+
+(defconst pcomplete--env-regexp
+  "\\(?:\\`\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(\\$\\(?:{\\([^}]+\\)}\\|\\(?2:[[:alnum:]_]+\\)\\)\\)")
 
 (defun pcomplete-entries (&optional regexp predicate)
   "Complete against a list of directory candidates.
@@ -903,65 +938,48 @@ If PREDICATE is non-nil, it will also be used to refine the match
 \(files for which the PREDICATE returns nil will be excluded).
 If no directory information can be extracted from the completed
 component, `default-directory' is used as the basis for completion."
-  (let* ((name (substitute-env-vars pcomplete-stub))
-         (completion-ignore-case pcomplete-ignore-case)
-	 (default-directory (expand-file-name
-			     (or (file-name-directory name)
-				 default-directory)))
-	 above-cutoff)
-    (setq name (file-name-nondirectory name)
-	  pcomplete-stub name)
-    (let ((completions
-	   (file-name-all-completions name default-directory)))
-      (if regexp
-	  (setq completions
-		(pcomplete-pare-list
-		 completions nil
-		 (function
-		  (lambda (file)
-		    (not (string-match regexp file)))))))
-      (if predicate
-	  (setq completions
-		(pcomplete-pare-list
-		 completions nil
-		 (function
-		  (lambda (file)
-		    (not (funcall predicate file)))))))
-      (if (or pcomplete-file-ignore pcomplete-dir-ignore)
-	  (setq completions
-		(pcomplete-pare-list
-		 completions nil
-		 (function
-		  (lambda (file)
-		    (if (eq (aref file (1- (length file)))
-			    ?/)
-			(and pcomplete-dir-ignore
-			     (string-match pcomplete-dir-ignore file))
-		      (and pcomplete-file-ignore
-			   (string-match pcomplete-file-ignore file))))))))
-      (setq above-cutoff (and pcomplete-cycle-cutoff-length
-			     (> (length completions)
-				pcomplete-cycle-cutoff-length)))
-      (sort completions
-	    (function
-	     (lambda (l r)
-	       ;; for the purposes of comparison, remove the
-	       ;; trailing slash from directory names.
-	       ;; Otherwise, "foo.old/" will come before "foo/",
-	       ;; since . is earlier in the ASCII alphabet than
-	       ;; /
-	       (let ((left (if (eq (aref l (1- (length l)))
-				   ?/)
-			       (substring l 0 (1- (length l)))
-			     l))
-		     (right (if (eq (aref r (1- (length r)))
-				    ?/)
-				(substring r 0 (1- (length r)))
-			      r)))
-		 (if above-cutoff
-		     (string-lessp left right)
-		   (funcall pcomplete-compare-entry-function
-			    left right)))))))))
+  ;; FIXME: The old code did env-var expansion here, so we reproduce this
+  ;; behavior for now, but really env-var handling should be performed globally
+  ;; rather than here since it also applies to non-file arguments.
+  (let ((table (pcomplete--entries regexp predicate)))
+    (lambda (string pred action)
+      (let ((strings nil)
+            (orig-length (length string)))
+        ;; Perform env-var expansion.
+        (while (string-match pcomplete--env-regexp string)
+          (push (substring string 0 (match-beginning 1)) strings)
+          (push (getenv (match-string 2 string)) strings)
+          (setq string (substring string (match-end 1))))
+        (if (not (and strings
+                      (or (eq action t)
+                          (eq (car-safe action) 'boundaries))))
+            (let ((newstring
+                   (mapconcat 'identity (nreverse (cons string strings)) "")))
+              ;; FIXME: We could also try to return unexpanded envvars.
+              (complete-with-action action table newstring pred))
+          (let* ((envpos (apply #'+ (mapcar #' length strings)))
+                 (newstring
+                  (mapconcat 'identity (nreverse (cons string strings)) ""))
+                 (bounds (completion-boundaries newstring table pred
+                                                (or (cdr-safe action) ""))))
+            (if (>= (car bounds) envpos)
+                ;; The env-var is "out of bounds".
+                (if (eq action t)
+                    (complete-with-action action table newstring pred)
+                  (list* 'boundaries
+                         (+ (car bounds) (- orig-length (length newstring)))
+                         (cdr bounds)))
+              ;; The env-var is in the file bounds.
+              (if (eq action t)
+                  (let ((comps (complete-with-action
+                                action table newstring pred))
+                        (len (- envpos (car bounds))))
+                    ;; Strip the part of each completion that's actually
+                    ;; coming from the env-var.
+                    (mapcar (lambda (s) (substring s len)) comps))
+                (list* 'boundaries
+                       (+ envpos (- orig-length (length newstring)))
+                       (cdr bounds))))))))))
 
 (defsubst pcomplete-all-entries (&optional regexp predicate)
   "Like `pcomplete-entries', but doesn't ignore any entries."
@@ -996,13 +1014,14 @@ component, `default-directory' is used as the basis for completion."
 	   (pcomplete-next-arg)
 	   (funcall sym)))))))
 
-(defun pcomplete-opt (options &optional prefix no-ganging args-follow)
+(defun pcomplete-opt (options &optional prefix _no-ganging _args-follow)
   "Complete a set of OPTIONS, each beginning with PREFIX (?- by default).
 PREFIX may be t, in which case no PREFIX character is necessary.
 If NO-GANGING is non-nil, each option is separate (-xy is not allowed).
 If ARGS-FOLLOW is non-nil, then options which take arguments may have
 the argument appear after a ganged set of options.  This is how tar
-behaves, for example."
+behaves, for example.
+Arguments NO-GANGING and ARGS-FOLLOW are currently ignored."
   (if (and (= pcomplete-index pcomplete-last)
 	   (string= (pcomplete-arg) "-"))
       (let ((len (length options))
@@ -1249,11 +1268,12 @@ extra checking, and munging of the COMPLETIONS list."
       (setq completions
             (apply-partially 'completion-table-with-predicate
                              completions
-                             (lambda (f)
-                               (not (member
-                                     (funcall pcomplete-norm-func
-                                              (directory-file-name f))
-                                     pcomplete-seen)))
+                             (when pcomplete-seen
+                               (lambda (f)
+                                 (not (member
+                                       (funcall pcomplete-norm-func
+                                                (directory-file-name f))
+                                       pcomplete-seen))))
                              'strict)))
     ;; OK, we've got a list of completions.
     (if pcomplete-show-list
@@ -1339,25 +1359,6 @@ If specific documentation can't be given, be generic."
 
 ;; general utilities
 
-(defun pcomplete-pare-list (l r &optional pred)
-  "Destructively remove from list L all elements matching any in list R.
-Test is done using `equal'.
-If PRED is non-nil, it is a function used for further removal.
-Returns the resultant list."
-  (while (and l (or (and r (member (car l) r))
-		    (and pred
-			 (funcall pred (car l)))))
-    (setq l (cdr l)))
-  (let ((m l))
-    (while m
-      (while (and (cdr m)
-		  (or (and r (member (cadr m) r))
-		      (and pred
-			   (funcall pred (cadr m)))))
-	(setcdr m (cddr m)))
-      (setq m (cdr m))))
-  l)
-
 (defun pcomplete-uniqify-list (l)
   "Sort and remove multiples in L."
   (setq l (sort l 'string-lessp))
@@ -1391,5 +1392,4 @@ Returns the resultant list."
 
 (provide 'pcomplete)
 
-;; arch-tag: ae32ef2d-dbed-4244-8b0f-cf5a2a3b07a4
 ;;; pcomplete.el ends here