Re: Any objection to adding completing-read-function?

[Leo]

On 2010-12-28 22:03 +0000, Stefan Monnier wrote:
>> How about fixing `read-file-name-function' the same way now, so the
>> two will be symmetric?  In the vanilla Emacs sources only Ido uses
>> `read-file-name-function' at present.  3rd parties can
>> adjust accordingly.
>
> Fine by me,

Is the following patch (against 24, not touching ido.el yet) something
people have in mind? - Leo

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 8d09d5d..7038f1c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1474,8 +1474,9 @@ except that it passes the file name through 
`substitute-in-file-name'."
                             'completion--file-name-table)
   "Internal subroutine for `read-file-name'.  Do not call this.")
 
-(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-function 'read-file-name-default
+  "The function called by `read-file-name' to do its work.
+It should accept the same arguments as `read-file-name'.")
 
 (defcustom read-file-name-completion-ignore-case
   (if (memq system-type '(ms-dos windows-nt darwin cygwin))
@@ -1513,7 +1514,7 @@ such as making the current buffer visit no file in the 
case of
 (declare-function x-file-dialog "xfns.c"
                   (prompt dir &optional default-filename mustmatch only-dir-p))
 
-(defun read-file-name-defaults (&optional dir initial)
+(defun read-file-name--defaults (&optional dir initial)
   (let ((default
          (cond
           ;; With non-nil `initial', use `dir' as the first default.
@@ -1539,6 +1540,141 @@ such as making the current buffer visit no file in the 
case of
      (if (listp minibuffer-default) minibuffer-default (list 
minibuffer-default))
      (if (listp default) default (list default)))))
 
+(defun read-file-name-default (prompt &optional dir default-filename mustmatch 
initial predicate)
+  "Default method for reading file names.
+See `read-file-name' for the meaning of the arguments."
+  (unless dir (setq dir default-directory))
+  (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
+  (unless default-filename
+    (setq default-filename (if initial (expand-file-name initial dir)
+                             buffer-file-name)))
+  ;; If dir starts with user's homedir, change that to ~.
+  (setq dir (abbreviate-file-name dir))
+  ;; Likewise for default-filename.
+  (if default-filename
+      (setq default-filename
+           (if (consp default-filename)
+               (mapcar 'abbreviate-file-name default-filename)
+             (abbreviate-file-name default-filename))))
+  (let ((insdef (cond
+                 ((and insert-default-directory (stringp dir))
+                  (if initial
+                      (cons (minibuffer--double-dollars (concat dir initial))
+                            (length (minibuffer--double-dollars dir)))
+                    (minibuffer--double-dollars dir)))
+                 (initial (cons (minibuffer--double-dollars initial) 0)))))
+    
+    (let ((completion-ignore-case read-file-name-completion-ignore-case)
+         (minibuffer-completing-file-name t)
+         (pred (or predicate 'file-exists-p))
+         (add-to-history nil))
+
+      (let* ((val
+             (if (or (not (next-read-file-uses-dialog-p))
+                     ;; Graphical file dialogs can't handle remote
+                     ;; files (Bug#99).
+                     (file-remote-p dir))
+                 ;; We used to pass `dir' to `read-file-name-internal' by
+                 ;; abusing the `predicate' argument.  It's better to
+                 ;; just use `default-directory', but in order to avoid
+                 ;; changing `default-directory' in the current buffer,
+                 ;; we don't let-bind it.
+                 (lexical-let ((dir (file-name-as-directory
+                                     (expand-file-name dir))))
+                   (minibuffer-with-setup-hook
+                       (lambda ()
+                         (setq default-directory dir)
+                         ;; When the first default in `minibuffer-default'
+                         ;; duplicates initial input `insdef',
+                         ;; reset `minibuffer-default' to nil.
+                         (when (equal (or (car-safe insdef) insdef)
+                                      (or (car-safe minibuffer-default)
+                                          minibuffer-default))
+                           (setq minibuffer-default
+                                 (cdr-safe minibuffer-default)))
+                         ;; On the first request on `M-n' fill
+                         ;; `minibuffer-default' with a list of defaults
+                         ;; relevant for file-name reading.
+                         (set (make-local-variable 
'minibuffer-default-add-function)
+                              (lambda ()
+                                (with-current-buffer
+                                    (window-buffer 
(minibuffer-selected-window))
+                                  (read-file-name--defaults dir initial)))))
+                     (completing-read prompt 'read-file-name-internal
+                                      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))
+                     ;; When using a dialog, revert to nil and non-nil
+                     ;; interpretation of mustmatch. confirm options
+                     ;; need to be interpreted as nil, otherwise
+                     ;; it is impossible to create new files using
+                     ;; dialogs with the default settings.
+                     (dialog-mustmatch
+                      (not (memq mustmatch
+                                 '(nil confirm confirm-after-completion)))))
+                 (when (and (not default-filename)
+                            (not (zerop (length file))))
+                   (setq default-filename file)
+                   (setq dir (file-name-directory dir)))
+                 (when default-filename
+                   (setq default-filename
+                         (expand-file-name (if (consp default-filename)
+                                               (car default-filename)
+                                             default-filename)
+                                           dir)))
+                 (setq add-to-history t)
+                 (x-file-dialog prompt dir default-filename
+                                dialog-mustmatch
+                                (eq predicate 'file-directory-p)))))
+
+            (replace-in-history (eq (car-safe file-name-history) val)))
+       ;; If completing-read returned the inserted default string itself
+       ;; (rather than a new string with the same contents),
+       ;; it has to mean that the user typed RET with the minibuffer empty.
+       ;; In that case, we really want to return ""
+       ;; so that commands such as set-visited-file-name can distinguish.
+       (when (consp default-filename)
+         (setq default-filename (car default-filename)))
+       (when (eq val default-filename)
+         ;; In this case, completing-read has not added an element
+         ;; to the history.  Maybe we should.
+         (if (not replace-in-history)
+             (setq add-to-history t))
+         (setq val ""))
+       (unless val (error "No file name specified"))
+
+       (if (and default-filename
+                (string-equal val (if (consp insdef) (car insdef) insdef)))
+           (setq val default-filename))
+       (setq val (substitute-in-file-name val))
+
+       (if replace-in-history
+           ;; Replace what Fcompleting_read added to the history
+           ;; with what we will actually return.  As an exception,
+           ;; if that's the same as the second item in
+           ;; file-name-history, it's really a repeat (Bug#4657).
+           (let ((val1 (minibuffer--double-dollars val)))
+             (if history-delete-duplicates
+                 (setcdr file-name-history
+                         (delete val1 (cdr file-name-history))))
+             (if (string= val1 (cadr file-name-history))
+                 (pop file-name-history)
+               (setcar file-name-history val1)))
+         (if add-to-history
+             ;; Add the value to the history--but not if it matches
+             ;; the last value already there.
+             (let ((val1 (minibuffer--double-dollars val)))
+               (unless (and (consp file-name-history)
+                            (equal (car file-name-history) val1))
+                 (setq file-name-history
+                       (cons val1
+                             (if history-delete-duplicates
+                                 (delete val1 file-name-history)
+                               file-name-history)))))))
+       val))))
+
 (defun read-file-name (prompt &optional dir default-filename mustmatch initial 
predicate)
   "Read file name, prompting with PROMPT and completing in directory DIR.
 Value is not expanded---you must call `expand-file-name' yourself.
@@ -1580,140 +1716,8 @@ treated as equivalent to nil.
 
 See also `read-file-name-completion-ignore-case'
 and `read-file-name-function'."
-  (unless dir (setq dir default-directory))
-  (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
-  (unless default-filename
-    (setq default-filename (if initial (expand-file-name initial dir)
-                             buffer-file-name)))
-  ;; If dir starts with user's homedir, change that to ~.
-  (setq dir (abbreviate-file-name dir))
-  ;; Likewise for default-filename.
-  (if default-filename
-      (setq default-filename
-           (if (consp default-filename)
-               (mapcar 'abbreviate-file-name default-filename)
-             (abbreviate-file-name default-filename))))
-  (let ((insdef (cond
-                 ((and insert-default-directory (stringp dir))
-                  (if initial
-                      (cons (minibuffer--double-dollars (concat dir initial))
-                            (length (minibuffer--double-dollars dir)))
-                    (minibuffer--double-dollars dir)))
-                 (initial (cons (minibuffer--double-dollars initial) 0)))))
-
-    (if read-file-name-function
-        (funcall 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)
-            (pred (or predicate 'file-exists-p))
-            (add-to-history nil))
-
-        (let* ((val
-                (if (or (not (next-read-file-uses-dialog-p))
-                       ;; Graphical file dialogs can't handle remote
-                       ;; files (Bug#99).
-                       (file-remote-p dir))
-                    ;; We used to pass `dir' to `read-file-name-internal' by
-                    ;; abusing the `predicate' argument.  It's better to
-                    ;; just use `default-directory', but in order to avoid
-                    ;; changing `default-directory' in the current buffer,
-                    ;; we don't let-bind it.
-                    (lexical-let ((dir (file-name-as-directory
-                                        (expand-file-name dir))))
-                      (minibuffer-with-setup-hook
-                          (lambda ()
-                           (setq default-directory dir)
-                           ;; When the first default in `minibuffer-default'
-                           ;; duplicates initial input `insdef',
-                           ;; reset `minibuffer-default' to nil.
-                           (when (equal (or (car-safe insdef) insdef)
-                                        (or (car-safe minibuffer-default)
-                                            minibuffer-default))
-                             (setq minibuffer-default
-                                   (cdr-safe minibuffer-default)))
-                           ;; On the first request on `M-n' fill
-                           ;; `minibuffer-default' with a list of defaults
-                           ;; relevant for file-name reading.
-                           (set (make-local-variable 
'minibuffer-default-add-function)
-                                (lambda ()
-                                  (with-current-buffer
-                                      (window-buffer 
(minibuffer-selected-window))
-                                    (read-file-name-defaults dir initial)))))
-                        (completing-read prompt 'read-file-name-internal
-                                         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))
-                       ;; When using a dialog, revert to nil and non-nil
-                       ;; interpretation of mustmatch. confirm options
-                       ;; need to be interpreted as nil, otherwise
-                       ;; it is impossible to create new files using
-                       ;; dialogs with the default settings.
-                       (dialog-mustmatch
-                         (not (memq mustmatch
-                                    '(nil confirm confirm-after-completion)))))
-                    (when (and (not default-filename)
-                              (not (zerop (length file))))
-                      (setq default-filename file)
-                      (setq dir (file-name-directory dir)))
-                    (when default-filename
-                     (setq default-filename
-                           (expand-file-name (if (consp default-filename)
-                                                 (car default-filename)
-                                               default-filename)
-                                             dir)))
-                    (setq add-to-history t)
-                    (x-file-dialog prompt dir default-filename
-                                  dialog-mustmatch
-                                   (eq predicate 'file-directory-p)))))
-
-               (replace-in-history (eq (car-safe file-name-history) val)))
-          ;; If completing-read returned the inserted default string itself
-          ;; (rather than a new string with the same contents),
-          ;; it has to mean that the user typed RET with the minibuffer empty.
-          ;; In that case, we really want to return ""
-          ;; so that commands such as set-visited-file-name can distinguish.
-         (when (consp default-filename)
-           (setq default-filename (car default-filename)))
-          (when (eq val default-filename)
-            ;; In this case, completing-read has not added an element
-            ;; to the history.  Maybe we should.
-            (if (not replace-in-history)
-                (setq add-to-history t))
-            (setq val ""))
-          (unless val (error "No file name specified"))
-
-          (if (and default-filename
-                   (string-equal val (if (consp insdef) (car insdef) insdef)))
-              (setq val default-filename))
-          (setq val (substitute-in-file-name val))
-
-          (if replace-in-history
-              ;; Replace what Fcompleting_read added to the history
-              ;; with what we will actually return.  As an exception,
-              ;; if that's the same as the second item in
-              ;; file-name-history, it's really a repeat (Bug#4657).
-              (let ((val1 (minibuffer--double-dollars val)))
-                (if history-delete-duplicates
-                    (setcdr file-name-history
-                            (delete val1 (cdr file-name-history))))
-               (if (string= val1 (cadr file-name-history))
-                   (pop file-name-history)
-                 (setcar file-name-history val1)))
-            (if add-to-history
-                ;; Add the value to the history--but not if it matches
-                ;; the last value already there.
-                (let ((val1 (minibuffer--double-dollars val)))
-                  (unless (and (consp file-name-history)
-                               (equal (car file-name-history) val1))
-                    (setq file-name-history
-                          (cons val1
-                                (if history-delete-duplicates
-                                    (delete val1 file-name-history)
-                                  file-name-history)))))))
-          val)))))
+  (funcall read-file-name-function
+           prompt dir default-filename mustmatch initial predicate))
 
 (defun internal-complete-buffer-except (&optional buffer)
   "Perform completion on all buffers excluding BUFFER.