]> git.eshelyaron.com Git - emacs.git/commitdiff
Get rid of vmotion loop in `pixel-scroll-precision-scroll-up'
authorPo Lu <luangruo@yahoo.com>
Thu, 2 Dec 2021 01:15:43 +0000 (09:15 +0800)
committerPo Lu <luangruo@yahoo.com>
Thu, 2 Dec 2021 01:15:43 +0000 (09:15 +0800)
* lisp/pixel-scroll.el (pixel-scroll-precision-scroll-up): Use
posn-at-x-y for cursor motion.

lisp/pixel-scroll.el

index 59b5b71b9237e4e6e88e0fbe9a34c4d82121d913..9cd2352e1990767e0bd3867be08ae5b74908888f 100644 (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)