Re: read-directory-name, the unloved

[Antoine Levitt]

10/02/11 22:29, Antoine Levitt
> Sorry about that, there was a syntax mistake in the patch, here's the
> correct version http://pastebin.com/Z7fRevAV

I got asked by mail to post the patch on the list. There it is.

=== modified file 'lisp/dired.el'
--- lisp/dired.el       2011-02-02 16:21:52 +0000
+++ lisp/dired.el       2011-02-10 20:03:36 +0000
@@ -601,14 +601,8 @@
            (if current-prefix-arg
                (read-string "Dired listing switches: "
                             dired-listing-switches))
-           ;; If a dialog is about to be used, call read-directory-name so
-           ;; the dialog code knows we want directories.  Some dialogs can
-           ;; only select directories or files when popped up, not both.
-           (if (next-read-file-uses-dialog-p)
-               (read-directory-name (format "Dired %s(directory): " str)
-                                    nil default-directory nil)
-             (read-file-name (format "Dired %s(directory): " str)
-                             nil default-directory nil)))))
+           (read-directory-name (format "Dired %s(directory): " str)
+                                nil default-directory nil))))
 
 ;; We want to switch to a more sophisticated version of
 ;; dired-read-dir-and-switches like the following, if there is a way
=== modified file 'lisp/files.el'
--- lisp/files.el       2011-02-01 21:37:12 +0000
+++ lisp/files.el       2011-02-10 20:26:28 +0000
@@ -4776,7 +4776,7 @@
    (let* ((trashing (and delete-by-moving-to-trash
                         (null current-prefix-arg)))
          (dir (expand-file-name
-               (read-file-name
+               (read-directory-name
                 (if trashing
                     "Move directory to trash: "
                   "Delete directory: ")
@@ -4841,7 +4841,7 @@
    (let ((dir (read-directory-name
               "Copy directory: " default-directory default-directory t nil)))
      (list dir
-          (read-file-name
+          (read-directory-name
            (format "Copy directory %s to: " dir)
            default-directory default-directory nil nil)
           current-prefix-arg t)))
@@ -5539,7 +5539,7 @@
 Actions controlled by variables `list-directory-brief-switches'
 and `list-directory-verbose-switches'."
   (interactive (let ((pfx current-prefix-arg))
-                (list (read-file-name (if pfx "List directory (verbose): "
+                (list (read-directory-name (if pfx "List directory (verbose): "
                                         "List directory (brief): ")
                                       nil default-directory nil)
                       pfx)))

=== modified file 'lisp/find-file.el'
--- lisp/find-file.el   2011-01-25 04:08:28 +0000
+++ lisp/find-file.el   2011-02-10 20:29:35 +0000
@@ -494,7 +494,7 @@
 
             (setq name
                   (expand-file-name
-                   (read-file-name
+                   (read-directory-name
                     (format "Find or create %s in: " default-name)
                     default-directory default-name nil)))
 

=== modified file 'lisp/gnus/gnus-group.el'
--- lisp/gnus/gnus-group.el     2011-01-31 02:19:13 +0000
+++ lisp/gnus/gnus-group.el     2011-02-10 20:42:52 +0000
@@ -3102,7 +3102,7 @@
 directory will be used as a newsgroup.  The directory should contain
 mail messages or news articles in files that have numeric names."
   (interactive
-   (list (read-file-name "Create group from directory: ")))
+   (list (read-directory-name "Create group from directory: ")))
   (unless (file-exists-p dir)
     (error "No such directory"))
   (unless (file-directory-p dir)

=== modified file 'lisp/gnus/gnus-sum.el'
--- lisp/gnus/gnus-sum.el       2011-02-05 00:11:16 +0000
+++ lisp/gnus/gnus-sum.el       2011-02-10 20:00:09 +0000
@@ -12087,7 +12094,7 @@
                          gnus-summary-save-parts-default-mime)
                      'gnus-summary-save-parts-type-history)
         (setq gnus-summary-save-parts-last-directory
-              (read-file-name "Save to directory: "
+              (read-directory-name "Save to directory: "
                               gnus-summary-save-parts-last-directory
                               nil t))
         current-prefix-arg))

=== modified file 'lisp/gnus/gnus-uu.el'                                       
--- lisp/gnus/gnus-uu.el        2011-01-26 08:36:39 +0000                      
+++ lisp/gnus/gnus-uu.el        2011-02-10 21:03:57 +0000
@@ -366,7 +366,7 @@
   (interactive
    (list current-prefix-arg
         (file-name-as-directory
-         (read-file-name "Uudecode and save in dir: "
+         (read-directory-name "Uudecode and save in dir: "
                          gnus-uu-default-dir
                          gnus-uu-default-dir t))))
   (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
@@ -381,7 +381,7 @@
   (interactive
    (list current-prefix-arg
         (file-name-as-directory
-         (read-file-name "Unshar and save in dir: "
+         (read-directory-name "Unshar and save in dir: "
                          gnus-uu-default-dir
                          gnus-uu-default-dir t))))
   (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t))
@@ -390,12 +390,11 @@
   "Saves the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name
-         (if gnus-uu-save-separate-articles
-             "Save articles in dir: "
-           "Save articles in file: ")
-         gnus-uu-default-dir
-         gnus-uu-default-dir)))
+        (if gnus-uu-save-separate-articles
+            (read-directory-name
+             "Save articles in dir: " gnus-uu-default-dir gnus-uu-default-dir)
+          (read-file-name-name
+           "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir))))
   (setq gnus-uu-saved-article-name file)
   (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
 
@@ -404,7 +404,7 @@
   (interactive
    (list current-prefix-arg
         (file-name-as-directory
-         (read-file-name "Unbinhex and save in dir: "
+         (read-directory-name "Unbinhex and save in dir: "
                          gnus-uu-default-dir
                          gnus-uu-default-dir))))
   (setq gnus-uu-binhex-article-name
@@ -416,7 +416,7 @@
   (interactive
    (list current-prefix-arg
         (file-name-as-directory
-         (read-file-name "yEnc decode and save in dir: "
+         (read-directory-name "yEnc decode and save in dir: "
                          gnus-uu-default-dir
                          gnus-uu-default-dir))))
   (setq gnus-uu-yenc-article-name nil)
@@ -458,10 +458,11 @@
   "Saves and views the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name  (if gnus-uu-save-separate-articles
-                             "Save articles is dir: "
-                           "Save articles in file: ")
-                         gnus-uu-default-dir gnus-uu-default-dir)))
+        (if gnus-uu-save-separate-articles
+            (read-directory-name "Save articles in dir: "
+                                 gnus-uu-default-dir gnus-uu-default-dir)
+          (read-file-name "Save articles in file: "
+                          gnus-uu-default-dir gnus-uu-default-dir))))
   (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
     (gnus-uu-decode-save n file)))
 
@@ -742,7 +743,7 @@
   (interactive
    (list current-prefix-arg
         (file-name-as-directory
-         (read-file-name "Save in dir: "
+         (read-directory-name "Save in dir: "
                          gnus-uu-default-dir
                          gnus-uu-default-dir t))))
   (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article


=== modified file 'lisp/gnus/gnus.el'
--- lisp/gnus/gnus.el   2011-02-03 23:43:22 +0000
+++ lisp/gnus/gnus.el   2011-02-10 20:43:48 +0000
@@ -3263,7 +3263,7 @@
        ((= c ?d)
         (point))
        ((= c ?D)
-        (read-file-name prompt nil default-directory 'lambda))
+        (read-directory-name prompt nil default-directory 'lambda))
        ((= c ?f)
         (read-file-name prompt nil nil 'lambda))
        ((= c ?F)

=== modified file 'lisp/mh-e/mh-funcs.el'
--- lisp/mh-e/mh-funcs.el       2011-01-26 08:36:39 +0000
+++ lisp/mh-e/mh-funcs.el       2011-02-10 20:47:26 +0000
@@ -286,7 +286,7 @@
 storing the content of these messages."
   (interactive (list (let ((udir (or mh-store-default-directory
                                      default-directory)))
-                       (read-file-name "Store message in directory: "
+                       (read-directory-name "Store message in directory: "
                                        udir udir nil))))
   (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
     (with-current-buffer (get-buffer-create mh-temp-buffer)
@@ -300,7 +300,7 @@
 See `mh-store-msg' for a description of DIRECTORY."
   (interactive (list (let ((udir (or mh-store-default-directory
                                      default-directory)))
-                       (read-file-name "Store buffer in directory: "
+                       (read-directory-name "Store buffer in directory: "
                                        udir udir nil))))
   (let ((store-directory (expand-file-name directory))
         (sh-start (save-excursion

=== modified file 'lisp/mh-e/mh-mime.el'
--- lisp/mh-e/mh-mime.el        2011-01-25 04:08:28 +0000
+++ lisp/mh-e/mh-mime.el        2011-02-10 20:47:02 +0000
@@ -390,11 +390,11 @@
                     (equal nil mh-mime-save-parts-default-directory)
                     (equal t mh-mime-save-parts-default-directory))
                 (not mh-mime-save-parts-directory))
-           (read-file-name "Store in directory: " nil nil t nil))
+           (read-directory-name "Store in directory: " nil nil t))
           ((and (or prompt
                     (equal t mh-mime-save-parts-default-directory))
                 mh-mime-save-parts-directory)
-           (read-file-name (format
+           (read-directory-name (format
                             "Store in directory (default %s): "
                             mh-mime-save-parts-directory)
                            "" mh-mime-save-parts-directory t ""))

=== modified file 'lisp/net/ange-ftp.el'
--- lisp/net/ange-ftp.el        2011-01-26 08:36:39 +0000
+++ lisp/net/ange-ftp.el        2011-02-10 20:48:42 +0000
@@ -4071,7 +4071,7 @@
        (ange-ftp-get-files dir t))))
 
 (defun ange-ftp-make-directory (dir &optional parents)
-  (interactive (list (expand-file-name (read-file-name "Make directory: "))))
+  (interactive (list (expand-file-name (read-directory-name "Make directory: 
"))))
   (if parents
       (let ((parent (file-name-directory (directory-file-name dir))))
        (or (file-exists-p parent)

=== modified file 'lisp/printing.el'
--- lisp/printing.el    2011-01-25 04:08:28 +0000
+++ lisp/printing.el    2011-02-10 20:50:29 +0000
@@ -5707,8 +5707,8 @@
   (let* ((dir-name   (file-name-directory (or (buffer-file-name)
                                              default-directory)))
         (fmt-prompt (concat "%s[" mess "] Directory to print: "))
-        (dir        (read-file-name (format fmt-prompt "")
-                                    "" dir-name nil dir-name))
+        (dir        (read-directory-name (format fmt-prompt "")
+                                         "" dir-name nil dir-name))
         prompt)
     (while (cond ((not (file-directory-p dir))
                  (ding)
@@ -5718,8 +5718,8 @@
                  (setq prompt "Directory is unreadable! "))
                 (t nil))
       (setq dir-name (file-name-directory dir)
-           dir      (read-file-name (format fmt-prompt prompt)
-                                    "" dir-name nil dir-name)))
+           dir      (read-directory-name (format fmt-prompt prompt)
+                                         "" dir-name nil dir-name)))
     (file-name-as-directory dir)))
 
 

=== modified file 'lisp/progmodes/ada-prj.el'
--- lisp/progmodes/ada-prj.el   2011-01-25 04:08:28 +0000
+++ lisp/progmodes/ada-prj.el   2011-02-10 20:52:04 +0000
@@ -227,7 +227,7 @@
   ;;  the user to select a directory
   (let ((use-dialog-box nil))
     (unless file-name
-      (set 'file-name (read-file-name "Root directory: " nil nil t))))
+      (set 'file-name (read-directory-name "Root directory: " nil nil t))))
 
   (set 'ada-prj-current-values
        (plist-put ada-prj-current-values

=== modified file 'lisp/progmodes/ebnf2ps.el'
--- lisp/progmodes/ebnf2ps.el   2011-01-25 04:08:28 +0000
+++ lisp/progmodes/ebnf2ps.el   2011-02-10 20:51:25 +0000
@@ -2229,8 +2229,8 @@
 
 See also `ebnf-print-buffer'."
   (interactive
-   (list (read-file-name "Directory containing EBNF files (print): "
-                        nil default-directory)))
+   (list (read-directory-name "Directory containing EBNF files (print): "
+                             nil default-directory)))
   (ebnf-log-header "(ebnf-print-directory %S)" directory)
   (ebnf-directory 'ebnf-print-buffer directory))
 
@@ -2287,8 +2287,8 @@
 
 See also `ebnf-spool-buffer'."
   (interactive
-   (list (read-file-name "Directory containing EBNF files (spool): "
-                        nil default-directory)))
+   (list (read-directory-name "Directory containing EBNF files (spool): "
+                             nil default-directory)))
   (ebnf-log-header "(ebnf-spool-directory %S)" directory)
   (ebnf-directory 'ebnf-spool-buffer directory))
 
@@ -2340,8 +2340,8 @@
 
 See also `ebnf-eps-buffer'."
   (interactive
-   (list (read-file-name "Directory containing EBNF files (EPS): "
-                        nil default-directory)))
+   (list (read-directory-name "Directory containing EBNF files (EPS): "
+                             nil default-directory)))
   (ebnf-log-header "(ebnf-eps-directory %S)" directory)
   (ebnf-directory 'ebnf-eps-buffer directory))
 
@@ -2425,8 +2425,8 @@
 
 See also `ebnf-syntax-buffer'."
   (interactive
-   (list (read-file-name "Directory containing EBNF files (syntax): "
-                        nil default-directory)))
+   (list (read-directory-name "Directory containing EBNF files (syntax): "
+                             nil default-directory)))
   (ebnf-log-header "(ebnf-syntax-directory %S)" directory)
   (ebnf-directory 'ebnf-syntax-buffer directory))
 

=== modified file 'lisp/shell.el'
--- lisp/shell.el       2011-01-26 08:36:39 +0000
+++ lisp/shell.el       2011-02-10 20:53:34 +0000
@@ -567,9 +567,9 @@
                ;; of the current-buffer rather than of the *shell* buffer.
               (setq default-directory
                     (expand-file-name
-                     (read-file-name
+                     (read-directory-name
                       "Default directory: " default-directory default-directory
-                      t nil 'file-directory-p))))))))
+                      t nil))))))))
   (require 'ansi-color)
   (setq buffer (if (or buffer (not (derived-mode-p 'shell-mode))
                        (comint-check-proc (current-buffer)))

=== modified file 'lisp/speedbar.el'
--- lisp/speedbar.el    2011-01-26 08:36:39 +0000
+++ lisp/speedbar.el    2011-02-10 20:53:53 +0000
@@ -1614,7 +1614,7 @@
   (let ((f (speedbar-line-file)))
     (if f
        (let* ((basedir (file-name-directory f))
-              (nd (read-file-name "Create directory: "
+              (nd (read-directory-name "Create directory: "
                                   basedir)))
          ;; Make the directory
          (make-directory nd t)

=== modified file 'lisp/vc/emerge.el'
--- lisp/vc/emerge.el   2010-11-09 05:33:07 +0000
+++ lisp/vc/emerge.el   2011-02-10 20:57:29 +0000
@@ -1271,10 +1271,10 @@
 (defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir)
   (interactive
    (list
-    (read-file-name "A directory: " nil nil 'confirm)
-    (read-file-name "B directory: " nil nil 'confirm)
-    (read-file-name "Ancestor directory (null for none): " nil nil 'confirm)
-    (read-file-name "Output directory (null for none): " nil nil 'confirm)))
+    (read-directory-name "A directory: " nil nil 'confirm)
+    (read-directory-name "B directory: " nil nil 'confirm)
+    (read-directory-name "Ancestor directory (null for none): " nil nil 
'confirm)
+    (read-directory-name "Output directory (null for none): " nil nil 
'confirm)))
   ;; Check that we're not on a line
   (if (not (and (bolp) (eolp)))
       (error "There is text on this line"))

=== modified file 'lisp/vc/vc-dir.el'
--- lisp/vc/vc-dir.el   2011-02-10 19:37:42 +0000
+++ lisp/vc/vc-dir.el   2011-02-10 20:56:29 +0000
@@ -1184,9 +1184,9 @@
     ;; therefore it makes sense to always do that.
     ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
     ;; you may get a new *vc-dir* buffer, different from the original
-    (file-truename (read-file-name "VC status for directory: "
-                                   default-directory default-directory t
-                                   nil #'file-directory-p))
+    (file-truename (read-directory-name "VC status for directory: "
+                                       default-directory default-directory t
+                                       nil))
     (if current-prefix-arg
        (intern
         (completing-read

=== modified file 'lisp/vc/vc.el'
--- lisp/vc/vc.el       2011-01-29 03:12:32 +0000
+++ lisp/vc/vc.el       2011-02-10 20:56:04 +0000
@@ -1954,7 +1954,7 @@
          ;; For VC's that do not work at file level, it's pointless
          ;; to ask for a directory, branches are created at repository level.
          default-directory
-       (read-file-name "Directory: " default-directory default-directory t))
+       (read-directory-name "Directory: " default-directory default-directory 
t))
       (read-string (if current-prefix-arg "New branch name: " "New tag name: 
"))
       current-prefix-arg)))
   (message "Making %s... " (if branchp "branch" "tag"))
@@ -1980,7 +1980,7 @@
          ;; For VC's that do not work at file level, it's pointless
          ;; to ask for a directory, branches are created at repository level.
          default-directory
-       (read-file-name "Directory: " default-directory default-directory t))
+       (read-directory-name "Directory: " default-directory default-directory 
t))
       (read-string "Tag name to retrieve (default latest revisions): "))))
   (let ((update (yes-or-no-p "Update any affected buffers? "))
        (msg (if (or (not name) (string= name ""))