* lisp/files.el (cd): Make completion obey cd-path.

* lread.c (Qdir_ok): New constant.
(syms_of_lread): Initialize it.
(openp): Don't ignore directories if the predicate returns dir-ok.

Fixes: debbugs:7924

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f5d7d63cb6fc7dc3122900841c235d1cc128eda8..f65ec67e7b8e940cea76da3f1a4c7d81569e68b1 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2011-02-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * files.el (cd): Make completion obey cd-path (bug#7924).
+
 2011-02-18  Glenn Morris  <rgm@gnu.org>
 
        * progmodes/prolog.el: Don't require compile when compiling.

diff --git a/lisp/files.el b/lisp/files.el
index 2d3dbc67d728f97d5364d6dcb8fb35d3c5433356..fdbfe13b6713b3abe9fc82be23cf2b3606f99fac 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -681,26 +681,37 @@ that list of directories (separated by occurrences of
 `path-separator') when resolving a relative directory name.
 The path separator is colon in GNU and GNU-like systems."
   (interactive
-   (list (read-directory-name "Change default directory: "
-                        default-directory default-directory
-                        (and (member cd-path '(nil ("./")))
-                             (null (getenv "CDPATH"))))))
-  (if (file-name-absolute-p dir)
-      (cd-absolute (expand-file-name dir))
-    (if (null cd-path)
-       (let ((trypath (parse-colon-path (getenv "CDPATH"))))
-         (setq cd-path (or trypath (list "./")))))
-    (if (not (catch 'found
-              (mapc
-               (function (lambda (x)
-                           (let ((f (expand-file-name (concat x dir))))
-                             (if (file-directory-p f)
-                                 (progn
-                                   (cd-absolute f)
-                                   (throw 'found t))))))
-               cd-path)
-              nil))
-       (error "No such directory found via CDPATH environment variable"))))
+   (list
+    ;; FIXME: There's a subtle bug in the completion below.  Seems linked
+    ;; to a fundamental difficulty of implementing `predicate' correctly.
+    ;; The manifestation is that TAB may list non-directories in the case where
+    ;; those files also correspond to valid directories (if your cd-path is (A/
+    ;; B/) and you have A/a a file and B/a a directory, then both `a' and `a/'
+    ;; will be listed as valid completions).
+    ;; This is because `a' (listed because of A/a) is indeed a valid choice
+    ;; (which will lead to the use of B/a).
+    (minibuffer-with-setup-hook
+        (lambda ()
+          (setq minibuffer-completion-table
+                (apply-partially #'locate-file-completion-table
+                                 cd-path nil))
+          (setq minibuffer-completion-predicate
+                (lambda (dir)
+                  (locate-file dir cd-path nil
+                               (lambda (f) (and (file-directory-p f) 'dir-ok))))))
+      (unless cd-path
+        (setq cd-path (or (parse-colon-path (getenv "CDPATH"))
+                          (list "./"))))
+      (read-directory-name "Change default directory: "
+                           default-directory default-directory
+                           t))))
+  (unless cd-path
+    (setq cd-path (or (parse-colon-path (getenv "CDPATH"))
+                      (list "./"))))
+  (cd-absolute
+   (or (locate-file dir cd-path nil
+                    (lambda (f) (and (file-directory-p f) 'dir-ok)))
+       (error "No such directory found via CDPATH environment variable"))))
 
 (defun load-file (file)
   "Load the Lisp file named FILE."
@@ -720,9 +731,12 @@ If SUFFIXES is non-nil, it should be a list of suffixes to append to
 file name when searching.  If SUFFIXES is nil, it is equivalent to '(\"\").
 Use '(\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
 If non-nil, PREDICATE is used instead of `file-readable-p'.
+
+This function will normally skip directories, so if you want it to find
+directories, make sure the PREDICATE function returns `dir-ok' for them.
+
 PREDICATE can also be an integer to pass to the `access' system call,
 in which case file-name handlers are ignored.  This usage is deprecated.
-
 For compatibility, PREDICATE can also be one of the symbols
 `executable', `readable', `writable', or `exists', or a list of
 one or more of those symbols."

diff --git a/src/ChangeLog b/src/ChangeLog
index 72a9287513de4668062fbf8029da4e61aabf7782..9839c7fcc9839ca0a06e9c2919dff96fa00183f0 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2011-02-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * lread.c (Qdir_ok): New constant.
+       (syms_of_lread): Initialize it.
+       (openp): Don't ignore directories if the predicate returns dir-ok.
+
 2011-02-18  Eli Zaretskii  <eliz@gnu.org>
 
        * xdisp.c (display_line): Fix the change made for bug#7939.

diff --git a/src/lread.c b/src/lread.c
index 7e410fcc33440b2646f6ee6e86e01b2c0254c4e3..855869cd90de4b57c0341f9a9d09e2009e5b4ec4 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -1250,7 +1250,9 @@ If SUFFIXES is non-nil, it should be a list of suffixes to append to
 file name when searching.
 If non-nil, PREDICATE is used instead of `file-readable-p'.
 PREDICATE can also be an integer to pass to the access(2) function,
-in which case file-name-handlers are ignored.  */)
+in which case file-name-handlers are ignored.
+This function will normally skip directories, so if you want it to find
+directories, make sure the PREDICATE function returns `dir-ok' for them.  */)
   (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
 {
   Lisp_Object file;
@@ -1260,6 +1262,7 @@ in which case file-name-handlers are ignored.  */)
   return file;
 }
 
+static Lisp_Object Qdir_ok;
 
 /* Search for a file whose name is STR, looking in directories
    in the Lisp list PATH, and trying suffixes from SUFFIX.
@@ -1377,9 +1380,12 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
              if (NILP (predicate))
                exists = !NILP (Ffile_readable_p (string));
              else
-               exists = !NILP (call1 (predicate, string));
-             if (exists && !NILP (Ffile_directory_p (string)))
-               exists = 0;
+               {
+                 Lisp_Object tmp = call1 (predicate, string);
+                 exists = !NILP (tmp)
+                   && (EQ (tmp, Qdir_ok)
+                       || !NILP (Ffile_directory_p (string)));
+               }
 
              if (exists)
                {
@@ -4377,6 +4383,9 @@ to load.  See also `load-dangerous-libraries'.  */);
   Qfile_truename = intern_c_string ("file-truename");
   staticpro (&Qfile_truename) ;
 
+  Qdir_ok = intern_c_string ("dir-ok");
+  staticpro (&Qdir_ok);
+  
   Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation");
   staticpro (&Qdo_after_load_evaluation) ;