lisp/pixel-scroll.el

   1 ;;; pixel-scroll.el --- Scroll a line smoothly
   2
   3 ;; Copyright (C) 2017 Free Software Foundation, Inc.
   4 ;; Author: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
   5 ;; Keywords: mouse
   6 ;; Package: emacs
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;; Usage:
  24 ;;
  25 ;; To interactively toggle the mode:
  26 ;;
  27 ;;   M-x pixel-scroll-mode RET
  28 ;;
  29 ;; To make the mode permanent, put these in your init file:
  30 ;;
  31 ;;   (require 'pixel-scroll)
  32 ;;   (pixel-scroll-mode 1)
  33
  34 ;;; Commentary:
  35
  36 ;; This package offers a global minor mode which makes mouse-wheel
  37 ;; scroll a line smoothly.
  38 ;;
  39 ;; Scrolling a line up by `set-window-vscroll' and that by `scroll-up'
  40 ;; give similar display as shown below.
  41 ;;
  42 ;;  A: (scroll-up 1)
  43 ;;  B: (set-window-vscroll nil (frame-char-height) t)
  44 ;;
  45 ;; Also scrolling a pixel up by `set-window-vscroll' and that by
  46 ;; `scroll-up' give similar display, when vscroll is the last pixel of
  47 ;; the line, as shown below.
  48 ;;
  49 ;;  A: (scroll-up 1)
  50 ;;  B: (set-window-vscroll nil (1- (frame-char-height) t)) (scroll-up 1)
  51 ;;
  52 ;; When point reaches to the top of a window on scroll by
  53 ;; `set-window-vscroll', vscroll is set to zero.  To scroll a line
  54 ;; smoothly and continuously, this package scrolls a line by following
  55 ;; sequences.
  56 ;;
  57 ;;  (vertical-motion 1)
  58 ;;  (dolist (vs (number-sequence 1 (1- (frame-char-height))))
  59 ;;    (set-window-vscroll nil vs t) (sit-for 0))
  60 ;;  (scroll-up 1)
  61
  62 ;;; Todo:
  63 ;;
  64 ;; Allowing pixel-level scrolling in Emacs requires a thorough review
  65 ;; of the related functionalities, to make sure none of them zeroes
  66 ;; out vscroll where users won't want that.
  67
  68 ;;; Code:
  69
  70 (require 'mwheel)
  71
  72 (defvar pixel-wait 0
  73   "Idle time on each step of pixel scroll specified in second.
  74 More wait will result in slow and gentle scroll.")
  75
  76 (defvar pixel-resolution-fine-flag nil
  77   "Set scrolling resolution to a pixel instead of a line.
  78 After a pixel scroll, typing C-n or C-p scrolls the window to
  79 make it fully visible, and undoes the effect of the pixel-level
  80 scroll.")
  81
  82 ;;;###autoload
  83 (define-minor-mode pixel-scroll-mode
  84   "A minor mode to scroll text pixel-by-pixel.
  85 With a prefix argument ARG, enable Pixel Scroll mode if ARG is positive,
  86 and disable it otherwise.  If called from Lisp, enable Pixel Scroll mode
  87 if ARG is omitted or nil."
  88   :init-value nil
  89   :group 'scrolling
  90   :global t
  91   :version "26.1"
  92
  93   (if pixel-scroll-mode
  94       (setq mwheel-scroll-up-function 'pixel-scroll-up
  95             mwheel-scroll-down-function 'pixel-scroll-down)
  96     (setq mwheel-scroll-up-function 'scroll-up
  97           mwheel-scroll-down-function 'scroll-down)))
  98
  99 (defun pixel-scroll-up (&optional arg)
 100   "Scroll text of selected window up ARG lines.
 101 This is an alternative of `scroll-up'.  Scope moves downward."
 102   (interactive)
 103   (or arg (setq arg 1))
 104   (dotimes (ii arg) ; move scope downward
 105     (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
 106         (scroll-up 1) ; relay on robust method
 107       (when (pixel-point-at-top-p) ; prevent too late
 108         (vertical-motion 1)) ; move point downward
 109       (pixel-scroll-pixel-up (if pixel-resolution-fine-flag
 110                                  1
 111                                (pixel-line-height)))))) ; move scope downward
 112
 113 (defun pixel-scroll-down (&optional arg)
 114   "Scroll text of selected window down ARG lines.
 115 This is and alternative of `scroll-down'.  Scope moves upward."
 116   (interactive)
 117   (or arg (setq arg 1))
 118   (dotimes (ii arg)
 119     (if (or (pixel-bob-at-top-p) ; when beginning-of-the-buffer is seen
 120             (pixel-eob-at-top-p)) ; for file with a long line
 121         (scroll-down 1) ; relay on robust method
 122       (while (pixel-point-at-bottom-p) ; prevent too late (multi tries)
 123         (vertical-motion -1))
 124       (pixel-scroll-pixel-down (if pixel-resolution-fine-flag
 125                                    1
 126                                  (pixel-line-height -1))))))
 127
 128 (defun pixel-bob-at-top-p ()
 129   "Return non-nil if beginning of buffer is at top of window."
 130   (equal (window-start) (point-min)))
 131
 132 (defun pixel-eob-at-top-p ()
 133   "Return non-nil if end of buffer is at top of window."
 134   (<= (count-lines (window-start) (window-end)) 2)) ; count-screen-lines
 135
 136 (defun pixel-posn-y-at-point ()
 137   "Return y coordinates of point in pixels of current window."
 138   (let ((hscroll0 (window-hscroll))
 139         (y (cdr (posn-x-y (posn-at-point)))))
 140     ;; when point is out of scope by hscroll
 141     (unless y
 142       (save-excursion
 143         (set-window-hscroll nil (current-column))
 144         (setq y (cdr (posn-x-y (posn-at-point))))
 145         (set-window-hscroll nil hscroll0)))
 146     y))
 147
 148 (defun pixel-point-at-top-p ()
 149   "Return if point is located at top of a window."
 150   (let* ((y (pixel-posn-y-at-point))
 151          (top-margin y))
 152     (< top-margin (pixel-line-height))))
 153
 154 (defun pixel-point-at-bottom-p ()
 155   "Return if point is located at bottom of a window."
 156   (let* ((y (pixel-posn-y-at-point))
 157          (edges (window-inside-pixel-edges))
 158          (height (- (nth 3 edges) (nth 1 edges))) ; (- bottom top)
 159          (bottom-margin (- height (+ y (line-pixel-height))))) ; bottom margin
 160     (< bottom-margin (pixel-line-height -1)))) ; coming unseen line
 161
 162 (defun pixel-scroll-pixel-up (amt)
 163   "Scroll text of selected windows up AMT pixels.
 164 Scope moves downward."
 165   (while (>= (+ (window-vscroll nil t) amt)
 166              (pixel-line-height))
 167     (setq amt (- amt (pixel--whistlestop-line-up)))) ; major scroll
 168   (pixel--whistlestop-pixel-up amt)) ; minor scroll
 169
 170 (defun pixel-scroll-pixel-down (amt)
 171   "Scroll text of selected windows down AMT pixels.
 172 Scope moves upward."
 173   (while (> amt 0)
 174     (let ((vs (window-vscroll nil t)))
 175       (if (equal vs 0)
 176           (pixel-scroll-down-and-set-window-vscroll
 177            (1- (pixel-line-height -1)))
 178         (set-window-vscroll nil (1- vs) t))
 179       (setq amt (1- amt))
 180       (sit-for pixel-wait))))
 181
 182 (defun pixel--whistlestop-line-up ()
 183   "Scroll text upward a line with each pixel whistlestopped.
 184 When `vscroll' is non-zero, complete scrolling a line.  When
 185 `vscroll' is larger than height of multiple lines, for example
 186 88, this flushes multiple lines.  At the end, `vscroll' will be
 187 zero.  This assumes that the lines are with the same height.
 188 Scope moves downward.  This function returns number of pixels
 189 that was scrolled."
 190   (let* ((src (window-vscroll nil t))  ; EXAMPLE (initial)      @0   @8  @88
 191          (height (pixel-line-height))  ;                        25   25   23
 192          (line (1+ (/ src height)))    ; catch up + one line    Ä1   Ä1   Ä4
 193          (dst (* line height))         ; goal                  @25  @25  @92
 194          (delta (- dst src)))          ; pixels to be scrolled  25   17    4
 195     (pixel--whistlestop-pixel-up (1- delta)) ; until one less  @24  @24  @91
 196     (scroll-up line) (sit-for pixel-wait) ; scroll 1 pixel      @0   @0   @0
 197     delta))
 198
 199 (defun pixel--whistlestop-pixel-up (n)
 200   "Scroll text upward by N pixels with each pixel whistlestopped.
 201 Scope moves downward."
 202   (when (> n 0)
 203     (let ((vs0 (window-vscroll nil t)))
 204       (dolist (vs (number-sequence (1+ vs0) (+ vs0 n)))
 205         (set-window-vscroll nil vs t) (sit-for pixel-wait)))))
 206
 207 (defun pixel-line-height (&optional pos)
 208   "Return height in pixels of text line at POS in the selected window.
 209 When POS is nil or negative, height of the first line or the coming
 210 unseen line above the first line, respectively, is provided."
 211   (or pos (setq pos (window-start)))
 212   (when (< pos 0)
 213     (setq pos (pixel-point-at-unseen-line)))
 214   (save-excursion
 215     (goto-char pos)
 216     (line-pixel-height))) ; frame-char-height
 217
 218 (defun pixel-point-at-unseen-line ()
 219   "Return the character position of line above the selected window.
 220 The returned value is the position of the first character on the
 221 unseen line just above the scope of current window."
 222   (let* ((pos0 (window-start))
 223          (vscroll0 (window-vscroll nil t))
 224          (pos
 225           (save-excursion
 226             (goto-char pos0)
 227             (if (bobp)
 228                 (point-min)
 229               ;; When there's an overlay string at window-start,
 230               ;; (beginning-of-visual-line 0) stays put.
 231               (let ((ppos (point))
 232                     (tem (beginning-of-visual-line 0)))
 233                 (if (eq tem ppos)
 234                     (vertical-motion -1))
 235                 (point))))))
 236     ;; restore initial position
 237     (set-window-start nil pos0 t)
 238     (set-window-vscroll nil vscroll0 t)
 239     pos))
 240
 241 (defun pixel-scroll-down-and-set-window-vscroll (vscroll)
 242   "Scroll down a line and set VSCROLL in pixels.
 243 It is important to call `set-window-start' to force the display
 244 engine use that particular position as the window-start point.
 245 Otherwise, redisplay will reset the window's vscroll."
 246   (set-window-start nil (pixel-point-at-unseen-line) t)
 247   (set-window-vscroll nil vscroll t))
 248
 249 (provide 'pixel-scroll)
 250 ;;; pixel-scroll.el ends here