From 45609c347e7810b20c54bedc1ce5355182f240e5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 18 Mar 2022 13:17:19 +0800 Subject: [PATCH] Allow dragging files from Dired to other programs * etc/NEWS: Announce new user option `dired-mouse-drag-files'. * lisp/dired.el (dired-mouse-drag-files): New user option. (dired-mouse-drag): New command. (dired-mouse-drag-files-map): New variable. (dired-insert-set-properties): Add additional keymap if mouse dragging is enabled. * lisp/select.el (xselect-convert-to-targets): Handle new form of selection converters. (xselect-convert-to-username): (xselect-convert-to-text-uri-list): (xselect-uri-list-available-p): New functions. (selection-converter-alist): Add them as selection converters. * src/xselect.c (x_get_local_selection): Handle new form of selection converters. (syms_of_xselect): Update doc strings. --- etc/NEWS | 5 +++++ lisp/dired.el | 55 ++++++++++++++++++++++++++++++++++++++++++++++---- lisp/select.el | 38 +++++++++++++++++++++++++++++++--- src/xselect.c | 16 ++++++++++++--- 4 files changed, 104 insertions(+), 10 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index f4d8756950b..e2546bb3ca5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -932,6 +932,11 @@ the thumbnail file. ** Dired +*** New user option 'dired-mouse-drag-files'. +If non-nil, dragging filenames with the mouse in a Dired buffer will +initiate a drag-and-drop session allowing them to be opened in other +programs. + *** New user option 'dired-free-space'. Dired will now, by default, include the free space in the first line instead of having it on a separate line. To get the previous behavior diff --git a/lisp/dired.el b/lisp/dired.el index bca30189230..da3c3c80cc1 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -248,6 +248,18 @@ The target is used in the prompt for file copy, rename etc." (other :tag "Try to guess" t)) :group 'dired) +(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 . + +If the value is `link', then a symbolic link will be created to +the file instead by the other program (usually a file manager)." + :type '(choice (const :tag "Don't allow dragging" nil) + (const :tag "Copy file to other window" tx) + (const :tag "Create symbolic link to file" link))) + (defcustom dired-copy-preserve-time t "If non-nil, Dired preserves the last-modified time in a file copy. \(This works on only some systems.)" @@ -1674,6 +1686,36 @@ see `dired-use-ls-dired' for more details.") beg)) beg)))) +(declare-function x-begin-drag "xfns.cx") + +(defun dired-mouse-drag (event) + "Begin a drag-and-drop operation for the file at EVENT. +If we get a mouse motion event right " + (interactive "e") + (save-excursion + (goto-char (posn-point (event-end event))) + (track-mouse + (let ((new-event (read-event))) + (if (not (eq (event-basic-type new-event) 'mouse-movement)) + (push new-event unread-command-events) + ;; We can get an error if there's by some chance no file + ;; name at point. + (condition-case nil + (progn + (gui-backend-set-selection 'XdndSelection + (dired-file-name-at-point)) + (x-begin-drag '("text/uri-list" + "text/x-dnd-username") + (if (eq 'dired-mouse-drag-files 'link) + 'XdndActionLink + 'XdndActionCopy))) + (error (push new-event unread-command-events)))))))) + +(defvar dired-mouse-drag-files-map (let ((keymap (make-sparse-keymap))) + (define-key keymap [down-mouse-1] #'dired-mouse-drag) + keymap) + "Keymap applied to file names when `dired-mouse-drag-files' is enabled.") + (defun dired-insert-set-properties (beg end) "Add various text properties to the lines in the region, from BEG to END." (save-excursion @@ -1693,10 +1735,15 @@ see `dired-use-ls-dired' for more details.") (progn (dired-move-to-end-of-filename) (point)) - '(mouse-face - highlight - dired-filename t - help-echo "mouse-2: visit this file in other window")) + (append `(mouse-face + highlight + dired-filename t + help-echo ,(if dired-mouse-drag-files + "down-mouse-1: drag this file to another program +mouse-2: visit this file in other window" + "mouse-2: visit this file in other window")) + (when dired-mouse-drag-files + `(keymap ,dired-mouse-drag-files-map)))) (when (< (+ (point) 4) (line-end-position)) (put-text-property (+ (point) 4) (line-end-position) 'invisible 'dired-hide-details-link)))) diff --git a/lisp/select.el b/lisp/select.el index e9bc5451171..36452776e9a 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -546,16 +546,22 @@ two markers or an overlay. Otherwise, it is nil." (if len (xselect--int-to-cons len)))) -(defun xselect-convert-to-targets (_selection _type _value) +(defun xselect-convert-to-targets (selection _type value) ;; return a vector of atoms, but remove duplicates first. (let* ((all (cons 'TIMESTAMP (cons 'MULTIPLE - (mapcar 'car selection-converter-alist)))) + (mapcar (lambda (conv) + (if (or (not (consp (cdr conv))) + (funcall (cadr conv) selection + (car conv) value)) + (car conv) + '_EMACS_INTERNAL)) + selection-converter-alist)))) (rest all)) (while rest (cond ((memq (car rest) (cdr rest)) (setcdr rest (delq (car rest) (cdr rest)))) - ((eq (car (cdr rest)) '_EMACS_INTERNAL) ; shh, it's a secret + ((eq (car (cdr rest)) '_EMACS_INTERNAL) (setcdr rest (cdr (cdr rest)))) (t (setq rest (cdr rest))))) @@ -632,6 +638,30 @@ This function returns the string \"emacs\"." (when (eq selection 'CLIPBOARD) 'NULL)) +(defun xselect-convert-to-username (_selection _type _value) + (user-real-login-name)) + +(defun xselect-convert-to-text-uri-list (_selection _type value) + (when (and (stringp value) + (file-exists-p value)) + (concat (url-encode-url + ;; Uncomment the following code code in a better world where + ;; people write correct code that adds the hostname to the URI. + ;; Since most programs don't implement this properly, we omit the + ;; hostname so that copying files actually works. Most properly + ;; written programs will look at WM_CLIENT_MACHINE to determine + ;; the hostname anyway. (format "file://%s%s\n" (system-name) + ;; (expand-file-name value)) + (concat "file://" (expand-file-name value))) + "\n"))) + +(defun xselect-uri-list-available-p (selection _type value) + "Return whether or not `text/uri-list' is a valid target for SELECTION. +VALUE is the local selection value of SELECTION." + (and (eq selection 'XdndSelection) + (stringp value) + (file-exists-p value))) + (setq selection-converter-alist '((TEXT . xselect-convert-to-string) (COMPOUND_TEXT . xselect-convert-to-string) @@ -639,6 +669,8 @@ This function returns the string \"emacs\"." (UTF8_STRING . xselect-convert-to-string) (text/plain . xselect-convert-to-string) (text/plain\;charset=utf-8 . xselect-convert-to-string) + (text/uri-list . (xselect-uri-list-available-p . xselect-convert-to-text-uri-list)) + (text/x-xdnd-username . xselect-convert-to-username) (TARGETS . xselect-convert-to-targets) (LENGTH . xselect-convert-to-length) (DELETE . xselect-convert-to-delete) diff --git a/src/xselect.c b/src/xselect.c index cdc70d3e247..76a2f9f5075 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -386,6 +386,9 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, CHECK_SYMBOL (target_type); handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); + if (CONSP (handler_fn)) + handler_fn = XCDR (handler_fn); + if (!NILP (handler_fn)) value = call3 (handler_fn, selection_symbol, (local_request ? Qnil : target_type), @@ -2690,11 +2693,18 @@ syms_of_xselect (void) DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist, doc: /* An alist associating X Windows selection-types with functions. These functions are called to convert the selection, with three args: -the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); -a desired type to which the selection should be converted; -and the local selection value (whatever was given to +the name of the selection (typically `PRIMARY', `SECONDARY', or +`CLIPBOARD'); a desired type to which the selection should be +converted; and the local selection value (whatever was given to `x-own-selection-internal'). +On X Windows, the function can also be a cons of (PREDICATE +. FUNCTION), where PREDICATE determines whether or not the selection +type will appear in the list of selection types available to other +programs, and FUNCTION is the function which is actually called. +PREDICATE is called with the same arguments as FUNCTION, and should +return a non-nil value if the data type is to appear in that list. + The function should return the value to send to the X server \(typically a string). A return value of nil means that the conversion could not be done. -- 2.39.2