Re: find-file-read-args

[Juri Linkov]

>> Or more simply, maybe dired should be changed such that the dired window
>> is selected instead of the *Marked Files* window when the minibuffer
>> is invoked.
>
> I'm afraid this might affect `minibuffer-scroll-window' and thus the
> behavior of C-M-v in a quite non-intuitive manner.

Don't worry, I think it's quite useless to get the filename at point
from the Dired buffer when copying multiple files (i.e. when it shows
the *Marked files* window).  A list of directories would be enough.
The complete patch below avoids this problem by setting
`minibuffer-default-add-function' to nil in `dired-do-create-files'
and thus not using the filename guessing.

Index: lisp/files.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/files.el,v
retrieving revision 1.1101
diff -c -r1.1101 files.el
*** lisp/files.el       13 Nov 2009 22:19:51 -0000      1.1101
--- lisp/files.el       17 Nov 2009 09:56:31 -0000
***************
*** 1275,1283 ****
      ;;(make-frame-visible (window-frame old-window))
      ))
  
- (defvar find-file-default nil
-   "Used within `find-file-read-args'.")
- 
  (defmacro minibuffer-with-setup-hook (fun &rest body)
    "Add FUN to `minibuffer-setup-hook' while executing BODY.
  BODY should use the minibuffer at most once.
--- 1275,1280 ----
***************
*** 1298,1309 ****
         (remove-hook 'minibuffer-setup-hook ,hook)))))
  
  (defun find-file-read-args (prompt mustmatch)
!   (list (let ((find-file-default
!              (and buffer-file-name
!                   (abbreviate-file-name buffer-file-name))))
!         (minibuffer-with-setup-hook
!             (lambda () (setq minibuffer-default find-file-default))
!           (read-file-name prompt nil default-directory mustmatch)))
        t))
  
  (defun find-file (filename &optional wildcards)
--- 1295,1301 ----
         (remove-hook 'minibuffer-setup-hook ,hook)))))
  
  (defun find-file-read-args (prompt mustmatch)
!   (list (read-file-name prompt nil default-directory mustmatch)
        t))
  
  (defun find-file (filename &optional wildcards)
***************
*** 2020,2026 ****
  In a Lisp program, if you want to be sure of accessing a file's
  contents literally, you should create a temporary buffer and then read
  the file contents into it using `insert-file-contents-literally'."
!   (interactive "FFind file literally: ")
    (switch-to-buffer (find-file-noselect filename nil t)))
  
  (defvar after-find-file-from-revert-buffer nil)
--- 2012,2021 ----
  In a Lisp program, if you want to be sure of accessing a file's
  contents literally, you should create a temporary buffer and then read
  the file contents into it using `insert-file-contents-literally'."
!   (interactive
!    (list (read-file-name
!         "Find file literally: " nil default-directory
!         (confirm-nonexistent-file-or-buffer))))
    (switch-to-buffer (find-file-noselect filename nil t)))
  
  (defvar after-find-file-from-revert-buffer nil)

Index: lisp/dired.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/dired.el,v
retrieving revision 1.443
diff -c -r1.443 dired.el
*** lisp/dired.el       15 Nov 2009 16:23:11 -0000      1.443
--- lisp/dired.el       17 Nov 2009 09:57:27 -0000
***************
*** 599,610 ****
            (if (next-read-file-uses-dialog-p)
                (read-directory-name (format "Dired %s(directory): " str)
                                     nil default-directory nil)
!             (let ((default (and buffer-file-name
!                                 (abbreviate-file-name buffer-file-name))))
!               (minibuffer-with-setup-hook
!                   (lambda () (setq minibuffer-default default))
!                 (read-file-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
--- 599,606 ----
            (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)))))
  
  ;; We want to switch to a more sophisticated version of
  ;; dired-read-dir-and-switches like the following, if there is a way

Index: lisp/minibuffer.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/minibuffer.el,v
retrieving revision 1.96
diff -c -r1.96 minibuffer.el
*** lisp/minibuffer.el  12 Nov 2009 23:10:06 -0000      1.96
--- lisp/minibuffer.el  17 Nov 2009 09:57:32 -0000
***************
*** 1253,1258 ****
--- 1253,1310 ----
  ;; Not always defined, but only called if next-read-file-uses-dialog-p says 
so.
  (declare-function x-file-dialog "xfns.c"
                    (prompt dir &optional default-filename mustmatch 
only-dir-p))
+ (declare-function dired-get-filename "dired" (&optional localp 
no-error-if-not-filep))
+ 
+ (defun read-file-name-defaults (&optional dir initial)
+   (let ((default
+         (cond
+          ;; With non-nil `initial', use `dir' as the first default.
+          ;; Essentially, this mean reversing the normal order of the
+          ;; current directory name and the current file name, i.e.
+          ;; 1. with normal file reading:
+          ;; 1.1. initial input is the current directory
+          ;; 1.2. the first default is the current file name
+          ;; 2. with non-nil `initial' (for `find-alternate-file'):
+          ;; 2.2. initial input is the current file name
+          ;; 2.1. the first default is the current directory
+          (initial (abbreviate-file-name dir))
+          ;; In file buffers, try to get the current file name
+          (buffer-file-name
+           (abbreviate-file-name buffer-file-name))
+          ;; In Dired, get file name from the current line.
+          ((eq major-mode 'dired-mode)
+           (let ((filename (dired-get-filename nil t)))
+             (when filename
+               (if (file-directory-p filename)
+                   (file-name-as-directory (abbreviate-file-name filename))
+                 (abbreviate-file-name filename)))))))
+       (filename-at-point
+        (cond
+         ((fboundp 'ffap-guesser)
+          ;; Logic from `ffap-read-file-or-url' and `dired-at-point-prompter'
+          (let ((guess (ffap-guesser)))
+            (setq guess
+                  (if (or (not guess)
+                          (and (fboundp 'ffap-url-p)
+                               (ffap-url-p guess))
+                          (and (fboundp 'ffap-file-remote-p)
+                               (ffap-file-remote-p guess)))
+                      guess
+                    (abbreviate-file-name (expand-file-name guess))))
+            (when guess
+              (if (file-directory-p guess)
+                  (file-name-as-directory guess)
+                guess))))
+         ;; ((fboundp 'thing-at-point)
+         ;;  (thing-at-point 'filename))
+         )))
+     (when filename-at-point
+       (setq default (delete-dups
+                    (delete "" (delq nil (list filename-at-point default))))))
+     ;; Append new defaults to the end of existing `minibuffer-default'.
+     (append
+      (if (listp minibuffer-default) minibuffer-default (list 
minibuffer-default))
+      (if (listp default) default (list default)))))
  
  (defun read-file-name (prompt &optional dir default-filename mustmatch 
initial predicate)
    "Read file name, prompting with PROMPT and completing in directory DIR.
***************
*** 1337,1343 ****
                      (lexical-let ((dir (file-name-as-directory
                                          (expand-file-name dir))))
                        (minibuffer-with-setup-hook
!                           (lambda () (setq default-directory dir))
                          (completing-read prompt 'read-file-name-internal
                                           pred mustmatch insdef
                                           'file-name-history 
default-filename)))
--- 1389,1407 ----
                      (lexical-let ((dir (file-name-as-directory
                                          (expand-file-name dir))))
                        (minibuffer-with-setup-hook
!                           (lambda ()
!                           (setq default-directory dir)
!                           ;; Unless a list of defaults in `minibuffer-default'
!                           ;; is provided, reset it to nil and on the
!                           ;; first request on `M-n' fill it with a list
!                           ;; of defaults relevant for file-name reading.
!                           (unless (consp minibuffer-default)
!                             (setq minibuffer-default nil)
!                             (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)))

Index: lisp/dired-aux.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/dired-aux.el,v
retrieving revision 1.197
diff -c -r1.197 dired-aux.el
*** lisp/dired-aux.el   13 Nov 2009 22:19:50 -0000      1.197
--- lisp/dired-aux.el   17 Nov 2009 09:57:57 -0000
***************
*** 1462,1471 ****
         (default (and dired-one-file
                       (expand-file-name (file-name-nondirectory (car fn-list))
                                         target-dir)))
         (target (expand-file-name ; fluid variable inside dired-create-files
!                  (dired-mark-read-file-name
!                   (concat (if dired-one-file op1 operation) " %s to: ")
!                   target-dir op-symbol arg rfn-list default)))
         (into-dir (cond ((null how-to)
                          ;; Allow DOS/Windows users to change the letter
                          ;; case of a directory.  If we don't test these
--- 1462,1477 ----
         (default (and dired-one-file
                       (expand-file-name (file-name-nondirectory (car fn-list))
                                         target-dir)))
+        (defaults (dired-do-create-files-defaults
+                   dired-one-file fn-list target-dir))
         (target (expand-file-name ; fluid variable inside dired-create-files
!                 (minibuffer-with-setup-hook
!                     (lambda ()
!                       (set (make-local-variable 
'minibuffer-default-add-function) nil)
!                       (setq minibuffer-default defaults))
!                   (dired-mark-read-file-name
!                    (concat (if dired-one-file op1 operation) " %s to: ")
!                    target-dir op-symbol arg rfn-list default))))
         (into-dir (cond ((null how-to)
                          ;; Allow DOS/Windows users to change the letter
                          ;; case of a directory.  If we don't test these
***************
*** 1520,1537 ****
     (function read-file-name)
     (format prompt (dired-mark-prompt arg files)) dir default))
  
+ (defun dired-do-create-files-defaults (dired-one-file fn-list target-dir)
+   ;; Return a list of default values for `dired-do-create-files'.
+   (let ((current-dir (and (eq major-mode 'dired-mode)
+                         (dired-current-directory)))
+       dired-dirs)
+     ;; Get a list of directories of visible buffers in dired-mode.
+     (walk-windows (lambda (w)
+                   (with-current-buffer (window-buffer w)
+                     (and (eq major-mode 'dired-mode)
+                          (push (dired-current-directory) dired-dirs)))))
+     ;; Force the current dir to be the first in the list.
+     (setq dired-dirs
+         (delete-dups (delq nil (cons current-dir (nreverse dired-dirs)))))
+     ;; Return default values.
+     (cond
+      (dired-dwim-target
+       ;; For non-nil `dired-dwim-target', remove the target dir from
+       ;; default values, because it should be already in initial input.
+       (setq dired-dirs (delete target-dir dired-dirs))
+       (if dired-one-file
+         ;; For one file operation, provide a list that contains
+         ;; other directories, other directories with the appended filename
+         ;; and the target directory with the appended filename, e.g.
+         ;; 1. /CURRENT-DIR/
+         ;; 2. /CURRENT-DIR/FILENAME
+         ;; 3. /TARGET-DIR/FILENAME
+         (append dired-dirs
+                 (mapcar (lambda (dir)
+                           (expand-file-name
+                            (file-name-nondirectory (car fn-list)) dir))
+                         (reverse dired-dirs))
+                 (list (expand-file-name
+                        (file-name-nondirectory (car fn-list)) target-dir)))
+       ;; For multi-file operation, provide a list of other directories.
+       dired-dirs))
+      (t
+       ;; For nil `dired-dwim-target', remove the current dir from
+       ;; default values, because it should be already in initial input.
+       (setq dired-dirs (delete current-dir dired-dirs))
+       (if dired-one-file
+         ;; For one file operation, provide a list that contains
+         ;; other directories, other directories with the appended filename
+         ;; and the current directory with the appended filename, e.g.
+         ;; 1. /TARGET-DIR/
+         ;; 2. /TARGET-DIR/FILENAME
+         ;; 3. /CURRENT-DIR/FILENAME
+         (append dired-dirs
+                 (mapcar (lambda (dir)
+                           (expand-file-name
+                            (file-name-nondirectory (car fn-list)) dir))
+                         (reverse dired-dirs))
+                 (list (expand-file-name
+                        (file-name-nondirectory (car fn-list)) current-dir)))
+       ;; For multi-file operation, provide a list of other directories.
+       dired-dirs)))))
+ 
  (defun dired-dwim-target-directory ()
    ;; Try to guess which target directory the user may want.

-- 
Juri Linkov
http://www.jurta.org/emacs/