diff options
| -rw-r--r-- | lisp/pixel-scroll.el | 71 |
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 | |||
| 82 | pixel scroll, typing \\[next-line] or \\[previous-line] scrolls the window to make it | 82 | pixel scroll, typing \\[next-line] or \\[previous-line] scrolls the window to make it |
| 83 | fully visible, and undoes the effect of the pixel-level scroll.") | 83 | fully 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. | ||
| 87 | If another scrolling request arrives within this period, scrolling | ||
| 88 | will be carried out without pixel resolution. If zero, scrolling | ||
| 89 | is 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. | ||
| 96 | When scrolling request is delivered soon after the previous one, | ||
| 97 | user 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 | ||
| 99 | function 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." | |||
| 104 | This is an alternative of `scroll-up'. Scope moves downward." | 125 | This 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. |
| 121 | This is and alternative of `scroll-down'. Scope moves upward." | 144 | This 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. |