Re: scroll-down with pixel transition

[Tak Kunihiro]

>> I think before pixel-level vertical scrolling up or down,
>> scrolling single line up or down `with pixel transition' should be
>> implemented.  It ends up (window-vscroll nil t) to be zero.
>> This may be good enough to give modern feel.
>> 
>> I assign the snippet to mwheel-scroll-up-function and it works
>> OK so far.
> 
> Sorry, I don't understand your proposal.  Can you show some code?

Yes.  I attach a package in a middle.  With this Emacs scrolls a line
with pixel transition but ONLY upward.

;;; pixel-scroll.el --- Scroll with pixel-to-pixel transition

;; Copyright (C) 2017 Tak Kunihiro
;; Author: Tak Kunihiro <address@hidden>
;; Maintainer: Tak Kunihiro <address@hidden>
;; URL: http://dream.misasa.okayama-u.ac.jp
;; Package-Requires: ((emacs "24.5"))
;; Version: 1.0.0
;; Package-Version: 20170413.1707
;; Keywords: convenience, usability

;;; This file is NOT part of GNU Emacs

;;; License

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.

;;; Commentary:

;; To interactively toggle the mode on / off:
;;
;;   M-x pixel-scroll-mode
;;
;; To make the mode permanent, put this in your init file:
;;
;;   (require 'pixel-scroll)
;;   (pixel-scroll-mode 1)
;;
;; If you want to scroll by pixel-level also include:
;;   (setq pixel-resolusion-fine-p t)
;;
;; This package offers a global minor mode which makes Emacs scroll
;; vertically with feel of modern applications.  This minor mode
;; offers pixel-by-pixel scroll upward by mouse wheel using
;; `set-window-vscroll', `window-vscroll', and `scroll-up'.  The minor
;; mode overwrites parameters defined in `mwheel.el' to refer
;; `pixel-scroll-up' and `pixel-scroll-down' instead of `scroll-up'
;; and `scroll-down'.

;;; Principle of vertical scroll:

;; Scrolling text upward a line by pixels using `set-window-vscroll'
;; and by a line using `scroll-up' gives similar visual feedback when
;; vscroll location is @0.  Note vscroll location is vertical shift
;; obtained by `window-vscroll'.  Line height by pixel is obtained by
;; `frame-char-height' (to be exact, this is true for buffer with
;; mono-sized font).  Following two lines scroll text in similar
;; fashion, visually.
;;
;;   (scroll-up 1)
;;   (set-window-vscroll nil (frame-char-height) t)
;;
;; Scrolling text upward by a pixel and a line yields similar result
;; when vscroll location is at the last pixel.  Following two lines
;; scroll text in similar fashion, visually.
;;
;;   (scroll-up 1)
;;   (set-window-vscroll nil (1- (frame-char-height) t)) (scroll-up 1)
;;
;; When vscroll gets larger and as soon as point is beyond beginning
;; of a window, vscroll is set to zero.  To user, scope is changed
;; suddenly without point moved.  This package tries to scroll text
;; upward by a line with pixel-by-pixel transition by following
;; sequences.
;;
;;   (progn
;;     (vertical-motion 1)
;;     (dolist (vs (number-sequence 1 (1- (frame-char-height))))
;;       (set-window-vscroll nil vs t) (sit-for 0.001))
;;     (scroll-up 1))

;;; Change Log:

;; 20170319.1153
;;  - Replace `frame-char-height' by `pixel-line-height'.

;;; TODO:
;; - Scroll pixel-by-pixel to upward direction.

;;; Code:

(require 'mwheel)

(defgroup pixel-scroll nil
  "Scroll pixel-by-pixel in Emacs."
  :group 'mouse
  :prefix "pixel-")

(defcustom pixel-wait 0
  "Idle time on pixel scroll specified in second."
  :group 'pixel-scroll
  :type 'float)

(defcustom pixel-amount '(1 ((shift) . 5) ((control)))
  "Amount to scroll by when spinning the mouse wheel."
  :group 'pixel-scroll)

(defcustom pixel-resolusion-fine-p nil
  "Enhance scrolling resolution to pixel-to-pixel instead of
line-to-line."
  :group 'pixel-scroll
  :type 'boolean)

(define-minor-mode pixel-scroll-mode
  "A minor mode to scroll text pixel-by-pixel.  With a prefix argument ARG,
enable Pixel Scroll mode if ARG is positive, and disable it
otherwise.  If called from Lisp, enable Pixel Scroll mode if ARG
is omitted or nil."
  :init-value nil
  :group 'pixel-scroll
  :global t

  (if pixel-scroll-mode
      (progn (setq mwheel-scroll-up-function 'pixel-scroll-up)
             ;; (setq mwheel-scroll-down-function 'pixel-scroll-down)
             (setq mouse-wheel-scroll-amount pixel-amount)
             (setq mouse-wheel-progressive-speed pixel-resolusion-fine-p))
    (setq mwheel-scroll-up-function 'scroll-up)
    ;; (setq mwheel-scroll-down-function 'scroll-down)
    (dolist (var '(mouse-wheel-scroll-amount
                   mouse-wheel-progressive-speed))
      (custom-reevaluate-setting var))))

(defun pixel-scroll-up (&optional arg)
  "Scroll text of selected window up ARG lines.  This is
alternative of `scroll-up'.  Scope moves downward."
  (interactive)
  (or arg (setq arg 1))
  (dotimes (ii arg) ; move scope downward
    ;; (equal (window-end) (point-max)) ; when end-of-buffer is seen, use 
`scroll-up' to be conservative
    (if (<= (count-lines (window-start) (window-end)) 2)
        (scroll-up 1) ; when end of scroll is close, relay on more robust guy
      (when (or (equal (point-at-bol) (window-start)) ; prevent too late
                (and scroll-preserve-screen-position
                     (not (equal (point-at-bol) (window-end))))) ; prevent too 
fast
        (vertical-motion 1)) ; move point downward
      (pixel-scroll-pixel-up (if pixel-resolusion-fine-p
                                 1
                               (pixel-line-height)))))) ; move scope downward

(defun pixel-scroll-pixel-up (amt)
  "Scroll text of selected windows up AMT pixels.  Scope moves
downward."
  (while (>= (+ (window-vscroll nil t) amt)
            (pixel-line-height))
    (setq amt (- amt (pixel--flush-line-up)))) ; major scroll
  (pixel--sweep-pixel-up amt)) ; minor scroll

(defun pixel--flush-line-up ()
  "Flush text upward a line with pixel transition.  When `vscroll' is non-zero,
complete scrolling a line.  When `vscroll' is larger than height
of multiple lines, this flushes the lines.  At the end, `vscroll'
will be set to zero.  This assumes that lines to be caught up are
with the same height.  Scope moves downward.  This function
returns number of pixels that were scroled."
  (let* ((src (window-vscroll nil t))  ; EXAMPLE (initial)      @0   @8  @88
         (height (pixel-line-height))  ;                        25   25   23
         (line (1+ (/ src height)))    ; catch up + one line    Δ1   Δ1   Δ4
         (dst (* line height))         ; goal                  @25  @25  @92
         (delta (- dst src)))          ; pixels to be scrolled  25   17    4
    (pixel--sweep-pixel-up (1- delta)) ; sweep until one less  @24  @24  @91
    (scroll-up line) (sit-for pixel-wait) ; scroll 1 pixel      @0   @0   @0
    delta))

(defun pixel--sweep-pixel-up (n)
  "Sweep text upward to N pixels.  Scope moves downward."
  (when (> n 0)
    (let ((vs0 (window-vscroll nil t)))
      (dolist (vs (number-sequence (1+ vs0) (+ vs0 n)))
        (set-window-vscroll nil vs t) (sit-for pixel-wait)))))

(defun pixel-line-height (&optional pos)
  "Measure line height of POS in pixel.  When height of all lines
are equal, you don't need this function but `frame-char-height'.
See Info node `(elisp) Line Height'."
  (or pos (setq pos (window-start)))
  (save-excursion
    (goto-char pos)
    (line-pixel-height)))

(provide 'pixel-scroll)
;;; pixel-scroll.el ends here