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.

1 files changed, 45 insertions, 40 deletions

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