feature/android fdc0bf25b2a: Allow interacting with the tab line from a touch screen

[Po Lu]

branch: feature/android
commit fdc0bf25b2a608625c6292c723ef40ad8e6ed76a
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Allow interacting with the tab line from a touch screen
    
    * doc/emacs/frames.texi (Tab Bars): Explain how to interact with
    the tab bar from a touch screen.
    * doc/emacs/input.texi (Touchscreens): Document exactly what a
    ``long press'' is.
    * doc/emacs/windows.texi (Tab Line): Likewise.
    * lisp/tab-line.el (tab-line-tab-map, tab-line-add-map)
    (tab-line-tab-close-map, tab-line-left-map, tab-line-right-map):
    Bind `touchscreen-begin' to each command.
    (tab-line-track-tap, tab-line-event-start): New functions.
    (tab-line-hscroll-right, tab-line-hscroll-left, tab-line-new-tab)
    (tab-line-select-tab, tab-line-close-tab): Use them.
---
 doc/emacs/frames.texi  |   9 +++
 doc/emacs/input.texi   |  17 +++--
 doc/emacs/windows.texi |   7 ++
 lisp/tab-line.el       | 169 ++++++++++++++++++++++++++++++++-----------------
 4 files changed, 138 insertions(+), 64 deletions(-)

diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index ce631561be7..4e09c1c3f67 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -1571,6 +1571,15 @@ the items that operate on the clicked tab.  Dragging the 
tab with
 wheel scrolling switches to the next or previous tab.  Holding down
 the @key{SHIFT} key during scrolling moves the tab to the left or right.
 
+  Touch screen input (@pxref{Other Input Devices}) can also be used to
+operate on tabs.  Long-pressing (@pxref{Touchscreens}) a tab will
+display a context menu with items that operate on the tab that was
+pressed, and long-pressing the tab bar itself will display a context
+menu which lets you create and remove tabs; tapping a tab itself will
+result in that tab's window configuration being selected, and tapping
+a button on the tab bar will behave as if it was clicked with
+@kbd{mouse-1}.
+
 @findex tab-bar-history-mode
   You can enable @code{tab-bar-history-mode} to remember window
 configurations used in every tab, and later restore them.
diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi
index b4b37501a14..96743349a1c 100644
--- a/doc/emacs/input.texi
+++ b/doc/emacs/input.texi
@@ -51,17 +51,20 @@ window horizontally to follow (@pxref{Horizontal 
Scrolling}.)
 
 @item
 @cindex dragging, touchscreens
-  ``Dragging'', meaning to place a tool on the display and leave it
-there for a while before moving the tool around, will make Emacs set
-the point to where the tool was and begin selecting text under the
-tool as it moves around, much like what would happen if @code{mouse-1}
-were to be held down.  @xref{Mouse Commands}.
+@cindex long-press, touchscreens
+  ``Dragging'', meaning to perform a @dfn{long-press} (placing a tool
+on the display and leaving it there for a while) before moving the
+tool around, will make Emacs set the point to where the tool was and
+begin selecting text under the tool as it moves around, much like what
+would happen if @code{mouse-1} were to be held down.  @xref{Mouse
+Commands}.
 @end itemize
 
 @vindex touch-screen-delay
   By default, Emacs considers a tool as having been left on the
-display for a while after 0.7 seconds, but this can be changed by
-customizing the variable @code{touch-screen-delay}.
+display long enough to trigger a ``long-press'' after 0.7 seconds, but
+this can be changed by customizing the variable
+@code{touch-screen-delay}.
 
 @node On-Screen Keyboards
 @section Using Emacs with virtual keyboards
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index e4abdef76be..665fd80e53b 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -642,6 +642,13 @@ to the window-local tab line of buffers, and clicking on 
the @kbd{x}
 icon of a tab deletes it.  The mouse wheel on the tab line scrolls
 the tabs horizontally.
 
+  Touch screen input (@pxref{Other Input Devices}) can also be used to
+interact with the ``tab line''.  Long-pressing (@pxref{Touchscreens})
+a tab will display a context menu with items that operate on the tab
+that was pressed; tapping a tab itself will result in switching to
+that tab's buffer, and tapping a button on the tab line will behave as
+if it was clicked with @kbd{mouse-1}.
+
 Selecting the previous window-local tab is the same as typing @kbd{C-x
 @key{LEFT}} (@code{previous-buffer}), selecting the next tab is the
 same as @kbd{C-x @key{RIGHT}} (@code{next-buffer}).  Both commands
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 1958f12975f..d7c3049270a 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -137,33 +137,38 @@ function `tab-line-tab-face-group'."
 
 (defvar-keymap tab-line-tab-map
   :doc "Local keymap for `tab-line-mode' window tabs."
-  "<tab-line> <down-mouse-1>" #'tab-line-select-tab
-  "<tab-line> <mouse-2>"      #'tab-line-close-tab
-  "<tab-line> <down-mouse-3>" #'tab-line-tab-context-menu
+  "<tab-line> <down-mouse-1>"      #'tab-line-select-tab
+  "<tab-line> <mouse-2>"           #'tab-line-close-tab
+  "<tab-line> <down-mouse-3>"      #'tab-line-tab-context-menu
+  "<tab-line> <touchscreen-begin>" #'tab-line-select-tab
   "RET" #'tab-line-select-tab)
 
 (defvar-keymap tab-line-add-map
   :doc "Local keymap to add `tab-line-mode' window tabs."
-  "<tab-line> <down-mouse-1>" #'tab-line-new-tab
-  "<tab-line> <down-mouse-2>" #'tab-line-new-tab
+  "<tab-line> <down-mouse-1>"      #'tab-line-new-tab
+  "<tab-line> <down-mouse-2>"      #'tab-line-new-tab
+  "<tab-line> <touchscreen-begin>" #'tab-line-new-tab
   "RET" #'tab-line-new-tab)
 
 (defvar-keymap tab-line-tab-close-map
   :doc "Local keymap to close `tab-line-mode' window tabs."
-  "<tab-line> <mouse-1>" #'tab-line-close-tab
-  "<tab-line> <mouse-2>" #'tab-line-close-tab)
+  "<tab-line> <mouse-1>"           #'tab-line-close-tab
+  "<tab-line> <mouse-2>"           #'tab-line-close-tab
+  "<tab-line> <touchscreen-begin>" #'tab-line-close-tab)
 
 (defvar-keymap tab-line-left-map
   :doc "Local keymap to scroll `tab-line-mode' window tabs to the left."
-  "<tab-line> <down-mouse-1>" #'tab-line-hscroll-left
-  "<tab-line> <down-mouse-2>" #'tab-line-hscroll-left
-  "RET" #'tab-line-new-tab)
+  "<tab-line> <down-mouse-1>"      #'tab-line-hscroll-left
+  "<tab-line> <down-mouse-2>"      #'tab-line-hscroll-left
+  "<tab-line> <touchscreen-begin>" #'tab-line-hscroll-left
+  "RET"                            #'tab-line-new-tab)
 
 (defvar-keymap tab-line-right-map
   :doc "Local keymap to scroll `tab-line-mode' window tabs to the right."
-  "<tab-line> <down-mouse-1>" #'tab-line-hscroll-right
-  "<tab-line> <down-mouse-2>" #'tab-line-hscroll-right
-  "RET" #'tab-line-new-tab)
+  "<tab-line> <down-mouse-1>"      #'tab-line-hscroll-right
+  "<tab-line> <down-mouse-2>"      #'tab-line-hscroll-right
+  "<tab-line> <touchscreen-begin>" #'tab-line-hscroll-right
+  "RET"                            #'tab-line-new-tab)
 
 
 (defcustom tab-line-new-tab-choice t
@@ -326,6 +331,48 @@ or by `tab-line-tabs-buffer-groups'."
   "Function to return a global list of buffers.
 Used only for `tab-line-tabs-mode-buffers' and `tab-line-tabs-buffer-groups'.")
 
+
+
+;;; Touch screen support.
+
+(defun tab-line-track-tap (event &optional function)
+  "Track a tap starting from EVENT.
+If EVENT is not a `touchscreen-begin' event, return t.
+Otherwise, return t if the tap completes successfully, and nil if
+the tap should be ignored.
+
+If FUNCTION is specified and the tap does not complete within
+`touch-screen-delay' seconds, display the appropriate context
+menu by calling FUNCTION with EVENT, and return nil."
+  (if (not (eq (car-safe event) 'touchscreen-begin))
+      t
+    (let ((result (catch 'context-menu
+                    (let (timer)
+                      (unwind-protect
+                          (progn
+                            (when function
+                              (setq timer
+                                    (run-at-time touch-screen-delay t
+                                                 #'throw 'context-menu
+                                                 'context-menu)))
+                            (touch-screen-track-tap event))
+                        (when timer
+                          (cancel-timer timer)))))))
+      (cond ((eq result 'context-menu)
+             (prog1 nil
+               (funcall function event)))
+            (result t)))))
+
+(defun tab-line-event-start (event)
+  "Like `event-start'.
+However, return the correct mouse position list if EVENT is a
+`touchscreen-begin' event."
+  (or (and (eq (car-safe event) 'touchscreen-begin)
+           (cdadr event))
+      (event-start event)))
+
+
+
 (defun tab-line-tabs-buffer-list ()
   (seq-filter (lambda (b) (and (buffer-live-p b)
                                (/= (aref (buffer-name b) 0) ?\s)))
@@ -719,17 +766,21 @@ the selected tab visible."
   "Scroll the tab line ARG positions to the right.
 Interactively, ARG is the prefix numeric argument and defaults to 1."
   (interactive (list current-prefix-arg last-nonmenu-event))
-  (let ((window (and (listp event) (posn-window (event-start event)))))
-    (tab-line-hscroll arg window)
-    (force-mode-line-update window)))
+  (when (tab-line-track-tap event)
+    (let ((window (and (listp event)
+                       (posn-window (tab-line-event-start event)))))
+      (tab-line-hscroll arg window)
+      (force-mode-line-update window))))
 
 (defun tab-line-hscroll-left (&optional arg event)
   "Scroll the tab line ARG positions to the left.
 Interactively, ARG is the prefix numeric argument and defaults to 1."
   (interactive (list current-prefix-arg last-nonmenu-event))
-  (let ((window (and (listp event) (posn-window (event-start event)))))
-    (tab-line-hscroll (- (or arg 1)) window)
-    (force-mode-line-update window)))
+  (when (tab-line-track-tap event)
+    (let ((window (and (listp event)
+                       (posn-window (tab-line-event-start event)))))
+      (tab-line-hscroll (- (or arg 1)) window)
+      (force-mode-line-update window))))
 
 
 (defun tab-line-new-tab (&optional event)
@@ -738,15 +789,16 @@ This command is usually invoked by clicking on the 
plus-shaped button
 on the tab line.  Switching to another buffer also adds a new tab
 corresponding to the new buffer shown in the window."
   (interactive (list last-nonmenu-event))
-  (if (functionp tab-line-new-tab-choice)
-      (funcall tab-line-new-tab-choice)
-    (let ((tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups))
-      (if (and (listp event)
-               (display-popup-menus-p)
-               (not tty-menu-open-use-tmm))
-          (mouse-buffer-menu event) ; like (buffer-menu-open)
-        ;; tty menu doesn't support mouse clicks, so use tmm
-        (tmm-prompt (mouse-buffer-menu-keymap))))))
+  (when (tab-line-track-tap event)
+    (if (functionp tab-line-new-tab-choice)
+        (funcall tab-line-new-tab-choice)
+      (let ((tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups))
+        (if (and (listp event)
+                 (display-popup-menus-p)
+                 (not tty-menu-open-use-tmm))
+            (mouse-buffer-menu event) ; like (buffer-menu-open)
+          ;; tty menu doesn't support mouse clicks, so use tmm
+          (tmm-prompt (mouse-buffer-menu-keymap)))))))
 
 (defun tab-line-select-tab (&optional event)
   "Switch to the buffer specified by the tab on which you click.
@@ -754,16 +806,17 @@ This command maintains the original order of prev/next 
buffers.
 So, for example, switching to a previous tab is equivalent to
 using the `previous-buffer' command."
   (interactive "e")
-  (let* ((posnp (event-start event))
-         (tab (tab-line--get-tab-property 'tab (car (posn-string posnp))))
-         (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
-    (if buffer
-        (tab-line-select-tab-buffer buffer (posn-window posnp))
-      (let ((select (cdr (assq 'select tab))))
-        (when (functionp select)
-          (with-selected-window (posn-window posnp)
-            (funcall select)
-            (force-mode-line-update)))))))
+  (when (tab-line-track-tap event #'tab-line-tab-context-menu)
+    (let* ((posnp (tab-line-event-start event))
+           (tab (tab-line--get-tab-property 'tab (car (posn-string posnp))))
+           (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
+      (if buffer
+          (tab-line-select-tab-buffer buffer (posn-window posnp))
+        (let ((select (cdr (assq 'select tab))))
+          (when (functionp select)
+            (with-selected-window (posn-window posnp)
+              (funcall select)
+              (force-mode-line-update))))))))
 
 (defun tab-line-select-tab-buffer (buffer &optional window)
   (let* ((window-buffer (window-buffer window))
@@ -869,25 +922,27 @@ This command is usually invoked by clicking on the close 
button on the
 right side of the tab.  This command buries the buffer, so it goes out of
 sight of the tab line."
   (interactive (list last-nonmenu-event))
-  (let* ((posnp (and (listp event) (event-start event)))
-         (window (and posnp (posn-window posnp)))
-         (tab (tab-line--get-tab-property 'tab (car (posn-string posnp))))
-         (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab))))
-         (close-function (unless (bufferp tab) (cdr (assq 'close tab)))))
-    (with-selected-window (or window (selected-window))
-      (cond
-       ((functionp close-function)
-        (funcall close-function))
-       ((eq tab-line-close-tab-function 'kill-buffer)
-        (kill-buffer buffer))
-       ((eq tab-line-close-tab-function 'bury-buffer)
-        (if (eq buffer (current-buffer))
-            (bury-buffer)
-          (set-window-prev-buffers nil (assq-delete-all buffer 
(window-prev-buffers)))
-          (set-window-next-buffers nil (delq buffer (window-next-buffers)))))
-       ((functionp tab-line-close-tab-function)
-        (funcall tab-line-close-tab-function tab)))
-      (force-mode-line-update))))
+  (when (tab-line-track-tap event)
+    (let* ((posnp (and (listp event)
+                       (tab-line-event-start event)))
+           (window (and posnp (posn-window posnp)))
+           (tab (tab-line--get-tab-property 'tab (car (posn-string posnp))))
+           (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab))))
+           (close-function (unless (bufferp tab) (cdr (assq 'close tab)))))
+      (with-selected-window (or window (selected-window))
+        (cond
+         ((functionp close-function)
+          (funcall close-function))
+         ((eq tab-line-close-tab-function 'kill-buffer)
+          (kill-buffer buffer))
+         ((eq tab-line-close-tab-function 'bury-buffer)
+          (if (eq buffer (current-buffer))
+              (bury-buffer)
+            (set-window-prev-buffers nil (assq-delete-all buffer 
(window-prev-buffers)))
+            (set-window-next-buffers nil (delq buffer (window-next-buffers)))))
+         ((functionp tab-line-close-tab-function)
+          (funcall tab-line-close-tab-function tab)))
+        (force-mode-line-update)))))
 
 (defun tab-line-tab-context-menu (&optional event)
   "Pop up the context menu for a tab-line tab."