mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
Improve touch screen scrolling support
* 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
parent
e1761019a9
commit
5d89602e29
1 changed files with 291 additions and 200 deletions
|
|
@ -405,21 +405,17 @@ right most column of the window using `posn-at-x-y'."
|
|||
(long-line-optimizations-p)
|
||||
(let ((window-line-height (window-line-height))
|
||||
(maximum-height (* 2 (frame-char-height))))
|
||||
(or (and window-line-height
|
||||
(> (car window-line-height)
|
||||
maximum-height))
|
||||
(unless window-line-height
|
||||
;; `window-line-height' isn't available.
|
||||
;; Redisplay first and try to ascertain the height
|
||||
;; of the line again.
|
||||
(prog1 nil (redisplay t))
|
||||
;; Likewise if the line height still isn't
|
||||
;; available.
|
||||
(not (setq window-line-height
|
||||
(window-line-height)))
|
||||
;; Actually check the height now.
|
||||
(redisplay t)
|
||||
(setq window-line-height (window-line-height)))
|
||||
;; `window-line-height' might still be unavailable.
|
||||
(and window-line-height
|
||||
(> (car window-line-height)
|
||||
maximum-height))))
|
||||
(if (catch 'hscrolled-away
|
||||
(catch 'hscrolled-away
|
||||
(let ((beg nil) end string y)
|
||||
;; Detect whether or not the window is hscrolled. If it
|
||||
;; 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 " "
|
||||
'display (list 'space
|
||||
:width (list width)))))
|
||||
nil)))))
|
||||
nil))))
|
||||
|
||||
(defun touch-screen-drag (event)
|
||||
"Handle a drag EVENT by setting the region to its new point.
|
||||
|
|
@ -523,18 +519,25 @@ 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 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))
|
||||
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.
|
||||
;; 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 (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)
|
||||
(initial touch-screen-word-select-initial-word)
|
||||
(maybe-select-word (or (not touch-screen-word-select)
|
||||
|
|
@ -593,9 +596,10 @@ area."
|
|||
(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.
|
||||
;; 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)))
|
||||
|
|
@ -604,32 +608,119 @@ area."
|
|||
(> (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.
|
||||
;; 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)))
|
||||
(let ((scroll-conservatively 101))
|
||||
(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) 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
|
||||
(goto-char (1- (window-start)))
|
||||
(setq touch-screen-word-select-bounds nil))
|
||||
(redisplay))
|
||||
((> (cdr relative-xy)
|
||||
(let ((edges (window-inside-pixel-edges)))
|
||||
(- (nth 3 edges) (cadr edges))))
|
||||
(ignore-errors
|
||||
(goto-char (1+ (window-end nil t)))
|
||||
(setq touch-screen-word-select-bounds nil))
|
||||
(redisplay)))
|
||||
;; Finally, display a preview of the line now around point
|
||||
;; if requested by the user.
|
||||
;; 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)))
|
||||
;; Display a preview of the line now around point if
|
||||
;; requested by the user.
|
||||
(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)
|
||||
"Restart dragging to select text.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue