From: Po Lu <luangruo@yahoo.com>
Date: Sun, 16 Jul 2023 07:30:01 +0000 (+0800)
Subject: Improve touch-screen support
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7b346b92b4c30c634d094e6162b65a22a52b93bb;p=emacs.git

Improve touch-screen support

* doc/emacs/emacs.texi (Top):
* doc/emacs/input.texi (Other Input Devices): Correctly
capitalize subsection name.
(Touchscreens): Document additional translation.
* doc/lispref/commands.texi (Touchscreen Events): Document that
`touchscreen-end' events now have prefix keys.  Also, describe
mouse emulation and `touchscreen-scroll' events.
* doc/lispref/keymaps.texi (Translation Keymaps): Document
`current-key-remap-sequence'.
* lisp/touch-screen.el (touch-screen-translate-prompt): New
function.
(touch-screen-scroll): New command.  Bind to
`touchscreen-scroll'.
(touch-screen-handle-point-update, touch-screen-handle-point-up)
(touch-screen-handle-touch): Refactor to actually translate
touch screen event sequences, as opposed to looking up commands
and executing them.
(touch-screen-translate-touch): New function.  Bind in
function-key-map to all touch screen events.
(touch-screen-drag-mode-line-1, touch-screen-drag-mode-line)
(touch-screen-tap-header-line): Remove special commands for
dragging the mode line and clicking on the header line.
* lisp/wid-edit.el (widget-button-click): Adjust accordingly.
* src/keyboard.c (access_keymap_keyremap): Bind
`current-key-remap-sequence' to the key sequence being remapped.
(keyremap_step): Give fkey->start and fkey->end to
access_keymap_keyremap.
(head_table): Add imaginary prefix to touchscreen-end events as
well.
(syms_of_keyboard): New variable Vcurrent_key_remap_sequence.
---

diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 92be9f9b9a9..b255e679d5f 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -1273,7 +1273,7 @@ Emacs and Android
 * Android Troubleshooting::     Dealing with problems.
 * Android Software::            Getting extra software.
 
-Emacs and unconventional input devices
+Emacs and Unconventional Input Devices
 
 * Touchscreens::        Using Emacs on touchscreens.
 * On-Screen Keyboards:: Using Emacs with virtual keyboards.
diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi
index 0df3162ce97..66554653def 100644
--- a/doc/emacs/input.texi
+++ b/doc/emacs/input.texi
@@ -2,7 +2,7 @@
 @c Copyright (C) 2023 Free Software Foundation, Inc.
 @c See file emacs.texi for copying conditions.
 @node Other Input Devices
-@appendix Emacs and unconventional input devices
+@appendix Emacs and Unconventional Input Devices
 @cindex other input devices
 
   Emacs was originally developed with the assumption that its users
@@ -21,7 +21,7 @@ which is detailed here.
 
 @node Touchscreens
 @section Using Emacs on touchscreens
-@cindex touchscreens
+@cindex touchscreen input
 
   Touchscreen input works by pressing and moving tools (which include
 fingers and some pointing devices--styluses, for example) onto a frame
@@ -40,6 +40,9 @@ executing any command bound to @code{mouse-1} at that location in the
 window.  If the tap happened on top of a link (@pxref{Mouse
 References}), then Emacs will follow the link instead.
 
+  If a command bound to @code{down-mouse-1} is bound to the location
+where the tap took place, Emacs will execute that command as well.
+
 @item
 @cindex scrolling, touchscreens
   ``Scrolling'', meaning to place a tool on the display and move it up
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 7a076406bed..725ca900165 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2013,10 +2013,7 @@ finger against the touchscreen.
 
 These events also have imaginary prefixes keys added by
 @code{read-key-sequence} when they originate on top of a special part
-of a frame or window.  @xref{Key Sequence Input}.  The reason the
-other touch screen events do not undergo this treatment is that they
-are rarely useful without being used in tandem from their
-corresponding @code{touchscreen-begin} events.
+of a frame or window.  @xref{Key Sequence Input}.
 
 @cindex @code{touchscreen-update} event
 @item (touchscreen-update @var{points})
@@ -2029,12 +2026,73 @@ up-to-date positions of each touch point currently on the touchscreen.
 This event is sent when @var{point} is no longer present on the
 display, because another program took the grab, or because the user
 raised the finger from the touchscreen.
+
+These events also have imaginary prefixes keys added by
+@code{read-key-sequence} when they originate on top of a special part
+of a frame or window.
 @end table
 
 If a touchpoint is pressed against the menu bar, then Emacs will not
 generate any corresponding @code{touchscreen-begin} or
 @code{touchscreen-end} events; instead, the menu bar may be displayed
-when @code{touchscreen-end} should have been delivered.
+after @code{touchscreen-end} would have been delivered under other
+circumstances.
+
+@cindex mouse emulation from touch screen events
+When no command is bound to @code{touchscreen-begin},
+@code{touchscreen-end} or @code{touchscreen-update}, Emacs calls a
+``key translation function'' (@pxref{Translation Keymaps}) to
+translate key sequences containing touch screen events into ordinary
+mouse events (@pxref{Mouse Events}.)  Since Emacs doesn't support
+distinguishing events originating from separate mouse devices, it
+assumes that only one touchpoint is active while translation takes
+place; breaking this assumption may lead to unexpected behavior.
+
+Emacs applies two different strategies for translating touch events
+into mouse events, contingent on factors such as the commands bound to
+keymaps that are active at the location of the
+@code{touchscreen-begin} event.  If a command is bound to
+@code{down-mouse-1} at that location, the initial translation consists
+of a single @code{down-mouse-1} event, with subsequent
+@code{touchscreen-update} events translated to mouse motion events
+(@pxref{Motion Events}), and a final @code{touchscreen-end} event
+translated to a @code{mouse-1} or @code{drag-mouse-1} event.  This is
+referred to ``simple translation'', and produces a simple
+correspondence between touchpoint motion and mouse motion.
+
+@cindex @code{ignored-mouse-command}, a symbol property
+However, some commands bound to
+@code{down-mouse-1}--@code{mouse-drag-region}, for example--either
+conflict with defined touch screen gestures (such as ``long-press to
+drag''), or with user expectations for touch input, and shouldn't
+subject the touch sequence to simple translation.  If a command whose
+name contains the property @code{ignored-mouse-command} is encountered
+or there is no command bound to @code{down-mouse-1}, a more irregular
+form of translation takes place: here, Emacs processes touch screen
+gestures (@pxref{Touchscreens,,, emacs, The GNU Emacs Manual}) first,
+and finally attempts to translate touch screen events into mouse
+events if no gesture was detected prior to a closing
+@code{touchscreen-end} event and a command is bound to @code{mouse-1}
+at the location of that event.  Before generating the @code{mouse-1}
+event, point is also set to the location of the @code{touchscreen-end}
+event, and the window containing the position of that event is
+selected, as a compromise for packages which assume
+@code{mouse-drag-region} has already set point to the location of any
+mouse click and selected the window where it took place.
+
+@cindex @code{touchscreen-scroll} event
+If a ``scrolling'' gesture is detected during the translation process,
+each subsequent @code{touchscreen-update} event is translated to a
+@code{touchscreen-scroll} event of the form:
+
+@example
+@w{@code{(touchscreen-scroll @var{window} @var{dx} @var{dy})}}
+@end example
+
+where @var{dx} and @var{dy} specify, in pixels, the relative motion of
+the tool from the position of the @code{touchscreen-begin} event that
+started the sequence or the last @code{touchscreen-scroll} event,
+whichever came later.
 
 @cindex handling touch screen events
 @cindex tap and drag, touch screen gestures
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 05dc17eb03f..e41dbf9def8 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -2044,6 +2044,15 @@ to turn the character that follows into a Hyper character:
 @end group
 @end example
 
+@cindex accessing events within a key translation function
+@vindex current-key-remap-sequence
+A key translation function might want to adjust its behavior based on
+parameters to events within a key sequence containing non-key events
+(@pxref{Input Events}.)  This information is available from the
+variable @code{current-key-remap-sequence}, which is bound to the key
+sub-sequence being translated around calls to key translation
+functions.
+
 @subsection Interaction with normal keymaps
 
 The end of a key sequence is detected when that key sequence either is bound
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index 242ea4fcd9b..0f584269931 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -49,6 +49,11 @@ keyboard after a mouse command is executed in response to a
   "Timer used to track long-presses.
 This is always cleared upon any significant state change.")
 
+(defvar touch-screen-translate-prompt nil
+  "Prompt given to the touch screen translation function.
+If non-nil, the touch screen key event translation machinery
+is being called from `read-sequence' or some similar function.")
+
 (defcustom touch-screen-display-keyboard nil
   "If non-nil, always display the on screen keyboard.
 A buffer local value means to always display the on screen
@@ -70,6 +75,14 @@ See `pixel-scroll-precision-mode' for more details."
   :group 'mouse
   :version "30.1")
 
+
+
+;; Touch screen event translation.  The code here translates raw touch
+;; screen events into `touchscreen-scroll' events and mouse events in
+;; a ``DWIM'' fashion, consulting the keymaps at the position of the
+;; mouse event to determine the best course of action, while also
+;; recognizing drag-to-select and other gestures.
+
 (defun touch-screen-relative-xy (posn window)
   "Return the coordinates of POSN, a mouse position list.
 However, return the coordinates relative to WINDOW.
@@ -201,6 +214,26 @@ horizontal scrolling according to the movement in DX."
                  (setcar (nthcdr 8 touch-screen-current-tool) lines-hscrolled)
                  nil)))))
 
+(defun touch-screen-scroll (event)
+  "Scroll the window within EVENT, a `touchscreen-scroll' event.
+If `touch-screen-precision-scroll', scroll the window vertically
+by the number of pixels specified within that event.  Else,
+scroll the window by one line for every
+`window-default-line-height' pixels worth of movement.
+
+If EVENT also specifies horizontal motion and no significant
+amount of vertical scrolling has taken place, also scroll the
+window horizontally in conjunction with the number of pixels in
+the event."
+  (interactive "e")
+  (let ((window (nth 1 event))
+        (dx (nth 2 event))
+        (dy (nth 3 event)))
+    (with-selected-window window
+      (touch-screen-handle-scroll dx dy))))
+
+(global-set-key [touchscreen-scroll] #'touch-screen-scroll)
+
 (defun touch-screen-handle-timeout (arg)
   "Start the touch screen timeout or handle it depending on ARG.
 When ARG is nil, start the `touch-screen-current-timer' to go off
@@ -236,19 +269,30 @@ known position of the tool."
 
 (defun touch-screen-handle-point-update (point)
   "Notice that the touch point POINT has changed position.
+Perform the editing operations or throw to the input translation
+function with an input event tied to any gesture that is
+recognized.
+
 POINT must be the touch point currently being tracked as
 `touch-screen-current-tool'.
 
 If the fourth element of `touch-screen-current-tool' is nil, then
 the touch has just begun.  Determine how much POINT has moved.
 If POINT has moved upwards or downwards by a significant amount,
-then set the fourth element to `scroll'.  Then, call
-`touch-screen-handle-scroll' to scroll the display by that
-amount.
+then set the fourth element to `scroll'.  Then, generate a
+`touchscreen-scroll' event with the window that POINT was
+initially placed upon, and pixel deltas describing how much point
+has moved relative to its previous position in the X and Y axes.
+
+If the fourth element of `touchscreen-current-tool' is `scroll',
+then generate a `touchscreen-scroll' event with the window that
+qPOINT was initially placed upon, and pixel deltas describing how
+much point has moved relative to its previous position in the X
+and Y axes.
 
-If the fourth element of `touch-screen-current-tool' is `scroll',
-then scroll the display by how much POINT has moved in the Y
-axis.
+If the fourth element of `touch-screen-current-tool' is
+`mouse-drag' and `track-mouse' is non-nil, then generate a
+`mouse-movement' event with the position of POINT.
 
 If the fourth element of `touch-screen-current-tool' is `held',
 then the touch has been held down for some time.  If motion
@@ -275,8 +319,11 @@ then move point to the position of POINT."
                        'scroll)
                (setcar (nthcdr 2 touch-screen-current-tool)
                        relative-xy)
-               (with-selected-window window
-                 (touch-screen-handle-scroll diff-x diff-y))
+               ;; Generate a `touchscreen-scroll' event with `diff-x'
+               ;; and `diff-y'.
+               (throw 'input-event
+                      (list 'touchscreen-scroll
+                            window diff-x diff-y))
                ;; Cancel the touch screen long-press timer, if it is
                ;; still there by any chance.
                (when touch-screen-current-timer
@@ -301,8 +348,18 @@ then move point to the position of POINT."
              (setcar (nthcdr 2 touch-screen-current-tool)
                      relative-xy)
              (unless (and (zerop diff-x) (zerop diff-y))
-               (with-selected-window window
-                 (touch-screen-handle-scroll diff-x diff-y)))))
+               (throw 'input-event
+                      ;; Generate a `touchscreen-scroll' event with
+                      ;; `diff-x' and `diff-y'.
+                      (list 'touchscreen-scroll
+                            window diff-x diff-y)))))
+          ((eq what 'mouse-drag)
+           ;; There was a `down-mouse-1' event bound at the starting
+           ;; point of the event.  Generate a mouse-motion event if
+           ;; mouse movement is being tracked.
+           (when track-mouse
+             (throw 'input-event (list 'mouse-movement
+                                       (cdr point)))))
           ((eq what 'held)
            (let* ((posn (cdr point))
                   (relative-xy
@@ -319,7 +376,6 @@ then move point to the position of POINT."
                ;; Activate the mark.  It should have been set by the
                ;; time `touch-screen-timeout' was called.
                (activate-mark)
-
                ;; Figure out what character to go to.  If this posn is
                ;; in the window, go to (posn-point posn).  If not,
                ;; then go to the line before either window start or
@@ -385,127 +441,357 @@ in response to the minibuffer being closed."
         (cancel-timer minibuffer-on-screen-keyboard-timer)
         (setq minibuffer-on-screen-keyboard-timer nil)))))
 
-(defun touch-screen-handle-point-up (point)
+(defun touch-screen-handle-point-up (point prefix)
   "Notice that POINT has been removed from the screen.
 POINT should be the point currently tracked as
 `touch-screen-current-tool'.
+PREFIX should be a virtual function key used to look up key
+bindings.
+
+If the fourth element of `touch-screen-current-tool' is nil, move
+point to the position of POINT, selecting the window under POINT
+as well, and deactivate the mark; if there is a button or link at
+POINT, call the command bound to `mouse-2' there.  Otherwise,
+call the command bound to `mouse-1'.
 
-If the fourth argument of `touch-screen-current-tool' is nil,
-move point to the position of POINT, selecting the window under
-POINT as well, and deactivate the mark; if there is a button or
-link at POINT, call the command bound to `mouse-2' there.
-Otherwise, call the command bound to `mouse-1'.
+If the fourth element of `touch-screen-current-tool' is
+`mouse-drag', then generate either a `mouse-1' or a
+`drag-mouse-1' event depending on how far the position of POINT
+is from the starting point of the touch.
 
 If the command being executed is listed in
 `touch-screen-set-point-commands' also display the on-screen
 keyboard if the current buffer and the character at the new point
 is not read-only."
-  (let ((what (nth 3 touch-screen-current-tool)))
+  (let ((what (nth 3 touch-screen-current-tool))
+        (posn (cdr point)) window point)
     (cond ((null what)
-           (when (windowp (posn-window (cdr point)))
+           (when (windowp (posn-window posn))
+             (setq point (posn-point point)
+                   window (posn-window posn))
              ;; Select the window that was tapped.
-             (select-window (posn-window (cdr point)))
+             (select-window window)
              ;; Now simulate a mouse click there.  If there is a link
              ;; or a button, use mouse-2 to push it.
-             (let ((event (list (if (or (mouse-on-link-p (cdr point))
-                                        (button-at (posn-point (cdr point))))
-                                    'mouse-2
-                                  'mouse-1)
-                                (cdr point)))
-                   ;; Look for an extra keymap to look in.
-                   (keymap (and (posn-object (cdr point))
-                                (stringp
-                                 (posn-object (cdr point)))
-                                (get-text-property
-                                 0 'keymap
-                                 (posn-object (cdr point)))))
-                   command)
-               (save-excursion
-                 (when (posn-point (cdr point))
-                   (goto-char (posn-point (cdr point))))
-                 (if keymap
-                     (setq keymap (cons keymap (current-active-maps t)))
-                   (setq keymap (current-active-maps t)))
-                 (setq command (lookup-key keymap (vector (car event)))))
+             (let* ((event (list (if (or (mouse-on-link-p posn)
+                                         (and point (button-at point)))
+                                     'mouse-2
+                                   'mouse-1)
+                                 posn))
+                    ;; Look for the command bound to this event.
+                    (command (key-binding (if prefix
+                                                 (vector prefix
+                                                         (car event))
+                                            (vector (car event)))
+                                          t nil posn)))
                (deactivate-mark)
-               ;; This is necessary for following links.
-               (goto-char (posn-point (cdr point)))
+               (when point
+                 ;; This is necessary for following links.
+                 (goto-char point))
                ;; Figure out if the on screen keyboard needs to be
                ;; displayed.
                (when command
-                 (call-interactively command nil
-                                     (vector event))
-                 (when (memq command touch-screen-set-point-commands)
-                   (if (and (or (not buffer-read-only)
-                                touch-screen-display-keyboard)
-                            ;; Detect the splash screen and avoid
-                            ;; displaying the on screen keyboard
-                            ;; there.
-                            (not (equal (buffer-name) "*GNU Emacs*")))
-                       ;; Once the on-screen keyboard has been opened,
-                       ;; add `touch-screen-window-selection-changed'
-                       ;; as a window selection change function This
-                       ;; allows the on screen keyboard to be hidden
-                       ;; if the selected window's point becomes read
-                       ;; only at some point in the future.
-                       (progn
-                         (add-hook 'window-selection-change-functions
-                                   #'touch-screen-window-selection-changed)
-                         (frame-toggle-on-screen-keyboard (selected-frame) nil))
-                     ;; Otherwise, hide the on screen keyboard now.
-                     (frame-toggle-on-screen-keyboard (selected-frame) t))))))))))
-
-(defun touch-screen-handle-touch (event)
+                 (if (memq command touch-screen-set-point-commands)
+                     (if touch-screen-translate-prompt
+                         ;; When a `mouse-set-point' command is
+                         ;; encountered and
+                         ;; `touch-screen-handle-touch' is being
+                         ;; called from the keyboard command loop,
+                         ;; call it immediately so that point is set
+                         ;; prior to the on screen keyboard being
+                         ;; displayed.
+                         (call-interactively command nil
+                                             (vector event))
+                       (if (and (or (not buffer-read-only)
+                                    touch-screen-display-keyboard)
+                                ;; Detect the splash screen and avoid
+                                ;; displaying the on screen keyboard
+                                ;; there.
+                                (not (equal (buffer-name) "*GNU Emacs*")))
+                           ;; Once the on-screen keyboard has been
+                           ;; opened, add
+                           ;; `touch-screen-window-selection-changed'
+                           ;; as a window selection change function
+                           ;; This allows the on screen keyboard to be
+                           ;; hidden if the selected window's point
+                           ;; becomes read only at some point in the
+                           ;; future.
+                           (progn
+                             (add-hook 'window-selection-change-functions
+                                       #'touch-screen-window-selection-changed)
+                             (frame-toggle-on-screen-keyboard (selected-frame)
+                                                              nil))
+                         ;; Otherwise, hide the on screen keyboard
+                         ;; now.
+                         (frame-toggle-on-screen-keyboard (selected-frame) t))
+                       ;; But if it's being called from `describe-key'
+                       ;; or some such, return it as a key sequence.
+                       (throw 'input-event event)))
+                 ;; If not, return the event.
+                 (throw 'input-event event)))))
+          ((eq what 'mouse-drag)
+           ;; Generate a corresponding `mouse-1' event.
+           (let* ((new-window (posn-window posn))
+                  (new-point (posn-point posn))
+                  (old-posn (nth 4 touch-screen-current-tool))
+                  (old-window (posn-window posn))
+                  (old-point (posn-point posn)))
+             (throw 'input-event
+                    ;; If the position of the touch point hasn't
+                    ;; changed, or it doesn't start or end on a
+                    ;; window...
+                    (if (and (eq new-window old-window)
+                             (eq new-point old-point)
+                             (windowp new-window)
+                             (windowp old-window))
+                        ;; ... generate a mouse-1 event...
+                        (list 'mouse-1 posn)
+                      ;; ... otherwise, generate a drag-mouse-1 event.
+                      (list 'drag-mouse-1 (cons old-window
+                                                old-posn)
+                            (cons new-window posn)))))))))
+
+(defun touch-screen-handle-touch (event prefix &optional interactive)
   "Handle a single touch EVENT, and perform associated actions.
-EVENT can either be a touchscreen-begin, touchscreen-update or
-touchscreen-end event."
-  (interactive "e")
-  (cond
-   ((eq (car event) 'touchscreen-begin)
-    ;; A tool was just pressed against the screen.  Figure out the
-    ;; window where it is and make it the tool being tracked on the
-    ;; window.
-    (let ((touchpoint (caadr event))
-          (position (cdadr event)))
-      ;; Cancel the touch screen timer, if it is still there by any
-      ;; chance.
-      (when touch-screen-current-timer
-        (cancel-timer touch-screen-current-timer)
-        (setq touch-screen-current-timer nil))
-      ;; Replace any previously ongoing gesture.  If POSITION has no
-      ;; window or position, make it nil instead.
-      (setq touch-screen-current-tool (and (windowp (posn-window position))
-                                           (posn-point position)
-                                           (list touchpoint
-                                                 (posn-window position)
-                                                 (posn-x-y position)
-                                                 nil position nil nil
-                                                 nil nil)))
-      ;; Start the long-press timer.
-      (touch-screen-handle-timeout nil)))
-   ((eq (car event) 'touchscreen-update)
-    ;; The positions of tools currently pressed against the screen
-    ;; have changed.  If there is a tool being tracked as part of a
-    ;; gesture, look it up in the list of tools.
-    (let ((new-point (assq (car touch-screen-current-tool)
-                           (cadr event))))
-      (when new-point
-        (touch-screen-handle-point-update new-point))))
-   ((eq (car event) 'touchscreen-end)
-    ;; A tool has been removed from the screen.  If it is the tool
-    ;; currently being tracked, clear `touch-screen-current-tool'.
-    (when (eq (caadr event) (car touch-screen-current-tool))
-      ;; Cancel the touch screen long-press timer, if it is still there
-      ;; by any chance.
-      (when touch-screen-current-timer
-        (cancel-timer touch-screen-current-timer)
-        (setq touch-screen-current-timer nil))
-      (touch-screen-handle-point-up (cadr event))
-      (setq touch-screen-current-tool nil)))))
-
-(define-key global-map [touchscreen-begin] #'touch-screen-handle-touch)
-(define-key global-map [touchscreen-update] #'touch-screen-handle-touch)
-(define-key global-map [touchscreen-end] #'touch-screen-handle-touch)
+EVENT can either be a `touchscreen-begin', `touchscreen-update' or
+`touchscreen-end' event.
+PREFIX is either nil, or a symbol specifying a virtual function
+key to apply to EVENT.
+
+If INTERACTIVE, execute the command associated with any event
+generated instead of throwing `input-event'.  Otherwise, throw
+`input-event' with a single input event if that event should take
+the place of EVENT within the key sequence being translated, or
+`nil' if all tools have been released."
+  (interactive "e\ni\np")
+  (if interactive
+      ;; Called interactively (probably from wid-edit.el.)
+      ;; Add any event generated to `unread-command-events'.
+      (let ((event (catch 'input-event
+                     (touch-screen-handle-touch event prefix) nil)))
+        (when event
+          (setq unread-command-events
+                (nconc unread-command-events
+                       (list event)))))
+    (cond
+     ((eq (car event) 'touchscreen-begin)
+      ;; A tool was just pressed against the screen.  Figure out the
+      ;; window where it is and make it the tool being tracked on the
+      ;; window.
+      (let* ((touchpoint (caadr event))
+             (position (cdadr event))
+             (window (posn-window position))
+             (point (posn-point position)))
+        ;; Cancel the touch screen timer, if it is still there by any
+        ;; chance.
+        (when touch-screen-current-timer
+          (cancel-timer touch-screen-current-timer)
+          (setq touch-screen-current-timer nil))
+        ;; Replace any previously ongoing gesture.  If POSITION has no
+        ;; window or position, make it nil instead.
+        (setq touch-screen-current-tool (and (windowp window)
+                                             (list touchpoint window
+                                                   (posn-x-y position)
+                                                   nil position
+                                                   nil nil nil nil)))
+        ;; Determine if there is a command bound to `down-mouse-1' at
+        ;; the position of the tap and that command is not a command
+        ;; whose functionality is replaced by the long-press mechanism.
+        ;; If so, set the fourth element of `touch-screen-current-tool'
+        ;; to `mouse-drag' and generate an emulated `mouse-1' event.
+        (if (and touch-screen-current-tool
+                 (with-selected-window window
+                   (let ((binding (key-binding (if prefix
+                                                   (vector prefix
+                                                           'down-mouse-1)
+                                                 [down-mouse-1])
+                                               t nil position)))
+                     (and binding
+                          (not (and (symbolp binding)
+                                    (get binding 'ignored-mouse-command)))))))
+            (progn (setcar (nthcdr 3 touch-screen-current-tool)
+                           'mouse-drag)
+                   (throw 'input-event (list 'down-mouse-1 position)))
+          (and point
+               ;; Start the long-press timer.
+               (touch-screen-handle-timeout nil)))))
+     ((eq (car event) 'touchscreen-update)
+      ;; The positions of tools currently pressed against the screen
+      ;; have changed.  If there is a tool being tracked as part of a
+      ;; gesture, look it up in the list of tools.
+      (let ((new-point (assq (car touch-screen-current-tool)
+                             (cadr event))))
+        (when new-point
+          (touch-screen-handle-point-update new-point))))
+     ((eq (car event) 'touchscreen-end)
+      ;; A tool has been removed from the screen.  If it is the tool
+      ;; currently being tracked, clear `touch-screen-current-tool'.
+      (when (eq (caadr event) (car touch-screen-current-tool))
+        ;; Cancel the touch screen long-press timer, if it is still there
+        ;; by any chance.
+        (when touch-screen-current-timer
+          (cancel-timer touch-screen-current-timer)
+          (setq touch-screen-current-timer nil))
+        (unwind-protect
+            (touch-screen-handle-point-up (cadr event) prefix)
+          ;; Make sure the tool list is cleared even if
+          ;; `touch-screen-handle-point-up' throws.
+          (setq touch-screen-current-tool nil)))
+      ;; Throw to the key translation function.
+      (throw 'input-event nil)))))
+
+;; Mark `mouse-drag-region' as ignored for the purposes of mouse click
+;; emulation.
+
+(put 'mouse-drag-region 'ignored-mouse-command t)
+
+(defun touch-screen-translate-touch (prompt)
+  "Translate touch screen events into a sequence of mouse events.
+PROMPT is the prompt string given to `read-key-sequence', or nil
+if this function is being called from the keyboard command loop.
+Value is a new key sequence.
+
+Read the touch screen event within `current-key-remap-sequence'
+and give it to `touch-screen-handle-touch'.  Return any key
+sequence signaled.
+
+If `touch-screen-handle-touch' does not signal for an event to be
+returned after the last element of the key sequence is read,
+continue reading touch screen events until
+`touch-screen-handle-touch' signals.  Return a sequence
+consisting of the first event encountered that is not a touch
+screen event.
+
+In addition to non-touchscreen events read, key sequences
+returned may contain any one of the following events:
+
+  (touchscreen-scroll WINDOW DX DY)
+
+where WINDOW specifies a window to scroll, and DX and DY are
+integers describing how many pixels to be scrolled horizontally
+and vertically.
+
+  (down-mouse-1 POSN)
+  (drag-mouse-1 POSN)
+
+where POSN is the position of the mouse button press or click.
+
+  (mouse-1 POSN)
+  (mouse-2 POSN)
+
+where POSN is the position of the mouse click, either `mouse-2'
+if POSN is on a link or a button, or `mouse-1' otherwise."
+  (if (> (length current-key-remap-sequence) 0)
+      ;; Save the virtual function key if this is a mode line event.
+      (let* ((prefix (and (> (length current-key-remap-sequence) 1)
+                          (aref current-key-remap-sequence 0)))
+             (touch-screen-translate-prompt prompt)
+             (event (catch 'input-event
+                      ;; First, process the one event already within
+                      ;; `current-key-remap-sequence'.
+                      (touch-screen-handle-touch
+                       (aref current-key-remap-sequence
+                             (if prefix 1 0))
+                       prefix)
+                      ;; Next, continue reading input events.
+                      (while t
+                        (let ((event1 (read-event)))
+                          ;; If event1 is a virtual function key, make
+                          ;; it the new prefix.
+                          (if (memq event1 '(mode-line tab-line
+                                             header-line tool-bar tab-bar
+                                             left-fringe right-fringe
+                                             left-margin right-margin
+                                             right-divider bottom-divider))
+                              (setq prefix event1)
+                            ;; If event1 is not a touch screen event, return
+                            ;; it.
+                            (if (not (memq (car-safe event1)
+                                           '(touchscreen-begin
+                                             touchscreen-end
+                                             touchscreen-update)))
+                                (throw 'input-event event1)
+                              ;; Process this event as well.
+                              (touch-screen-handle-touch event1 prefix))))))))
+        ;; Return a key sequence consisting of event
+        ;; or an empty vector if it is nil, meaning that
+        ;; no key events have been translated.
+        (if event (or (and prefix (consp event)
+                           ;; If this is a mode line event, then generate
+                           ;; the appropriate function key.
+                           (vector prefix event))
+                      (vector event))
+          ""))))
+
+(define-key function-key-map [touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [mode-line touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [mode-line touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [mode-line touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [header-line touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [header-line touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [header-line touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [bottom-divider touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [bottom-divider touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [bottom-divider touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [right-divider touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [right-divider touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [right-divider touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [right-divider touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [right-divider touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [right-divider touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [left-fringe touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [left-fringe touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [left-fringe touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [right-fringe touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [right-fringe touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [right-fringe touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [left-margin touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [left-margin touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [left-margin touchscreen-end]
+            #'touch-screen-translate-touch)
+
+(define-key function-key-map [right-margin touchscreen-begin]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [right-margin touchscreen-update]
+            #'touch-screen-translate-touch)
+(define-key function-key-map [right-margin touchscreen-end]
+            #'touch-screen-translate-touch)
 
 
 ;; Exports.  These functions are intended for use externally.
@@ -582,149 +868,6 @@ touch point in EVENT did not move significantly, and t otherwise."
 
 
 
-;; Modeline dragging.
-
-(defun touch-screen-drag-mode-line-1 (event)
-  "Internal helper for `touch-screen-drag-mode-line'.
-This is called when that function determines that no drag really
-happened.  EVENT is the same as in `touch-screen-drag-mode-line'."
-  ;; If there is an object at EVENT, then look either a keymap bound
-  ;; to [down-mouse-1] or a command bound to [mouse-1].  Then, if a
-  ;; keymap was found, pop it up as a menu.  Otherwise, wait for a tap
-  ;; to complete and run the command found.
-  ;; Also, select the window in EVENT.
-  (select-window (posn-window (cdadr event)))
-  (let* ((object (posn-object (cdadr event)))
-         (object-keymap (and (consp object)
-                             (stringp (car object))
-                             (or (get-text-property (cdr object)
-                                                    'keymap
-                                                    (car object))
-                                 (get-text-property (cdr object)
-                                                    'local-map
-                                                    (car object)))))
-         (keymap (lookup-key object-keymap [mode-line down-mouse-1]))
-         (command (or (lookup-key object-keymap [mode-line mouse-1])
-                      keymap)))
-    (when (or (keymapp keymap) command)
-      (if (keymapp keymap)
-          (when-let* ((command (x-popup-menu event keymap))
-                      (tem (lookup-key keymap
-                                       (if (consp command)
-                                           (apply #'vector command)
-                                         (vector command))
-                                       t)))
-            (call-interactively tem))
-        (when (commandp command)
-          (call-interactively command nil
-                              (vector (list 'mouse-1 (cdadr event)))))))))
-
-(defun touch-screen-drag-mode-line (event)
-  "Begin dragging the mode line in response to a touch EVENT.
-Change the height of the window based on where the touch point in
-EVENT moves.
-
-If it does not actually move anywhere and the touch point is
-removed, and EVENT lies on top of text with a mouse command
-bound, run that command instead."
-  (interactive "e")
-  ;; Find the window that should be dragged and the starting position.
-  (let* ((window (posn-window (cdadr event)))
-         (relative-xy (touch-screen-relative-xy (cdadr event)
-                                                'frame))
-         (last-position (cdr relative-xy)))
-    (when (window-resizable window 0)
-      (when (eq
-             (touch-screen-track-drag
-              event (lambda (new-event &optional _data)
-                      ;; Find the position of the touchpoint in
-                      ;; NEW-EVENT.
-                      (let* ((touchpoint (assq (caadr event)
-                                               (cadr new-event)))
-                             (new-relative-xy
-                              (touch-screen-relative-xy (cdr touchpoint) 'frame))
-                             (position (cdr new-relative-xy))
-                             (window-resize-pixelwise t)
-                             growth)
-                        ;; Now set the new height of the window.  If
-                        ;; new-relative-y is above relative-xy, then
-                        ;; make the window that much shorter.
-                        ;; Otherwise, make it bigger.
-                        (unless (or (zerop (setq growth
-                                                 (- position last-position)))
-                                    (and (> growth 0)
-                                         (< position
-                                            (+ (window-pixel-top window)
-                                               (window-pixel-height window))))
-                                    (and (< growth 0)
-                                         (> position
-                                            (+ (window-pixel-top window)
-                                               (window-pixel-height window)))))
-                          (when (ignore-errors
-                                  (adjust-window-trailing-edge window growth nil t) t)
-                            (setq last-position position))))))
-             'no-drag)
-        ;; Dragging did not actually happen, so try to run any command
-        ;; necessary.
-        (touch-screen-drag-mode-line-1 event)))))
-
-(global-set-key [mode-line touchscreen-begin]
-                #'touch-screen-drag-mode-line)
-(global-set-key [bottom-divider touchscreen-begin]
-                #'touch-screen-drag-mode-line)
-
-
-
-;; Header line tapping.
-
-(defun touch-screen-tap-header-line (event)
-  "Handle a `touchscreen-begin' EVENT on the header line.
-Wait for the tap to complete, then run any command bound to
-`mouse-1' at the position of EVENT.
-
-If another keymap is bound to `down-mouse-1', then display a menu
-with its contents instead, and run the selected command."
-  (interactive "e")
-  (let* ((posn (cdadr event))
-         (object (posn-object posn))
-         ;; Look for the keymap defined by the object itself.
-         (object-keymap (and (consp object)
-                             (stringp (car object))
-                             (or (get-text-property (cdr object)
-                                                    'keymap
-                                                    (car object))
-                                 (get-text-property (cdr object)
-                                                    'local-map
-                                                    (car object)))))
-         command keymap)
-    ;; Now look for either a command bound to `mouse-1' or a keymap
-    ;; bound to `down-mouse-1'.
-    (with-selected-window (posn-window posn)
-      (setq command (lookup-key object-keymap
-				[header-line mouse-1] t)
-            keymap (lookup-key object-keymap
-			       [header-line down-mouse-1] t))
-      (unless (keymapp keymap)
-	(setq keymap nil)))
-    ;; Wait for the tap to complete.
-    (when (touch-screen-track-tap event)
-      ;; Select the window whose header line was clicked.
-      (with-selected-window (posn-window posn)
-        (if keymap
-            (when-let* ((command (x-popup-menu event keymap))
-                        (tem (lookup-key keymap
-                                         (if (consp command)
-                                             (apply #'vector command)
-                                           (vector command))
-                                         t)))
-              (call-interactively tem))
-          (when (commandp command)
-            (call-interactively command nil
-                                (vector (list 'mouse-1 (cdadr event))))))))))
-
-(global-set-key [header-line touchscreen-begin]
-                #'touch-screen-tap-header-line)
-
 (provide 'touch-screen)
 
 ;;; touch-screen ends here
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 4df1fb7ab08..fa801cab51b 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1193,8 +1193,7 @@ If nothing was called, return non-nil."
 	    ;; up event.
             (cond
              ((eq (car event) 'touchscreen-begin)
-              (setq command (lookup-key widget-global-map
-                                        [touchscreen-begin])))
+              (setq command 'touch-screen-handle-touch))
              (mouse-1 (cond ((setq command	;down event
                                    (lookup-key widget-global-map [down-mouse-1]))
                              (setq up nil))
@@ -1213,6 +1212,11 @@ If nothing was called, return non-nil."
 	      (call-interactively command)))))
     (message "You clicked somewhere weird.")))
 
+;; Make sure `touch-screen-handle-touch' abstains from emulating
+;; down-mouse-1 events for `widget-button-click'.
+
+(put 'widget-button-click 'ignored-mouse-command t)
+
 (defun widget-button-press (pos &optional event)
   "Invoke button at POS."
   (interactive "@d")
diff --git a/src/keyboard.c b/src/keyboard.c
index ea07c538aa2..e10128def13 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -9994,13 +9994,18 @@ typedef struct keyremap
    If the mapping is a function and DO_FUNCALL is true,
    the function is called with PROMPT as parameter and its return
    value is used as the return value of this function (after checking
-   that it is indeed a vector).  */
+   that it is indeed a vector).
+
+   START and END are the indices of the first and last key of the
+   sequence being remapped within the keyboard buffer KEYBUF.  */
 
 static Lisp_Object
 access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
-			bool do_funcall)
+			bool do_funcall, ptrdiff_t start, ptrdiff_t end,
+			Lisp_Object *keybuf)
 {
   Lisp_Object next;
+  specpdl_ref count;
 
   next = access_keymap (map, key, 1, 0, 1);
 
@@ -10016,10 +10021,18 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
      its value instead.  */
   if (do_funcall && FUNCTIONP (next))
     {
-      Lisp_Object tem;
+      Lisp_Object tem, remap;
       tem = next;
 
-      next = call1 (next, prompt);
+      /* Build Vcurrent_key_remap_sequence.  */
+      remap = Fvector (end - start + 1, keybuf + start);
+
+      /* Bind `current-key-remap-sequence' to the key sequence being
+	 remapped.  */
+      count = SPECPDL_INDEX ();
+      specbind (Qcurrent_key_remap_sequence, remap);
+      next = unbind_to (count, call1 (next, prompt));
+
       /* If the function returned something invalid,
 	 barf--don't ignore it.  */
       if (! (NILP (next) || VECTORP (next) || STRINGP (next)))
@@ -10044,11 +10057,17 @@ keyremap_step (Lisp_Object *keybuf, volatile keyremap *fkey,
 	       int input, bool doit, int *diff, Lisp_Object prompt)
 {
   Lisp_Object next, key;
+  ptrdiff_t buf_start, buf_end;
+
+  /* Save the key sequence being translated.  */
+  buf_start = fkey->start;
+  buf_end = fkey->end;
 
   key = keybuf[fkey->end++];
 
   if (KEYMAPP (fkey->parent))
-    next = access_keymap_keyremap (fkey->map, key, prompt, doit);
+    next = access_keymap_keyremap (fkey->map, key, prompt, doit,
+				   buf_start, buf_end, keybuf);
   else
     next = Qnil;
 
@@ -12479,6 +12498,7 @@ static const struct event_head head_table[] = {
   {SYMBOL_INDEX (Qselect_window),       SYMBOL_INDEX (Qswitch_frame)},
   /* Touchscreen events should be prefixed by the posn.  */
   {SYMBOL_INDEX (Qtouchscreen_begin),	SYMBOL_INDEX (Qtouchscreen)},
+  {SYMBOL_INDEX (Qtouchscreen_end),	SYMBOL_INDEX (Qtouchscreen)},
 };
 
 static Lisp_Object
@@ -13575,6 +13595,15 @@ If non-nil, text conversion will continue to happen after a prefix
 key has been read inside `read-key-sequence'.  */);
   disable_inhibit_text_conversion = false;
 
+  DEFVAR_LISP ("current-key-remap-sequence",
+	       Vcurrent_key_remap_sequence,
+    doc: /* The key sequence currently being remap, or nil.
+Bound to a vector containing the sub-sequence matching a binding
+within `input-decode-map' or `local-function-key-map' when its bound
+function is called to remap that sequence.  */);
+  Vcurrent_key_remap_sequence = Qnil;
+  DEFSYM (Qcurrent_key_remap_sequence, "current-key-remap-sequence");
+
   pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper);
 }