mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
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.
This commit is contained in:
Po Lu
parent
9e22cd30eb
commit
64eb4ce0af
@ -684,6 +684,8 @@ Must be bound to event E."
|
|||||||
(sit-for 0)
|
(sit-for 0)
|
||||||
(popup-menu (mouse-menu-major-mode-map) e)))
|
(popup-menu (mouse-menu-major-mode-map) e)))
|
||||||
|
|
||||||
|
(put 'dframe-popup-kludge 'mouse-1-menu-command t)
|
||||||
|
|
||||||
;;; Interactive user functions for the mouse
|
;;; Interactive user functions for the mouse
|
||||||
;;
|
;;
|
||||||
(defun dframe-mouse-event-p (event)
|
(defun dframe-mouse-event-p (event)
|
||||||
|
|||||||
@ -1254,17 +1254,20 @@ response to the minibuffer being closed."
|
|||||||
(cancel-timer minibuffer-on-screen-keyboard-timer)
|
(cancel-timer minibuffer-on-screen-keyboard-timer)
|
||||||
(setq minibuffer-on-screen-keyboard-timer nil)))))
|
(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.
|
"Notice that POINT has been removed from the screen.
|
||||||
POINT should be the point currently tracked as
|
POINT should be the point currently tracked as
|
||||||
`touch-screen-current-tool'.
|
`touch-screen-current-tool'.
|
||||||
PREFIX should be a virtual function key used to look up key
|
PREFIX should be a virtual function key used to look up key
|
||||||
bindings.
|
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
|
If an ancillary touch point is being observed, transfer touch
|
||||||
information from `touch-screen-aux-tool' to
|
information from `touch-screen-aux-tool' to
|
||||||
`touch-screen-current-tool' and set it to nil, thereby resuming
|
`touch-screen-current-tool' and set the former to nil, thereby
|
||||||
gesture recognition with that tool replacing the tool removed.
|
resuming gesture recognition with that tool replacing the tool
|
||||||
|
removed.
|
||||||
|
|
||||||
Otherwise:
|
Otherwise:
|
||||||
|
|
||||||
@ -1315,136 +1318,144 @@ is not read-only."
|
|||||||
;; hasn't been moved, translate the sequence into a
|
;; hasn't been moved, translate the sequence into a
|
||||||
;; regular mouse click.
|
;; regular mouse click.
|
||||||
(eq what 'restart-drag))
|
(eq what 'restart-drag))
|
||||||
(when (windowp (posn-window posn))
|
;; Don't attempt to execute commands bound to mouse events
|
||||||
(setq point (posn-point posn)
|
;; if the touch sequence has been canceled.
|
||||||
window (posn-window posn))
|
(unless canceled
|
||||||
;; Select the window that was tapped given that it
|
(when (windowp (posn-window posn))
|
||||||
;; isn't an inactive minibuffer window.
|
(setq point (posn-point posn)
|
||||||
(when (or (not (eq window
|
window (posn-window posn))
|
||||||
(minibuffer-window
|
;; Select the window that was tapped given that it
|
||||||
(window-frame window))))
|
;; isn't an inactive minibuffer window.
|
||||||
(minibuffer-window-active-p window))
|
(when (or (not (eq window
|
||||||
(select-window window))
|
(minibuffer-window
|
||||||
;; Now simulate a mouse click there. If there is a
|
(window-frame window))))
|
||||||
;; link or a button, use mouse-2 to push it.
|
(minibuffer-window-active-p window))
|
||||||
(let* ((event (list (if (or (mouse-on-link-p posn)
|
(select-window window))
|
||||||
(and point (button-at point)))
|
;; Now simulate a mouse click there. If there is a
|
||||||
'mouse-2
|
;; link or a button, use mouse-2 to push it.
|
||||||
'mouse-1)
|
(let* ((event (list (if (or (mouse-on-link-p posn)
|
||||||
posn))
|
(and point (button-at point)))
|
||||||
;; Look for the command bound to this event.
|
'mouse-2
|
||||||
(command (key-binding (if prefix
|
'mouse-1)
|
||||||
(vector prefix
|
posn))
|
||||||
(car event))
|
;; Look for the command bound to this event.
|
||||||
(vector (car event)))
|
(command (key-binding (if prefix
|
||||||
t nil posn)))
|
(vector prefix
|
||||||
(deactivate-mark)
|
(car event))
|
||||||
(when point
|
(vector (car event)))
|
||||||
;; This is necessary for following links.
|
t nil posn)))
|
||||||
(goto-char point))
|
(deactivate-mark)
|
||||||
;; Figure out if the on screen keyboard needs to be
|
(when point
|
||||||
;; displayed.
|
;; This is necessary for following links.
|
||||||
(when command
|
(goto-char point))
|
||||||
(if (memq command touch-screen-set-point-commands)
|
;; Figure out if the on screen keyboard needs to be
|
||||||
(if touch-screen-translate-prompt
|
;; displayed.
|
||||||
;; Forgo displaying the virtual keyboard
|
(when command
|
||||||
;; should touch-screen-translate-prompt be
|
(if (memq command touch-screen-set-point-commands)
|
||||||
;; set, for then the key won't be delivered
|
(if touch-screen-translate-prompt
|
||||||
;; to the command loop, but rather to a
|
;; Forgo displaying the virtual keyboard
|
||||||
;; caller of read-key-sequence such as
|
;; should touch-screen-translate-prompt be
|
||||||
;; describe-key.
|
;; set, for then the key won't be delivered
|
||||||
(throw 'input-event event)
|
;; to the command loop, but rather to a
|
||||||
(if (and (or (not buffer-read-only)
|
;; caller of read-key-sequence such as
|
||||||
touch-screen-display-keyboard)
|
;; describe-key.
|
||||||
;; Detect the splash screen and
|
(throw 'input-event event)
|
||||||
;; avoid displaying the on screen
|
(if (and (or (not buffer-read-only)
|
||||||
;; keyboard there.
|
touch-screen-display-keyboard)
|
||||||
(not (equal (buffer-name) "*GNU Emacs*")))
|
;; Detect the splash screen and
|
||||||
;; Once the on-screen keyboard has been
|
;; avoid displaying the on screen
|
||||||
;; opened, add
|
;; keyboard there.
|
||||||
;; `touch-screen-window-selection-changed'
|
(not (equal (buffer-name) "*GNU Emacs*")))
|
||||||
;; as a window selection change function
|
;; Once the on-screen keyboard has been
|
||||||
;; This then prevents it from being
|
;; opened, add
|
||||||
;; hidden after exiting the minibuffer.
|
;; `touch-screen-window-selection-changed'
|
||||||
(progn
|
;; as a window selection change function
|
||||||
(add-hook
|
;; This then prevents it from being
|
||||||
'window-selection-change-functions
|
;; hidden after exiting the minibuffer.
|
||||||
#'touch-screen-window-selection-changed)
|
(progn
|
||||||
(frame-toggle-on-screen-keyboard
|
(add-hook
|
||||||
(selected-frame) nil))
|
'window-selection-change-functions
|
||||||
;; Otherwise, hide the on screen keyboard
|
#'touch-screen-window-selection-changed)
|
||||||
;; now.
|
(frame-toggle-on-screen-keyboard
|
||||||
(frame-toggle-on-screen-keyboard (selected-frame)
|
(selected-frame) nil))
|
||||||
t))
|
;; Otherwise, hide the on screen keyboard
|
||||||
;; But if it's being called from `describe-key'
|
;; now.
|
||||||
;; or some such, return it as a key sequence.
|
(frame-toggle-on-screen-keyboard (selected-frame)
|
||||||
(throw 'input-event event)))
|
t))
|
||||||
;; If not, return the event.
|
;; But if it's being called from `describe-key'
|
||||||
(throw 'input-event event)))))
|
;; 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)
|
((eq what 'mouse-drag)
|
||||||
;; Generate a corresponding `mouse-1' event.
|
;; Generate a corresponding `mouse-1' event.
|
||||||
(let* ((new-window (posn-window posn))
|
;; Alternatively, quit if the touch sequence was canceled.
|
||||||
(new-point (posn-point posn))
|
(if canceled
|
||||||
(old-posn (nth 4 touch-screen-current-tool))
|
(keyboard-quit)
|
||||||
(old-window (posn-window posn))
|
(let* ((new-window (posn-window posn))
|
||||||
(old-point (posn-point posn)))
|
(new-point (posn-point posn))
|
||||||
(throw 'input-event
|
(old-posn (nth 4 touch-screen-current-tool))
|
||||||
;; If the position of the touch point hasn't
|
(old-window (posn-window posn))
|
||||||
;; changed, or it doesn't start or end on a
|
(old-point (posn-point posn)))
|
||||||
;; window...
|
(throw 'input-event
|
||||||
(if (and (not old-point) (not new-point))
|
;; If the position of the touch point hasn't
|
||||||
;; Should old-point and new-point both equal
|
;; changed, or it doesn't start or end on a
|
||||||
;; nil, compare the posn areas and nominal
|
;; window...
|
||||||
;; column position. If either are
|
(if (and (not old-point) (not new-point))
|
||||||
;; different, generate a drag event.
|
;; Should old-point and new-point both equal
|
||||||
(let ((new-col-row (posn-col-row posn))
|
;; nil, compare the posn areas and nominal
|
||||||
(new-area (posn-area posn))
|
;; column position. If either are
|
||||||
(old-col-row (posn-col-row old-posn))
|
;; different, generate a drag event.
|
||||||
(old-area (posn-area old-posn)))
|
(let ((new-col-row (posn-col-row posn))
|
||||||
(if (and (equal new-col-row old-col-row)
|
(new-area (posn-area posn))
|
||||||
(eq new-area old-area))
|
(old-col-row (posn-col-row old-posn))
|
||||||
;; ... generate a mouse-1 event...
|
(old-area (posn-area old-posn)))
|
||||||
(list 'mouse-1 posn)
|
(if (and (equal new-col-row old-col-row)
|
||||||
;; ... otherwise, generate a
|
(eq new-area old-area))
|
||||||
;; drag-mouse-1 event.
|
;; ... generate a mouse-1 event...
|
||||||
(list 'drag-mouse-1 old-posn posn)))
|
(list 'mouse-1 posn)
|
||||||
(if (and (eq new-window old-window)
|
;; ... otherwise, generate a
|
||||||
(eq new-point old-point)
|
;; drag-mouse-1 event.
|
||||||
(windowp new-window)
|
(list 'drag-mouse-1 old-posn posn)))
|
||||||
(windowp old-window))
|
(if (and (eq new-window old-window)
|
||||||
;; ... generate a mouse-1 event...
|
(eq new-point old-point)
|
||||||
(list 'mouse-1 posn)
|
(windowp new-window)
|
||||||
;; ... otherwise, generate a drag-mouse-1
|
(windowp old-window))
|
||||||
;; event.
|
;; ... generate a mouse-1 event...
|
||||||
(list 'drag-mouse-1 old-posn posn))))))
|
(list 'mouse-1 posn)
|
||||||
|
;; ... otherwise, generate a drag-mouse-1
|
||||||
|
;; event.
|
||||||
|
(list 'drag-mouse-1 old-posn posn)))))))
|
||||||
((eq what 'mouse-1-menu)
|
((eq what 'mouse-1-menu)
|
||||||
;; Generate a `down-mouse-1' event at the position the tap
|
;; Generate a `down-mouse-1' event at the position the tap
|
||||||
;; took place.
|
;; took place, unless the touch sequence was canceled.
|
||||||
(throw 'input-event
|
(unless canceled
|
||||||
(list 'down-mouse-1
|
(throw 'input-event
|
||||||
(nth 4 touch-screen-current-tool))))
|
(list 'down-mouse-1
|
||||||
|
(nth 4 touch-screen-current-tool)))))
|
||||||
((or (eq what 'drag)
|
((or (eq what 'drag)
|
||||||
;; Merely initiating a drag is sufficient to select a
|
;; Merely initiating a drag is sufficient to select a
|
||||||
;; word if word selection is enabled.
|
;; word if word selection is enabled.
|
||||||
(eq what 'held))
|
(eq what 'held))
|
||||||
;; Display the on screen keyboard if the region is now
|
(unless canceled
|
||||||
;; active. Check this within the window where the tool
|
;; Display the on screen keyboard if the region is now
|
||||||
;; was first place.
|
;; active. Check this within the window where the tool
|
||||||
(setq window (nth 1 touch-screen-current-tool))
|
;; was first place.
|
||||||
(when window
|
(setq window (nth 1 touch-screen-current-tool))
|
||||||
(with-selected-window window
|
(when window
|
||||||
(when (and (region-active-p)
|
(with-selected-window window
|
||||||
(not buffer-read-only))
|
(when (and (region-active-p)
|
||||||
;; Once the on-screen keyboard has been opened, add
|
(not buffer-read-only))
|
||||||
;; `touch-screen-window-selection-changed' as a
|
;; Once the on-screen keyboard has been opened, add
|
||||||
;; window selection change function. This then
|
;; `touch-screen-window-selection-changed' as a
|
||||||
;; prevents it from being hidden after exiting the
|
;; window selection change function. This then
|
||||||
;; minibuffer.
|
;; prevents it from being hidden after exiting the
|
||||||
(progn
|
;; minibuffer.
|
||||||
(add-hook 'window-selection-change-functions
|
(progn
|
||||||
#'touch-screen-window-selection-changed)
|
(add-hook 'window-selection-change-functions
|
||||||
(frame-toggle-on-screen-keyboard (selected-frame)
|
#'touch-screen-window-selection-changed)
|
||||||
nil))))))))))
|
(frame-toggle-on-screen-keyboard (selected-frame)
|
||||||
|
nil)))))))))))
|
||||||
|
|
||||||
(defun touch-screen-handle-touch (event prefix &optional interactive)
|
(defun touch-screen-handle-touch (event prefix &optional interactive)
|
||||||
"Handle a single touch EVENT, and perform associated actions.
|
"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))
|
(setq touch-screen-current-timer nil))
|
||||||
(let ((old-aux-tool touch-screen-aux-tool))
|
(let ((old-aux-tool touch-screen-aux-tool))
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
;; Don't perform any actions associated with releasing the
|
(touch-screen-handle-point-up (cadr event) prefix
|
||||||
;; tool if the touch sequence was intercepted by another
|
(caddr event))
|
||||||
;; program.
|
|
||||||
(if (caddr event)
|
|
||||||
(setq touch-screen-current-tool nil)
|
|
||||||
(touch-screen-handle-point-up (cadr event) prefix))
|
|
||||||
;; If an ancillary tool is present the function call above
|
;; If an ancillary tool is present the function call above
|
||||||
;; will merely transfer information from it into the current
|
;; will simply transfer information from it into the current
|
||||||
;; tool list, thereby rendering it the new current tool,
|
;; tool list, rendering the new current tool, until such
|
||||||
;; until such time as it too is released.
|
;; time as it too is released.
|
||||||
(when (not (and old-aux-tool (not touch-screen-aux-tool)))
|
(when (not (and old-aux-tool (not touch-screen-aux-tool)))
|
||||||
;; Make sure the tool list is cleared even if
|
;; Make sure the tool list is cleared even if
|
||||||
;; `touch-screen-handle-point-up' throws.
|
;; `touch-screen-handle-point-up' throws.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user