[Emacs-diffs] /srv/bzr/emacs/trunk r103737: First step towards using standard completion in comint.

[Stefan Monnier]

------------------------------------------------------------
revno: 103737
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2011-03-24 18:05:01 -0400
message:
  First step towards using standard completion in comint.
  * lisp/minibuffer.el (completion--flush-all-sorted-completions):
  Remove itself from hook.
  (completion-at-point): Let the functions perform the completion
  immediately and return nil or t.
  * lisp/comint.el (comint-dynamic-complete-functions): Now identical to
  completion-at-point-functions.
  (comint-dynamic-list-input-ring): Remove unused var `index'.
  (comint--match-partial-filename, comint--unquote&expand-filename):
  New funs, split from comint-match-partial-filename.
  (comint-dynamic-complete): Use completion-at-point.
  (comint-dynamic-complete-filename): Use comint--match-partial-filename.
modified:
  lisp/ChangeLog
  lisp/comint.el
  lisp/minibuffer.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-03-24 16:38:12 +0000
+++ b/lisp/ChangeLog    2011-03-24 22:05:01 +0000
@@ -1,3 +1,17 @@
+2011-03-24  Stefan Monnier  <address@hidden>
+
+       * minibuffer.el (completion--flush-all-sorted-completions):
+       Remove itself from hook.
+       (completion-at-point): Let the functions perform the completion
+       immediately and return nil or t.
+       * comint.el (comint-dynamic-complete-functions): Now identical to
+       completion-at-point-functions.
+       (comint-dynamic-list-input-ring): Remove unused var `index'.
+       (comint--match-partial-filename, comint--unquote&expand-filename):
+       New funs, split from comint-match-partial-filename.
+       (comint-dynamic-complete): Use completion-at-point.
+       (comint-dynamic-complete-filename): Use comint--match-partial-filename.
+
 2011-03-24  Drew Adams  <address@hidden>
 
        * thingatpt.el: Support `defun'.
@@ -52,8 +66,8 @@
        (provide-theme): Ignore custom--inhibit-theme-enable.
        (load-theme): Enable the theme explicitly if NO-ENABLE is non-nil.
        (custom-enabling-themes): Delete variable.
-       (enable-theme): Accept only loaded themes as arguments.  Ignore
-       the special custom-enabled-themes variable.
+       (enable-theme): Accept only loaded themes as arguments.
+       Ignore the special custom-enabled-themes variable.
        (custom-enabled-themes): Forbid themes from setting this.
        Eliminate use of custom-enabling-themes.
        (custom-push-theme): Quote "changed" custom var entry.
@@ -390,8 +404,8 @@
 
 2011-03-09  Michael Albinus  <address@hidden>
 
-       * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Do
-       not use `tramp-file-name-port', because this returns also
+       * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band):
+       Do not use `tramp-file-name-port', because this returns also
        `tramp-default-port'.
 
 2011-03-09  Deniz Dogan  <address@hidden>
@@ -420,8 +434,8 @@
        * emacs-lisp/package.el (package-tar-file-info): Handle also
        remote files.
 
-       * emacs-lisp/package-x.el (package-upload-buffer-internal): Use
-       `equal' for upload base check.
+       * emacs-lisp/package-x.el (package-upload-buffer-internal):
+       Use `equal' for upload base check.
 
 2011-03-08  Arni Magnusson  <address@hidden>  (tiny change)
 
@@ -750,9 +764,9 @@
 2011-03-03  Christian Ohler  <address@hidden>
 
        * emacs-lisp/ert.el (ert--explain-equal): New function.
-       (ert--explain-equal-rec): Renamed from `ert--explain-not-equal'.
+       (ert--explain-equal-rec): Rename from `ert--explain-not-equal'.
        All callers changed.
-       (ert--explain-equal-including-properties): Renamed from
+       (ert--explain-equal-including-properties): Rename from
        `ert--explain-not-equal-including-properties'.  All callers
        changed.
 
@@ -8275,8 +8289,8 @@
 
        Sync with Tramp 2.1.19.
 
-       * net/tramp-gvfs.el (tramp-gvfs-handle-write-region): Protect
-       deleting tmpfile.
+       * net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
+       Protect deleting tmpfile.
        (tramp-gvfs-maybe-open-connection): Use `tramp-compat-funcall'.
 
        * net/tramp.el (tramp-handle-expand-file-name)
@@ -10554,8 +10568,8 @@
        * net/tramp-ftp.el (tramp-ftp-file-name-handler):
        Use `delete-file' instead of `tramp-compat-delete-file'.
 
-       * net/tramp-gvfs.el (tramp-gvfs-handle-write-region): Use
-       `delete-file' instead of `tramp-compat-delete-file'.
+       * net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
+       Use `delete-file' instead of `tramp-compat-delete-file'.
 
        * net/tramp-imap.el (tramp-imap-do-copy-or-rename-file):
        Use `delete-file' instead of `tramp-compat-delete-file'.

=== modified file 'lisp/comint.el'
--- a/lisp/comint.el    2011-01-25 04:08:28 +0000
+++ b/lisp/comint.el    2011-03-24 22:05:01 +0000
@@ -368,7 +368,7 @@
 (defvar comint-dynamic-complete-functions
   '(comint-replace-by-expanded-history comint-dynamic-complete-filename)
   "List of functions called to perform completion.
-Functions should return non-nil if completion was performed.
+Works like `completion-at-point-functions'.
 See also `comint-dynamic-complete'.
 
 This is a good thing to set in mode hooks.")
@@ -1008,7 +1008,6 @@
       (message "No history")
     (let ((history nil)
          (history-buffer " *Input History*")
-         (index (1- (ring-length comint-input-ring)))
          (conf (current-window-configuration)))
       ;; We have to build up a list ourselves from the ring vector.
       (dotimes (index (ring-length comint-input-ring))
@@ -2946,13 +2945,22 @@
              (setq name (replace-match env-var-val t t name))))))
     name))
 
+(defun comint--match-partial-filename ()
+  "Return the filename at point as-is, or nil if none is found.
+See `comint-word'."
+  (comint-word comint-file-name-chars))
+
+(defun comint--unquote&expand-filename (filename)
+  ;; FIXME: The code below does unquote-then-expand which means that "\\$HOME"
+  ;; gets expanded to the same as "$HOME"
+  (comint-substitute-in-file-name
+   (comint-unquote-filename filename)))
+
 (defun comint-match-partial-filename ()
-  "Return the filename at point, or nil if none is found.
+  "Return the unquoted&expanded filename at point, or nil if none is found.
 Environment variables are substituted.  See `comint-word'."
-  (let ((filename (comint-word comint-file-name-chars)))
-    (and filename (comint-substitute-in-file-name
-                  (comint-unquote-filename filename)))))
-
+  (let ((filename (comint--match-partial-filename)))
+    (and filename (comint--unquote&expand-filename filename))))
 
 (defun comint-quote-filename (filename)
   "Return FILENAME with magic characters quoted.
@@ -2987,13 +2995,13 @@
 completion until a function returns non-nil, at which point completion is
 assumed to have occurred."
   (interactive)
-  (run-hook-with-args-until-success 'comint-dynamic-complete-functions))
+  (let ((completion-at-point-functions comint-dynamic-complete-functions))
+    (completion-at-point)))
 
 
 (defun comint-dynamic-complete-filename ()
   "Dynamically complete the filename at point.
-Completes if after a filename.  See `comint-match-partial-filename' and
-`comint-dynamic-complete-as-filename'.
+Completes if after a filename.
 This function is similar to `comint-replace-by-expanded-filename', except that
 it won't change parts of the filename already entered in the buffer; it just
 adds completion characters to the end of the filename.  A completions listing
@@ -3005,7 +3013,7 @@
 
 Returns t if successful."
   (interactive)
-  (when (comint-match-partial-filename)
+  (when (comint--match-partial-filename)
     (unless (window-minibuffer-p (selected-window))
       (message "Completing file name..."))
     (comint-dynamic-complete-as-filename)))
@@ -3021,18 +3029,12 @@
         ;;(file-name-handler-alist nil)
         (minibuffer-p (window-minibuffer-p (selected-window)))
         (success t)
-        (dirsuffix (cond ((not comint-completion-addsuffix)
-                          "")
-                         ((not (consp comint-completion-addsuffix))
-                          "/")
-                         (t
-                          (car comint-completion-addsuffix))))
-        (filesuffix (cond ((not comint-completion-addsuffix)
-                           "")
-                          ((not (consp comint-completion-addsuffix))
-                           " ")
-                          (t
-                           (cdr comint-completion-addsuffix))))
+        (dirsuffix (cond ((not comint-completion-addsuffix) "")
+                         ((not (consp comint-completion-addsuffix)) "/")
+                         (t (car comint-completion-addsuffix))))
+        (filesuffix (cond ((not comint-completion-addsuffix) "")
+                          ((not (consp comint-completion-addsuffix)) " ")
+                          (t (cdr comint-completion-addsuffix))))
         (filename (comint-match-partial-filename))
         (filename-beg (if filename (match-beginning 0) (point)))
         (filename-end (if filename (match-end 0) (point)))

=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el        2011-03-21 14:55:00 +0000
+++ b/lisp/minibuffer.el        2011-03-24 22:05:01 +0000
@@ -688,6 +688,8 @@
         (t     t)))))
 
 (defun completion--flush-all-sorted-completions (&rest ignore)
+  (remove-hook 'after-change-functions
+               'completion--flush-all-sorted-completions t)
   (setq completion-cycling nil)
   (setq completion-all-sorted-completions nil))
 
@@ -1242,6 +1244,8 @@
   (assert (<= start (point)) (<= (point) end))
   ;; FIXME: undisplay the *Completions* buffer once the completion is done.
   (with-wrapper-hook
+      ;; FIXME: Maybe we should use this hook to provide a "display
+      ;; completions" operation as well.
       completion-in-region-functions (start end collection predicate)
     (let ((minibuffer-completion-table collection)
           (minibuffer-completion-predicate predicate)
@@ -1253,7 +1257,9 @@
 
 (defvar completion-at-point-functions '(tags-completion-at-point-function)
   "Special hook to find the completion table for the thing at point.
-It is called without any argument and should return either nil,
+Each function on this hook is called in turns without any argument and should
+return either nil to mean that it is not applicable at point,
+or t to mean that it already performed completion (discouraged),
 or a function of no argument to perform completion (discouraged),
 or a list of the form (START END COLLECTION &rest PROPS) where
  START and END delimit the entity to complete and should include point,
@@ -1271,7 +1277,7 @@
               'completion-at-point-functions)))
     (cond
      ((functionp res) (funcall res))
-     (res
+     ((consp res)
       (let* ((plist (nthcdr 3 res))
              (start (nth 0 res))
              (end (nth 1 res))
@@ -1279,7 +1285,8 @@
               (or (plist-get plist :annotation-function)
                   completion-annotate-function)))
         (completion-in-region start end (nth 2 res)
-                              (plist-get plist :predicate)))))))
+                              (plist-get plist :predicate))))
+     (res))))  ;Maybe completion already happened and the function returned t.
 
 ;;; Key bindings.