master ca2e7409dc: Allow dragging multiple files from a Dired buffer

[Po Lu]

branch: master
commit ca2e7409dcd694742704e424c3f6f5bc5f230f25
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Allow dragging multiple files from a Dired buffer
    
    * doc/lispref/frames.texi (Drag and Drop): Document new function
    `dnd-begin-drag-files'.
    * lisp/dired.el (dired-mouse-drag-files): Update doc string.
    (dired-map-over-marks): Accept a new value of ARG `marked',
    meaning to not fall back to the current file if no marks were
    found.
    (dired-mouse-drag): Handle marked files in an intuitive way.
    
    * lisp/dnd.el (dnd-last-dragged-remote-file): Allow list values
    as well.
    (dnd-remove-last-dragged-remote-file): Handle list values.
    (dnd-begin-file-drag): Fix file name expansion.
    (dnd-begin-drag-files): New function.
    * lisp/select.el (xselect-convert-to-filename): Handle mutiple
    files
    (a vector of file names):.
---
 doc/lispref/frames.texi |  6 ++++
 lisp/dired.el           | 49 ++++++++++++++++++++++++--------
 lisp/dnd.el             | 75 ++++++++++++++++++++++++++++++++++++++++++++++---
 lisp/select.el          | 20 ++++++++++---
 4 files changed, 130 insertions(+), 20 deletions(-)

diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 26b519be23..33592e7504 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4175,6 +4175,12 @@ specify @code{link} as the action if @var{file} is a 
remote file.
 @code{dnd-begin-text-drag}.
 @end defun
 
+@defun dnd-begin-drag-files files &optional frame action allow-same-frame
+This function is like @code{dnd-begin-file-drag}, except that
+@var{files} is a list of files.  If the drop target doesn't support
+dropping multiple files, then the first file will be used instead.
+@end defun
+
 @cindex initiating drag-and-drop, low-level
   The high-level interfaces described above are implemented on top of
 a lower-level primitive.  If you need to drag content other than files
diff --git a/lisp/dired.el b/lisp/dired.el
index 94df2ddc4e..1ab2c8c38b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -253,8 +253,9 @@ The target is used in the prompt for file copy, rename etc."
 (defcustom dired-mouse-drag-files nil
   "If non-nil, allow the mouse to drag files from inside a Dired buffer.
 Dragging the mouse and then releasing it over the window of
-another program will result in that program opening the file, or
-creating a copy of it.  This feature is supported only on X
+another program will result in that program opening or creating a
+copy of the file underneath the mouse pointer (or all marked
+files if it was marked).  This feature is supported only on X
 Windows, Haiku, and Nextstep (macOS or GNUstep).
 
 If the value is `link', then a symbolic link will be created to
@@ -809,6 +810,9 @@ that commands on the next ARG (instead of the marked) files 
can
 be chained easily.
 For any other non-nil value of ARG, use the current file.
 
+If ARG is `marked', don't return the current file if nothing else
+is marked.
+
 If optional third arg SHOW-PROGRESS evaluates to non-nil,
 redisplay the dired buffer after each file is processed.
 
@@ -830,7 +834,7 @@ marked file, return (t FILENAME) instead of (FILENAME)."
   ;;This warning should not apply any longer, sk  2-Sep-1991 14:10.
   `(prog1
        (let ((inhibit-read-only t) case-fold-search found results)
-        (if ,arg
+        (if (and ,arg (not (eq ,arg 'marked)))
             (if (integerp ,arg)
                 (progn ;; no save-excursion, want to move point.
                   (dired-repeat-over-lines
@@ -841,8 +845,8 @@ marked file, return (t FILENAME) instead of (FILENAME)."
                   (if (< ,arg 0)
                       (nreverse results)
                     results))
-              ;; non-nil, non-integer ARG means use current file:
-              (list ,body))
+              ;; non-nil, non-integer, non-marked ARG means use current file:
+               (list ,body))
           (let ((regexp (dired-marker-regexp)) next-position)
             (save-excursion
               (goto-char (point-min))
@@ -867,7 +871,8 @@ marked file, return (t FILENAME) instead of (FILENAME)."
                 (setq results (cons t results)))
             (if found
                 results
-              (list ,body)))))
+               (unless (eq ,arg 'marked)
+                (list ,body))))))
      ;; save-excursion loses, again
      (dired-move-to-filename)))
 
@@ -1706,7 +1711,9 @@ see `dired-use-ls-dired' for more details.")
 (declare-function x-begin-drag "xfns.c")
 
 (defun dired-mouse-drag (event)
-  "Begin a drag-and-drop operation for the file at EVENT."
+  "Begin a drag-and-drop operation for the file at EVENT.
+If there are marked files and that file is marked, drag every
+other marked file as well.  Otherwise, unmark all files."
   (interactive "e")
   (when mark-active
     (deactivate-mark))
@@ -1736,12 +1743,30 @@ see `dired-use-ls-dired' for more details.")
             (condition-case nil
                 (let ((filename (with-selected-window (posn-window
                                                        (event-end event))
-                                  (dired-file-name-at-point))))
+                                  (let ((marked-files (dired-map-over-marks 
(dired-get-filename
+                                                                             
nil 'no-error-if-not-filep)
+                                                                            
'marked))
+                                        (file-name (dired-get-filename nil 
'no-error-if-not-filep)))
+                                    (if (and marked-files
+                                             (member file-name marked-files))
+                                        marked-files
+                                      (when marked-files
+                                        (dired-map-over-marks (dired-unmark 
nil)
+                                                              'marked))
+                                      file-name)))))
                   (when filename
-                    (dnd-begin-file-drag filename nil
-                                         (if (eq 'dired-mouse-drag-files 'link)
-                                             'move 'copy)
-                                         t)))
+                    (if (and (consp filename)
+                             (cdr filename))
+                        (dnd-begin-drag-files filename nil
+                                              (if (eq 'dired-mouse-drag-files 
'link)
+                                                  'move 'copy)
+                                              t)
+                      (dnd-begin-file-drag (if (stringp filename)
+                                               filename
+                                             (car filename))
+                                           nil (if (eq 'dired-mouse-drag-files 
'link)
+                                                   'move 'copy)
+                                           t))))
               (error (when (eq (event-basic-type new-event) 'mouse-1)
                        (push new-event unread-command-events))))))))))
 
diff --git a/lisp/dnd.el b/lisp/dnd.el
index f45f8fc849..c5d5788dc4 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -288,18 +288,24 @@ TEXT is the text as a string, WINDOW is the window where 
the drop happened."
 
 (defvar dnd-last-dragged-remote-file nil
   "If non-nil, the name of a local copy of the last remote file that was 
dragged.
+This may also be a list of files, if multiple files were dragged.
 It can't be removed immediately after the drag-and-drop operation
 completes, since there is no way to determine when the drop
 target has finished opening it.  So instead, this file is removed
 when Emacs exits or the user drags another file.")
 
 (defun dnd-remove-last-dragged-remote-file ()
-  "Remove the local copy of the last remote file to be dragged."
+  "Remove the local copy of the last remote file to be dragged.
+If `dnd-last-dragged-remote-file' is a list, remove all the files
+in that list instead."
   (when dnd-last-dragged-remote-file
     (unwind-protect
-        (delete-file dnd-last-dragged-remote-file)
+        (if (consp dnd-last-dragged-remote-file)
+            (mapc #'delete-file dnd-last-dragged-remote-file)
+          (delete-file dnd-last-dragged-remote-file))
       (setq dnd-last-dragged-remote-file nil)))
-  (remove-hook 'kill-emacs-hook #'dnd-remove-last-dragged-remote-file))
+  (remove-hook 'kill-emacs-hook
+               #'dnd-remove-last-dragged-remote-file))
 
 (declare-function x-begin-drag "xfns.c")
 
@@ -410,7 +416,7 @@ currently being held down.  It should only be called upon a
         (add-hook 'kill-emacs-hook
                   #'dnd-remove-last-dragged-remote-file)))
     (gui-set-selection 'XdndSelection
-                       (propertize file 'text/uri-list
+                       (propertize (expand-file-name file) 'text/uri-list
                                    (concat "file://"
                                            (expand-file-name file))))
     (let ((return-value
@@ -444,6 +450,67 @@ currently being held down.  It should only be called upon a
        ((not return-value) nil)
        (t 'private)))))
 
+(defun dnd-begin-drag-files (files &optional frame action allow-same-frame)
+  "Begin dragging FILES from FRAME.
+This is like `dnd-begin-file-drag', except with multiple files.
+FRAME, ACTION and ALLOW-SAME-FRAME mean the same as in
+`dnd-begin-file-drag'.
+
+FILES is a list of files that will be dragged.  If the drop
+target doesn't support dropping multiple files, the first file in
+FILES will be dragged."
+  (unless (fboundp 'x-begin-drag)
+    (error "Dragging files from Emacs is not supported by this window system"))
+  (dnd-remove-last-dragged-remote-file)
+  (let* ((new-files (copy-sequence files))
+         (tem new-files))
+    (while tem
+      (setcar tem (expand-file-name (car tem)))
+      (when (file-remote-p (car tem))
+        (when (eq action 'link)
+          (error "Cannot create symbolic link to remote file"))
+        (setcar tem (file-local-copy (car tem)))
+        (push (car tem) dnd-last-dragged-remote-file))
+      (setq tem (cdr tem)))
+    (unless action
+      (setq action 'copy))
+    (gui-set-selection 'XdndSelection
+                       (propertize (car new-files)
+                                   'text/uri-list
+                                   (cl-loop for file in new-files
+                                            collect (concat "file://" file)
+                                            into targets finally return
+                                            (apply #'vector targets))
+                                   'FILE_NAME (apply #'vector new-files)))
+    (let ((return-value
+           (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
+                           ;; modern programs that expect filenames to
+                           ;; be supplied as URIs.
+                           "text/uri-list" "text/x-dnd-username"
+                           ;; Traditional X selection targets used by
+                           ;; programs supporting the Motif
+                           ;; drag-and-drop protocols.  Also used by NS
+                           ;; and Haiku.
+                           "FILE_NAME" "HOST_NAME")
+                         (cl-ecase action
+                           ('copy 'XdndActionCopy)
+                           ('move 'XdndActionMove)
+                           ('link 'XdndActionLink))
+                         frame nil allow-same-frame)))
+      (cond
+       ((eq return-value 'XdndActionCopy) 'copy)
+       ((eq return-value 'XdndActionMove)
+        (prog1 'move
+          ;; If original-file is a remote file, delete it from the
+          ;; remote as well.
+          (dolist (original-file files)
+            (when (file-remote-p original-file)
+              (ignore-errors
+                (delete-file original-file))))))
+       ((eq return-value 'XdndActionLink) 'link)
+       ((not return-value) nil)
+       (t 'private)))))
+
 (provide 'dnd)
 
 ;;; dnd.el ends here
diff --git a/lisp/select.el b/lisp/select.el
index 01e002db70..df1d402655 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -628,10 +628,22 @@ two markers or an overlay.  Otherwise, it is nil."
   (if (not (eq selection 'XdndSelection))
       (when (setq value (xselect--selection-bounds value))
         (xselect--encode-string 'TEXT (buffer-file-name (nth 2 value))))
-    (when (and (stringp value)
-               (file-exists-p value))
-      (xselect--encode-string 'TEXT (expand-file-name value)
-                              nil t))))
+    (if (and (stringp value)
+             (file-exists-p value))
+        (xselect--encode-string 'TEXT (expand-file-name value)
+                                nil t)
+      (when (vectorp value)
+        (with-temp-buffer
+          (cl-loop for file across value
+                   do (progn (insert (encode-coding-string
+                                      (expand-file-name file)
+                                      file-name-coding-system))
+                             (insert "\0")))
+          ;; Get rid of the last NULL byte.
+          (when (> (point) 1)
+            (delete-char -1))
+          ;; Motif wants STRING.
+          (cons 'STRING (buffer-string)))))))
 
 (defun xselect-convert-to-charpos (_selection _type value)
   (when (setq value (xselect--selection-bounds value))