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.

3 files changed, 90 insertions, 10 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