From: Po Lu <luangruo@yahoo.com>
Date: Tue, 30 Nov 2021 12:35:11 +0000 (+0800)
Subject: Improve upwards pixel scrolling for large images
X-Git-Tag: emacs-29.0.90~3635^2~15
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b79d779ae839d0484b24967b4753df9e9b85f614;p=emacs.git

Improve upwards pixel scrolling for large images

This fixes most of the problem, but with a large image the
vscroll can sometimes jump about, which has to be fixed.

* lisp/pixel-scroll.el (pixel-scroll-precision-up): Handle
vscrolling large images in the first unseen line.
---

diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 2fd7cace0b0..097e4e53ddc 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -423,50 +423,55 @@ the height of the current window."
 
 (defun pixel-scroll-precision-scroll-up (delta)
   "Scroll the current window up by DELTA pixels."
-  (when-let* ((max-y (- (window-text-height nil t)
-                        (frame-char-height)
-		        (window-tab-line-height)
-		        (window-header-line-height)))
-	      (posn (posn-at-point))
-	      (current-y (+ (cdr (posn-x-y posn))
-		            (line-pixel-height))))
-    (while (< (- max-y current-y) delta)
-      (vertical-motion -1)
-      (setq current-y (- current-y (line-pixel-height)))))
-  (let ((current-vscroll (window-vscroll nil 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)
+  (let* ((edges (window-edges nil t nil t))
+         (max-y (- (nth 3 edges)
+                   (window-tab-line-height)
+                   (window-header-line-height)))
+         (usable-height (- max-y (nth 1 edges))))
+    (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)))
+    (let ((current-vscroll (window-vscroll nil 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) usable-height)
+              (goto-char (car position)))
+            (setq delta (- delta (cdr position)))))
+        (when (< delta 0)
+          (if-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))))
-          (let ((object (posn-object desired-pos)))
-            (if (or (consp object) (stringp object))
-                (set-window-vscroll nil (+ (window-vscroll nil t)
-                                           (- delta))
-                                    t)
-              (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.
+              (progn
+                (set-window-start nil desired-start t)
+                (set-window-vscroll nil desired-vscroll t))
+            (set-window-vscroll nil (abs delta) t)))))))
+
+;; FIXME: This doesn't _always_ work when there's an image above the
+;; current line that is taller than the window, and scrolling can
+;; sometimes be jumpy in that case.
 (defun pixel-scroll-precision (event)
   "Scroll the display vertically by pixels according to EVENT.
 Move the display up or down by the pixel deltas in EVENT to