]> git.eshelyaron.com Git - emacs.git/commitdiff
Make `pixel-scroll-precision-scroll-up' slightly more robust
authorPo Lu <luangruo@yahoo.com>
Sat, 27 Nov 2021 05:46:35 +0000 (13:46 +0800)
committerPo Lu <luangruo@yahoo.com>
Sat, 27 Nov 2021 05:46:35 +0000 (13:46 +0800)
* lisp/pixel-scroll.el (pixel-scroll-precision-scroll-up):
Subtract from existing vscroll if feasible.

lisp/pixel-scroll.el

index 131519a2585bb3b651136f3e23a39578b6528e96..84e1f66fa55ff1638d4ab18eb0553ab8effbee2f 100644 (file)
@@ -432,21 +432,31 @@ the height of the current window."
       (vertical-motion -1)
       (setq current-y (- current-y (line-pixel-height)))))
   (let ((current-vscroll (window-vscroll nil t)))
-    (setq delta (- delta current-vscroll))
-    (set-window-vscroll nil 0 t))
-  (while (> delta 0)
-    (let ((position (pixel-point-and-height-at-unseen-line)))
-      (set-window-start nil (car position) t)
-      (setq delta (- delta (cdr position)))))
-  (when (< delta 0)
-    (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta)
-                                         (window-tab-line-height)
-                                         (window-header-line-height))))
-               (desired-start (posn-point desired-pos))
-               (desired-vscroll (cdr (posn-object-x-y desired-pos))))
-      (unless (eq (window-start) desired-start)
-        (set-window-start nil desired-start t))
-      (set-window-vscroll nil desired-vscroll t))))
+    (if (<= delta current-vscroll)
+        (set-window-vscroll nil (- current-vscroll delta) t)
+      (setq delta (- delta current-vscroll))
+      (set-window-vscroll nil 0 t)
+      (while (> delta 0)
+        (let ((position (pixel-point-and-height-at-unseen-line)))
+          (unless (cdr position)
+            (signal 'beginning-of-buffer nil))
+          (set-window-start nil (car position) t)
+          ;; If the line above is taller than the window height (i.e. there's
+          ;; a very tall image), keep point on it.
+          (when (> (cdr position) (window-text-height nil t))
+            (let ((vs (window-vscroll nil t)))
+              (goto-char (car position))
+              (set-window-vscroll nil vs t)))
+          (setq delta (- delta (cdr position)))))
+      (when (< delta 0)
+        (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta)
+                                                  (window-tab-line-height)
+                                                  (window-header-line-height))))
+                   (desired-start (posn-point desired-pos))
+                   (desired-vscroll (cdr (posn-object-x-y desired-pos))))
+          (unless (eq (window-start) desired-start)
+            (set-window-start nil desired-start t))
+          (set-window-vscroll nil desired-vscroll t))))))
 
 ;; FIXME: This doesn't work when there's an image above the current
 ;; line that is taller than the window.