[Emacs-diffs] emacs/lisp ChangeLog pcomplete.el

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        09/10/22 15:17:52

Modified files:
        lisp           : ChangeLog pcomplete.el 

Log message:
        Allow the use of completion-tables.
        (pcomplete-std-complete): New command.
        (pcomplete-dirs-or-entries): Use a single call to pcomplete-entries.
        (pcomplete--here): Use a function for `form' rather than an expression,
        so it can be byte-compiled.
        (pcomplete-here, pcomplete-here*): Adjust accordingly.
        Add edebug declaration.
        (pcomplete-show-completions): Remove unused var `curbuf'.
        (pcomplete-do-complete, pcomplete-stub):
        Don't assume `completions' is a list of strings any more.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16476&r2=1.16477
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/pcomplete.el?cvsroot=emacs&r1=1.40&r2=1.41

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16476
retrieving revision 1.16477
diff -u -b -r1.16476 -r1.16477
--- ChangeLog   22 Oct 2009 09:42:22 -0000      1.16476
+++ ChangeLog   22 Oct 2009 15:17:48 -0000      1.16477
@@ -1,3 +1,16 @@
+2009-10-22  Stefan Monnier  <address@hidden>
+
+       * pcomplete.el: Allow the use of completion-tables.
+       (pcomplete-std-complete): New command.
+       (pcomplete-dirs-or-entries): Use a single call to pcomplete-entries.
+       (pcomplete--here): Use a function for `form' rather than an expression,
+       so it can be byte-compiled.
+       (pcomplete-here, pcomplete-here*): Adjust accordingly.
+       Add edebug declaration.
+       (pcomplete-show-completions): Remove unused var `curbuf'.
+       (pcomplete-do-complete, pcomplete-stub):
+       Don't assume `completions' is a list of strings any more.
+
 2009-10-22  Juanma Barranquero  <address@hidden>
 
        * find-dired.el (find-name-arg): Fix typo in docstring.

Index: pcomplete.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/pcomplete.el,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -b -r1.40 -r1.41
--- pcomplete.el        12 Jul 2009 16:20:53 -0000      1.40
+++ pcomplete.el        22 Oct 2009 15:17:52 -0000      1.41
@@ -60,8 +60,9 @@
 ;;   it means no completions were available.
 ;;
 ;; @ In order to provide completions, they must throw the tag
-;;   `pcomplete-completions'.  The value must be the list of possible
-;;   completions for the final argument.
+;;   `pcomplete-completions'.  The value must be a completion table
+;;   (i.e. a table that can be passed to try-completion and friends)
+;;   for the final argument.
 ;;
 ;; @ To simplify completion function logic, the tag `pcompleted' may
 ;;   be thrown with a value of nil in order to abort the function.  It
@@ -118,7 +119,7 @@
 
 ;;; Code:
 
-(provide 'pcomplete)
+(eval-when-compile (require 'cl))
 
 (defgroup pcomplete nil
   "Programmable completion."
@@ -393,6 +394,41 @@
                                           '(sole shortest))
                                     pcomplete-last-completion-raw))))))
 
+(defun pcomplete-std-complete ()
+  "Provide standard completion using pcomplete's completion tables.
+Same as `pcomplete' but using the standard completion UI."
+  (interactive)
+  ;; FIXME: it fails to unquote/requote the arguments.
+  ;; FIXME: it doesn't implement paring.
+  ;; FIXME: when we bring up *Completions* we never bring it back down.
+  (catch 'pcompleted
+    (let* ((pcomplete-stub)
+           pcomplete-seen pcomplete-norm-func
+           pcomplete-args pcomplete-last pcomplete-index
+           (pcomplete-autolist pcomplete-autolist)
+           (pcomplete-suffix-list pcomplete-suffix-list)
+           ;; Apparently the vars above are global vars modified by
+           ;; side-effects, whereas pcomplete-completions is the core
+           ;; function that finds the chunk of text to complete
+           ;; (returned indirectly in pcomplete-stub) and the set of
+           ;; possible completions.
+           (completions (pcomplete-completions))
+           ;; The pcomplete code seems to presume that pcomplete-stub
+           ;; is always the text before point.
+           (ol (make-overlay (- (point) (length pcomplete-stub))
+                             (point) nil nil t))
+           (minibuffer-completion-table
+            ;; 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.
+            (apply-partially 'completion-table-with-terminator
+                             '(" " . "\\`a\\`") completions))
+           (minibuffer-completion-predicate nil))
+      (overlay-put ol 'field 'pcomplete)
+      (unwind-protect
+          (call-interactively 'minibuffer-complete)
+        (delete-overlay ol)))))
+
 ;;;###autoload
 (defun pcomplete-reverse ()
   "If cycling completion is in use, cycle backwards."
@@ -424,7 +460,7 @@
        (pcomplete-expand-only-p t))
     (pcomplete)
     (when (and pcomplete-current-completions
-              (> (length pcomplete-current-completions) 0))
+              (> (length pcomplete-current-completions) 0)) ;??
       (delete-backward-char pcomplete-last-completion-length)
       (while pcomplete-current-completions
        (unless (pcomplete-insert-entry
@@ -599,7 +635,7 @@
 
 ;;;###autoload
 (defun pcomplete-shell-setup ()
-  "Setup shell-mode to use pcomplete."
+  "Setup `shell-mode' to use pcomplete."
   (pcomplete-comint-setup 'shell-dynamic-complete-functions))
 
 (declare-function comint-bol "comint" (&optional arg))
@@ -699,13 +735,15 @@
 
 (defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
   "Return either directories, or qualified entries."
-  (append (let ((pcomplete-stub pcomplete-stub))
+  ;; FIXME: pcomplete-entries doesn't return a list any more.
            (pcomplete-entries
-            regexp (or predicate
-                       (function
-                        (lambda (path)
-                          (not (file-directory-p path)))))))
-         (pcomplete-entries nil 'file-directory-p)))
+   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))))))))
 
 (defun pcomplete-entries (&optional regexp predicate)
   "Complete against a list of directory candidates.
@@ -873,7 +911,7 @@
            (setq pcomplete-seen nil)
          (unless (eq paring t)
            (let ((arg (pcomplete-arg)))
-             (unless (not (stringp arg))
+             (when (stringp arg)
                (setq pcomplete-seen
                      (cons (if paring
                                (funcall paring arg)
@@ -891,12 +929,17 @@
       (setq pcomplete-norm-func (or paring 'file-truename)))
     (unless form-only
       (run-hooks 'pcomplete-try-first-hook))
-    (throw 'pcomplete-completions (eval form))))
+    (throw 'pcomplete-completions
+           (if (functionp form)
+               (funcall form)
+             ;; Old calling convention, might still be used by files
+             ;; byte-compiled with the older code.
+             (eval form)))))
 
 (defmacro pcomplete-here (&optional form stub paring form-only)
   "Complete against the current argument, if at the end.
-If completion is to be done here, evaluate FORM to generate the list
-of strings which will be used for completion purposes.  If STUB is a
+If completion is to be done here, evaluate FORM to generate the completion
+table which will be used for completion purposes.  If STUB is a
 string, use it as the completion stub instead of the default (which is
 the entire text of the current argument).
 
@@ -904,7 +947,7 @@
 argument text is 'long-path-name/', you don't want the completions
 list display to be cluttered by 'long-path-name/' appearing at the
 beginning of every alternative.  Not only does this make things less
-intelligle, but it is also inefficient.  Yet, if the completion list
+intelligible, but it is also inefficient.  Yet, if the completion list
 does not begin with this string for every entry, the current argument
 won't complete correctly.
 
@@ -923,11 +966,14 @@
 If FORM-ONLY is non-nil, only the result of FORM will be used to
 generate the completions list.  This means that the hook
 `pcomplete-try-first-hook' will not be run."
-  `(pcomplete--here (quote ,form) ,stub ,paring ,form-only))
+  (declare (debug t))
+  `(pcomplete--here (lambda () ,form) ,stub ,paring ,form-only))
+
 
 (defmacro pcomplete-here* (&optional form stub form-only)
   "An alternate form which does not participate in argument paring."
-  `(pcomplete-here ,form ,stub t ,form-only))
+  (declare (debug t))
+  `(pcomplete-here (lambda () ,form) ,stub t ,form-only))
 
 ;; display support
 
@@ -958,7 +1004,6 @@
 (defun pcomplete-show-completions (completions)
   "List in help buffer sorted COMPLETIONS.
 Typing SPC flushes the help buffer."
-  (let* ((curbuf (current-buffer)))
     (when pcomplete-window-restore-timer
       (cancel-timer pcomplete-window-restore-timer)
       (setq pcomplete-window-restore-timer nil))
@@ -995,7 +1040,7 @@
                 pcomplete-restore-window-delay)
            (setq pcomplete-window-restore-timer
                  (run-with-timer pcomplete-restore-window-delay nil
-                                 'pcomplete-restore-windows)))))))
+                                'pcomplete-restore-windows))))))
 
 ;; insert completion at point
 
@@ -1043,40 +1088,25 @@
           (message "No completions of %s" stub)
         (message "No completions")))
     ;; pare it down, if applicable
-    (if (and pcomplete-use-paring pcomplete-seen)
-       (let* ((arg (pcomplete-arg))
-              (prefix
-               (file-name-as-directory
-                (funcall pcomplete-norm-func
-                         (substring arg 0 (- (length arg)
-                                             (length pcomplete-stub)))))))
+    (when (and pcomplete-use-paring pcomplete-seen)
          (setq pcomplete-seen
                (mapcar 'directory-file-name pcomplete-seen))
-         (let ((p pcomplete-seen))
-           (while p
+      (dolist (p pcomplete-seen)
              (add-to-list 'pcomplete-seen
-                          (funcall pcomplete-norm-func (car p)))
-             (setq p (cdr p))))
+                     (funcall pcomplete-norm-func p)))
          (setq completions
-               (mapcar
-                (function
-                 (lambda (elem)
-                   (file-relative-name elem prefix)))
-                (pcomplete-pare-list
-                 (mapcar
-                  (function
-                   (lambda (elem)
-                     (expand-file-name elem prefix)))
-                  completions)
-                 pcomplete-seen
-                 (function
-                  (lambda (elem)
-                    (member (directory-file-name
-                             (funcall pcomplete-norm-func elem))
-                            pcomplete-seen))))))))
+            (apply-partially 'completion-table-with-predicate
+                             completions
+                             (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
-       (pcomplete-show-completions completions)
+        ;; FIXME: pay attention to boundaries.
+       (pcomplete-show-completions (all-completions stub completions))
       (pcomplete-stub stub completions))))
 
 (defun pcomplete-stub (stub candidates &optional cycle-p)
@@ -1093,29 +1123,32 @@
 
 See also `pcomplete-filename'."
   (let* ((completion-ignore-case pcomplete-ignore-case)
-        (candidates (mapcar 'list candidates))
-        (completions (all-completions stub candidates)))
-    (let (result entry)
+        (completions (all-completions stub candidates))
+         (entry (try-completion stub candidates))
+         result)
       (cond
-       ((null completions)
+     ((null entry)
        (if (and stub (> (length stub) 0))
            (message "No completions of %s" stub)
          (message "No completions")))
+     ((eq entry t)
+      (setq entry stub)
+      (message "Sole completion")
+      (setq result 'sole))
        ((= 1 (length completions))
-       (setq entry (car completions))
-       (if (string-equal entry stub)
-           (message "Sole completion"))
        (setq result 'sole))
        ((and pcomplete-cycle-completions
             (or cycle-p
                 (not pcomplete-cycle-cutoff-length)
                 (<= (length completions)
                     pcomplete-cycle-cutoff-length)))
+      (let ((bound (car (completion-boundaries stub candidates nil ""))))
+        (unless (zerop bound)
+          (setq completions (mapcar (lambda (c) (concat (substring stub 0 
bound) c))
+                                    completions)))
        (setq entry (car completions)
-             pcomplete-current-completions completions))
-       (t ; There's no unique completion; use longest substring
-       (setq entry (try-completion stub candidates))
-       (cond ((and pcomplete-recexact
+              pcomplete-current-completions completions)))
+     ((and pcomplete-recexact
                    (string-equal stub entry)
                    (member entry completions))
               ;; It's not unique, but user wants shortest match.
@@ -1124,12 +1157,13 @@
              ((or pcomplete-autolist
                   (string-equal stub entry))
               ;; It's not unique, list possible completions.
+      ;; FIXME: pay attention to boundaries.
               (pcomplete-show-completions completions)
               (setq result 'listed))
              (t
               (message "Partially completed")
-              (setq result 'partial)))))
-      (cons result entry))))
+      (setq result 'partial)))
+    (cons result entry)))
 
 ;; context sensitive help
 
@@ -1194,14 +1228,16 @@
 ;; create a set of aliases which allow completion functions to be not
 ;; quite so verbose
 
-;; jww (1999-10-20): are these a good idea?
-; (defalias 'pc-here 'pcomplete-here)
-; (defalias 'pc-test 'pcomplete-test)
-; (defalias 'pc-opt 'pcomplete-opt)
-; (defalias 'pc-match 'pcomplete-match)
-; (defalias 'pc-match-string 'pcomplete-match-string)
-; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
-; (defalias 'pc-match-end 'pcomplete-match-end)
+;;; jww (1999-10-20): are these a good idea?
+;; (defalias 'pc-here 'pcomplete-here)
+;; (defalias 'pc-test 'pcomplete-test)
+;; (defalias 'pc-opt 'pcomplete-opt)
+;; (defalias 'pc-match 'pcomplete-match)
+;; (defalias 'pc-match-string 'pcomplete-match-string)
+;; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
+;; (defalias 'pc-match-end 'pcomplete-match-end)
+
+(provide 'pcomplete)
 
 ;; arch-tag: ae32ef2d-dbed-4244-8b0f-cf5a2a3b07a4
 ;;; pcomplete.el ends here