[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 7b346b92b4c: Improve touch-screen support
|
From: |
Po Lu |
|
Subject: |
feature/android 7b346b92b4c: Improve touch-screen support |
|
Date: |
Sun, 16 Jul 2023 03:32:17 -0400 (EDT) |
branch: feature/android
commit 7b346b92b4c30c634d094e6162b65a22a52b93bb
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
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.
---
doc/emacs/emacs.texi | 2 +-
doc/emacs/input.texi | 7 +-
doc/lispref/commands.texi | 68 ++++-
doc/lispref/keymaps.texi | 9 +
lisp/touch-screen.el | 657 ++++++++++++++++++++++++++++------------------
lisp/wid-edit.el | 8 +-
src/keyboard.c | 39 ++-
7 files changed, 518 insertions(+), 272 deletions(-)
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);
}
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- feature/android 7b346b92b4c: Improve touch-screen support,
Po Lu <=