master 84cf3be6f7: Handle mouse movement correctly during DND from one of our own frames

[Po Lu]

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

    Handle mouse movement correctly during DND from one of our own frames
    
    * lisp/dnd.el (dnd-handle-movement): Select the window specified
    in posn.
    * lisp/term/x-win.el (x-dnd-movement): New function.
    (x-dnd-movement-function): Set it as the default.
    * src/frame.c (delete_frame): Prevent deleting the drop source
    frame.
    * src/xterm.c (x_dnd_send_position): Set new mouse movement
    flags if the target window is one of our own frames.
    (x_dnd_begin_drag_and_drop): Call DND movement function whenever
    appropriate.
    (x_free_frame_resources): Remove useless code.
    (syms_of_xterm): New defvar `x-dnd-movement-function'.
    * src/xterm.h: Update prototypes.
---
 lisp/dnd.el        |  52 +++++++++++++-------------
 lisp/term/x-win.el |   8 ++++
 src/frame.c        |   4 ++
 src/xterm.c        | 106 +++++++++++++++++++++++++++++------------------------
 src/xterm.h        |   3 ++
 5 files changed, 101 insertions(+), 72 deletions(-)

diff --git a/lisp/dnd.el b/lisp/dnd.el
index 8b11973eb4..4f71edf1aa 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -107,31 +107,33 @@ program."
 
 (defun dnd-handle-movement (posn)
   "Handle mouse movement to POSN when receiving a drop from another program."
-  (when dnd-scroll-margin
-    (ignore-errors
-      (let* ((row (cdr (posn-col-row posn)))
-             (window (when (windowp (posn-window posn))
-                       (posn-window posn)))
-             (text-height (window-text-height window))
-             ;; Make sure it's possible to scroll both up
-             ;; and down if the margin is too large for the
-             ;; window.
-             (margin (min (/ text-height 3) dnd-scroll-margin)))
-        ;; At 2 lines, the window becomes too small for any
-        ;; meaningful scrolling.
-        (unless (<= text-height 2)
-          (cond
-           ;; Inside the bottom scroll margin, scroll up.
-           ((> row (- text-height margin))
-            (with-selected-window window
-              (scroll-up 1)))
-           ;; Inside the top scroll margin, scroll down.
-           ((< row margin)
-            (with-selected-window window
-              (scroll-down 1))))))))
-  (when dnd-indicate-insertion-point
-    (ignore-errors
-      (goto-char (posn-point posn)))))
+  (when (windowp (posn-window posn))
+    (with-selected-window (posn-window posn)
+      (when dnd-scroll-margin
+        (ignore-errors
+          (let* ((row (cdr (posn-col-row posn)))
+                 (window (when (windowp (posn-window posn))
+                           (posn-window posn)))
+                 (text-height (window-text-height window))
+                 ;; Make sure it's possible to scroll both up
+                 ;; and down if the margin is too large for the
+                 ;; window.
+                 (margin (min (/ text-height 3) dnd-scroll-margin)))
+            ;; At 2 lines, the window becomes too small for any
+            ;; meaningful scrolling.
+            (unless (<= text-height 2)
+              (cond
+               ;; Inside the bottom scroll margin, scroll up.
+               ((> row (- text-height margin))
+                (with-selected-window window
+                  (scroll-up 1)))
+               ;; Inside the top scroll margin, scroll down.
+               ((< row margin)
+                (with-selected-window window
+                  (scroll-down 1))))))))
+      (when dnd-indicate-insertion-point
+        (ignore-errors
+          (goto-char (posn-point posn)))))))
 
 (defun dnd-handle-one-url (window action url)
   "Handle one dropped url by calling the appropriate handler.
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 9ae238661e..f0b9b27f66 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -85,6 +85,7 @@
 (defvar x-selection-timeout)
 (defvar x-session-id)
 (defvar x-session-previous-id)
+(defvar x-dnd-movement-function)
 
 (defun x-handle-no-bitmap-icon (_switch)
   (setq default-frame-alist (cons '(icon-type) default-frame-alist)))
@@ -1576,6 +1577,13 @@ frames on all displays."
 (add-variable-watcher 'x-gtk-use-native-input
                       #'x-gtk-use-native-input-watcher)
 
+(defun x-dnd-movement (_frame position)
+  "Handle movement to POSITION during drag-and-drop."
+  (dnd-handle-movement position)
+  (redisplay))
+
+(setq x-dnd-movement-function #'x-dnd-movement)
+
 (provide 'x-win)
 (provide 'term/x-win)
 
diff --git a/src/frame.c b/src/frame.c
index 7a9ed3302e..05b22ac72b 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1987,6 +1987,10 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
       else
        error ("Attempt to delete the only frame");
     }
+#ifdef HAVE_X_WINDOWS
+  else if (x_dnd_in_progress && f == x_dnd_frame)
+    error ("Attempt to delete the drop source frame");
+#endif
 
   XSETFRAME (frame, f);
 
diff --git a/src/xterm.c b/src/xterm.c
index 2e4df67c76..d29a7a122a 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -846,7 +846,10 @@ static int x_filter_event (struct x_display_info *, XEvent 
*);
 /* Global state maintained during a drag-and-drop operation.  */
 
 /* Flag that indicates if a drag-and-drop operation is in progress.  */
-static bool x_dnd_in_progress;
+bool x_dnd_in_progress;
+
+/* The frame where the drag-and-drop operation originated.  */
+struct frame *x_dnd_frame;
 
 /* Flag that indicates if a drag-and-drop operation is no longer in
    progress, but the nested event loop should continue to run, because
@@ -946,9 +949,6 @@ static Atom *x_dnd_targets = NULL;
 /* The number of elements in that array.  */
 static int x_dnd_n_targets;
 
-/* The frame where the drag-and-drop operation originated.  */
-static struct frame *x_dnd_frame;
-
 /* The old window attributes of the root window before the
    drag-and-drop operation started.  It is used to keep the old event
    mask around, since that should be restored after the operation
@@ -959,6 +959,13 @@ static XWindowAttributes x_dnd_old_window_attrs;
    up the drag and drop operation.  */
 static bool x_dnd_unwind_flag;
 
+/* The frame for which `x-dnd-movement-function' should be called.  */
+static struct frame *x_dnd_movement_frame;
+
+/* The coordinates which the movement function should be called
+   with.  */
+static int x_dnd_movement_x, x_dnd_movement_y;
+
 struct x_client_list_window
 {
   Window window;
@@ -3137,6 +3144,23 @@ x_dnd_send_position (struct frame *f, Window target, int 
supported,
 {
   struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
   XEvent msg;
+  struct frame *target_frame;
+  int dest_x, dest_y;
+  Window child_return;
+
+  target_frame = x_top_window_to_frame (dpyinfo, target);
+
+  if (target_frame && XTranslateCoordinates (dpyinfo->display,
+                                            dpyinfo->root_window,
+                                            FRAME_X_WINDOW (target_frame),
+                                            root_x, root_y, &dest_x,
+                                            &dest_y, &child_return))
+    {
+      x_dnd_movement_frame = target_frame;
+      x_dnd_movement_x = dest_x;
+      x_dnd_movement_y = dest_y;
+      return;
+    }
 
   if (target == x_dnd_mouse_rect_target
       && x_dnd_mouse_rect.width
@@ -3151,9 +3175,6 @@ x_dnd_send_position (struct frame *f, Window target, int 
supported,
        return;
     }
 
-  if (x_top_window_to_frame (dpyinfo, target))
-    return;
-
   msg.xclient.type = ClientMessage;
   msg.xclient.message_type = dpyinfo->Xatom_XdndPosition;
   msg.xclient.format = 32;
@@ -9143,6 +9164,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, 
Atom xaction,
   ptrdiff_t i, end, fill;
   XTextProperty prop;
   xm_drop_start_message dmsg;
+  Lisp_Object frame_object, x, y;
 
   if (!FRAME_VISIBLE_P (f))
     error ("Frame is invisible");
@@ -9229,6 +9251,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, 
Atom xaction,
     = x_wm_supports (f, FRAME_DISPLAY_INFO 
(f)->Xatom_net_client_list_stacking);
   x_dnd_toplevels = NULL;
   x_dnd_allow_current_frame = allow_current_frame;
+  x_dnd_movement_frame = NULL;
 
   if (x_dnd_use_toplevels)
     {
@@ -9307,6 +9330,28 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, 
Atom xaction,
 #endif
 #endif
 
+      if (x_dnd_movement_frame)
+       {
+         XSETFRAME (frame_object, x_dnd_movement_frame);
+         XSETINT (x, x_dnd_movement_x);
+         XSETINT (y, x_dnd_movement_y);
+         x_dnd_movement_frame = NULL;
+
+         if (!NILP (Vx_dnd_movement_function)
+             && !FRAME_TOOLTIP_P (XFRAME (frame_object)))
+           {
+             x_dnd_old_window_attrs = root_window_attrs;
+             x_dnd_unwind_flag = true;
+
+             ref = SPECPDL_INDEX ();
+             record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f);
+             call2 (Vx_dnd_movement_function, frame_object,
+                    Fposn_at_x_y (x, y, frame_object, Qnil));
+             x_dnd_unwind_flag = false;
+             unbind_to (ref, Qnil);
+           }
+       }
+
       if (hold_quit.kind != NO_EVENT)
        {
          if (hold_quit.kind == SELECTION_REQUEST_EVENT)
@@ -20746,46 +20791,6 @@ x_free_frame_resources (struct frame *f)
   Lisp_Object bar;
   struct scroll_bar *b;
 #endif
-  xm_drop_start_message dmsg;
-
-  if (x_dnd_in_progress && f == x_dnd_frame)
-    {
-      block_input ();
-      if (x_dnd_last_seen_window != None
-         && x_dnd_last_protocol_version != -1)
-       x_dnd_send_leave (f, x_dnd_last_seen_window);
-      else if (x_dnd_last_seen_window != None
-              && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style)
-              && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE
-              && x_dnd_motif_setup_p)
-       {
-         dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR,
-                                       XM_DRAG_REASON_DROP_START);
-         dmsg.byte_order = XM_TARGETS_TABLE_CUR;
-         dmsg.timestamp = 0;
-         dmsg.side_effects
-           = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo,
-                                                              
x_dnd_wanted_action),
-                                  XM_DROP_SITE_VALID,
-                                  xm_side_effect_from_action (dpyinfo,
-                                                              
x_dnd_wanted_action),
-                                  XM_DROP_ACTION_DROP_CANCEL);
-         dmsg.x = 0;
-         dmsg.y = 0;
-         dmsg.index_atom = dpyinfo->Xatom_XdndSelection;
-         dmsg.source_window = FRAME_X_WINDOW (f);
-
-         xm_send_drop_message (dpyinfo, FRAME_X_WINDOW (f),
-                               x_dnd_last_seen_window, &dmsg);
-       }
-      unblock_input ();
-
-      x_dnd_end_window = None;
-      x_dnd_last_seen_window = None;
-      x_dnd_in_progress = false;
-      x_dnd_waiting_for_finish = false;
-      x_dnd_frame = NULL;
-    }
 
   block_input ();
 
@@ -23054,4 +23059,11 @@ coordinates to a Motif drop receiver when the mouse 
moves outside it
 during a drag-and-drop session, to work around broken implementations
 of Motif.  */);
   x_dnd_fix_motif_leave = true;
+
+  DEFVAR_LISP ("x-dnd-movement-function", Vx_dnd_movement_function,
+    doc: /* Function called upon mouse movement on a frame during 
drag-and-drop.
+It should either be nil, or accept two arguments FRAME and POSITION,
+where FRAME is the frame the mouse is on top of, and POSITION is a
+mouse position list.  */);
+  Vx_dnd_movement_function = Qnil;
 }
diff --git a/src/xterm.h b/src/xterm.h
index 57036af2bb..5627fd23c5 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1548,6 +1548,9 @@ extern void x_session_close (void);
 extern struct input_event xg_pending_quit_event;
 #endif
 
+extern bool x_dnd_in_progress;
+extern struct frame *x_dnd_frame;
+
 #ifdef HAVE_XINPUT2
 struct xi_device_t *xi_device_from_id (struct x_display_info *, int);
 #endif