From 01a6c0b409c4d9ad92c4bb99bdb06c742bf3b0dd Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 2 Dec 2021 09:15:43 +0800 Subject: [PATCH] Get rid of vmotion loop in `pixel-scroll-precision-scroll-up' * lisp/pixel-scroll.el (pixel-scroll-precision-scroll-up): Use posn-at-x-y for cursor motion. --- lisp/pixel-scroll.el | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 59b5b71b923..9cd2352e199 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -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) -- 2.39.2