procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Get rid of vmotion loop in `pixel-scroll-precision-scroll-up'

Browse source 
* lisp/pixel-scroll.el (pixel-scroll-precision-scroll-up): Use
posn-at-x-y for cursor motion.
This commit is contained in:
Po Lu 2021-12-02 09:15:43 +08:00
parent 1914d946d6
commit 01a6c0b409
1 changed files with 19 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
lisp/pixel-scroll.el
View file

@ -412,22 +412,25 @@ the height of the current window."
(let* ((edges (window-edges nil t nil t))
(max-y (- (nth 3 edges)
(nth 1 edges)))
(usable-height max-y))
(when-let* ((posn (posn-at-point))
(current-y (+ (cdr (posn-x-y posn))
(line-pixel-height))))
(while (and (<= (- max-y current-y) delta)
(<= (cdr (posn-object-width-height posn))
usable-height))
(vertical-motion -1)
(setq current-y (- current-y (line-pixel-height))))
(when (and (>= (cdr (posn-object-width-height posn))
usable-height)
(let ((prev-line-height (save-excursion
(vertical-motion -1)
(line-pixel-height))))
(<= 0 (- (cdr (posn-x-y posn)) prev-line-height))))
(vertical-motion -1)))
(usable-height max-y)
(posn (posn-at-x-y 0 (+ (window-tab-line-height)
(window-header-line-height)
(- max-y delta))))
(point (posn-point posn))
(up-point (save-excursion
(goto-char point)
(vertical-motion -1)
(point))))
(when (> (point) up-point)
(when (let ((pos-visible (pos-visible-in-window-p up-point nil t)))
(or (eq (length pos-visible) 2)
(when-let* ((posn (posn-at-point up-point))
(edges (window-edges nil t))
(usable-height (- (nth 3 edges)
(nth 1 edges))))
(> (cdr (posn-object-width-height posn))
usable-height))))
(goto-char up-point)))
(let ((current-vscroll (window-vscroll nil t)))
(if (<= delta current-vscroll)
(set-window-vscroll nil (- current-vscroll delta) t)