From: Po Lu <luangruo@yahoo.com>
Date: Wed, 1 Dec 2021 01:33:35 +0000 (+0800)
Subject: Make pixel scrolling faster
X-Git-Tag: emacs-29.0.90~3633^2~12
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=034d8a3ea8437a6ef88d33275e2a5818380afd74;p=emacs.git

Make pixel scrolling faster

* lisp/pixel-scroll.el (pixel-scroll-precision-scroll-down): Get
rid of big motion loop.
(pixel-scroll-precision-scroll-up): Stop subtracting height of
window lines.
---

diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 5ffa8caa71c..f514a010ad0 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -375,59 +375,42 @@ Otherwise, redisplay will reset the window's vscroll."
   "Scroll the current window down by DELTA pixels.
 Note that this function doesn't work if DELTA is larger than
 the height of the current window."
-  (when-let* ((posn (posn-at-point))
-	      (current-y (cdr (posn-x-y posn)))
-	      (min-y (+ (frame-char-height)
-                        (window-tab-line-height)
-		        (window-header-line-height)))
-              (cursor-height (line-pixel-height))
-              (window-height (window-text-height nil t))
-              (next-height (save-excursion
-                             (vertical-motion 1)
-                             (line-pixel-height))))
-    (if (and (> delta 0)
-             (<= cursor-height window-height))
-	(while (< (- current-y min-y) delta)
-	  (vertical-motion 1)
-          (setq current-y (+ current-y
-                             (line-pixel-height)))
-	  (when (eobp)
-	    (signal 'end-of-buffer nil)))
-      (when (< (- (cdr (posn-object-width-height posn))
-                  (cdr (posn-object-x-y posn)))
-               (- window-height next-height))
-        (vertical-motion 1)
-        (setq posn (posn-at-point)
-              current-y (cdr (posn-x-y posn)))
-        (while (< (- current-y min-y) delta)
-	  (vertical-motion 1)
-          (setq current-y (+ current-y
-                             (line-pixel-height)))
-	  (when (eobp)
-	    (signal 'end-of-buffer nil)))))
-    (let* ((desired-pos (posn-at-x-y 0 (+ delta
-					  (window-tab-line-height)
-					  (window-header-line-height))))
-           (object (posn-object desired-pos))
-	   (desired-start (posn-point desired-pos))
-	   (desired-vscroll (cdr (posn-object-x-y desired-pos))))
-      (if (or (consp object) (stringp object))
-          ;; We are either on an overlay or a string, so set vscroll
-          ;; directly.
-          (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)))))
+  (let* ((desired-pos (posn-at-x-y 0 (+ delta
+					(window-tab-line-height)
+					(window-header-line-height))))
+         (object (posn-object desired-pos))
+	 (desired-start (posn-point desired-pos))
+	 (desired-vscroll (cdr (posn-object-x-y desired-pos)))
+         (next-pos (save-excursion
+                     (goto-char desired-start)
+                     (when (zerop (vertical-motion 1))
+                       (signal 'end-of-buffer nil))
+                     (point))))
+    (if (and (< (point) next-pos)
+             (let ((pos-visibility (pos-visible-in-window-p next-pos nil t)))
+               (or (eq (length pos-visibility) 2)
+                   (when-let* ((posn (posn-at-point next-pos))
+                               (edges (window-edges nil t))
+                               (usable-height (- (nth 3 edges)
+                                                 (nth 1 edges))))
+                     (> (cdr (posn-object-width-height posn))
+                        usable-height)))))
+        (goto-char next-pos))
+    (if (or (consp object) (stringp object))
+        ;; We are either on an overlay or a string, so set vscroll
+        ;; directly.
+        (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))))
 
 (defun pixel-scroll-precision-scroll-up (delta)
   "Scroll the current window up by DELTA pixels."
   (let* ((edges (window-edges nil t nil t))
          (max-y (- (nth 3 edges)
-                   (nth 1 edges)
-                   (window-tab-line-height)
-                   (window-header-line-height)))
+                   (nth 1 edges)))
          (usable-height max-y))
     (when-let* ((posn (posn-at-point))
 	        (current-y (+ (cdr (posn-x-y posn))