Function: touch-screen-drag
touch-screen-drag is an interactive and byte-compiled function defined
in touch-screen.el.gz.
Signature
(touch-screen-drag EVENT)
Documentation
Handle a drag EVENT by setting the region to its new point.
If touch-screen-word-select and EVENT lies outside the last
word that was selected, select the word that now contains POINT.
Scroll the window if EVENT's coordinates are outside its text
area.
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/touch-screen.el.gz
(defun touch-screen-drag (event)
"Handle a drag EVENT by setting the region to its new point.
If `touch-screen-word-select' and EVENT lies outside the last
word that was selected, select the word that now contains POINT.
Scroll the window if EVENT's coordinates are outside its text
area."
(interactive "e")
(let* ((posn (cadr event)) ; Position of the tool.
(point (posn-point posn)) ; Point of the event.
;; Window where the tap originated.
(window (nth 1 touch-screen-current-tool))
;; The currently selected window. Used to redisplay within
;; the correct window while scrolling.
(old-window (selected-window))
;; Whether or not text should be selected word-by-word.
(word-select touch-screen-word-select)
;; Cons containing the confines of the word initially
;; selected when the touchpoint was first held down.
(initial touch-screen-word-select-initial-word)
initial-point)
;; Keep dragging.
(with-selected-window window
;; Figure out what character to go to. If this posn is in the
;; window, go to (posn-point posn). If not, then go to the line
;; before either window start or window end.
(setq initial-point (point))
(when (or (not point)
(not (eq point initial-point)))
(if (and (eq (posn-window posn) window)
point
;; point must be visible in the window. If it isn't,
;; the window must be scrolled.
(pos-visible-in-window-p point))
(let* ((bounds touch-screen-word-select-bounds)
(maybe-select-word (or (not touch-screen-word-select)
(or (not bounds)
(> point (cdr bounds))
(< point (car bounds))))))
(if (and word-select
;; point is now outside the last word selected.
maybe-select-word
(not (posn-object posn))
(when-let* ((char (char-after point))
(class (char-syntax char)))
;; Don't select words if point isn't inside a
;; word constituent or similar.
(or (eq class ?w) (eq class ?_))))
;; Determine the confines of the word containing
;; POINT.
(let (word-start word-end)
(save-excursion
(goto-char point)
(forward-word-strictly)
;; Set word-end to ZV if there is no word after
;; this one.
(setq word-end (point))
;; Now try to move backwards. Set word-start to
;; BEGV if this word is there.
(backward-word-strictly)
(setq word-start (point)))
(let ((mark (mark)))
;; Extend the region to cover either word-end or
;; word-start; whether to goto word-end or
;; word-start is subject to the position of the
;; mark relative to point.
(if (< word-start mark)
;; The start of the word is behind mark.
;; Extend the region towards the start.
(goto-char word-start)
;; Else, go to the end of the word.
(goto-char word-end))
;; If point is less than mark, which is is less
;; than the end of the word that was originally
;; selected, try to keep it selected by moving
;; mark there.
(when (and initial (<= (point) mark)
(< mark (cdr initial)))
(set-mark (cdr initial)))
;; Do the opposite when the converse is true.
(when (and initial (>= (point) mark)
(> mark (car initial)))
(set-mark (car initial))))
(if bounds
(progn (setcar bounds word-start)
(setcdr bounds word-end))
(setq touch-screen-word-select-bounds
(cons word-start word-end))))
(when maybe-select-word
(goto-char (posn-point posn))
(when initial
;; If point is less than mark, which is is less
;; than the end of the word that was originally
;; selected, try to keep it selected by moving
;; mark there.
(when (and (<= (point) (mark))
(< (mark) (cdr initial)))
(set-mark (cdr initial)))
;; Do the opposite when the converse is true.
(when (and (>= (point) (mark))
(> (mark) (car initial)))
(set-mark (car initial))))
(setq touch-screen-word-select-bounds nil)))
;; Finally, display a preview of the line around point
;; if requested by the user.
(when (and touch-screen-preview-select
(not (eq (point) initial-point)))
(touch-screen-preview-select)))
;; POSN is outside the window. Scroll accordingly.
(let* ((relative-xy
(touch-screen-relative-xy posn window))
(xy (posn-x-y posn))
;; The height of the window's text area.
(body-height (window-body-height nil t))
;; This is used to find the character closest to
;; POSN's column at the bottom of the window.
(height (- body-height
;; Use the last row of the window, not its
;; last pixel.
(frame-char-height)))
(midpoint (/ body-height 2))
(scroll-conservatively 101))
(cond
((< (cdr relative-xy) midpoint)
;; POSN is before half the window, yet POINT does not
;; exist or is not completely visible within. Scroll
;; downwards.
(ignore-errors
;; Scroll down by a single line.
(scroll-down 1)
;; After scrolling, look up the new posn at EVENT's
;; column and go there.
(setq posn (posn-at-x-y (car xy) 0)
point (posn-point posn))
(if point
(goto-char point)
;; If there's no buffer position at that column, go
;; to the window start.
(goto-char (window-start)))
;; If word selection is enabled, now try to keep the
;; initially selected word within the active region.
(when word-select
(when initial
;; If point is less than mark, which is is less
;; than the end of the word that was originally
;; selected, try to keep it selected by moving
;; mark there.
(when (and (<= (point) (mark))
(< (mark) (cdr initial)))
(set-mark (cdr initial)))
;; Do the opposite when the converse is true.
(when (and (>= (point) (mark))
(> (mark) (car initial)))
(set-mark (car initial))))
(setq touch-screen-word-select-bounds nil))
;; Display a preview of the line now around point if
;; requested by the user.
(when touch-screen-preview-select
(touch-screen-preview-select))
;; Select old-window, so that redisplay doesn't
;; display WINDOW as selected if it isn't already.
(with-selected-window old-window
;; Now repeat this every `mouse-scroll-delay' until
;; input becomes available, but scroll down a few
;; more lines.
(while (sit-for mouse-scroll-delay)
;; Select WINDOW again.
(with-selected-window window
;; Keep scrolling down until input becomes
;; available.
(scroll-down 4)
;; After scrolling, look up the new posn at
;; EVENT's column and go there.
(setq posn (posn-at-x-y (car xy) 0)
point (posn-point posn))
(if point
(goto-char point)
;; If there's no buffer position at that
;; column, go to the window start.
(goto-char (window-start)))
;; If word selection is enabled, now try to keep
;; the initially selected word within the active
;; region.
(when word-select
(when initial
;; If point is less than mark, which is is
;; less than the end of the word that was
;; originally selected, try to keep it
;; selected by moving mark there.
(when (and (<= (point) (mark))
(< (mark) (cdr initial)))
(set-mark (cdr initial)))
;; Do the opposite when the converse is true.
(when (and (>= (point) (mark))
(> (mark) (car initial)))
(set-mark (car initial))))
(setq touch-screen-word-select-bounds nil))
;; Display a preview of the line now around
;; point if requested by the user.
(when touch-screen-preview-select
(touch-screen-preview-select))))))
(setq touch-screen-word-select-bounds nil))
((>= (cdr relative-xy) midpoint)
;; Default to scrolling upwards even if POSN is still
;; within the confines of the window. If POINT is
;; partially visible, and the branch above hasn't been
;; taken it must be somewhere at the bottom of the
;; window, so scroll downwards.
(ignore-errors
;; Scroll up by a single line.
(scroll-up 1)
;; After scrolling, look up the new posn at EVENT's
;; column and go there.
(setq posn (posn-at-x-y (car xy) height)
point (posn-point posn))
(if point
(goto-char point)
;; If there's no buffer position at that column, go
;; to the window start.
(goto-char (window-end nil t)))
;; If word selection is enabled, now try to keep
;; the initially selected word within the active
;; region.
(when word-select
(when initial
;; If point is less than mark, which is is less
;; than the end of the word that was originally
;; selected, try to keep it selected by moving
;; mark there.
(when (and (<= (point) (mark))
(< (mark) (cdr initial)))
(set-mark (cdr initial)))
;; Do the opposite when the converse is true.
(when (and (>= (point) (mark))
(> (mark) (car initial)))
(set-mark (car initial))))
(setq touch-screen-word-select-bounds nil))
;; Display a preview of the line now around point if
;; requested by the user.
(when touch-screen-preview-select
(touch-screen-preview-select))
;; Select old-window, so that redisplay doesn't
;; display WINDOW as selected if it isn't already.
(with-selected-window old-window
;; Now repeat this every `mouse-scroll-delay' until
;; input becomes available, but scroll down a few
;; more lines.
(while (sit-for mouse-scroll-delay)
;; Select WINDOW again.
(with-selected-window window
;; Keep scrolling down until input becomes
;; available.
(scroll-up 4)
;; After scrolling, look up the new posn at
;; EVENT's column and go there.
(setq posn (posn-at-x-y (car xy) height)
point (posn-point posn))
(if point
(goto-char point)
;; If there's no buffer position at that
;; column, go to the window start.
(goto-char (window-end nil t)))
;; If word selection is enabled, now try to keep
;; the initially selected word within the active
;; region.
(when word-select
(when initial
;; If point is less than mark, which is is less
;; than the end of the word that was originally
;; selected, try to keep it selected by moving
;; mark there.
(when (and (<= (point) (mark))
(< (mark) (cdr initial)))
(set-mark (cdr initial)))
;; Do the opposite when the converse is true.
(when (and (>= (point) (mark))
(> (mark) (car initial)))
(set-mark (car initial))))
(setq touch-screen-word-select-bounds nil))
;; Display a preview of the line now around
;; point if requested by the user.
(when touch-screen-preview-select
(touch-screen-preview-select)))))))))))
(setq deactivate-mark nil))))