From 1dfc27576afe558da781b2d5f4845ca242dce3cc Mon Sep 17 00:00:00 2001
From: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
Date: Sun, 7 Jan 2018 09:17:09 +0200
Subject: [PATCH] Make pixel-wise scrolling less laggy

* lisp/pixel-scroll.el (pixel-dead-time, pixel-last-scroll-time):
New variables.
(pixel-scroll-up, pixel-scroll-down): Invoke 'scroll-up' or
'scroll-down' when called within 'pixel-dead-time'.  (Bug#29737)
---
 lisp/pixel-scroll.el | 71 ++++++++++++++++++++++++++++++--------------
 1 file changed, 48 insertions(+), 23 deletions(-)

diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index bfc48bac2e2..d362419e0fc 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -82,6 +82,27 @@ case you need scrolling resolution of a pixel, set to 1.  After a
 pixel scroll, typing \\[next-line] or \\[previous-line] scrolls the window to make it
 fully visible, and undoes the effect of the pixel-level scroll.")
 
+(defvar pixel-dead-time 0.1
+  "Minimal interval in seconds before next smooth scrolling.
+If another scrolling request arrives within this period, scrolling
+will be carried out without pixel resolution.  If zero, scrolling
+is always with pixel resolution.")
+
+(defvar pixel-last-scroll-time 0
+  "Time when the last scrolling was made, in second since the epoch.")
+
+(defun pixel-scroll-in-rush-p ()
+  "Return non-nil if next scroll should be non-smooth.
+When scrolling request is delivered soon after the previous one,
+user is in hurry.  When the time since last scroll is larger than
+`pixel-dead-time', we are ready for another smooth scroll, and this
+function returns nil."
+  (let* ((current-time (float-time))
+         (scroll-in-rush-p (< (- current-time pixel-last-scroll-time)
+                              pixel-dead-time)))
+    (setq pixel-last-scroll-time current-time)
+    scroll-in-rush-p))
+
 ;;;###autoload
 (define-minor-mode pixel-scroll-mode
   "A minor mode to scroll text pixel-by-pixel.
@@ -104,35 +125,39 @@ if ARG is omitted or nil."
 This is an alternative of `scroll-up'.  Scope moves downward."
   (interactive)
   (or arg (setq arg 1))
-  (dotimes (ii arg) ; move scope downward
-    (let ((amt (if pixel-resolution-fine-flag
-                   (if (integerp pixel-resolution-fine-flag)
-                       pixel-resolution-fine-flag
-                     (frame-char-height))
-                 (pixel-line-height))))
-      (if (pixel-eob-at-top-p)            ; when end-of-the-buffer is close
-          (scroll-up 1)                   ; relay on robust method
-        (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
-          (vertical-motion 1))            ; move point downward
-        (pixel-scroll-pixel-up amt)))))   ; move scope downward
+  (if (pixel-scroll-in-rush-p)
+      (scroll-up arg)
+    (dotimes (ii arg)                    ; move scope downward
+      (let ((amt (if pixel-resolution-fine-flag
+                     (if (integerp pixel-resolution-fine-flag)
+                         pixel-resolution-fine-flag
+                       (frame-char-height))
+                   (pixel-line-height))))
+        (if (pixel-eob-at-top-p)      ; when end-of-the-buffer is close
+            (scroll-up 1)             ; relay on robust method
+          (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
+            (vertical-motion 1))            ; move point downward
+          (pixel-scroll-pixel-up amt))))))  ; move scope downward
 
 (defun pixel-scroll-down (&optional arg)
   "Scroll text of selected window down ARG lines.
 This is and alternative of `scroll-down'.  Scope moves upward."
   (interactive)
   (or arg (setq arg 1))
-  (dotimes (ii arg)
-    (let ((amt (if pixel-resolution-fine-flag
-                   (if (integerp pixel-resolution-fine-flag)
-                       pixel-resolution-fine-flag
-                     (frame-char-height))
-                 (pixel-line-height -1))))
-      (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
-        (vertical-motion -1))              ; move point upward
-      (if (or (pixel-bob-at-top-p amt)     ; when beginning-of-the-buffer is seen
-              (pixel-eob-at-top-p))        ; for file with a long line
-          (scroll-down 1)                  ; relay on robust method
-        (pixel-scroll-pixel-down amt)))))
+  (if (pixel-scroll-in-rush-p)
+      (scroll-down arg)
+    (dotimes (ii arg)
+      (let ((amt (if pixel-resolution-fine-flag
+                     (if (integerp pixel-resolution-fine-flag)
+                         pixel-resolution-fine-flag
+                       (frame-char-height))
+                   (pixel-line-height -1))))
+        (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
+          (vertical-motion -1))              ; move point upward
+        (if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen
+                (pixel-eob-at-top-p))    ; for file with a long line
+            (scroll-down 1)              ; relay on robust method
+          (pixel-scroll-pixel-down amt))))))
 
 (defun pixel-bob-at-top-p (amt)
   "Return non-nil if window-start is at beginning of the current buffer.
-- 
2.39.2