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.

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.