@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
(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
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.
;;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
(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))
(setq results (cons t results)))
(if found
results
- (list ,body)))))
+ (unless (eq ,arg 'marked)
+ (list ,body))))))
;; save-excursion loses, again
(dired-move-to-filename)))
(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))
(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))))))))))
(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")
(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
((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
(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))
projects / emacs.git / commitdiff