Also show mouse DND tooltip contents during interprogram drag-and-drop

* doc/lispref/frames.texi (Drag and Drop): Document new
parameter to `x-begin-drag'.
* lisp/mouse.el (mouse-drag-and-drop-region): Don't hide tooltip
when initiating interprogram drag-and-drop.
* lisp/term/haiku-win.el (x-begin-drag):
* lisp/term/ns-win.el (x-begin-drag): Add stubs for new
parameter.
* src/xfns.c (Fx_begin_drag): New parameter `follow-tooltip'.
(Fx_show_tip, syms_of_xfns): Add records of the last dx and dy
given to `x-show-tip'.
* src/xterm.c (x_clear_dnd_monitors): New function.
(x_dnd_begin_drag_and_drop): Save monitor attributes list if
appropriate.
(x_dnd_compute_tip_xy, x_dnd_update_tooltip_position): New
function.
(x_dnd_update_state, handle_one_xevent): Update tooltip position
during DND mouse movement.
(syms_of_xterm): Update staticpros.
* src/xterm.h: Update prototypes.

7 files changed, 187 insertions, 11 deletions

diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 9f7666ac63c..16f7ad312a4 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4194,7 +4194,7 @@ 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
+@defun x-begin-drag targets &optional action frame return-frame allow-current-frame follow-tooltip
 This function begins a drag from @var{frame}, and returns when the
 drag-and-drop operation ends, either because the drop was successful,
 or because the drop was rejected.  The drop occurs when all mouse
@@ -4231,6 +4231,12 @@ want to treat dragging content from one frame to another specially,
 while also being able to drag content to other programs, but it is not
 guaranteed to work on all systems and with all window managers.
 
+If @var{follow-tooltip} is non-@code{nil}, the position of any tooltip
+(such as one shown by @code{tooltip-show}) will follow the location of
+the mouse pointer whenever it moves during the drag-and-drop
+operation.  The tooltip will be hidden once all mouse buttons are
+released.
+
 If the drop was rejected or no drop target was found, this function
 returns @code{nil}.  Otherwise, it returns a symbol describing the
 action the target chose to perform, which can differ from @var{action}
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 024a018bb91..6a2b1738f71 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -3244,7 +3244,6 @@ is copied instead of being cut."
                                                                (cdr mouse-position)))))))
                                         (not (posn-window (event-end event))))))
                       (setq drag-again-mouse-position nil)
-                      (mouse-drag-and-drop-region-hide-tooltip)
                       (gui-set-selection 'XdndSelection value-selection)
                       (let ((drag-action-or-frame
                              (condition-case nil
@@ -3259,7 +3258,7 @@ is copied instead of being cut."
                                                ;; `return-frame' doesn't
                                                ;; work, allow dropping on
                                                ;; the drop frame.
-                                               (eq window-system 'haiku))
+                                               (eq window-system 'haiku) t)
                                (quit nil))))
                         (when (framep drag-action-or-frame)
                           ;; With some window managers `x-begin-drag'
diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el
index 6ddf546ee57..58217513902 100644
--- a/lisp/term/haiku-win.el
+++ b/lisp/term/haiku-win.el
@@ -366,7 +366,8 @@ take effect on menu items until the menu bar is updated again."
 
 (setq haiku-drag-track-function #'haiku-dnd-drag-handler)
 
-(defun x-begin-drag (targets &optional action frame _return-frame allow-current-frame)
+(defun x-begin-drag (targets &optional action frame _return-frame
+                             allow-current-frame _follow-tooltip)
   "SKIP: real doc in xfns.c."
   (unless haiku-dnd-selection-value
     (error "No local value for XdndSelection"))
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 2e021b9b29c..0d46a895ce8 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -895,7 +895,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
                                          &context (window-system ns))
   (ns-get-selection selection-symbol target-type))
 
-(defun x-begin-drag (targets &optional action frame return-frame allow-current-frame)
+(defun x-begin-drag (targets &optional action frame return-frame
+                             allow-current-frame _follow-tooltip)
   "SKIP: real doc in xfns.c."
   (unless ns-dnd-selection-value
     (error "No local value for XdndSelection"))
diff --git a/src/xfns.c b/src/xfns.c
index f0a2ec666c9..15e96183e3b 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -6831,7 +6831,7 @@ The coordinates X and Y are interpreted in pixels relative to a position
   return Qnil;
 }
 
-DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 5, 0,
+DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 6, 0,
        doc: /* Begin dragging contents on FRAME, with targets TARGETS.
 TARGETS is a list of strings, which defines the X selection targets
 that will be available to the drop target.  Block until the mouse
@@ -6882,12 +6882,17 @@ If ALLOW-CURRENT-FRAME is not specified or nil, then the drop target
 is allowed to be FRAME.  Otherwise, no action will be taken if the
 mouse buttons are released on top of FRAME.
 
+If FOLLOW-TOOLTIP is non-nil, any tooltip currently being displayed
+will be moved to follow the mouse pointer while the drag is in
+progress.
+
 This function will sometimes return immediately if no mouse buttons
 are currently held down.  It should only be called when it is known
 that mouse buttons are being held down, such as immediately after a
 `down-mouse-1' (or similar) event.  */)
   (Lisp_Object targets, Lisp_Object action, Lisp_Object frame,
-   Lisp_Object return_frame, Lisp_Object allow_current_frame)
+   Lisp_Object return_frame, Lisp_Object allow_current_frame,
+   Lisp_Object follow_tooltip)
 {
   struct frame *f = decode_window_system_frame (frame);
   int ntargets = 0, nnames = 0;
@@ -6985,7 +6990,7 @@ that mouse buttons are being held down, such as immediately after a
                                     xaction, return_frame, action_list,
                                     (const char **) &name_list, nnames,
                                     !NILP (allow_current_frame), target_atoms,
-                                    ntargets, original);
+                                    ntargets, original, !NILP (follow_tooltip));
 
   SAFE_FREE ();
   return lval;
@@ -7787,12 +7792,15 @@ static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
                             Lisp_Object, int, int, int *, int *);
 
 /* The frame of the currently visible tooltip, or nil if none.  */
-static Lisp_Object tip_frame;
+Lisp_Object tip_frame;
 
 /* The window-system window corresponding to the frame of the
    currently visible tooltip.  */
 Window tip_window;
 
+/* The X and Y deltas of the last call to `x-show-tip'.  */
+Lisp_Object tip_dx, tip_dy;
+
 /* A timer that hides or deletes the currently visible tooltip when it
    fires.  */
 static Lisp_Object tip_timer;
@@ -8506,6 +8514,9 @@ Text larger than the specified size is clipped.  */)
   else
     CHECK_FIXNUM (dy);
 
+  tip_dx = dx;
+  tip_dy = dy;
+
 #ifdef USE_GTK
   if (use_system_tooltips)
     {
@@ -9931,6 +9942,10 @@ eliminated in future versions of Emacs.  */);
   staticpro (&tip_last_string);
   tip_last_parms = Qnil;
   staticpro (&tip_last_parms);
+  tip_dx = Qnil;
+  staticpro (&tip_dx);
+  tip_dy = Qnil;
+  staticpro (&tip_dy);
 
   defsubr (&Sx_uses_old_gtk_dialog);
 #if defined (USE_MOTIF) || defined (USE_GTK)
diff --git a/src/xterm.c b/src/xterm.c
index 3cc730c4eeb..557555e7a4d 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1104,6 +1104,13 @@ struct frame *x_dnd_finish_frame;
    important information.  */
 bool x_dnd_waiting_for_finish;
 
+/* Whether or not to move the tooltip along with the mouse pointer
+   during drag-and-drop.  */
+static bool x_dnd_update_tooltip;
+
+/* Monitor attribute list used for updating the tooltip position.  */
+static Lisp_Object x_dnd_monitors;
+
 /* The display the drop target that is supposed to send information is
    on.  */
 static Display *x_dnd_finish_display;
@@ -4190,6 +4197,12 @@ x_free_dnd_targets (void)
 }
 
 static void
+x_clear_dnd_monitors (void)
+{
+  x_dnd_monitors = Qnil;
+}
+
+static void
 x_free_dnd_toplevels (void)
 {
   if (!x_dnd_use_toplevels || !x_dnd_toplevels)
@@ -10738,7 +10751,8 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction,
                            Lisp_Object return_frame, Atom *ask_action_list,
                            const char **ask_action_names, size_t n_ask_actions,
                            bool allow_current_frame, Atom *target_atoms,
-                           int ntargets, Lisp_Object selection_target_list)
+                           int ntargets, Lisp_Object selection_target_list,
+                           bool follow_tooltip)
 {
 #ifndef USE_GTK
   XEvent next_event;
@@ -10941,6 +10955,15 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction,
       unblock_input ();
     }
 
+  if (follow_tooltip)
+    {
+      x_dnd_monitors
+        = Fx_display_monitor_attributes_list (frame);
+      record_unwind_protect_void (x_clear_dnd_monitors);
+    }
+
+  x_dnd_update_tooltip = follow_tooltip;
+
   /* This shouldn't happen.  */
   if (x_dnd_toplevels)
     x_dnd_free_toplevels (true);
@@ -15131,6 +15154,106 @@ mouse_or_wdesc_frame (struct x_display_info *dpyinfo, int wdesc)
     }
 }
 
+static void
+x_dnd_compute_tip_xy (int *root_x, int *root_y, Lisp_Object attributes)
+{
+  Lisp_Object monitor, geometry;
+  int min_x, min_y, max_x, max_y;
+  int width, height;
+
+  width = FRAME_PIXEL_WIDTH (XFRAME (tip_frame));
+  height = FRAME_PIXEL_HEIGHT (XFRAME (tip_frame));
+
+  max_y = -1;
+
+  /* Try to determine the monitor where the mouse pointer is and
+     its geometry.  See bug#22549.  */
+  while (CONSP (attributes))
+    {
+      monitor = XCAR (attributes);
+      geometry = assq_no_quit (Qgeometry, monitor);
+
+      if (CONSP (geometry))
+        {
+          min_x = XFIXNUM (Fnth (make_fixnum (1), geometry));
+          min_y = XFIXNUM (Fnth (make_fixnum (2), geometry));
+          max_x = min_x + XFIXNUM (Fnth (make_fixnum (3), geometry));
+          max_y = min_y + XFIXNUM (Fnth (make_fixnum (4), geometry));
+
+          if (min_x <= *root_x && *root_x < max_x
+              && min_y <= *root_y && *root_y < max_y)
+            break;
+
+          max_y = -1;
+        }
+
+      attributes = XCDR (attributes);
+    }
+
+  /* It was not possible to determine the monitor's geometry, so we
+     assign some sane defaults here: */
+  if (max_y < 0)
+    {
+      min_x = 0;
+      min_y = 0;
+      max_x = x_display_pixel_width (FRAME_DISPLAY_INFO (x_dnd_frame));
+      max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (x_dnd_frame));
+    }
+
+  if (*root_y + XFIXNUM (tip_dy) <= min_y)
+    *root_y = min_y; /* Can happen for negative dy */
+  else if (*root_y + XFIXNUM (tip_dy) + height <= max_y)
+    /* It fits below the pointer */
+    *root_y += XFIXNUM (tip_dy);
+  else if (height + XFIXNUM (tip_dy) + min_y <= *root_y)
+    /* It fits above the pointer.  */
+    *root_y -= height + XFIXNUM (tip_dy);
+  else
+    /* Put it on the top.  */
+    *root_y = min_y;
+
+  if (*root_x + XFIXNUM (tip_dx) <= min_x)
+    *root_x = 0; /* Can happen for negative dx */
+  else if (*root_x + XFIXNUM (tip_dx) + width <= max_x)
+    /* It fits to the right of the pointer.  */
+    *root_x += XFIXNUM (tip_dx);
+  else if (width + XFIXNUM (tip_dx) + min_x <= *root_x)
+    /* It fits to the left of the pointer.  */
+    *root_x -= width + XFIXNUM (tip_dx);
+  else
+    /* Put it left justified on the screen -- it ought to fit that way.  */
+    *root_x = min_x;
+}
+
+static void
+x_dnd_update_tooltip_position (int root_x, int root_y)
+{
+  struct frame *tip_f;
+
+  if (!x_dnd_in_progress || !x_dnd_update_tooltip)
+    return;
+
+  if (!FRAMEP (tip_frame))
+    return;
+
+  tip_f = XFRAME (tip_frame);
+
+  if (!FRAME_LIVE_P (tip_f)
+      || (FRAME_X_DISPLAY (tip_f)
+          != FRAME_X_DISPLAY (x_dnd_frame)))
+    return;
+
+  if (tip_window != None
+      && FIXNUMP (tip_dx) && FIXNUMP (tip_dy))
+    {
+      x_dnd_compute_tip_xy (&root_x, &root_y,
+                            x_dnd_monitors);
+
+      XMoveWindow (FRAME_X_DISPLAY (x_dnd_frame),
+                   tip_window, root_x, root_y);
+    }
+}
+
 /* Get the window underneath the pointer, see if it moved, and update
    the DND state accordingly.  */
 static void
@@ -15292,6 +15415,8 @@ x_dnd_update_state (struct x_display_info *dpyinfo, Time timestamp)
             xm_send_drag_motion_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame),
                                          target, &dmsg);
         }
+
+      x_dnd_update_tooltip_position (root_x, root_y);
     }
   /* The pointer moved out of the screen.  */
   else if (x_dnd_last_protocol_version != -1)
@@ -17462,6 +17587,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
                                                target, &dmsg);
               }
 
+            x_dnd_update_tooltip_position (event->xmotion.x_root,
+                                           event->xmotion.y_root);
+
             goto OTHER;
           }
 
@@ -17966,6 +18094,14 @@ handle_one_xevent (struct x_display_info *dpyinfo,
                   {
                     x_dnd_end_window = x_dnd_last_seen_window;
                     x_dnd_in_progress = false;
+
+                    if (x_dnd_update_tooltip
+                        && FRAMEP (tip_frame)
+                        && FRAME_LIVE_P (XFRAME (tip_frame))
+                        && (FRAME_X_DISPLAY (XFRAME (tip_frame))
+                            == FRAME_X_DISPLAY (x_dnd_frame)))
+                      Fx_hide_tip ();
+
                     x_dnd_finish_frame = x_dnd_frame;
 
                     if (x_dnd_last_seen_window != None
@@ -19172,6 +19308,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
                                                      target, &dmsg);
                     }
 
+                  x_dnd_update_tooltip_position (xev->root_x, xev->root_y);
+
                   goto XI_OTHER;
                 }
 
@@ -19332,6 +19470,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
                           x_dnd_end_window = x_dnd_last_seen_window;
                           x_dnd_in_progress = false;
 
+                          /* If a tooltip that we're following is
+                             displayed, hide it now.  */
+
+                          if (x_dnd_update_tooltip
+                              && FRAMEP (tip_frame)
+                              && FRAME_LIVE_P (XFRAME (tip_frame))
+                              && (FRAME_X_DISPLAY (XFRAME (tip_frame))
+                                  == FRAME_X_DISPLAY (x_dnd_frame)))
+                            Fx_hide_tip ();
+
                           /* This doesn't have to be marked since it
                              is only accessed if
                              x_dnd_waiting_for_finish is true, which
@@ -26645,6 +26793,9 @@ syms_of_xterm (void)
   x_error_message = NULL;
   PDUMPER_IGNORE (x_error_message);
 
+  x_dnd_monitors = Qnil;
+  staticpro (&x_dnd_monitors);
+
   DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms");
   DEFSYM (Qlatin_1, "latin-1");
   DEFSYM (Qnow, "now");
diff --git a/src/xterm.h b/src/xterm.h
index 7e91e28ed13..25d145c6c0a 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -736,6 +736,9 @@ extern bool x_display_ok (const char *);
 extern void select_visual (struct x_display_info *);
 
 extern Window tip_window;
+extern Lisp_Object tip_dx;
+extern Lisp_Object tip_dy;
+extern Lisp_Object tip_frame;
 
 /* Each X frame object points to its own struct x_output object
    in the output_data.x field.  The x_output structure contains
@@ -1467,7 +1470,7 @@ extern bool x_detect_pending_selection_requests (void);
 extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom,
                                               Lisp_Object, Atom *, const char **,
                                               size_t, bool, Atom *, int,
-                                              Lisp_Object);
+                                              Lisp_Object, bool);
 extern void x_dnd_do_unsupported_drop (struct x_display_info *, Lisp_Object,
                                        Lisp_Object, Lisp_Object, Window, int,
                                        int, Time);