mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Improve touch screen scrolling support

Browse source 
* lisp/touch-screen.el (touch-screen-preview-select): Avoid
unnecessary redisplays.
(touch-screen-drag): Scroll at window margins using window
scrolling functions instead of relying on redisplay to recenter
the window around point.
This commit is contained in:
Po Lu 2023-07-21 14:22:54 +08:00
parent e1761019a9
commit 5d89602e29
1 changed files with 291 additions and 200 deletions
Download patch file Download diff file Expand all files Collapse all files

169
lisp/touch-screen.el
View file

@ -405,21 +405,17 @@ right most column of the window using `posn-at-x-y'."
(long-line-optimizations-p) (long-line-optimizations-p)
(let ((window-line-height (window-line-height)) (let ((window-line-height (window-line-height))
(maximum-height (* 2 (frame-char-height)))) (maximum-height (* 2 (frame-char-height))))
(or (and window-line-height (unless window-line-height
(> (car window-line-height)
maximum-height))
;; `window-line-height' isn't available. ;; `window-line-height' isn't available.
;; Redisplay first and try to ascertain the height ;; Redisplay first and try to ascertain the height
;; of the line again. ;; of the line again.
(prog1 nil (redisplay t)) (redisplay t)
;; Likewise if the line height still isn't (setq window-line-height (window-line-height)))
;; available. ;; `window-line-height' might still be unavailable.
(not (setq window-line-height (and window-line-height
(window-line-height)))
;; Actually check the height now.
(> (car window-line-height) (> (car window-line-height)
maximum-height)))) maximum-height))))
(if (catch 'hscrolled-away (catch 'hscrolled-away
(let ((beg nil) end string y) (let ((beg nil) end string y)
;; Detect whether or not the window is hscrolled. If it ;; Detect whether or not the window is hscrolled. If it
;; is, set beg to the location of the first column ;; is, set beg to the location of the first column
@ -512,7 +508,7 @@ right most column of the window using `posn-at-x-y'."
(propertize " " (propertize " "
'display (list 'space 'display (list 'space
:width (list width))))) :width (list width)))))
nil))))) nil))))
(defun touch-screen-drag (event) (defun touch-screen-drag (event)
"Handle a drag EVENT by setting the region to its new point. "Handle a drag EVENT by setting the region to its new point.
@ -523,18 +519,25 @@ area."
(interactive "e") (interactive "e")
(let* ((posn (cadr event)) ; Position of the tool. (let* ((posn (cadr event)) ; Position of the tool.
(point (posn-point posn)) ; Point of the event. (point (posn-point posn)) ; Point of the event.
; Window where the tap originated. ;; Window where the tap originated.
(window (nth 1 touch-screen-current-tool)) (window (nth 1 touch-screen-current-tool))
;; The currently selected window. Used to redisplay within
;; the correct window while scrolling.
(old-window (selected-window))
initial-point) initial-point)
;; Keep dragging. ;; Keep dragging.
(with-selected-window window (with-selected-window window
;; Figure out what character to go to. If this posn is ;; Figure out what character to go to. If this posn is in the
;; in the window, go to (posn-point posn). If not, ;; window, go to (posn-point posn). If not, then go to the line
;; then go to the line before either window start or ;; before either window start or window end.
;; window end.
(setq initial-point (point)) (setq initial-point (point))
(when (or (not point)
(not (eq point initial-point)))
(if (and (eq (posn-window posn) window) (if (and (eq (posn-window posn) window)
point (not (eq point initial-point))) 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) (let* ((bounds touch-screen-word-select-bounds)
(initial touch-screen-word-select-initial-word) (initial touch-screen-word-select-initial-word)
(maybe-select-word (or (not touch-screen-word-select) (maybe-select-word (or (not touch-screen-word-select)
@ -593,9 +596,10 @@ area."
(when maybe-select-word (when maybe-select-word
(goto-char (posn-point posn)) (goto-char (posn-point posn))
(when initial (when initial
;; If point is less than mark, which is is less than ;; If point is less than mark, which is is less
;; the end of the word that was originally selected, ;; than the end of the word that was originally
;; try to keep it selected by moving mark there. ;; selected, try to keep it selected by moving
;; mark there.
(when (and (<= (point) (mark)) (when (and (<= (point) (mark))
(< (mark) (cdr initial))) (< (mark) (cdr initial)))
(set-mark (cdr initial))) (set-mark (cdr initial)))
@ -604,32 +608,119 @@ area."
(> (mark) (car initial))) (> (mark) (car initial)))
(set-mark (car initial)))) (set-mark (car initial))))
(setq touch-screen-word-select-bounds nil))) (setq touch-screen-word-select-bounds nil)))
;; Finally, display a preview of the line around point if ;; Finally, display a preview of the line around point
;; requested by the user. ;; if requested by the user.
(when (and touch-screen-preview-select (when (and touch-screen-preview-select
(not (eq (point) initial-point))) (not (eq (point) initial-point)))
(touch-screen-preview-select))) (touch-screen-preview-select)))
;; POSN is outside the window. Scroll accordingly. ;; POSN is outside the window. Scroll accordingly.
(let ((relative-xy (let* ((relative-xy
(touch-screen-relative-xy posn window))) (touch-screen-relative-xy posn window))
(let ((scroll-conservatively 101)) (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 (cond
((< (cdr relative-xy) 0) ((< (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 (ignore-errors
(goto-char (1- (window-start))) ;; Scroll down by a single line.
(setq touch-screen-word-select-bounds nil)) (scroll-down 1)
(redisplay)) ;; After scrolling, look up the new posn at EVENT's
((> (cdr relative-xy) ;; column and go there.
(let ((edges (window-inside-pixel-edges))) (setq posn (posn-at-x-y (car xy) 0)
(- (nth 3 edges) (cadr edges)))) point (posn-point posn))
(ignore-errors (if point
(goto-char (1+ (window-end nil t))) (goto-char point)
(setq touch-screen-word-select-bounds nil)) ;; If there's no buffer position at that column, go
(redisplay))) ;; to the window start.
;; Finally, display a preview of the line now around point (goto-char (window-start)))
;; if requested by the user. ;; Display a preview of the line now around point if
;; requested by the user.
(when touch-screen-preview-select (when touch-screen-preview-select
(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)))
;; 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)))
;; 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)))
;; Display a preview of the line now around
;; point if requested by the user.
(when touch-screen-preview-select
(touch-screen-preview-select))))))))))))))
(defun touch-screen-restart-drag (event) (defun touch-screen-restart-drag (event)
"Restart dragging to select text. "Restart dragging to select text.