Function: touch-screen-handle-touch
touch-screen-handle-touch is an interactive and byte-compiled function
defined in touch-screen.el.gz.
Signature
(touch-screen-handle-touch EVENT PREFIX &optional INTERACTIVE)
Documentation
Handle a single touch EVENT, and perform associated actions.
EVENT can either be a touchscreen-begin, touchscreen-update or
touchscreen-end event.
PREFIX is either nil, or a symbol specifying a virtual function
key to apply to EVENT.
If INTERACTIVE, execute the command associated with any event
generated instead of throwing input-event. Otherwise, throw
input-event with a single input event if that event should take
the place of EVENT within the key sequence being translated, or
nil if all tools have been released.
Set touch-screen-events-received to t to indicate that touch
screen events have been received, and thus by extension require
functions undertaking event management themselves to call
read-key rather than read-event.
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/touch-screen.el.gz
(defun touch-screen-handle-touch (event prefix &optional interactive)
"Handle a single touch EVENT, and perform associated actions.
EVENT can either be a `touchscreen-begin', `touchscreen-update' or
`touchscreen-end' event.
PREFIX is either nil, or a symbol specifying a virtual function
key to apply to EVENT.
If INTERACTIVE, execute the command associated with any event
generated instead of throwing `input-event'. Otherwise, throw
`input-event' with a single input event if that event should take
the place of EVENT within the key sequence being translated, or
nil if all tools have been released.
Set `touch-screen-events-received' to t to indicate that touch
screen events have been received, and thus by extension require
functions undertaking event management themselves to call
`read-key' rather than `read-event'."
(interactive "e\ni\np")
(unless touch-screen-events-received
(setq touch-screen-events-received t))
(if interactive
;; Called interactively (probably from wid-edit.el.)
;; Add any event generated to `unread-command-events'.
(let ((event1
(let ((current-key-remap-sequence (vector event)))
(touch-screen-translate-touch nil))))
(when (vectorp event1)
(setq unread-command-events
(nconc unread-command-events
(nreverse (append event1 nil))))))
(cond
((eq (car event) 'touchscreen-begin)
;; A tool was just pressed against the screen. Figure out the
;; window where it is and make it the tool being tracked on the
;; window.
(let* ((touchpoint (caadr event))
(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.
(when touch-screen-current-timer
(cancel-timer touch-screen-current-timer)
(setq touch-screen-current-timer nil))
;; If a tool already exists...
(if (and touch-screen-current-tool
;; ..and the number of this tool is at variance with
;; that of the current tool: if a `touchscreen-end'
;; event is delivered that is somehow withheld from
;; this function and the system does not assign
;; monotonically increasing touch point identifiers,
;; then the ancillary tool will be set to a tool
;; bearing the same number as the current tool, and
;; consequently the mechanism for detecting
;; erroneously retained touch points upon the
;; registration of `touchscreen-update' events will
;; not be activated.
(not (eq touchpoint (car touch-screen-current-tool))))
;; Then record this tool as the ``auxiliary tool''.
;; Updates to the auxiliary tool are considered in unison
;; with those to the current tool; the distance between
;; both tools is measured and compared with that when the
;; auxiliary tool was first pressed, then interpreted as a
;; scale by which to adjust text within the current tool's
;; 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
;; frames components of a single gesture.
(window-frame (nth 1 touch-screen-current-tool)))
;; Set touch-screen-aux-tool as is proper. Mind that
;; the last field is always relative to the current
;; tool's window.
(let* ((window (nth 1 touch-screen-current-tool))
(relative-x-y (touch-screen-relative-xy position
window))
(initial-pos (nth 4 touch-screen-current-tool))
(initial-x-y (touch-screen-relative-xy initial-pos
window))
computed-distance computed-centrum)
;; Calculate the distance and centrum from this point
;; to the initial position of the current tool.
(setq computed-distance (touch-screen-distance relative-x-y
initial-x-y)
computed-centrum (touch-screen-centrum relative-x-y
initial-x-y))
;; If computed-distance is zero, ignore this tap.
(unless (zerop computed-distance)
(setq touch-screen-aux-tool (vector touchpoint window
position relative-x-y
computed-distance
computed-centrum
1.0 nil nil nil)))
;; When an auxiliary tool is pressed, any gesture
;; previously in progress must be terminated, so long
;; as it represents a gesture recognized from the
;; current tool's motion rather than ones detected by
;; this function from circumstances surrounding its
;; first press, such as the presence of a menu or
;; down-mouse-1 button beneath its first press.
(unless (memq (nth 3 touch-screen-current-tool)
'(mouse-drag mouse-1-menu))
;; Set the what field to the symbol `ancillary-tool'
;; rather than nil, that mouse events may not be
;; generated if no gesture is subsequently
;; recognized; this, among others, prevents
;; undesirable point movement (through the execution
;; of `mouse-set-point') after both points are
;; released without any gesture being detected.
(setcar (nthcdr 3 touch-screen-current-tool)
'ancillary-tool))))
;; Replace any previously ongoing gesture. If POSITION has no
;; window or position, make it nil instead.
(setq tool-list (and (windowp window)
(list touchpoint window
(posn-x-y position)
nil position
nil nil nil nil
(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.
(save-selected-window
;; Check if `touch-screen-extend-selection' is enabled,
;; the tap lies on the point or the mark, and the region
;; is active. If that's the case, set the fourth element
;; of `touch-screen-current-tool' to `restart-drag', then
;; generate a `touchscreen-restart-drag' event.
(when tool-list
;; tool-list is always non-nil where the selected window
;; matters.
(select-window window)
(when (and touch-screen-extend-selection
(or (eq point (point))
(eq point (mark)))
(region-active-p)
;; Only restart drag-to-select if the tap
;; falls on the same row as the selection.
;; This prevents dragging from starting if
;; the tap is below the last window line with
;; text and `point' is at ZV, as the user
;; most likely meant to scroll the window
;; instead.
(when-let* ((posn-point (posn-at-point point))
(posn-row (cdr
(posn-col-row posn-point))))
(eq (cdr (posn-col-row position)) posn-row)))
;; Indicate that a drag is about to restart.
(setcar (nthcdr 3 tool-list) 'restart-drag)
;; Generate the `restart-drag' event.
(throw 'input-event (list 'touchscreen-restart-drag
position))))
;; 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, 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
(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
;; displays it as a menu, that event could cause
;; unwanted commands to be run. Set what to
;; `mouse-1-menu' instead and wait for the up
;; event to display the menu.
(setcar (nthcdr 3 tool-list) 'mouse-1-menu)
(progn
(setcar (nthcdr 3 tool-list) 'mouse-drag)
;; Record the extents of the glyph beneath this
;; touch point to avoid generating extraneous events
;; when it next moves.
(setcar
(nthcdr 5 touch-screen-current-tool)
(let* ((edges (window-inside-pixel-edges window))
(point (posn-x-y position))
(frame-offsets (if (framep window)
'(0 . 0)
(cons (car edges)
(cadr edges)))))
(remember-mouse-glyph (or (and (framep window) window)
(window-frame window))
(+ (car point)
(car frame-offsets))
(+ (cdr point)
(cdr frame-offsets)))))
(throw 'input-event (list 'down-mouse-1 position))))
(and point
;; Start the long-press timer.
(touch-screen-handle-timeout nil)))))))
((eq (car event) 'touchscreen-update)
(unless touch-screen-current-tool
;; If a stray touchscreen-update event arrives (most likely
;; from the menu bar), stop translating this sequence.
(throw 'input-event nil))
;; The positions of tools currently pressed against the screen
;; have changed. If there is a tool being tracked as part of a
;; gesture, look it up in the list of tools.
(if-let* ((new-point (assq (car touch-screen-current-tool)
(cadr event))))
(if touch-screen-aux-tool
(touch-screen-handle-aux-point-update (cdr new-point)
(car new-point))
(touch-screen-handle-point-update new-point))
;; If the current tool exists no longer, a touchscreen-end
;; event is certain to have been disregarded. So that
;; touchscreen gesture translation might continue as usual
;; after this aberration to the normal flow of events, delete
;; the current tool now.
(when touch-screen-current-timer
;; Cancel the touch screen long-press timer, if it is still
;; there by any chance.
(cancel-timer touch-screen-current-timer)
(setq touch-screen-current-timer nil))
;; Don't call `touch-screen-handle-point-up' when terminating
;; translation abnormally.
(setq touch-screen-current-tool nil
;; Delete the ancillary tool while at it.
touch-screen-aux-tool nil)
(message "Current touch screen tool vanished!"))
;; Check for updates to any ancillary point being monitored.
(when touch-screen-aux-tool
(let ((new-point (assq (aref touch-screen-aux-tool 0)
(cadr event))))
(when new-point
(touch-screen-handle-aux-point-update (cdr new-point)
(car new-point))))))
((eq (car event) 'touchscreen-end)
;; A tool has been removed from the screen. If it is the tool
;; currently being tracked, clear `touch-screen-current-tool'.
(when (eq (caadr event) (car touch-screen-current-tool))
;; Cancel the touch screen long-press timer, if it is still
;; there by any chance.
(when touch-screen-current-timer
(cancel-timer touch-screen-current-timer)
(setq touch-screen-current-timer nil))
(let ((old-aux-tool touch-screen-aux-tool))
(unwind-protect
(touch-screen-handle-point-up (cadr event) prefix
(caddr event))
;; If an ancillary tool is present the function call above
;; 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.
(setq touch-screen-current-tool nil)))))
;; If it is rather the ancillary tool, delete its vector. No
;; further action is required, for the next update received will
;; resume regular gesture recognition.
;;
;; The what field in touch-screen-current-tool is set to a
;; signal value when the ancillary tool is pressed, so gesture
;; recognition will commence with a clean slate, save for when
;; the first touch landed atop a menu or some other area
;; down-mouse-1 was bound.
;;
;; Gesture recognition will be inhibited in that case, so that
;; mouse menu or mouse motion events are generated in its place
;; as they would be were no ancillary tool ever pressed.
(when (and touch-screen-aux-tool
(eq (caadr event) (aref touch-screen-aux-tool 0)))
(setq touch-screen-aux-tool nil))
;; Throw to the key translation function.
(throw 'input-event nil)))))