From 32aa5c76bdb0236f159f24a7d8a7698b88fcb712 Mon Sep 17 00:00:00 2001
From: Po Lu <luangruo@yahoo.com>
Date: Fri, 10 Jun 2022 15:27:07 +0800
Subject: [PATCH] Fix receiving drops from drop-only Motif programs

* lisp/x-dnd.el (x-dnd-xm-read-targets-table): Fix doc string.
(x-dnd-handle-motif): Recompute types and state on XmDROP_START
if no state already exists.
---
 lisp/x-dnd.el | 121 ++++++++++++++++++++++++++++----------------------
 1 file changed, 67 insertions(+), 54 deletions(-)

diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 85b4138f170..7ee20e0fc3c 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -624,7 +624,9 @@ describing the selection targets in the current rec."
 
 (defun x-dnd-xm-read-targets-table (frame)
   "Read the Motif targets table on FRAME.
-Return a vector of vectors of numbers (the drop targets)."
+Return a vector of vectors of numbers, which are the atoms of the
+available selection targets for each index into the selection
+table."
   (let* ((drag-window (x-window-property "_MOTIF_DRAG_WINDOW"
                                          frame "WINDOW" 0 nil t))
          (targets-data (x-window-property "_MOTIF_DRAG_TARGETS"
@@ -809,60 +811,71 @@ Return a vector of atoms containing the selection targets."
 		    (selection-atom (x-dnd-get-motif-value
 				     data 12 4 source-byteorder))
 		    (atom-name (x-get-atom-name selection-atom))
-		    (dnd-source (x-dnd-get-motif-value
-			         data 16 4 source-byteorder))
-		    (action-type (x-dnd-maybe-call-test-function
-				  window
-				  source-action))
-		    (reply-action (and (not (posn-area (event-start event)))
-                                       (car (rassoc (car action-type)
-					            x-dnd-motif-to-action))))
-		    (reply-flags
-		     (x-dnd-motif-value-to-list
-                      (if (posn-area (event-start event))
-                          (+ ?\x20     ; 20: invalid drop site
-                             ?\x200)   ; 200: drop cancel
-		        (if reply-action
-			    (+ reply-action
-			       ?\x30   ; 30:  valid drop site
-			       ?\x700) ; 700: can do copy, move or link
-		          (+ ?\x30     ; 30:  drop site, but noop.
-			     ?\x200))) ; 200: drop cancel.
+                    (dnd-source (x-dnd-get-motif-value
+			         data 16 4 source-byteorder)))
+
+               ;; This might be a drop from a program that doesn't use
+               ;; the Motif drag protocol.  Compute all the necessary
+               ;; state here if that is true.
+               (unless (and (x-dnd-get-state-for-frame frame)
+                            (aref (x-dnd-get-state-for-frame frame) 2))
+                 (x-dnd-forget-drop frame)
+                 (let ((types (x-dnd-xm-read-targets frame dnd-source
+                                                     atom-name)))
+                   (x-dnd-save-state window nil nil types dnd-source)))
+
+               (let* ((action-type (x-dnd-maybe-call-test-function
+			            window
+			            source-action))
+		      (reply-action (and (not (posn-area (event-start event)))
+                                         (car (rassoc (car action-type)
+					              x-dnd-motif-to-action))))
+		      (reply-flags
+		       (x-dnd-motif-value-to-list
+                        (if (posn-area (event-start event))
+                            (+ ?\x20     ; 20: invalid drop site
+                               ?\x200)   ; 200: drop cancel
+		          (if reply-action
+			      (+ reply-action
+			         ?\x30   ; 30:  valid drop site
+			         ?\x700) ; 700: can do copy, move or link
+		            (+ ?\x30     ; 30:  drop site, but noop.
+			       ?\x200))) ; 200: drop cancel.
 		        2 my-byteorder))
-		    (reply (append
-			    (list
-			     (+ ?\x80	; 0x80 indicates a reply.
-			        5)	; DROP_START.
-			     my-byteorder)
-			    reply-flags
-			    x y))
-		    (timestamp (x-dnd-get-motif-value
-			        data 4 4 source-byteorder))
-		    action)
-
-	       (x-send-client-message frame
-				      dnd-source
-				      frame
-				      "_MOTIF_DRAG_AND_DROP_MESSAGE"
-				      8
-				      reply)
-	       (setq action
-		     (when (and reply-action atom-name)
-		       (let* ((value (x-get-selection-internal
-				      (intern atom-name)
-				      (intern (x-dnd-current-type window)))))
-		         (when value
-			   (condition-case info
-			       (x-dnd-drop-data event frame window value
-					        (x-dnd-current-type window))
-			     (error
-			      (message "Error: %s" info)
-			      nil))))))
-	       (x-get-selection-internal
-	        (intern atom-name)
-	        (if action 'XmTRANSFER_SUCCESS 'XmTRANSFER_FAILURE)
-	        timestamp)
-	       (x-dnd-forget-drop frame)))
+		      (reply (append
+			      (list
+			       (+ ?\x80	; 0x80 indicates a reply.
+			          5)	; DROP_START.
+			       my-byteorder)
+			      reply-flags
+			      x y))
+		      (timestamp (x-dnd-get-motif-value
+			          data 4 4 source-byteorder))
+		      action)
+
+	         (x-send-client-message frame
+				        dnd-source
+				        frame
+				        "_MOTIF_DRAG_AND_DROP_MESSAGE"
+				        8
+				        reply)
+	         (setq action
+		       (when (and reply-action atom-name)
+		         (let* ((value (x-get-selection-internal
+				        (intern atom-name)
+				        (intern (x-dnd-current-type window)))))
+		           (when value
+			     (condition-case info
+			         (x-dnd-drop-data event frame window value
+					          (x-dnd-current-type window))
+			       (error
+			        (message "Error: %s" info)
+			        nil))))))
+	         (x-get-selection-internal
+	          (intern atom-name)
+	          (if action 'XmTRANSFER_SUCCESS 'XmTRANSFER_FAILURE)
+	          timestamp)
+	         (x-dnd-forget-drop frame))))
 
             (t (message "Unknown Motif drag-and-drop message: %s"
                         (logand (aref data 0) #x3f)))))))
-- 
2.39.2