master e65647a70e: Add easier-to-use interfaces for initiating drag-and-drop

[Po Lu]

branch: master
commit e65647a70e5c055c4cdab004d671c198c7a1d3ce
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Add easier-to-use interfaces for initiating drag-and-drop
    
    The previous interface required that users know intricacies of
    the data types used to transfer data on each platform Emacs
    supports.
    
    * doc/lispref/frames.texi (Drag and Drop): Document new
    functions.
    * lisp/dired.el (dired-last-dragged-remote-file)
    (dired-remove-last-dragged-local-file): Delete functions.
    (dired-mouse-drag): Use `dnd-begin-file-drag'.
    * lisp/dnd.el (dnd-last-dragged-remote-file)
    (dnd-remove-last-dragged-remote-file): New variables and
    functions.
    (dnd-begin-text-drag, dnd-begin-file-drag): New functions.
    * src/xterm.c (x_dnd_begin_drag_and_drop): Add porting note.
---
 doc/lispref/frames.texi |  89 ++++++++++++++++++++++++++
 lisp/dired.el           |  47 ++------------
 lisp/dnd.el             | 165 ++++++++++++++++++++++++++++++++++++++++++++++++
 src/xterm.c             |  14 ++++
 4 files changed, 273 insertions(+), 42 deletions(-)

diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index a2a74f8148..26b519be23 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4094,6 +4094,95 @@ specific drag-n-drop protocol being used.  Plain text 
may be
   On capable window systems, Emacs also supports dragging contents
 from its frames to windows of other applications.
 
+@defun dnd-begin-text-drag text &optional frame action allow-same-frame
+This function begins dragging text from @var{frame} to another program
+(the drop target), and returns until it is dropped or the
+drag-and-drop operation is cancelled.
+
+The return value is the action that the drop target actually
+performed, which can be one of the following symbols:
+
+@table @code
+@item copy
+The drop target inserted @var{text}.
+
+@item move
+The drop target inserted @var{text}, but in addition the caller should
+delete @var{text} from wherever it originated, such as a buffer.
+
+@item private
+The drop target performed an unspecified action.
+@end table
+
+@code{nil} can also be returned if the drag-and-drop operation was
+cancelled.
+
+@var{text} is the text that will be inserted by the drop target.
+
+@var{action} must be one of the symbols @code{copy} or @code{move},
+where @code{copy} means that @var{text} should be inserted by the drop
+target, and @code{move} means the same as @code{copy}, but in addition
+the caller may have to delete @var{text} from its source as explained
+above.
+
+@var{frame} is the frame where the mouse is currently held down, or
+@code{nil}, which means to use the selected frame.  This function may
+return immediately if no mouse buttons are held down, so it should be
+only called immediately after a @code{down-mouse-1} or similar event
+(@pxref{Mouse Events}), with @var{frame} set to the frame where that
+event was generated (@pxref{Click Events}).
+
+@var{allow-same-frame} specifies whether or not drops on top of
+@var{frame} itself won't be ignored.
+@end defun
+
+@defun dnd-begin-file-drag file &optional frame action allow-same-frame
+This function begins dragging @var{file} from @var{frame} to another
+program, and returns until it is dropped or the drag-and-drop
+operation is cancelled.
+
+The return value is the action that the drop target actually
+performed, which can be one of the following symbols:
+
+@table @code
+@item copy
+The drop target opened or copied @var{file} to a different location.
+
+@item move
+The drop target moved @var{file} to a different location.
+
+@item link
+The drop target (usually a file manager) created a symbolic link to
+@var{file}.
+
+@item private
+The drop target performed an unspecified action.
+@end table
+
+@code{nil} can also be returned if the drag-and-drop operation was
+cancelled.
+
+If @var{file} is a remote file, then a temporary copy will be made.
+
+@var{action} must be one of the symbols @code{copy}, @code{move} or
+@code{link}, where @code{copy} means that @var{file} should be opened
+or copied by the drop target, @code{move} means the drop target should
+move the file to another location, and @code{link} means the drop
+target should create a symbolic link to @var{file}.  It is an error to
+specify @code{link} as the action if @var{file} is a remote file.
+
+@var{frame} and @var{allow-same-frame} mean the same as in
+@code{dnd-begin-text-drag}.
+@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
+or text, the low-level interface @code{x-begin-drag} can be used
+instead.  However, using it will require detailed knowledge of the
+data types and actions used by the programs to transfer content via
+drag-and-drop on each platform you want to support.
+
 @defun x-begin-drag targets &optional action frame return-frame 
allow-current-frame
 This function begins a drag from @var{frame}, and returns when the
 drag-and-drop operation ends, either because the drop was successful,
diff --git a/lisp/dired.el b/lisp/dired.el
index 5a1fce860e..94df2ddc4e 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -38,6 +38,7 @@
 (eval-when-compile (require 'cl-lib))
 ;; When bootstrapping dired-loaddefs has not been generated.
 (require 'dired-loaddefs nil t)
+(require 'dnd)
 
 (declare-function dired-buffer-more-recently-used-p
                  "dired-x" (buffer1 buffer2))
@@ -1702,29 +1703,13 @@ see `dired-use-ls-dired' for more details.")
           beg))
         beg))))
 
-(defvar dired-last-dragged-remote-file nil
-  "If non-nil, the name of a local copy of the last remote file that was 
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.")
-
 (declare-function x-begin-drag "xfns.c")
 
-(defun dired-remove-last-dragged-local-file ()
-  "Remove the local copy of the last remote file to be dragged."
-  (when dired-last-dragged-remote-file
-    (unwind-protect
-        (delete-file dired-last-dragged-remote-file)
-      (setq dired-last-dragged-remote-file nil)))
-  (remove-hook 'kill-emacs-hook #'dired-remove-last-dragged-local-file))
-
 (defun dired-mouse-drag (event)
   "Begin a drag-and-drop operation for the file at EVENT."
   (interactive "e")
   (when mark-active
     (deactivate-mark))
-  (dired-remove-last-dragged-local-file)
   (save-excursion
     (with-selected-window (posn-window (event-end event))
       (goto-char (posn-point (event-end event))))
@@ -1753,32 +1738,10 @@ when Emacs exits or the user drags another file.")
                                                        (event-end event))
                                   (dired-file-name-at-point))))
                   (when filename
-                    ;; In theory x-dnd-username combined with a proper
-                    ;; file URI containing the hostname of the remote
-                    ;; server could be used here instead of creating a
-                    ;; local copy of the remote file, but no program
-                    ;; actually implements file DND according to the
-                    ;; spec.
-                    (when (file-remote-p filename)
-                      (setq filename (file-local-copy filename))
-                      (setq dired-last-dragged-remote-file filename)
-                      (add-hook 'kill-emacs-hook
-                                #'dired-remove-last-dragged-local-file))
-                    (gui-backend-set-selection
-                     ;; FIXME: this seems arbitrarily confusing.
-                     ;; Should drag-and-drop for common items (such as
-                     ;; files and text) should be abstracted into
-                     ;; dnd.el?
-                     'XdndSelection
-                     (propertize filename 'text/uri-list
-                                 (concat "file://"
-                                         (expand-file-name filename))))
-                    (x-begin-drag '("text/uri-list" "text/x-dnd-username"
-                                    "FILE_NAME" "FILE" "HOST_NAME" 
"_DT_NETFILE")
-                                  (if (eq 'dired-mouse-drag-files 'link)
-                                      'XdndActionLink
-                                    'XdndActionCopy)
-                                  nil nil t)))
+                    (dnd-begin-file-drag 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))))))))))
 
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 4f71edf1aa..f45f8fc849 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -33,6 +33,9 @@
 
 ;;; Customizable variables
 
+(eval-when-compile
+  (require 'cl-lib))
+
 (defgroup dnd nil
   "Handling data from drag and drop."
   :group 'environment)
@@ -278,6 +281,168 @@ TEXT is the text as a string, WINDOW is the window where 
the drop happened."
     (insert text))
   action)
 
+
+;;; Functions for dragging stuff to other programs.  These build upon
+;;; the lower-level `x-begin-drag' interface, but take care of data
+;;; types and abstracting around the different return values.
+
+(defvar dnd-last-dragged-remote-file nil
+  "If non-nil, the name of a local copy of the last remote file that was 
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."
+  (when dnd-last-dragged-remote-file
+    (unwind-protect
+        (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))
+
+(declare-function x-begin-drag "xfns.c")
+
+(defun dnd-begin-text-drag (text &optional frame action allow-same-frame)
+  "Begin dragging TEXT from FRAME.
+Initate a drag-and-drop operation allowing the user to drag text
+from Emacs to another program (the drop target), then block until
+the drop happens or is cancelled.
+
+Return the action that the drop target actually performed, which
+can be one of the following symbols:
+
+  - `copy', which means TEXT was inserted by the drop target.
+
+  - `move', which means TEXT was inserted, and the caller should
+    additionally delete TEXT from its source (such as the buffer
+    where it originated).
+
+  - `private', which means the drop target chose to perform an
+    unspecified action.
+
+Return nil if the drop was cancelled.
+
+TEXT is a string containing text that will be inserted by the
+program where the drop happened.  FRAME is the frame where the
+mouse is currently held down, or nil (which means to use the
+current frame).  ACTION is one of the symbols `copy' or `move',
+where `copy' means that the text should be inserted by the drop
+target, and `move' means the the same as copy, but in addition
+the caller might have to delete TEXT from its source after this
+function returns.  If ALLOW-SAME-FRAME is nil, any drops on FRAME
+itself will be ignored.
+
+This function might return immediately if no mouse buttons are
+currently being held down.  It should only be called upon a
+`down-mouse-1' (or similar) event."
+  (unless (fboundp 'x-begin-drag)
+    (error "Dragging text from Emacs is not supported by this window system"))
+  (gui-set-selection 'XdndSelection text)
+  (unless action
+    (setq action 'copy))
+  (let ((return-value
+         (x-begin-drag '(;; Traditional X selection targets used by GTK, the
+                         ;; Motif drag-and-drop protocols, and programs like
+                         ;; Xterm.  `STRING' is also used on NS and Haiku.
+                         "STRING" "TEXT" "COMPOUND_TEXT" "UTF8_STRING"
+                         ;; Used by Xdnd clients that strictly comply with
+                         ;; the standard (i.e. Qt programs).
+                         "text/plain" "text/plain;charset=utf-8")
+                       (cl-ecase action
+                         ('copy 'XdndActionCopy)
+                         ('move 'XdndActionMove))
+                       frame nil allow-same-frame)))
+    (cond
+     ((eq return-value 'XdndActionCopy) 'copy)
+     ((eq return-value 'XdndActionMove) 'move)
+     ((not return-value) nil)
+     (t 'private))))
+
+(defun dnd-begin-file-drag (file &optional frame action allow-same-frame)
+  "Begin dragging FILE from FRAME.
+Initate a drag-and-drop operation allowing the user to drag files
+from Emacs to another program (the drop target), then block until
+the drop happens or is cancelled.
+
+Return the action that the drop target actually performed, which
+can be one of the following symbols:
+
+  - `copy', which means FILE was opened by the drop target.
+
+  - `move', which means FILE was moved to another location by the
+    drop target.
+
+  - `link', which means a symbolic link was created to FILE by
+    the drop target, usually a file manager.
+
+  - `private', which means the drop target chose to perform an
+    unspecified action.
+
+Return nil if the drop was cancelled.
+
+FILE is the file name that will be inserted by the program where
+the drop happened.  If it is a remote file, a temporary copy will
+be made.  FRAME is the frame where the mouse is currently held
+down, or nil (which means to use the current frame).  ACTION is
+one of the symbols `copy', `move' or `link', where `copy' means
+that the file should be opened or copied by the drop target,
+`move' means the drop target should move the file to another
+location, and `link' means the drop target should create a
+symbolic link to FILE.  It is an error to specify `link' as the
+action if FILE is a remote file.  If ALLOW-SAME-FRAME is nil, any
+drops on FRAME itself will be ignored.
+
+This function might return immediately if no mouse buttons are
+currently being held down.  It should only be called upon a
+`down-mouse-1' (or similar) event."
+  (unless (fboundp 'x-begin-drag)
+    (error "Dragging files from Emacs is not supported by this window system"))
+  (dnd-remove-last-dragged-remote-file)
+  (unless action
+    (setq action 'copy))
+  (let ((original-file file))
+    (when (file-remote-p file)
+      (if (eq action 'link)
+          (error "Cannot create symbolic link to remote file")
+        (setq file (file-local-copy file))
+        (setq dnd-last-dragged-remote-file file)
+        (add-hook 'kill-emacs-hook
+                  #'dnd-remove-last-dragged-remote-file)))
+    (gui-set-selection 'XdndSelection
+                       (propertize file 'text/uri-list
+                                   (concat "file://"
+                                           (expand-file-name file))))
+    (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" "FILE" "HOST_NAME"
+                           ;; ToolTalk filename.  Mostly used by CDE
+                           ;; programs.
+                           "_DT_NETFILE")
+                         (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.
+          (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)
 
diff --git a/src/xterm.c b/src/xterm.c
index bca24f22e3..ecee000439 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10414,6 +10414,20 @@ x_next_event_from_any_display (XEvent *event)
 /* This function is defined far away from the rest of the XDND code so
    it can utilize `x_any_window_to_frame'.  */
 
+/* Implementors beware!  On most other platforms (where drag-and-drop
+   data is not provided via selections, but some kind of serialization
+   mechanism), it is usually much easier to implement a suitable
+   primitive instead of copying the C code here, and then to build
+   `x-begin-drag' on top of that, by making it a wrapper function in
+   Lisp that converts the list of targets and value of `XdndSelection'
+   to serialized data.  Also be sure to update the data types used in
+   dnd.el.
+
+   For examples of how to do this, see `haiku-drag-message' and
+   `x-begin-drag' in haikuselect.c and lisp/term/haiku-win.el, and
+   `ns-begin-drag' and `x-begin-drag' in nsselect.m and
+   lisp/term/ns-win.el.  */
+
 Lisp_Object
 x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction,
                           Lisp_Object return_frame, Atom *ask_action_list,