master 0936d6fa20: Implement `follow-tooltip' for DND on Haiku

[Po Lu]

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

    Implement `follow-tooltip' for DND on Haiku
    
    * lisp/term/haiku-win.el (x-begin-drag): Implement
    `follow-tooltip'.
    * src/haikufns.c (Fx_show_tip): Record last dx and dy.
    (syms_of_haikufns): New staticpros.
    
    * src/haikuselect.c (haiku_unwind_drag_message): Clear new flag.
    (Fhaiku_drag_message): New argument `follow-tooltip'.  Set new
    flag.
    (haiku_dnd_compute_tip_xy): New function.
    (haiku_note_drag_motion): Move tooltip if flag is true.
    
    * src/haikuterm.c (haiku_read_socket): Don't generate help event
    if mouse moves onto a tooltip during DND.
    * src/haikuterm.h: Update prototypes.
---
 lisp/term/haiku-win.el |  5 ++--
 src/haikufns.c         | 10 +++++++
 src/haikuselect.c      | 77 ++++++++++++++++++++++++++++++++++++++++++++++++--
 src/haikuterm.c        |  9 ++++--
 src/haikuterm.h        |  4 +++
 5 files changed, 98 insertions(+), 7 deletions(-)

diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el
index 5821751390..f99d332bd2 100644
--- a/lisp/term/haiku-win.el
+++ b/lisp/term/haiku-win.el
@@ -367,7 +367,7 @@ 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 _follow-tooltip)
+                             allow-current-frame follow-tooltip)
   "SKIP: real doc in xfns.c."
   (unless haiku-dnd-selection-value
     (error "No local value for XdndSelection"))
@@ -409,7 +409,8 @@ take effect on menu items until the menu bar is updated 
again."
                     action)
                'XdndActionCopy)
       (haiku-drag-message (or frame (selected-frame))
-                          message allow-current-frame))))
+                          message allow-current-frame
+                          follow-tooltip))))
 
 (add-variable-watcher 'use-system-tooltips #'haiku-use-system-tooltips-watcher)
 
diff --git a/src/haikufns.c b/src/haikufns.c
index 6a79eede0e..0b8bf89d85 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -50,6 +50,9 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
 /* The frame of the currently visible tooltip.  */
 Lisp_Object tip_frame;
 
+/* The X and Y deltas of the last call to `x-show-tip'.  */
+Lisp_Object tip_dx, tip_dy;
+
 /* The window-system window corresponding to the frame of the
    currently visible tooltip.  */
 static Window tip_window;
@@ -2352,6 +2355,9 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
   else
     CHECK_FIXNUM (dy);
 
+  tip_dx = dx;
+  tip_dy = dy;
+
   if (use_system_tooltips)
     {
       int root_x, root_y;
@@ -3165,6 +3171,10 @@ syms_of_haikufns (void)
   staticpro (&tip_last_string);
   tip_last_parms = Qnil;
   staticpro (&tip_last_parms);
+  tip_dx = Qnil;
+  staticpro (&tip_dx);
+  tip_dy = Qnil;
+  staticpro (&tip_dy);
 
   DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size,
               doc: /* SKIP: real doc in xfns.c.  */);
diff --git a/src/haikuselect.c b/src/haikuselect.c
index 80604252cb..b69fcfff13 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -33,6 +33,9 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
    the nested event loop inside be_drag_message.  */
 struct frame *haiku_dnd_frame;
 
+/* Whether or not to move the tip frame during drag-and-drop.  */
+bool haiku_dnd_follow_tooltip;
+
 static void haiku_lisp_to_message (Lisp_Object, void *);
 
 static enum haiku_clipboard
@@ -752,10 +755,13 @@ haiku_unwind_drag_message (void *message)
 {
   haiku_dnd_frame = NULL;
   BMessage_delete (message);
+
+  if (haiku_dnd_follow_tooltip)
+    Fx_hide_tip ();
 }
 
 DEFUN ("haiku-drag-message", Fhaiku_drag_message, Shaiku_drag_message,
-       2, 3, 0,
+       2, 4, 0,
        doc: /* Begin dragging MESSAGE from FRAME.
 
 MESSAGE an alist of strings, denoting message field names, to a list
@@ -789,8 +795,12 @@ FRAME is a window system frame that must be visible, from 
which the
 drag will originate.
 
 ALLOW-SAME-FRAME, if nil or not specified, means that MESSAGE will be
-ignored if it is dropped on top of FRAME.  */)
-  (Lisp_Object frame, Lisp_Object message, Lisp_Object allow_same_frame)
+ignored if it is dropped on top of FRAME.
+
+FOLLOW-TOOLTIP, if non-nil, will cause any non-system tooltip
+currently being displayed to move along with the mouse pointer.  */)
+  (Lisp_Object frame, Lisp_Object message, Lisp_Object allow_same_frame,
+   Lisp_Object follow_tooltip)
 {
   specpdl_ref idx;
   void *be_message;
@@ -804,15 +814,18 @@ ignored if it is dropped on top of FRAME.  */)
     error ("Frame is invisible");
 
   haiku_dnd_frame = f;
+  haiku_dnd_follow_tooltip = !NILP (follow_tooltip);
   be_message = be_create_simple_message ();
 
   record_unwind_protect_ptr (haiku_unwind_drag_message, be_message);
   haiku_lisp_to_message (message, be_message);
+
   rc = be_drag_message (FRAME_HAIKU_VIEW (f), be_message,
                        !NILP (allow_same_frame),
                        block_input, unblock_input,
                        process_pending_signals,
                        haiku_should_quit_drag);
+
   FRAME_DISPLAY_INFO (f)->grabbed = 0;
 
   if (rc)
@@ -918,6 +931,44 @@ after it starts.  */)
   return SAFE_FREE_UNBIND_TO (depth, Qnil);
 }
 
+static void
+haiku_dnd_compute_tip_xy (int *root_x, int *root_y)
+{
+  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));
+
+  min_x = 0;
+  min_y = 0;
+  be_get_screen_dimensions (&max_x, &max_y);
+
+  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 Lisp_Object
 haiku_note_drag_motion_1 (void *data)
 {
@@ -936,6 +987,26 @@ haiku_note_drag_motion_2 (enum nonlocal_exit exit, 
Lisp_Object error)
 void
 haiku_note_drag_motion (void)
 {
+  struct frame *tip_f;
+  int x, y;
+
+  if (FRAMEP (tip_frame) && haiku_dnd_follow_tooltip
+      && FIXNUMP (tip_dx) && FIXNUMP (tip_dy))
+    {
+      tip_f = XFRAME (tip_frame);
+
+      if (FRAME_LIVE_P (tip_f))
+       {
+         BView_get_mouse (FRAME_HAIKU_VIEW (haiku_dnd_frame),
+                          &x, &y);
+         BView_convert_to_screen (FRAME_HAIKU_VIEW (haiku_dnd_frame),
+                                  &x, &y);
+
+         haiku_dnd_compute_tip_xy (&x, &y);
+         BWindow_set_offset (FRAME_HAIKU_WINDOW (tip_f), x, y);
+       }
+    }
+
   internal_catch_all (haiku_note_drag_motion_1, NULL,
                      haiku_note_drag_motion_2);
 }
diff --git a/src/haikuterm.c b/src/haikuterm.c
index 55e8640ec2..d47e61e60d 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -3286,10 +3286,15 @@ haiku_read_socket (struct terminal *terminal, struct 
input_event *hold_quit)
            if (FRAME_TOOLTIP_P (f))
              {
                /* Dismiss the tooltip if the mouse moves onto a
-                  tooltip frame.  FIXME: for some reason we don't get
-                  leave notification events for this.  */
+                  tooltip frame (except when drag-and-drop is in
+                  progress and we are trying to move the tooltip
+                  along with the mouse pointer).  FIXME: for some
+                  reason we don't get leave notification events for
+                  this.  */
 
                if (any_help_event_p
+                   && !(be_drag_and_drop_in_progress ()
+                        && haiku_dnd_follow_tooltip)
                    && !((EQ (track_mouse, Qdrag_source)
                          || EQ (track_mouse, Qdropping))
                         && gui_mouse_grabbed (x_display_list)))
diff --git a/src/haikuterm.h b/src/haikuterm.h
index 41b1a85b00..ea20289b5d 100644
--- a/src/haikuterm.h
+++ b/src/haikuterm.h
@@ -219,7 +219,11 @@ extern struct haiku_display_info *x_display_list;
 extern struct font_driver const haikufont_driver;
 
 extern Lisp_Object tip_frame;
+extern Lisp_Object tip_dx;
+extern Lisp_Object tip_dy;
+
 extern struct frame *haiku_dnd_frame;
+extern bool haiku_dnd_follow_tooltip;
 
 extern frame_parm_handler haiku_frame_parm_handlers[];