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.
This commit is contained in:
Po Lu 2024-07-03 17:05:24 +08:00
parent 667ca66481
commit 65bd41d1cf
4 changed files with 90 additions and 66 deletions

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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