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):.
This commit is contained in:
Po Lu
@@ -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
|
||||
|
||||
@@ -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))))))))))
|
||||
|
||||
|
||||
75
lisp/dnd.el
75
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
|
||||
|
||||
@@ -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))
|
||||
|
||||
Reference in New Issue
Block a user