summaryrefslogtreecommitdiff
path: root/lisp/dnd.el
diff options
context:
space:
mode:
authorPo Lu <luangruo@yahoo.com>2022-06-03 19:43:06 +0800
committerPo Lu <luangruo@yahoo.com>2022-06-03 19:46:25 +0800
commitca2e7409dcd694742704e424c3f6f5bc5f230f25 (patch)
treec966c37aacd1071d72faeea5256f04999b6e57f2 /lisp/dnd.el
parent977f3f27c549db27a2d6fb33e0112b03f9b57371 (diff)
downloademacs-ca2e7409dcd694742704e424c3f6f5bc5f230f25.tar.gz
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):.
Diffstat (limited to 'lisp/dnd.el')
-rw-r--r--lisp/dnd.el75
1 files changed, 71 insertions, 4 deletions
diff --git a/lisp/dnd.el b/lisp/dnd.el
index f45f8fc8497..c5d5788dc49 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