* minibuffer.el (completion-table-with-terminator): Properly implement

boundaries, in case `terminator' appears in the suffix.
(completion--embedded-envvar-table): Don't return boundaries if
there's no valid completion.  Simplify.
(completion-file-name-table): New completion table extracted from
completion--file-name-table.
(completion--file-name-table): Use it.
(read-file-name-predicate): Declare obsolete.
(read-file-name): Use the pred arg i.s.o read-file-name-predicate.
* vc-bzr.el (vc-bzr-revision-completion-table): Use the new
completion-file-name-table, and use the `pred' argument.
* files.el (locate-file-completion-table): Use the `pred' arg rather
than read-file-name-predicate.
(abbreviate-file-name): Use \` rather than ^ for BOS.

5 files changed, 167 insertions, 86 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 4d8778b10b0..ff31476fb57 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -256,6 +256,11 @@ Command*'.
 
 * Lisp changes in Emacs 23.2
 
+** read-file-name-predicate is obsolete.  It was used to pass the predicate
+to read-file-name-internal because read-file-name-internal abused its `pred'
+argument to pass the current directory, but this hack is not needed
+any more.
+
 ** completion-base-size is obsoleted by completion-base-position.
 This change causes a few backward incompatibilities, mostly with
 choose-completion-string-functions where the `mini-p' argument has
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4834d05c570..ce126ee434f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,20 @@
+2009-10-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * minibuffer.el (completion-table-with-terminator): Properly implement
+        boundaries, in case `terminator' appears in the suffix.
+        (completion--embedded-envvar-table): Don't return boundaries if
+        there's no valid completion.  Simplify.
+        (completion-file-name-table): New completion table extracted from
+        completion--file-name-table.
+        (completion--file-name-table): Use it.
+        (read-file-name-predicate): Declare obsolete.
+        (read-file-name): Use the pred arg i.s.o read-file-name-predicate.
+        * vc-bzr.el (vc-bzr-revision-completion-table): Use the new
+        completion-file-name-table, and use the `pred' argument.
+        * files.el (locate-file-completion-table): Use the `pred' arg rather
+        than read-file-name-predicate.
+        (abbreviate-file-name): Use \` rather than ^ for BOS.
+
 2009-10-21  Dan Nicolaescu  <dann@ics.uci.edu>
 
         * vc.el (vc-deduce-fileset): Undo previous change, do not tell
diff --git a/lisp/files.el b/lisp/files.el
index 9bb4d757dfe..ce9791fdaae 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -728,8 +728,10 @@ one or more of those symbols."
   "Do completion for file names passed to `locate-file'."
   (cond
    ((file-name-absolute-p string)
-    (let ((read-file-name-predicate pred))
-      (read-file-name-internal string nil action)))
+    ;; FIXME: maybe we should use completion-file-name-table instead,
+    ;; tho at least for `load', the arg is passed through
+    ;; substitute-in-file-name for historical reasons.
+    (read-file-name-internal string pred action))
    ((eq (car-safe action) 'boundaries)
     (let ((suffix (cdr action)))
       (list* 'boundaries
@@ -1603,7 +1605,7 @@ home directory is a root directory) and removes automounter prefixes
       (or abbreviated-home-dir
           (setq abbreviated-home-dir
                 (let ((abbreviated-home-dir "$foo"))
-                  (concat "^" (abbreviate-file-name (expand-file-name "~"))
+                  (concat "\\`" (abbreviate-file-name (expand-file-name "~"))
                           "\\(/\\|\\'\\)"))))
 
       ;; If FILENAME starts with the abbreviated homedir,
@@ -1614,9 +1616,7 @@ home directory is a root directory) and removes automounter prefixes
                          (= (aref filename 0) ?/)))
                ;; MS-DOS root directories can come with a drive letter;
                ;; Novell Netware allows drive letters beyond `Z:'.
-               (not (and (or (eq system-type 'ms-dos)
-                             (eq system-type 'cygwin)
-                             (eq system-type 'windows-nt))
+               (not (and (memq system-type '(ms-dos windows-nt cygwin))
                          (save-match-data
                            (string-match "^[a-zA-`]:/$" filename)))))
           (setq filename
@@ -1643,8 +1643,7 @@ If there is no such live buffer, return nil."
           (when (and buf (funcall predicate buf)) buf))
         (let ((list (buffer-list)) found)
           (while (and (not found) list)
-            (save-excursion
-              (set-buffer (car list))
+            (with-current-buffer (car list)
               (if (and buffer-file-name
                        (string= buffer-file-truename truename)
                        (funcall predicate (current-buffer)))
@@ -4834,7 +4833,7 @@ non-nil, it is called instead of rereading visited file contents."
                                         file-name)))
                (run-hooks 'before-revert-hook)
                ;; If file was backed up but has changed since,
-               ;; we shd make another backup.
+               ;; we should make another backup.
                (and (not auto-save-p)
                     (not (verify-visited-file-modtime (current-buffer)))
                     (setq buffer-backed-up nil))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index c8bb26002af..2024a5bd7d1 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -37,26 +37,39 @@
 ;;   it should only lists the ones that `try-completion' would consider.
 ;;   E.g.  it should honor completion-ignored-extensions.
 ;; - choose-completion can't automatically figure out the boundaries
-;;   corresponding to the displayed completions.  `base-size' gives the left
-;;   boundary, but not the righthand one.  So we need to add
-;;   completion-extra-size.
+;;   corresponding to the displayed completions because we only
+;;   provide the start info but not the end info in
+;;   completion-base-position.
+;; - choose-completion doesn't know how to quote the text it inserts.
+;;   E.g. it fails to double the dollars in file-name completion, or
+;;   to backslash-escape spaces and other chars in comint completion.
+;; - C-x C-f ~/*/sr ? should not list "~/./src".
+;; - minibuffer-force-complete completes ~/src/emacs/t<!>/lisp/minibuffer.el
+;;   to ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
 
 ;;; Todo:
 
 ;; - make partial-complete-mode obsolete:
 ;;   - (?) <foo.h> style completion for file names.
-
-;; - case-sensitivity is currently confuses two issues:
+;;     This can't be done identically just by tweaking completion,
+;;     because partial-completion-mode's behavior is to expand <string.h>
+;;     to /usr/include/string.h only when exiting the minibuffer, at which
+;;     point the completion code is actually not involved normally.
+;;     Partial-completion-mode does it via a find-file-not-found-function.
+;;   - special code for C-x C-f <> to visit the file ref'd at point
+;;     via (require 'foo) or #include "foo".  ffap seems like a better
+;;     place for this feature (supplemented with major-mode-provided
+;;     functions to find the file ref'd at point).
+
+;; - case-sensitivity currently confuses two issues:
 ;;   - whether or not a particular completion table should be case-sensitive
-;;     (i.e. whether strings that different only by case are semantically
+;;     (i.e. whether strings that differ only by case are semantically
 ;;     equivalent)
 ;;   - whether the user wants completion to pay attention to case.
 ;;   e.g. we may want to make it possible for the user to say "first try
 ;;   completion case-sensitively, and if that fails, try to ignore case".
 
-;; - make lisp-complete-symbol and sym-comp use it.
 ;; - add support for ** to pcm.
-;; - Make read-file-name-predicate obsolete.
 ;; - Add vc-file-name-completion-table to read-file-name-internal.
 ;; - A feature like completing-help.el.
 ;; - make lisp/complete.el obsolete.
@@ -182,12 +195,29 @@ You should give VAR a non-nil `risky-local-variable' property."
        (t comp)))))
 
 (defun completion-table-with-terminator (terminator table string pred action)
+  "Construct a completion table like TABLE but with an extra TERMINATOR.
+This is meant to be called in a curried way by first passing TERMINATOR
+and TABLE only (via `apply-partially').
+TABLE is a completion table, and TERMINATOR is a string appended to TABLE's
+completion if it is complete.  TERMINATOR is also used to determine the
+completion suffix's boundary."
   (cond
+   ((eq (car-safe action) 'boundaries)
+    (let* ((suffix (cdr action))
+           (bounds (completion-boundaries string table pred suffix))
+           (max (string-match (regexp-quote terminator) suffix)))
+      (list* 'boundaries (car bounds)
+             (min (cdr bounds) (or max (length suffix))))))
    ((eq action nil)
     (let ((comp (try-completion string table pred)))
       (if (eq comp t)
           (concat string terminator)
         (if (and (stringp comp)
+                 ;; FIXME: Try to avoid this second call, especially since
+                 ;; it may be very inefficient (because `comp' made us
+                 ;; jump to a new boundary, so we complete in that
+                 ;; boundary with an empty start string).
+                 ;; completion-boundaries might help.
                  (eq (try-completion comp table pred) t))
             (concat comp terminator)
           comp))))
@@ -232,6 +262,8 @@ Note: TABLE needs to be a proper completion table which obeys predicates."
 
 (defun completion-table-in-turn (&rest tables)
   "Create a completion table that tries each table in TABLES in turn."
+  ;; FIXME: the boundaries may come from TABLE1 even when the completion list
+  ;; is returned by TABLE2 (because TABLE1 returned an empty list).
   (lexical-let ((tables tables))
     (lambda (string pred action)
       (completion--some (lambda (table)
@@ -533,6 +565,8 @@ scroll the window of possible completions."
 Repeated uses step through the possible completions."
   (interactive)
   ;; FIXME: Need to deal with the extra-size issue here as well.
+  ;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
+  ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
   (let* ((start (field-beginning))
          (end (field-end))
          (all (completion-all-sorted-completions)))
@@ -1026,19 +1060,26 @@ variables.")
           "$\\([[:alnum:]_]*\\|{\\([^}]*\\)\\)\\'"))
 
 (defun completion--embedded-envvar-table (string pred action)
-  (if (eq (car-safe action) 'boundaries)
-      ;; Compute the boundaries of the subfield to which this
-      ;; completion applies.
-      (let ((suffix (cdr action)))
-        (if (string-match completion--embedded-envvar-re string)
-            (list* 'boundaries
-                   (or (match-beginning 2) (match-beginning 1))
-                   (when (string-match "[^[:alnum:]_]" suffix)
-                     (match-beginning 0)))))
-    (when (string-match completion--embedded-envvar-re string)
-      (let* ((beg (or (match-beginning 2) (match-beginning 1)))
-             (table (completion--make-envvar-table))
-             (prefix (substring string 0 beg)))
+  (when (string-match completion--embedded-envvar-re string)
+    (let* ((beg (or (match-beginning 2) (match-beginning 1)))
+           (table (completion--make-envvar-table))
+           (prefix (substring string 0 beg)))
+      (if (eq (car-safe action) 'boundaries)
+          ;; Only return boundaries if there's something to complete,
+          ;; since otherwise when we're used in
+          ;; completion-table-in-turn, we could return boundaries and
+          ;; let some subsequent table return a list of completions.
+          ;; FIXME: Maybe it should rather be fixed in
+          ;; completion-table-in-turn instead, but it's difficult to
+          ;; do it efficiently there.
+          (when (try-completion prefix table pred)
+            ;; Compute the boundaries of the subfield to which this
+            ;; completion applies.
+            (let ((suffix (cdr action)))
+              (list* 'boundaries
+                     (or (match-beginning 2) (match-beginning 1))
+                     (when (string-match "[^[:alnum:]_]" suffix)
+                       (match-beginning 0)))))
         (if (eq (aref string (1- beg)) ?{)
             (setq table (apply-partially 'completion-table-with-terminator
                                          "}" table)))
@@ -1048,75 +1089,102 @@ variables.")
           (completion-table-with-context
            prefix table (substring string beg) pred action))))))
 
-(defun completion--file-name-table (string pred action)
-  "Internal subroutine for `read-file-name'.  Do not call this."
+(defun completion-file-name-table (string pred action)
+  "Completion table for file names."
+  (ignore-errors
   (cond
-   ((and (zerop (length string)) (eq 'lambda action))
-    nil)                                ; FIXME: why?
    ((eq (car-safe action) 'boundaries)
-    ;; FIXME: Actually, this is not always right in the presence of
-    ;; envvars, but there's not much we can do, I think.
     (let ((start (length (file-name-directory string)))
           (end (string-match-p "/" (cdr action))))
       (list* 'boundaries start end)))
 
+     ((eq action 'lambda)
+      (if (zerop (length string))
+          nil    ;Not sure why it's here, but it probably doesn't harm.
+        (funcall (or pred 'file-exists-p) string)))
+
    (t
-    (let* ((dir (if (stringp pred)
-                    ;; It used to be that `pred' was abused to pass `dir'
-                    ;; as an argument.
-                    (prog1 (expand-file-name pred) (setq pred nil))
-                  default-directory))
-           (str (condition-case nil
-                    (substitute-in-file-name string)
-                  (error string)))
-           (name (file-name-nondirectory str))
-           (specdir (file-name-directory str))
-           (realdir (if specdir (expand-file-name specdir dir)
-                      (file-name-as-directory dir))))
+      (let* ((name (file-name-nondirectory string))
+             (specdir (file-name-directory string))
+             (realdir (or specdir default-directory)))
 
       (cond
        ((null action)
-        (let ((comp (file-name-completion name realdir
-                                          read-file-name-predicate)))
-          (cond
-           ((stringp comp)
-            ;; Requote the $s before returning the completion.
-            (minibuffer--double-dollars (concat specdir comp)))
-           (comp
-            ;; Requote the $s before checking for changes.
-            (setq str (minibuffer--double-dollars str))
-            (if (string-equal string str)
-                comp
-              ;; If there's no real completion, but substitute-in-file-name
-              ;; changed the string, then return the new string.
-              str)))))
+          (let ((comp (file-name-completion name realdir pred)))
+            (if (stringp comp)
+                (concat specdir comp)
+              comp)))
 
        ((eq action t)
         (let ((all (file-name-all-completions name realdir)))
 
           ;; Check the predicate, if necessary.
-          (unless (memq read-file-name-predicate '(nil file-exists-p))
+            (unless (memq pred '(nil file-exists-p))
             (let ((comp ())
                   (pred
-                   (if (eq read-file-name-predicate 'file-directory-p)
+                     (if (eq pred 'file-directory-p)
                        ;; Brute-force speed up for directory checking:
                        ;; Discard strings which don't end in a slash.
                        (lambda (s)
                          (let ((len (length s)))
                            (and (> len 0) (eq (aref s (1- len)) ?/))))
                      ;; Must do it the hard (and slow) way.
-                     read-file-name-predicate)))
-              (let ((default-directory realdir))
+                       pred)))
+                (let ((default-directory (expand-file-name realdir)))
                 (dolist (tem all)
                   (if (funcall pred tem) (push tem comp))))
               (setq all (nreverse comp))))
 
-          all))
+            all))))))))
+
+(defvar read-file-name-predicate nil
+  "Current predicate used by `read-file-name-internal'.")
+(make-obsolete-variable 'read-file-name-predicate
+                        "use the regular PRED argument" "23.2")
+
+(defun completion--file-name-table (string pred action)
+  "Internal subroutine for `read-file-name'.  Do not call this.
+This is a completion table for file names, like `completion-file-name-table'
+except that it passes the file name through `substitute-in-file-name'."
+  (cond
+   ((eq (car-safe action) 'boundaries)
+    ;; For the boundaries, we can't really delegate to
+    ;; completion-file-name-table and then fix them up, because it
+    ;; would require us to track the relationship between `str' and
+    ;; `string', which is difficult.  And in any case, if
+    ;; substitute-in-file-name turns "fo-$TO-ba" into "fo-o/b-ba", there's
+    ;; no way for us to return proper boundaries info, because the
+    ;; boundary is not (yet) in `string'.
+    (let ((start (length (file-name-directory string)))
+          (end (string-match-p "/" (cdr action))))
+      (list* 'boundaries start end)))
 
        (t
-        ;; Only other case actually used is ACTION = lambda.
-        (let ((default-directory dir))
-          (funcall (or read-file-name-predicate 'file-exists-p) str))))))))
+    (let* ((default-directory
+             (if (stringp pred)
+                 ;; It used to be that `pred' was abused to pass `dir'
+                 ;; as an argument.
+                 (prog1 (file-name-as-directory (expand-file-name pred))
+                   (setq pred nil))
+               default-directory))
+           (str (condition-case nil
+                    (substitute-in-file-name string)
+                  (error string)))
+           (comp (completion-file-name-table
+                  str (or pred read-file-name-predicate) action)))
+
+      (cond
+       ((stringp comp)
+        ;; Requote the $s before returning the completion.
+        (minibuffer--double-dollars comp))
+       ((and (null action) comp
+             ;; Requote the $s before checking for changes.
+             (setq str (minibuffer--double-dollars str))
+             (not (string-equal string str)))
+        ;; If there's no real completion, but substitute-in-file-name
+        ;; changed the string, then return the new string.
+        str)
+       (t comp))))))
 
 (defalias 'read-file-name-internal
   (completion-table-in-turn 'completion--embedded-envvar-table
@@ -1126,9 +1194,6 @@ variables.")
 (defvar read-file-name-function nil
   "If this is non-nil, `read-file-name' does its work by calling this function.")
 
-(defvar read-file-name-predicate nil
-  "Current predicate used by `read-file-name-internal'.")
-
 (defcustom read-file-name-completion-ignore-case
   (if (memq system-type '(ms-dos windows-nt darwin cygwin))
       t nil)
@@ -1227,7 +1292,7 @@ and `read-file-name-function'."
                  prompt dir default-filename mustmatch initial predicate)
       (let ((completion-ignore-case read-file-name-completion-ignore-case)
             (minibuffer-completing-file-name t)
-            (read-file-name-predicate (or predicate 'file-exists-p))
+            (pred (or predicate 'file-exists-p))
             (add-to-history nil))
 
         (let* ((val
@@ -1242,8 +1307,8 @@ and `read-file-name-function'."
                       (minibuffer-with-setup-hook
                           (lambda () (setq default-directory dir))
                         (completing-read prompt 'read-file-name-internal
-                                         nil mustmatch insdef 'file-name-history
-                                         default-filename)))
+                                         pred mustmatch insdef
+                                         'file-name-history default-filename)))
                   ;; If DEFAULT-FILENAME not supplied and DIR contains
                   ;; a file name, split it.
                   (let ((file (file-name-nondirectory dir))
@@ -1253,9 +1318,8 @@ and `read-file-name-function'."
                         ;; it is impossible to create new files using
                         ;; dialogs with the default settings.
                         (dialog-mustmatch
-                         (and (not (eq mustmatch 'confirm))
-                              (not (eq mustmatch 'confirm-after-completion))
-                              mustmatch)))
+                         (not (memq mustmatch
+                                    '(nil confirm confirm-after-completion)))))
                     (when (and (not default-filename)
                                (not (zerop (length file))))
                       (setq default-filename file)
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index da9c97f2c17..b5118538cff 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -736,14 +736,10 @@ stream.  Standard error output is discarded."
        ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
                       string)
         (completion-table-with-context (substring string 0 (match-end 0))
-                                       ;; FIXME: only allow directories.
-                                       ;; FIXME: don't allow envvars.
-                                       'read-file-name-internal
+                                       'completion-file-name-table
                                        (substring string (match-end 0))
-                                       ;; Dropping `pred'.   Maybe we should
-                                       ;; just stash it in
-                                       ;; `read-file-name-predicate'?
-                                       nil
+                                       ;; Dropping `pred' for no good reason.
+                                       'file-directory-p
                                        action))
        ((string-match "\\`\\(before\\):" string)
         (completion-table-with-context (substring string 0 (match-end 0))