Add touchscreen support to the tab bar

* lisp/menu-bar.el (popup-menu-normalize-position): Normalize
`touchscreen-begin' events correctly.
* lisp/tab-bar.el (tab-bar-mouse-context-menu): New argument
POSN.  Use it if specified.
(touch-screen-track-tap, tab-bar-handle-timeout)
(tab-bar-touchscreen-begin): New functions.
(tab-bar-map): Bind [tab-bar touchscreen-begin].
* lisp/touch-screen.el (touch-screen-track-drag): Fix doc
string.
* src/dispextern.h: Export `get_tab_bar_item_kbd'.
* src/keyboard.c (coords_in_tab_bar_window): New function.
(make_lispy_event): Adjust touchscreen begin event mouse
position list for tab bar.
* src/xdisp.c (tab_bar_item_info): Allow CLOSE_P to be NULL.
(get_tab_bar_item): Adjust doc string.
(get_tab_bar_item_kbd): New function.

6 files changed, 211 insertions, 22 deletions

diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 949d805465d..da002a46621 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -2669,20 +2669,25 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus."
 POSITION can be an event, a posn- value, a value having the
 form ((XOFFSET YOFFSET) WINDOW), or nil.
 If nil, the current mouse position is used, or nil if there is no mouse."
-  (pcase position
+  (cond
     ;; nil -> mouse cursor position
-    ('nil
+    ((eq position nil)
      (let ((mp (mouse-pixel-position)))
        (list (list (cadr mp) (cddr mp)) (car mp))))
     ;; Value returned from `event-end' or `posn-at-point'.
-    ((pred posnp)
+    ((posnp position)
      (let ((xy (posn-x-y position)))
        (list (list (car xy) (cdr xy))
 	     (posn-window position))))
+    ;; `touchscreen-begin' or `touchscreen-end' event.
+    ((or (eq (car-safe position) 'touchscreen-begin)
+         (eq (car-safe position) 'touchscreen-end))
+     position)
     ;; Event.
-    ((pred eventp)
+    ((eventp position)
      (popup-menu-normalize-position (event-end position)))
-    (_ position)))
+    ;; Some other value.
+    (t position)))
 
 (defcustom tty-menu-open-use-tmm nil
   "If non-nil, \\[menu-bar-open] on a TTY will invoke `tmm-menubar'.
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 9d703b5d048..1a33eda0866 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -341,10 +341,12 @@ only when you click on its \"x\" close button."
     (unless (eq tab-number t)
       (tab-bar-close-tab tab-number))))
 
-(defun tab-bar-mouse-context-menu (event)
-  "Pop up the context menu for the tab on which you click."
+(defun tab-bar-mouse-context-menu (event &optional posn)
+  "Pop up the context menu for the tab on which you click.
+EVENT is a mouse or touch screen event.  POSN is nil or the
+position of EVENT."
   (interactive "e")
-  (let* ((item (tab-bar--event-to-item (event-start event)))
+  (let* ((item (tab-bar--event-to-item (or posn (event-start event))))
          (tab-number (tab-bar--key-to-number (nth 0 item)))
          (menu (make-sparse-keymap (propertize "Context Menu" 'hide t))))
 
@@ -397,6 +399,78 @@ at the mouse-down event to the position at mouse-up event."
       (tab-bar-move-tab-to
        (if (null to) (1+ (tab-bar--current-tab-index)) to) from))))
 
+
+
+;;; Tab bar touchscreen support.
+
+(declare-function touch-screen-track-tap "touch-screen.el")
+
+(defun tab-bar-handle-timeout ()
+  "Handle a touch-screen timeout on the tab bar.
+Beep, then throw to `context-menu' and return."
+  (beep)
+  (throw 'context-menu 'context-menu))
+
+(defun tab-bar-touchscreen-begin (event)
+  "Handle a touchscreen begin EVENT on the tab bar.
+
+Determine where the touch was made.  If it was made on a tab
+itself, start a timer set to go off after a certain amount of
+time, and wait for the touch point to be released, and either
+display a context menu or select a tab as appropriate.
+
+Otherwise, if it was made on a button, close or create a tab as
+appropriate."
+  (interactive "e")
+  (let* ((posn (cdadr event))
+         (item (tab-bar--event-to-item posn))
+         (number (tab-bar--key-to-number (car item)))
+         timer)
+    (when (eq (catch 'context-menu
+                (cond ((integerp number)
+                       ;; The touch began on a tab.  Start a context
+                       ;; menu timer and start tracking the tap.
+                       (unwind-protect
+                           (progn
+                             (setq timer (run-at-time touch-screen-delay nil
+                                                      #'tab-bar-handle-timeout))
+                             ;; Now wait for the tap to complete.
+                             (when (touch-screen-track-tap event)
+                               ;; And select the tab, or close it,
+                               ;; depending on whether or not the
+                               ;; close button was pressed.
+                               (if (caddr item)
+                                   (tab-bar-close-tab number)
+                                 (tab-bar-select-tab number))))
+                         ;; Cancel the timer.
+                         (cancel-timer timer)))
+                      ((and (memq (car item) '(add-tab history-back
+                                                       history-forward))
+                            (functionp (cadr item)))
+                       ;; This is some kind of button.  Wait for the
+                       ;; tap to complete and press it.
+                       (when (touch-screen-track-tap event)
+                         (call-interactively (cadr item))))
+                      (t
+                       ;; The touch began on the tab bar itself.
+                       ;; Start a context menu timer and start
+                       ;; tracking the tap, but don't do anything
+                       ;; afterwards.
+                       (unwind-protect
+                           (progn
+                             (setq timer (run-at-time touch-screen-delay nil
+                                                      #'tab-bar-handle-timeout))
+                             ;; Now wait for the tap to complete.
+                             (touch-screen-track-tap event))
+                         ;; Cancel the timer.
+                         (cancel-timer timer)))))
+              'context-menu)
+      ;; Display the context menu in response to a time out waiting
+      ;; for the tap to complete.
+      (tab-bar-mouse-context-menu event posn))))
+
+
+
 (defvar-keymap tab-bar-map
   :doc "Keymap for the commands used on the tab bar."
   "<down-mouse-1>"  #'tab-bar-mouse-down-1
@@ -418,7 +492,8 @@ at the mouse-down event to the position at mouse-up event."
   "S-<wheel-up>"    #'tab-bar-move-tab-backward
   "S-<wheel-down>"  #'tab-bar-move-tab
   "S-<wheel-left>"  #'tab-bar-move-tab-backward
-  "S-<wheel-right>" #'tab-bar-move-tab)
+  "S-<wheel-right>" #'tab-bar-move-tab
+  "<touchscreen-begin>" #'tab-bar-touchscreen-begin)
 
 (global-set-key [tab-bar]
                 `(menu-item ,(purecopy "tab bar") ,(make-sparse-keymap)
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index 31d46b062ed..a7fa5b4829c 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -529,7 +529,7 @@ otherwise, return t once the `touchscreen-end' event arrives."
 
 (defun touch-screen-track-drag (event update &optional data)
   "Track a single drag starting from EVENT.
-EVENT should be a `touchscreen-end' event.
+EVENT should be a `touchscreen-begin' event.
 
 Read touch screen events until a `touchscreen-end' event is
 received with the same ID as in EVENT.  For each
diff --git a/src/dispextern.h b/src/dispextern.h
index 36e998070a4..402972d33d9 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3528,6 +3528,7 @@ extern void get_glyph_string_clip_rect (struct glyph_string *,
                                         NativeRectangle *nr);
 extern Lisp_Object find_hot_spot (Lisp_Object, int, int);
 
+extern int get_tab_bar_item_kbd (struct frame *, int, int, int *, bool *);
 extern Lisp_Object handle_tab_bar_click (struct frame *,
 					 int, int, bool, int);
 extern void handle_tool_bar_click (struct frame *,
diff --git a/src/keyboard.c b/src/keyboard.c
index 6e63cd71f30..c0d201f72ad 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -5875,6 +5875,25 @@ coords_in_menu_bar_window (struct frame *f, int x, int y)
 
 #endif
 
+/* Return whether or not the coordinates X and Y are inside the
+   tab-bar window of the given frame F.  */
+
+static bool
+coords_in_tab_bar_window (struct frame *f, int x, int y)
+{
+  struct window *window;
+
+  if (!WINDOWP (f->tab_bar_window))
+    return false;
+
+  window = XWINDOW (f->tab_bar_window);
+
+  return (y >= WINDOW_TOP_EDGE_Y (window)
+	  && x >= WINDOW_LEFT_EDGE_X (window)
+	  && y <= WINDOW_BOTTOM_EDGE_Y (window)
+	  && x <= WINDOW_RIGHT_EDGE_X (window));
+}
+
 /* Given a struct input_event, build the lisp event which represents
    it.  If EVENT is 0, build a mouse movement event from the mouse
    movement buffer, which should have a movement event in it.
@@ -6522,11 +6541,14 @@ make_lispy_event (struct input_event *event)
     case TOUCHSCREEN_END_EVENT:
       {
 	Lisp_Object x, y, id, position;
-	struct frame *f = XFRAME (event->frame_or_window);
+	struct frame *f;
+	int tab_bar_item;
+	bool close;
 #if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR
 	int column, row, dummy;
-#endif
+#endif /* defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR */
 
+	f = XFRAME (event->frame_or_window);
 	id = event->arg;
 	x = event->x;
 	y = event->y;
@@ -6589,10 +6611,53 @@ make_lispy_event (struct input_event *event)
 
 	    return Qnil;
 	  }
-#endif
+#endif /* defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR */
 
 	position = make_lispy_position (f, x, y, event->timestamp);
 
+#ifdef HAVE_WINDOW_SYSTEM
+
+	/* Now check if POSITION lies on the tab bar.  If so, look up
+	   the corresponding tab bar item's propertized string as the
+	   OBJECT.  */
+
+	if (coords_in_tab_bar_window (f, XFIXNUM (event->x),
+				      XFIXNUM (event->y))
+	    /* `get_tab_bar_item_kbd' returns 0 if the item was
+	       previously highlighted, 1 otherwise, and -1 if there is
+	       no tab bar item.  */
+	    && get_tab_bar_item_kbd (f, XFIXNUM (event->x),
+				     XFIXNUM (event->y), &tab_bar_item,
+				     &close) >= 0)
+	  {
+	    /* First, obtain the propertized string.  */
+	    x = Fcopy_sequence (AREF (f->tab_bar_items,
+				      (tab_bar_item
+				       + TAB_BAR_ITEM_CAPTION)));
+
+	    /* Next, add the key binding.  */
+	    AUTO_LIST2 (y, Qmenu_item, list3 (AREF (f->tab_bar_items,
+						    (tab_bar_item
+						     + TAB_BAR_ITEM_KEY)),
+					      AREF (f->tab_bar_items,
+						    (tab_bar_item
+						     + TAB_BAR_ITEM_BINDING)),
+					      close ? Qt : Qnil));
+
+	    /* And add the new properties to the propertized string.  */
+	    Fadd_text_properties (make_fixnum (0),
+				  make_fixnum (SCHARS (x)),
+				  y, x);
+
+	    /* Set the position to 0.  */
+	    x = Fcons (x, make_fixnum (0));
+
+	    /* Finally, add the OBJECT.  */
+	    position = nconc2 (position, Fcons (x, Qnil));
+	  }
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
 	return list2 (((event->kind
 			== TOUCHSCREEN_BEGIN_EVENT)
 		       ? Qtouchscreen_begin
diff --git a/src/xdisp.c b/src/xdisp.c
index 89b1ae77e6f..09b1cc616f2 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -14584,21 +14584,32 @@ tab_bar_item_info (struct frame *f, struct glyph *glyph,
 			     Qmenu_item, f->current_tab_bar_string);
   if (! FIXNUMP (prop))
     return false;
+
   *prop_idx = XFIXNUM (prop);
 
-  *close_p = !NILP (Fget_text_property (make_fixnum (charpos),
-                                        Qclose_tab,
-                                        f->current_tab_bar_string));
+  if (close_p)
+    *close_p = !NILP (Fget_text_property (make_fixnum (charpos),
+					  Qclose_tab,
+					  f->current_tab_bar_string));
 
   return true;
 }
 
 
-/* Get information about the tab-bar item at position X/Y on frame F.
-   Return in *GLYPH a pointer to the glyph of the tab-bar item in
-   the current matrix of the tab-bar window of F, or NULL if not
-   on a tab-bar item.  Return in *PROP_IDX the index of the tab-bar
-   item in F->tab_bar_items.  Value is
+/* Get information about the tab-bar item at position X/Y on frame F's
+   tab bar window.
+
+   Set *GLYPH to a pointer to the glyph of the tab-bar item in the
+   current matrix of the tab-bar window of F, or NULL if not on a
+   tab-bar item.  Return in *PROP_IDX the index of the tab-bar item in
+   F->tab_bar_items.
+
+   Place the window-relative vpos of Y in *VPOS, and the
+   window-relative hpos of X in *HPOS.  If CLOSE_P, set it to whether
+   or not the tab bar item represents a button that should close a
+   tab.
+
+   Value is
 
    -1	if X/Y is not on a tab-bar item
    0	if X/Y is on the same item that was highlighted before.
@@ -14606,7 +14617,7 @@ tab_bar_item_info (struct frame *f, struct glyph *glyph,
 
 static int
 get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
-		   int *hpos, int *vpos, int *prop_idx, bool *close_p)
+		  int *hpos, int *vpos, int *prop_idx, bool *close_p)
 {
   struct window *w = XWINDOW (f->tab_bar_window);
   int area;
@@ -14624,6 +14635,38 @@ get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
   return *prop_idx == f->last_tab_bar_item ? 0 : 1;
 }
 
+/* EXPORT:
+
+   Like `get_tab_bar_item'.  However, don't return anything for GLYPH,
+   HPOS, or VPOS, and treat X and Y as relative to F itself, as
+   opposed to its tab bar window.  */
+
+int
+get_tab_bar_item_kbd (struct frame *f, int x, int y, int *prop_idx,
+		      bool *close_p)
+{
+  struct window *w;
+  int area, vpos, hpos;
+  struct glyph *glyph;
+
+  w = XWINDOW (f->tab_bar_window);
+
+  /* Convert X and Y to window coordinates.  */
+  frame_to_window_pixel_xy (w, &x, &y);
+
+  /* Find the glyph under X/Y.  */
+  glyph = x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0,
+			    0, &area);
+  if (glyph == NULL)
+    return -1;
+
+  /* Get the start of this tab-bar item's properties in
+     f->tab_bar_items.  */
+  if (!tab_bar_item_info (f, glyph, prop_idx, close_p))
+    return -1;
+
+  return *prop_idx == f->last_tab_bar_item ? 0 : 1;
+}
 
 /* EXPORT:
    Handle mouse button event on the tab-bar of frame F, at