From 65bd41d1cf6d8ea6b95b69d9c60b0111a1c33392 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 3 Jul 2024 17:05:24 +0800 Subject: [PATCH] Adapt doc-view-set-slice-using-mouse to touch-screen input * doc/lispref/commands.texi (Touchscreen Events): Document means of unconditionally enabling simple conversion. * lisp/doc-view.el (doc-view-set-slice-using-mouse): Bind touch-screen-simple-mouse-conversion to t, and read translated mouse events with read-key rather than read-event. * lisp/subr.el (read-key): Don't permit idle timer to interfere with reporting of translated mouse events. * lisp/touch-screen.el (touch-screen-simple-mouse-conversion): New variable. (touch-screen-handle-point-up, touch-screen-handle-touch): Unconditionally enable `mouse-drag' translation if set. Decide whether to send drag or mouse events by the values of the two touchpoints' XY positions and point and double-click-fuzz, as in make_lispy_event. --- doc/lispref/commands.texi | 19 ++++-- lisp/doc-view.el | 7 ++- lisp/subr.el | 10 +++- lisp/touch-screen.el | 120 ++++++++++++++++++++------------------ 4 files changed, 90 insertions(+), 66 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index a9da6c75367..6ddb70a3b9f 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2128,7 +2128,7 @@ motion and mouse motion. 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 +drag''), or with user expectations for touch input, and should not subject the touch sequence to simple translation. If a command whose name contains the property (@pxref{Symbol Properties}) @code{ignored-mouse-command} is encountered or there is no command @@ -2146,13 +2146,20 @@ 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. -To prevent unwanted @code{mouse-1} events arriving after a mouse menu -is dismissed (@pxref{Mouse Menus}), Emacs also avoids simple +To prevent unwanted @code{mouse-1} events from arriving after a mouse +menu is dismissed (@pxref{Mouse Menus}), Emacs also disables simple translation if @code{down-mouse-1} is bound to a keymap, making it a prefix key. In lieu of simple translation, it translates the closing -@code{touchscreen-end} to a @code{down-mouse-1} event with the -starting position of the touch sequence, consequently displaying -the mouse menu. +@code{touchscreen-end} to a @code{down-mouse-1} event with the starting +position of the touch sequence, consequently displaying the mouse menu. + +@vindex @code{touch-screen-simple-mouse-conversion} +Simple conversion will be enabled without regard to the existence of +command or menu bindings if the variable +@code{touch-screen-simple-mouse-conversion} is bound or set to a +non-@code{nil} value, as, for example, it may be by a caller of +@code{read-key} expecting to receive @code{mouse-movement} and +@code{drag-mouse-1} events. @cindex @code{mouse-1-menu-command}, a symbol property Since certain commands are also bound to @code{down-mouse-1} for the diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 4ae9a5e6629..f96b1bad886 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1511,15 +1511,18 @@ to do that. To reset the slice use `doc-view-reset-slice'." ;; Redisplay (doc-view-goto-page (doc-view-current-page))) +(defvar touch-screen-simple-mouse-conversion) ; Defined in touch-screen.el. + (defun doc-view-set-slice-using-mouse () "Set the slice of the images that should be displayed. You set the slice by pressing mouse-1 at its top-left corner and dragging it to its bottom-right corner. See also `doc-view-set-slice' and `doc-view-reset-slice'." (interactive) - (let (x y w h done) + (let ((touch-screen-simple-mouse-conversion t) + x y w h done) (while (not done) - (let ((e (read-event + (let ((e (read-key (concat "Press mouse-1 at the top-left corner and " "drag it to the bottom-right corner!")))) (when (eq (car e) 'drag-mouse-1) diff --git a/lisp/subr.el b/lisp/subr.el index ab388630a91..36b5353b577 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3338,7 +3338,15 @@ only unbound fallback disabled is downcasing of the last event." ;; though read-key-sequence thinks we should wait ;; for more input to decide how to interpret the ;; current input. - (throw 'read-key keys))))))) + ;; + ;; As this treatment will completely defeat the + ;; purpose of touch screen event conversion, + ;; dispense with this timeout when the first + ;; event in this vector is a touch-screen event. + (unless (memq (car-safe (aref keys 0)) '(touchscreen-begin + touchscreen-update + touchscreen-end)) + (throw 'read-key keys)))))))) (unwind-protect (progn (use-global-map diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index c5918efb800..57eff075e73 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -157,13 +157,22 @@ dragging.") ;; Should this variable be documented? (defvar-local touch-screen-keyboard-function nil "Function that decides whether to display the on screen keyboard. -If set, this function is called with point set to the position of the -tap involved when a command listed in `touch-screen-set-point-commands' -is about to be invoked in response to a tap, the current buffer, or the -text beneath point (in the case of an `inhibit-read-only' text -property), is not read only, and `touch-screen-display-keyboard' is nil, -and should return non-nil if it is appropriate to display the on-screen -keyboard afterwards.") +If set, this function is called with point set to the position +of the tap involved when a command listed in +`touch-screen-set-point-commands' is about to be invoked in +response to a tap, the current buffer, or the text beneath +point (in the case of an `inhibit-read-only' text property), is +not read only, and `touch-screen-display-keyboard' is nil, and +should return non-nil if it is appropriate to display the +on-screen keyboard afterwards.") + +(defvar touch-screen-simple-mouse-conversion nil + "Whether to unconditionally enable simple mouse event translation. +If non-nil, touch screen event conversion will always proceed as +though a command was bound to `down-mouse-1' at the position of +the initial tap. That is to say, taps, mouse motion, and +touchpoint removals will be unconditionally converted into +mouse-down, mouse motion, mouse drag, and mouse button events.") @@ -1418,36 +1427,27 @@ is not read-only." (new-point (posn-point posn)) (old-posn (nth 4 touch-screen-current-tool)) (old-window (posn-window posn)) - (old-point (posn-point posn))) + (old-point (posn-point posn)) + (new-relative-xy (touch-screen-relative-xy + posn new-window)) + (old-relative-xy (touch-screen-relative-xy + old-posn new-window))) (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 (not old-point) (not new-point)) - ;; Should old-point and new-point both equal - ;; nil, compare the posn areas and nominal - ;; column position. If either are - ;; different, generate a drag event. - (let ((new-col-row (posn-col-row posn)) - (new-area (posn-area posn)) - (old-col-row (posn-col-row old-posn)) - (old-area (posn-area old-posn))) - (if (and (equal new-col-row old-col-row) - (eq new-area old-area)) - ;; ... generate a mouse-1 event... - (list 'mouse-1 posn) - ;; ... otherwise, generate a - ;; drag-mouse-1 event. - (list 'drag-mouse-1 old-posn posn))) - (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 old-posn posn))))))) + ;; If the position of the touch point has + ;; changed, or it has moved significantly, as + ;; measured by reference to double-click-fuzz... + (if (or (let ((xdiff (- (car new-relative-xy) + (car old-relative-xy))) + (ydiff (- (cdr new-relative-xy) + (cdr old-relative-xy)))) + (and (>= (abs xdiff) double-click-fuzz) + (>= (abs ydiff) double-click-fuzz))) + (not (eq old-window new-window)) + (not (eq old-point new-point))) + ;; ... generate a drag-mouse-1 event... + (list 'drag-mouse-1 old-posn posn) + ;; ... otherwise, generate a mouse-1 event. + (list 'mouse-1 posn)))))) ((eq what 'mouse-1-menu) ;; Generate a `down-mouse-1' event at the position the tap ;; took place, unless the touch sequence was canceled. @@ -1633,29 +1633,35 @@ functions undertaking event management themselves to call ;; Generate the `restart-drag' event. (throw 'input-event (list 'touchscreen-restart-drag position)))) - ;; 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. + ;; Determine whether 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. Likewise if + ;; touch event translation is being invoked by a caller of + ;; `read-key' that expects unprocessed mouse input, ;; - ;; If the command in question is a keymap, set that - ;; element to `mouse-1-menu' instead of `mouse-drag', and - ;; don't generate a `down-mouse-1' event immediately. - ;; Instead, wait for the touch point to be released. + ;; If the command in question is a keymap, set that element + ;; to `mouse-1-menu' instead of `mouse-drag', and don't + ;; generate a `down-mouse-1' event immediately, but wait for + ;; the touch point to be released, so that the menu bar may + ;; not be displayed before the user has released the touch + ;; point and the window system is ready to display a menu. (if (and tool-list - (and (setq binding - (key-binding (if prefix - (vector prefix - 'down-mouse-1) - [down-mouse-1]) - t nil position)) - (not (and (symbolp binding) - (get binding 'ignored-mouse-command))))) - (if (or (keymapp binding) - (and (symbolp binding) - (get binding 'mouse-1-menu-command))) + (or (and (setq binding + (key-binding (if prefix + (vector prefix + 'down-mouse-1) + [down-mouse-1]) + t nil position)) + (not (and (symbolp binding) + (get binding 'ignored-mouse-command)))) + touch-screen-simple-mouse-conversion)) + (if (and (not touch-screen-simple-mouse-conversion) + (or (keymapp binding) + (and (symbolp binding) + (get binding 'mouse-1-menu-command)))) ;; binding is a keymap, or a command that does ;; almost the same thing. If a `mouse-1' event is ;; generated after the keyboard command loop