Implement wheel movement during DND on Haiku

* lisp/term/haiku-win.el (haiku-dnd-wheel-count): New defvar.
(haiku-note-wheel-click, haiku-handle-drag-wheel): New
functions.

* src/haiku_support.cc (EmacsWindow): Get rid of window ID
logic.
(MessageReceived, MouseMoved, be_drag_message): Use thread ID to
identify windows instead of window ID.

* src/haikuselect.c (Fhaiku_drag_message): Record whether or not
the DND frame is a valid drop target.
(haiku_note_drag_wheel): New function.
(syms_of_haikuselect): New defvar.

* src/haikuterm.c (haiku_read_socket): Call
`haiku_note_drag_wheel' when appropriate.
* src/haikuterm.h: Update prototypes.

5 files changed, 115 insertions, 20 deletions

diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el
index ec1e2f384a9..4a8db7c3217 100644
--- a/lisp/term/haiku-win.el
+++ b/lisp/term/haiku-win.el
@@ -459,7 +459,59 @@ take effect on menu items until the menu bar is updated again."
                           message allow-current-frame
                           follow-tooltip))))
 
-(add-variable-watcher 'use-system-tooltips #'haiku-use-system-tooltips-watcher)
+(add-variable-watcher 'use-system-tooltips
+                      #'haiku-use-system-tooltips-watcher)
+
+(defvar haiku-dnd-wheel-count nil
+  "Cons used to determine how many times the wheel has been turned.
+The car is just that; cdr is the timestamp of the last wheel
+movement.")
+
+(defun haiku-note-wheel-click (timestamp)
+  "Note that the mouse wheel was moved at TIMESTAMP during drag-and-drop.
+Return the number of clicks that were made in quick succession."
+  (if (not (integerp double-click-time))
+      1
+    (let ((cell haiku-dnd-wheel-count))
+      (unless cell
+        (setq cell (cons 0 timestamp))
+        (setq haiku-dnd-wheel-count cell))
+      (when (< (cdr cell) (- timestamp double-click-time))
+        (setcar cell 0))
+      (setcar cell (1+ (car cell)))
+      (setcdr cell timestamp)
+      (car cell))))
+
+(defvar haiku-drag-wheel-function)
+
+(defun haiku-handle-drag-wheel (frame x y horizontal up)
+  "Handle wheel movement during drag-and-drop.
+FRAME is the frame on top of which the wheel moved.
+X and Y are the frame-relative coordinates of the wheel movement.
+HORIZONTAL is whether or not the wheel movement was horizontal.
+UP is whether or not the wheel moved up (or left)."
+  ;; FIXME: redisplay is very slow after this.
+  (let ((function (cond
+                   ((and (not horizontal) up)
+                    mwheel-scroll-up-function)
+                   ((not horizontal)
+                    mwheel-scroll-down-function)
+                   (up (if mouse-wheel-flip-direction
+                           mwheel-scroll-right-function
+                         mwheel-scroll-left-function))
+                   (t (if mouse-wheel-flip-direction
+                          mwheel-scroll-left-function
+                        mwheel-scroll-right-function))))
+        (timestamp (time-convert nil 1000)))
+    (when function
+      (let ((posn (posn-at-x-y x y frame)))
+        (when (windowp (posn-window posn))
+          (with-selected-window (posn-window posn)
+            (funcall function
+                     (or (and (not mouse-wheel-progressive-speed) 1)
+                         (haiku-note-wheel-click (car timestamp))))))))))
+
+(setq haiku-drag-wheel-function #'haiku-handle-drag-wheel)
 
 
 ;;;; Session management.
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index 1f7f372a9b4..098739cd98b 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -189,10 +189,6 @@ static BMessage volatile *popup_track_message;
    number.  */
 static int32 volatile alert_popup_value;
 
-/* The current window ID.  This is increased every time a frame is
-   created.  */
-static int current_window_id;
-
 /* The view that has the passive grab.  */
 static void *grab_view;
 
@@ -698,7 +694,6 @@ public:
                    was_shown_p (false),
                    menu_bar_active_p (false),
                    override_redirect_p (false),
-                   window_id (current_window_id),
                    menus_begun (NULL),
                    z_group (Z_GROUP_NONE),
                    tooltip_p (false),
@@ -941,12 +936,11 @@ public:
     if (msg->WasDropped ())
       {
         BPoint whereto;
-        int32 windowid;
+        int64 threadid;
         struct haiku_drag_and_drop_event rq;
 
-        if (msg->FindInt32 ("emacs:window_id", &windowid) == B_OK
-            && !msg->IsSourceRemote ()
-            && windowid == this->window_id)
+        if (msg->FindInt64 ("emacs:thread_id", &threadid) == B_OK
+            && threadid == find_thread (NULL))
           return;
 
         whereto = msg->DropPoint ();
@@ -1794,7 +1788,7 @@ public:
   MouseMoved (BPoint point, uint32 transit, const BMessage *drag_msg)
   {
     struct haiku_mouse_motion_event rq;
-    int32 windowid;
+    int64 threadid;
     EmacsWindow *window;
 
     window = (EmacsWindow *) Window ();
@@ -1810,9 +1804,9 @@ public:
     rq.time = system_time ();
 
     if (drag_msg && (drag_msg->IsSourceRemote ()
-                     || drag_msg->FindInt32 ("emacs:window_id",
-                                             &windowid) != B_OK
-                     || windowid != window->window_id))
+                     || drag_msg->FindInt64 ("emacs:thread_id",
+                                             &threadid) != B_OK
+                     || threadid != find_thread (NULL)))
       rq.dnd_message = true;
     else
       rq.dnd_message = false;
@@ -5046,13 +5040,17 @@ be_drag_message (void *view, void *message, bool allow_same_view,
   BMessage cancel_message (CANCEL_DROP);
   struct object_wait_info infos[2];
   ssize_t stat;
+  thread_id window_thread;
 
   block_input_function ();
 
-  if (!allow_same_view &&
-      (msg->ReplaceInt32 ("emacs:window_id", window->window_id)
-       == B_NAME_NOT_FOUND))
-    msg->AddInt32 ("emacs:window_id", window->window_id);
+  if (!allow_same_view)
+    window_thread = window->Looper ()->Thread ();
+
+  if (!allow_same_view
+      && (msg->ReplaceInt64 ("emacs:thread_id", window_thread)
+          == B_NAME_NOT_FOUND))
+    msg->AddInt64 ("emacs:thread_id", window_thread);
 
   if (!vw->LockLooper ())
     gui_abort ("Failed to lock view looper for drag");
diff --git a/src/haikuselect.c b/src/haikuselect.c
index daad98da2b4..268d8b1ec92 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -37,6 +37,10 @@ struct frame *haiku_dnd_frame;
 /* Whether or not to move the tip frame during drag-and-drop.  */
 bool haiku_dnd_follow_tooltip;
 
+/* Whether or not the current DND frame is able to receive drops from
+   the current drag-and-drop operation.  */
+bool haiku_dnd_allow_same_frame;
+
 static void haiku_lisp_to_message (Lisp_Object, void *);
 
 static enum haiku_clipboard
@@ -830,6 +834,8 @@ currently being displayed to move along with the mouse pointer.  */)
 
   haiku_dnd_frame = f;
   haiku_dnd_follow_tooltip = !NILP (follow_tooltip);
+  haiku_dnd_allow_same_frame = !NILP (allow_same_frame);
+
   be_message = be_create_simple_message ();
 
   record_unwind_protect_ptr (haiku_unwind_drag_message, be_message);
@@ -1038,6 +1044,31 @@ haiku_note_drag_motion (void)
 }
 
 void
+haiku_note_drag_wheel (struct input_event *ie)
+{
+  bool horizontal, up;
+
+  up = false;
+  horizontal = false;
+
+  if (ie->modifiers & up_modifier)
+    up = true;
+
+  if (ie->kind == HORIZ_WHEEL_EVENT)
+    horizontal = true;
+
+  ie->kind = NO_EVENT;
+
+  if (!NILP (Vhaiku_drag_wheel_function)
+      && (haiku_dnd_allow_same_frame
+          || XFRAME (ie->frame_or_window) != haiku_dnd_frame))
+    safe_call (6, Vhaiku_drag_wheel_function, ie->frame_or_window,
+               ie->x, ie->y, horizontal ? Qt : Qnil, up ? Qt : Qnil);
+
+  redisplay_preserve_echo_area (35);
+}
+
+void
 init_haiku_select (void)
 {
   be_clipboard_init ();
@@ -1100,13 +1131,13 @@ void
 syms_of_haikuselect (void)
 {
   DEFVAR_BOOL ("haiku-signal-invalid-refs", haiku_signal_invalid_refs,
-     doc: /* If nil, silently ignore invalid file names in system messages.
+    doc: /* If nil, silently ignore invalid file names in system messages.
 Otherwise, an error will be signalled if adding a file reference to a
 system message failed.  */);
   haiku_signal_invalid_refs = true;
 
   DEFVAR_LISP ("haiku-drag-track-function", Vhaiku_drag_track_function,
-     doc: /* If non-nil, a function to call upon mouse movement while dragging a message.
+    doc: /* If non-nil, a function to call upon mouse movement while dragging a message.
 The function is called without any arguments.  `mouse-position' can be
 used to retrieve the current position of the mouse.  */);
   Vhaiku_drag_track_function = Qnil;
@@ -1116,6 +1147,16 @@ used to retrieve the current position of the mouse.  */);
 These are only called if a connection to the Haiku display was opened.  */);
   Vhaiku_lost_selection_functions = Qnil;
 
+  DEFVAR_LISP ("haiku-drag-wheel-function", Vhaiku_drag_wheel_function,
+    doc: /* Function called upon wheel movement while dragging a message.
+If non-nil, it is called with 5 arguments when the mouse wheel moves
+while a drag-and-drop operation is in progress: the frame where the
+mouse moved, the frame-relative X and Y positions where the mouse
+moved, whether or not the wheel movement was horizontal, and whether
+or not the wheel moved up (or left, if the movement was
+horizontal).  */);
+  Vhaiku_drag_wheel_function = Qnil;
+
   DEFSYM (QSECONDARY, "SECONDARY");
   DEFSYM (QCLIPBOARD, "CLIPBOARD");
   DEFSYM (QSTRING, "STRING");
diff --git a/src/haikuterm.c b/src/haikuterm.c
index bcb3af0e2c3..7630d9c103c 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -3867,6 +3867,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit)
                                    : down_modifier);
                 py = 0.0f;
                 px = 0.0f;
+
+                if (be_drag_and_drop_in_progress ())
+                  haiku_note_drag_wheel (&inev);
               }
 
             break;
diff --git a/src/haikuterm.h b/src/haikuterm.h
index 46a2218e492..02a364f6712 100644
--- a/src/haikuterm.h
+++ b/src/haikuterm.h
@@ -333,6 +333,7 @@ extern Lisp_Object haiku_popup_dialog (struct frame *, Lisp_Object, Lisp_Object)
 extern void haiku_activate_menubar (struct frame *);
 extern void haiku_wait_for_event (struct frame *, int);
 extern void haiku_note_drag_motion (void);
+extern void haiku_note_drag_wheel (struct input_event *);
 
 extern void initialize_frame_menubar (struct frame *);