diff --git a/lisp/mouse.el b/lisp/mouse.el index f75800763e6..33aef3b729f 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -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, diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index ee4687e8d63..4109bd96ca2 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -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)