master 9b053968ef: Implement using the OffiX protocol for dropping

[Po Lu]

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

    Implement using the OffiX protocol for dropping
    
    * lisp/x-dnd.el (x-dnd-use-offix-drop): New user option.
    (x-dnd-handle-unsupported-drop): Return t if the OffiX protocol
    was used.
    (x-treat-local-requests-remotely): New defvar.
    (x-dnd-convert-to-offix, x-dnd-do-offix-drop): New functions.
    
    * src/xterm.c: Update commentary.
    (x_term_init): Extend number of DND atoms allocated by default.
---
 lisp/x-dnd.el | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 src/xterm.c   | 19 +++++++++----
 2 files changed, 98 insertions(+), 11 deletions(-)

diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 7022b71c55..684f8f8155 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -102,6 +102,16 @@ The types are chosen in the order they appear in the list."
   :type '(repeat string)
   :group 'x)
 
+(defcustom x-dnd-use-offix-drop nil
+  "If non-nil, use the OffiX protocol to drop files and text.
+This allows dropping (via `dired-mouse-drag-files' or
+`mouse-drag-and-drop-region-cross-program') on some old Java
+applets and old KDE programs.  Turning this off allows dropping
+only text on some other programs such as xterm and urxvt."
+  :version "29.1"
+  :type 'boolean
+  :group 'x)
+
 ;; Internal variables
 
 (defvar x-dnd-current-state nil
@@ -938,14 +948,82 @@ Return a vector of atoms containing the selection 
targets."
 
 ;;; Handling drops.
 
-(defun x-dnd-handle-unsupported-drop (targets _x _y action _window-id _frame 
_time)
-  "Return non-nil if the drop described by TARGETS and ACTION should not 
proceed."
+(defvar x-treat-local-requests-remotely)
+
+(defun x-dnd-convert-to-offix (targets)
+  "Convert the contents of `XdndSelection' to OffiX data.
+TARGETS should be the list of targets currently available in
+`XdndSelection'.  Return a list of an OffiX type, and data
+suitable for passing to `x-change-window-property', or nil if the
+data could not be converted."
+  (let ((x-treat-local-requests-remotely t)
+        file-name-data string-data)
+    (cond
+     ((and (member "FILE_NAME" targets)
+           (setq file-name-data
+                 (gui-get-selection 'XdndSelection 'FILE_NAME)))
+      (if (string-match-p "\0" file-name-data)
+          ;; This means there are multiple file names in
+          ;; XdndSelection.  Convert the file name data to a format
+          ;; that OffiX understands.
+          (cons 'DndTypeFiles (concat file-name-data "\0"))
+        (cons 'DndTypeFile (concat file-name-data "\0"))))
+     ((and (member "STRING" targets)
+           (setq string-data
+                 (gui-get-selection 'XdndSelection 'STRING)))
+      (cons 'DndTypeText (encode-coding-string string-data
+                                               'latin-1))))))
+
+(defun x-dnd-do-offix-drop (targets x y frame window-id)
+  "Perform an OffiX drop on WINDOW-ID with the contents of `XdndSelection'.
+Return non-nil if the drop succeeded, or nil if it did not
+happen, which can happen if TARGETS didn't contain anything that
+the OffiX protocol can represent.
+
+X and Y are the root window coordinates of the drop.  TARGETS is
+the list of targets `XdndSelection' can be converted to."
+  (if-let* ((data (x-dnd-convert-to-offix targets))
+            (type-id (car (rassq (car data)
+                                 x-dnd-offix-id-to-name)))
+            (source-id (string-to-number
+                        (frame-parameter frame 'window-id)))
+            (message-data (list type-id           ; l[0] = DataType
+                                0                 ; l[1] = event->xbutton.state
+                                source-id         ; l[2] = window
+                                (+ x (* 65536 y)) ; l[3] = drop_x + 65536 * 
drop_y
+                                1)))              ; l[4] = protocol version
+    (prog1 t
+      ;; Send a legacy (old KDE) message first.  Newer clients will
+      ;; ignore it, since the protocol version is 1.
+      (x-change-window-property "DndSelection"
+                                (cdr data) frame
+                                "STRING" 8 nil 0)
+      (x-send-client-message frame window-id
+                             frame "DndProtocol"
+                             32 message-data)
+      ;; Now send a modern _DND_PROTOCOL message.
+      (x-change-window-property "_DND_SELECTION"
+                                (cdr data) frame
+                                "STRING" 8 nil 0)
+      (x-send-client-message frame window-id
+                             frame "_DND_PROTOCOL"
+                             32 message-data))))
+
+(defun x-dnd-handle-unsupported-drop (targets x y action window-id frame _time)
+  "Return non-nil if the drop described by TARGETS and ACTION should not 
proceed.
+X and Y are the root window coordinates of the drop.
+FRAME is the frame the drop originated on.
+WINDOW-ID is the X window the drop should happen to."
   (not (and (or (eq action 'XdndActionCopy)
                 (eq action 'XdndActionMove))
-            (or (member "STRING" targets)
-                (member "UTF8_STRING" targets)
-                (member "COMPOUND_TEXT" targets)
-                (member "TEXT" targets)))))
+            (not (and x-dnd-use-offix-drop
+                      (x-dnd-do-offix-drop targets x
+                                           y frame window-id)))
+            (or
+             (member "STRING" targets)
+             (member "UTF8_STRING" targets)
+             (member "COMPOUND_TEXT" targets)
+             (member "TEXT" targets)))))
 
 (defvar x-dnd-targets-list)
 (defvar x-dnd-native-test-function)
diff --git a/src/xterm.c b/src/xterm.c
index b1e7ee578a..f2f80b42be 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -520,9 +520,9 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
   replying to the initiating client) is performed from Lisp inside
   `x-dnd.el'.
 
-  However, dragging contents from Emacs is implemented entirely in C.
-  X Windows has several competing drag-and-drop protocols, of which
-  Emacs supports two: the XDND protocol (see
+  However, dragging contents from Emacs is implemented almost entirely
+  in C.  X Windows has several competing drag-and-drop protocols, of
+  which Emacs supports two on the C level: the XDND protocol (see
   https://freedesktop.org/wiki/Specifications/XDND) and the Motif drag
   and drop protocols.  These protocols are based on the initiator
   owning a special selection, specifying an action the recipient
@@ -545,7 +545,16 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
   released over the recipient window, Emacs sends a "drop" message to
   the target window, waits for a reply, and returns the action
   selected by the recipient to the Lisp code that initiated the
-  drag-and-drop operation.  */
+  drag-and-drop operation.
+
+  When a drop happens on a window not supporting any protocol
+  implemented on the C level, the function inside
+  `x-dnd-unsupported-drop-function' is called with some parameters of
+  the drop.  If it returns non-nil, then Emacs tries to simulate a
+  drop happening with the primary selection and synthetic button
+  events (see `x_dnd_do_unsupported_drop').  That function implements
+  the OffiX drag-and-drop protocol by default.  See
+  `x-dnd-handle-unsupported-drop' in `x-dnd.el' for more details.  */
 
 #include <config.h>
 #include <stdlib.h>
@@ -26571,7 +26580,7 @@ x_term_init (Lisp_Object display_name, char 
*xrm_option, char *resource_name)
   x_find_modifier_meanings (dpyinfo);
 #endif
 
-  dpyinfo->x_dnd_atoms_size = 8;
+  dpyinfo->x_dnd_atoms_size = 16;
   dpyinfo->x_dnd_atoms = xmalloc (sizeof *dpyinfo->x_dnd_atoms
                                   * dpyinfo->x_dnd_atoms_size);
   dpyinfo->gray