[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 64eb4ce0af8 2/2: Improve treatment of aborted touch events in Spe
|
From: |
Po Lu |
|
Subject: |
master 64eb4ce0af8 2/2: Improve treatment of aborted touch events in Speedbar and elsewhere |
|
Date: |
Mon, 8 Apr 2024 22:39:51 -0400 (EDT) |
branch: master
commit 64eb4ce0af80b840c7b1da137e4323a3d06062fa
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Improve treatment of aborted touch events in Speedbar and elsewhere
* lisp/dframe.el (dframe-popup-kludge): Mark as a
mouse-1-menu-command.
* lisp/touch-screen.el (touch-screen-handle-point-up): New
argument CANCELED. Implement specific responses to cancellation
for each tool state.
(touch-screen-handle-touch): Adjust to match.
---
lisp/dframe.el | 2 +
lisp/touch-screen.el | 275 ++++++++++++++++++++++++++-------------------------
2 files changed, 143 insertions(+), 134 deletions(-)
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 4031e0784c2..8e664c0204a 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -684,6 +684,8 @@ Must be bound to event E."
(sit-for 0)
(popup-menu (mouse-menu-major-mode-map) e)))
+(put 'dframe-popup-kludge 'mouse-1-menu-command t)
+
;;; Interactive user functions for the mouse
;;
(defun dframe-mouse-event-p (event)
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index c8de1d8ee31..037386112d3 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -1254,17 +1254,20 @@ 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 prefix)
+(defun touch-screen-handle-point-up (point prefix canceled)
"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.
+CANCELED should indicate whether the touch point was removed by
+window-system intervention rather than user action.
If an ancillary touch point is being observed, transfer touch
information from `touch-screen-aux-tool' to
-`touch-screen-current-tool' and set it to nil, thereby resuming
-gesture recognition with that tool replacing the tool removed.
+`touch-screen-current-tool' and set the former to nil, thereby
+resuming gesture recognition with that tool replacing the tool
+removed.
Otherwise:
@@ -1315,136 +1318,144 @@ is not read-only."
;; hasn't been moved, translate the sequence into a
;; regular mouse click.
(eq what 'restart-drag))
- (when (windowp (posn-window posn))
- (setq point (posn-point posn)
- window (posn-window posn))
- ;; Select the window that was tapped given that it
- ;; isn't an inactive minibuffer window.
- (when (or (not (eq window
- (minibuffer-window
- (window-frame window))))
- (minibuffer-window-active-p window))
- (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 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)
- (when point
- ;; This is necessary for following links.
- (goto-char point))
- ;; Figure out if the on screen keyboard needs to be
- ;; displayed.
- (when command
- (if (memq command touch-screen-set-point-commands)
- (if touch-screen-translate-prompt
- ;; Forgo displaying the virtual keyboard
- ;; should touch-screen-translate-prompt be
- ;; set, for then the key won't be delivered
- ;; to the command loop, but rather to a
- ;; caller of read-key-sequence such as
- ;; describe-key.
- (throw 'input-event 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 then prevents it from being
- ;; hidden after exiting the minibuffer.
- (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)))))
+ ;; Don't attempt to execute commands bound to mouse events
+ ;; if the touch sequence has been canceled.
+ (unless canceled
+ (when (windowp (posn-window posn))
+ (setq point (posn-point posn)
+ window (posn-window posn))
+ ;; Select the window that was tapped given that it
+ ;; isn't an inactive minibuffer window.
+ (when (or (not (eq window
+ (minibuffer-window
+ (window-frame window))))
+ (minibuffer-window-active-p window))
+ (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 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)
+ (when point
+ ;; This is necessary for following links.
+ (goto-char point))
+ ;; Figure out if the on screen keyboard needs to be
+ ;; displayed.
+ (when command
+ (if (memq command touch-screen-set-point-commands)
+ (if touch-screen-translate-prompt
+ ;; Forgo displaying the virtual keyboard
+ ;; should touch-screen-translate-prompt be
+ ;; set, for then the key won't be delivered
+ ;; to the command loop, but rather to a
+ ;; caller of read-key-sequence such as
+ ;; describe-key.
+ (throw 'input-event 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 then prevents it from being
+ ;; hidden after exiting the minibuffer.
+ (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 (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))))))
+ ;; Alternatively, quit if the touch sequence was canceled.
+ (if canceled
+ (keyboard-quit)
+ (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 (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)))))))
((eq what 'mouse-1-menu)
;; Generate a `down-mouse-1' event at the position the tap
- ;; took place.
- (throw 'input-event
- (list 'down-mouse-1
- (nth 4 touch-screen-current-tool))))
+ ;; took place, unless the touch sequence was canceled.
+ (unless canceled
+ (throw 'input-event
+ (list 'down-mouse-1
+ (nth 4 touch-screen-current-tool)))))
((or (eq what 'drag)
;; Merely initiating a drag is sufficient to select a
;; word if word selection is enabled.
(eq what 'held))
- ;; Display the on screen keyboard if the region is now
- ;; active. Check this within the window where the tool
- ;; was first place.
- (setq window (nth 1 touch-screen-current-tool))
- (when window
- (with-selected-window window
- (when (and (region-active-p)
- (not buffer-read-only))
- ;; Once the on-screen keyboard has been opened, add
- ;; `touch-screen-window-selection-changed' as a
- ;; window selection change function. This then
- ;; prevents it from being hidden after exiting the
- ;; minibuffer.
- (progn
- (add-hook 'window-selection-change-functions
- #'touch-screen-window-selection-changed)
- (frame-toggle-on-screen-keyboard (selected-frame)
- nil))))))))))
+ (unless canceled
+ ;; Display the on screen keyboard if the region is now
+ ;; active. Check this within the window where the tool
+ ;; was first place.
+ (setq window (nth 1 touch-screen-current-tool))
+ (when window
+ (with-selected-window window
+ (when (and (region-active-p)
+ (not buffer-read-only))
+ ;; Once the on-screen keyboard has been opened, add
+ ;; `touch-screen-window-selection-changed' as a
+ ;; window selection change function. This then
+ ;; prevents it from being hidden after exiting the
+ ;; minibuffer.
+ (progn
+ (add-hook 'window-selection-change-functions
+ #'touch-screen-window-selection-changed)
+ (frame-toggle-on-screen-keyboard (selected-frame)
+ nil)))))))))))
(defun touch-screen-handle-touch (event prefix &optional interactive)
"Handle a single touch EVENT, and perform associated actions.
@@ -1684,16 +1695,12 @@ functions undertaking event management themselves to
call
(setq touch-screen-current-timer nil))
(let ((old-aux-tool touch-screen-aux-tool))
(unwind-protect
- ;; Don't perform any actions associated with releasing the
- ;; tool if the touch sequence was intercepted by another
- ;; program.
- (if (caddr event)
- (setq touch-screen-current-tool nil)
- (touch-screen-handle-point-up (cadr event) prefix))
+ (touch-screen-handle-point-up (cadr event) prefix
+ (caddr event))
;; If an ancillary tool is present the function call above
- ;; will merely transfer information from it into the current
- ;; tool list, thereby rendering it the new current tool,
- ;; until such time as it too is released.
+ ;; will simply transfer information from it into the current
+ ;; tool list, rendering the new current tool, until such
+ ;; time as it too is released.
(when (not (and old-aux-tool (not touch-screen-aux-tool)))
;; Make sure the tool list is cleared even if
;; `touch-screen-handle-point-up' throws.