aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/pixel-scroll.el71
1 files 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
82pixel scroll, typing \\[next-line] or \\[previous-line] scrolls the window to make it 82pixel scroll, typing \\[next-line] or \\[previous-line] scrolls the window to make it
83fully visible, and undoes the effect of the pixel-level scroll.") 83fully visible, and undoes the effect of the pixel-level scroll.")
84 84
85(defvar pixel-dead-time 0.1
86 "Minimal interval in seconds before next smooth scrolling.
87If another scrolling request arrives within this period, scrolling
88will be carried out without pixel resolution. If zero, scrolling
89is always with pixel resolution.")
90
91(defvar pixel-last-scroll-time 0
92 "Time when the last scrolling was made, in second since the epoch.")
93
94(defun pixel-scroll-in-rush-p ()
95 "Return non-nil if next scroll should be non-smooth.
96When scrolling request is delivered soon after the previous one,
97user is in hurry. When the time since last scroll is larger than
98`pixel-dead-time', we are ready for another smooth scroll, and this
99function returns nil."
100 (let* ((current-time (float-time))
101 (scroll-in-rush-p (< (- current-time pixel-last-scroll-time)
102 pixel-dead-time)))
103 (setq pixel-last-scroll-time current-time)
104 scroll-in-rush-p))
105
85;;;###autoload 106;;;###autoload
86(define-minor-mode pixel-scroll-mode 107(define-minor-mode pixel-scroll-mode
87 "A minor mode to scroll text pixel-by-pixel. 108 "A minor mode to scroll text pixel-by-pixel.
@@ -104,35 +125,39 @@ if ARG is omitted or nil."
104This is an alternative of `scroll-up'. Scope moves downward." 125This is an alternative of `scroll-up'. Scope moves downward."
105 (interactive) 126 (interactive)
106 (or arg (setq arg 1)) 127 (or arg (setq arg 1))
107 (dotimes (ii arg) ; move scope downward 128 (if (pixel-scroll-in-rush-p)
108 (let ((amt (if pixel-resolution-fine-flag 129 (scroll-up arg)
109 (if (integerp pixel-resolution-fine-flag) 130 (dotimes (ii arg) ; move scope downward
110 pixel-resolution-fine-flag 131 (let ((amt (if pixel-resolution-fine-flag
111 (frame-char-height)) 132 (if (integerp pixel-resolution-fine-flag)
112 (pixel-line-height)))) 133 pixel-resolution-fine-flag
113 (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close 134 (frame-char-height))
114 (scroll-up 1) ; relay on robust method 135 (pixel-line-height))))
115 (while (pixel-point-at-top-p amt) ; prevent too late (multi tries) 136 (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
116 (vertical-motion 1)) ; move point downward 137 (scroll-up 1) ; relay on robust method
117 (pixel-scroll-pixel-up amt))))) ; move scope downward 138 (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
139 (vertical-motion 1)) ; move point downward
140 (pixel-scroll-pixel-up amt)))))) ; move scope downward
118 141
119(defun pixel-scroll-down (&optional arg) 142(defun pixel-scroll-down (&optional arg)
120 "Scroll text of selected window down ARG lines. 143 "Scroll text of selected window down ARG lines.
121This is and alternative of `scroll-down'. Scope moves upward." 144This is and alternative of `scroll-down'. Scope moves upward."
122 (interactive) 145 (interactive)
123 (or arg (setq arg 1)) 146 (or arg (setq arg 1))
124 (dotimes (ii arg) 147 (if (pixel-scroll-in-rush-p)
125 (let ((amt (if pixel-resolution-fine-flag 148 (scroll-down arg)
126 (if (integerp pixel-resolution-fine-flag) 149 (dotimes (ii arg)
127 pixel-resolution-fine-flag 150 (let ((amt (if pixel-resolution-fine-flag
128 (frame-char-height)) 151 (if (integerp pixel-resolution-fine-flag)
129 (pixel-line-height -1)))) 152 pixel-resolution-fine-flag
130 (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries) 153 (frame-char-height))
131 (vertical-motion -1)) ; move point upward 154 (pixel-line-height -1))))
132 (if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen 155 (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
133 (pixel-eob-at-top-p)) ; for file with a long line 156 (vertical-motion -1)) ; move point upward
134 (scroll-down 1) ; relay on robust method 157 (if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen
135 (pixel-scroll-pixel-down amt))))) 158 (pixel-eob-at-top-p)) ; for file with a long line
159 (scroll-down 1) ; relay on robust method
160 (pixel-scroll-pixel-down amt))))))
136 161
137(defun pixel-bob-at-top-p (amt) 162(defun pixel-bob-at-top-p (amt)
138 "Return non-nil if window-start is at beginning of the current buffer. 163 "Return non-nil if window-start is at beginning of the current buffer.