mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Fix mouse dragging on touch screens

Browse source 
* lisp/mouse.el (mouse-position-for-drag-line): New function;
return position of active touch screen tool if a sequence is
being translated into mouse movement events, and the last mouse
position otherwise.
(mouse-drag-line): Invoke `mouse-position-for-drag-line' rather
than reading the mouse position manually.

* lisp/touch-screen.el (touch-screen-current-tool): New 10th
field holding the frame-relative last attested position of this
tool.
(touch-screen-relative-xy): Clarify doc string.
(touch-screen-handle-point-update): Update the said field with
POSN's position relative to its frame.
(touch-screen-handle-touch): Initialize the 10th field of new
tool lists with such a position.
(touch-screen-last-drag-position): New function.
This commit is contained in:
Po Lu 2025-11-25 10:48:27 +08:00
parent c767928997
commit 0d1bb23d8c
2 changed files with 57 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

23
lisp/mouse.el
View file

@ -853,6 +853,17 @@ This command must be bound to a mouse click."
(split-window-horizontally
(min (max new-width first-col) last-col)))))))
(defun mouse-position-for-drag-line (tty)
"Return the last mouse position observed for the purposes of `mouse-drag-line'.
If TTY is non-nil, return the last attested position of the mouse
relative to the root frame. Otherwise, return the position of the mouse
relative to the selected frame, unless the current drag operation was
produced from a touch screen event, in which event, return the position
of the active touch-screen tool relative to the same."
(if tty (mouse-position-in-root-frame)
(or (touch-screen-last-drag-position)
(mouse-absolute-pixel-position))))
(defun mouse-drag-line (start-event line)
"Drag a mode, header, tab or vertical line with the mouse.
START-EVENT is the starting mouse event of the drag action. LINE
@ -888,9 +899,7 @@ must be one of the symbols `header', `mode', `tab' or `vertical'."
;; START-EVENT here because that would give us coordinates for
;; 'posn-window' of that event and we don't want that (see the
;; comment above).
(position-x-y (if tty
(mouse-position-in-root-frame)
(mouse-absolute-pixel-position)))
(position-x-y (mouse-position-for-drag-line tty))
;; 'position' records the x- (for vertical dragging) or y- (for
;; mode, header and tab line dragging) coordinate of the
;; current mouse position
@ -956,9 +965,7 @@ must be one of the symbols `header', `mode', `tab' or `vertical'."
nil)
((eq line 'vertical)
;; Drag right edge of 'window'.
(setq position (if tty
(car (mouse-position-in-root-frame))
(car (mouse-absolute-pixel-position))))
(setq position (car (mouse-position-for-drag-line tty)))
(unless (zerop (setq growth (- position last-position)))
;; When we drag characterwise and we either drag for
;; the first time or the dragging direction changes,
@ -989,9 +996,7 @@ must be one of the symbols `header', `mode', `tab' or `vertical'."
))
(t
;; Drag bottom edge of 'window'.
(setq position (cdr (if tty
(mouse-position-in-root-frame)
(mouse-absolute-pixel-position))))
(setq position (cdr (mouse-position-for-drag-line tty)))
(unless (zerop (setq growth (- position last-position)))
;; When we drag characterwise and we either drag for
;; the first time or the dragging direction changes,

53
lisp/touch-screen.el
View file

@ -61,7 +61,13 @@ accessed as follows:
touch point.
(nth 9 touch-screen-current-tool)
The last known position of the touch point.
The last known position of the touch point, relative to the
window in the second element.
(nth 10 touch-screen-current-tool)
The same position, relative to the frame to which the window
in the second element belongs.
See `touch-screen-handle-point-update' and
`touch-screen-handle-point-up' for the meanings of the fourth
@ -201,15 +207,16 @@ mouse-down, mouse motion, mouse drag, and mouse button events.")
;;; Scroll gesture.
(defun touch-screen-relative-xy (posn window)
"Return the coordinates of POSN, a mouse position list.
However, return the coordinates relative to WINDOW.
"Return the coordinates of POSN, a mouse position list, relative to WINDOW.
If (posn-window posn) is the same as window, simply return the
coordinates in POSN. Otherwise, convert them to the frame, and
then back again.
If (posn-window POSN) is the same as window, simply return the
coordinates in POSN. Otherwise, translate these coordinates
into that window's frame's coordinate system and from there into
that of WINDOW.
If WINDOW is the symbol `frame', simply convert the coordinates
to the frame that they belong in."
If WINDOW is the symbol `frame', just convert these coordinates
to the coordinate system of the frame containing POSN or its
window."
(if (or (eq (posn-window posn) window)
(and (eq window 'frame)
(framep (posn-window posn))))
@ -1104,6 +1111,10 @@ then move point to the position of POINT."
(relative-xy (touch-screen-relative-xy posn window)))
;; Update the 10th field of the tool list with RELATIVE-XY.
(setcar (nthcdr 9 touch-screen-current-tool) relative-xy)
;; And the 11th with the absolute position of POSN relative to its
;; frame.
(setcar (nthcdr 10 touch-screen-current-tool)
(touch-screen-relative-xy posn 'frame))
(cond ((or (null what)
(eq what 'ancillary-tool))
(let* ((last-posn (nth 2 touch-screen-current-tool))
@ -1576,6 +1587,8 @@ functions undertaking event management themselves to call
(position (cdadr event))
(window (posn-window position))
(point (posn-point position))
(frame-or-window-frame
(if (framep window) window (window-frame window)))
binding tool-list)
;; Cancel the touch screen timer, if it is still there by any
;; chance.
@ -1603,7 +1616,7 @@ functions undertaking event management themselves to call
;; auxiliary tool was first pressed, then interpreted as a
;; scale by which to adjust text within the current tool's
;; window.
(when (eq (if (framep window) window (window-frame window))
(when (eq frame-or-window-frame
;; Verify that the new tool was placed on the
;; same frame the current tool has, so as not to
;; consider events distributed across distinct
@ -1657,7 +1670,9 @@ functions undertaking event management themselves to call
(posn-x-y position)
nil position
nil nil nil nil
(posn-x-y position)))
(posn-x-y position)
(touch-screen-relative-xy position
'frame)))
touch-screen-current-tool tool-list)
;; Select the window underneath the event as the checks below
;; will look up keymaps and markers inside its buffer.
@ -2155,6 +2170,24 @@ Must be called from a command bound to a `touchscreen-hold' or
;; Now set the fourth element of tool to `command-inhibit'.
(setcar (nthcdr 3 tool) 'command-inhibit)))
;;;###autoload
(defun touch-screen-last-drag-position ()
"Return the last attested position of the current touch screen tool.
Value is a pair of integers (X . Y) representing the pixel
position of the said tool relative to the frame where it was
placed (not the selected frame), or nil if this function was
not invoked after the generation of a `mouse-movement' or
`down-mouse-1' event by touch screen event translation.
This function must be consulted in preference to
`mouse-absolute-pixel-position' if the latter is required in any
command that handles `mouse-movement' or `down-mouse-1' events."
(when-let* ((tool touch-screen-current-tool)
(window (nth 1 tool))
(pos (nth 10 tool)))
(and (eq (nth 3 tool) 'mouse-drag)
(window-live-p window) pos)))
(provide 'touch-screen)