add iscroll and change vertical scroll bar configuration

lisp/iscroll.el

@@ -0,0 +1,312 @@
+;;; iscroll.el --- Smooth scrolling over images      -*- lexical-binding: t; -*-
+
+;; Author: Yuan Fu <casouri@gmail.com>
+;; Maintainer: Yuan Fu <casouri@gmail.com>
+;; URL: https://github.com/casouri/iscroll
+;; Package-Version: 20210128.1938
+;; Package-Commit: d6e11066169d232fe23c2867d44c012722ddfc5a
+;; Version: 1.0.0
+;; Keywords: convenience, image
+;; Package-Requires: ((emacs "26.0"))
+
+;; This file is not part of GNU Emacs.
+
+;; 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 of the License, 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.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Gone are the days when images jumps in and out of the window when
+;; scrolling! This package makes scrolling over images as if the image
+;; is made of many lines, instead of a single line. (Indeed, sliced
+;; image with default scrolling has the similar behavior as what this
+;; package provides.)
+;;
+;; To use this package:
+;;
+;;     M-x iscroll-mode RET
+;;
+;; This mode remaps mouse scrolling functions and `next/previous-line'.
+;; If you use other commands, you need to adapt them accordingly. See
+;; `iscroll-mode-map' and `iscroll-mode' for some inspiration.
+;;
+;; You probably don't want to enable this in programming modes because
+;; it is slower than normal scrolling commands.
+;;
+;; If a line is taller than double the default line height, smooth
+;; scrolling is triggered and Emacs will reveal one line’s height each
+;; time.
+;;
+;; Commands provided:
+;;
+;; - iscroll-up
+;; - iscroll-down
+;; - iscroll-next-line
+;; - iscroll-previous-line
+;;
+
+;;; Code:
+;;
+
+(require 'cl-lib)
+
+(defvar iscroll-preserve-screen-position
+  scroll-preserve-screen-position
+  "Whether to preserve screen position when scrolling.
+\(I want to control this behavior for iscroll separately.)")
+
+(defun iscroll-up (&optional arg)
+  "Scroll up ARG lines.
+Normally just calls `scroll-up'. But if the top of the window is
+an image, scroll inside the image. Return the number of logical
+lines scrolled."
+  (interactive "p")
+  (let ((arg (or arg 1))
+        (display-lines-scrolled 0)
+        (original-point (point))
+        (scroll-amount nil)
+        (need-to-recalculate-img-height t)
+        (preserve-screen-pos iscroll-preserve-screen-position)
+        img-height
+        hit-end-of-buffer)
+    ;; 1) We first do a dry-run: not actually scrolling, just moving
+    ;; point and modifying SCROLL-AMOUNT.
+    (goto-char (window-start))
+    (while (> arg 0)
+      ;; Initialize SCROLL-AMOUNT when we arrived at a new line or
+      ;; first entered the command.
+      (when (null scroll-amount)
+        (setq scroll-amount (window-vscroll nil t)))
+      ;; `line-pixel-height' is expensive so we try to call it as less
+      ;; as possible.
+      (when need-to-recalculate-img-height
+        (setq img-height (line-pixel-height)
+              need-to-recalculate-img-height nil))
+      ;; Scroll.
+      (if (and (>= img-height (* 2 (default-line-height)))
+               (< scroll-amount img-height))
+          ;; If we are in the middle of scrolling an image, scroll
+          ;; that image.
+          (setq scroll-amount
+                (min (+ scroll-amount (default-line-height))
+                     img-height))
+        ;; If we are not on an image or the image is scrolled over,
+        ;; scroll display line.
+        (cl-incf display-lines-scrolled)
+        (setq need-to-recalculate-img-height t)
+        ;; We hit the end of buffer, stop.
+        (when (not (eq (vertical-motion 1) 1))
+          (setq hit-end-of-buffer t)
+          (setq arg 0))
+        (setq scroll-amount nil))
+      (cl-decf arg))
+    ;; 2) Finally, we’ve finished the dry-run, apply the result.
+    ;;
+    ;; The third argument `t' tells redisplay that (point) doesn't
+    ;; have to be the window start and completely visible. That
+    ;; allows our vscroll value to survive.
+    (set-window-start nil (point) t)
+    (if scroll-amount
+        (set-window-vscroll nil scroll-amount t)
+      (set-window-vscroll nil 0 t))
+    ;; 3) Misc stuff.
+    ;;
+    ;; If the original point is after window-start, it is in the
+    ;; visible portion of the window, and is safe to go back to.
+    (if (> original-point (window-start))
+        (goto-char original-point)
+      ;; If not, we just stay at current position, i.e. window-start.
+      (setq preserve-screen-pos nil))
+    ;; (Maybe) move point to preserve screen position.
+    (when preserve-screen-pos
+      (vertical-motion display-lines-scrolled))
+    ;; Show “error message”.
+    (when hit-end-of-buffer
+      (message "%s" (error-message-string '(end-of-buffer))))
+    display-lines-scrolled))
+
+(defun iscroll-down (&optional arg)
+  "Scroll down ARG lines.
+Normally just calls `scroll-down'. But if the top of the window is
+an image, scroll inside the image. Return the number of logical
+lines scrolled. If PRESERVE-SCREEN-POS non-nil, try to preserve
+screen position."
+  (interactive "p")
+  (let ((arg (or arg 1))
+        (display-lines-scrolled 0)
+        (original-point (point))
+        ;; Nil means this needs to re-measured.
+        (scroll-amount nil)
+        (preserve-screen-pos iscroll-preserve-screen-position)
+        hit-beginning-of-buffer)
+    ;; 1) Dry-run.
+    (goto-char (window-start))
+    (while (> arg 0)
+      (when (null scroll-amount)
+        (setq scroll-amount (window-vscroll nil t)))
+      (let ((img-height (line-pixel-height)))
+        (if (and (>= img-height (* 2 (default-line-height)))
+                 (> scroll-amount 0))
+            ;; Scroll image.
+            (setq scroll-amount
+                  (- scroll-amount (default-line-height)))
+          ;; Scroll display line.
+          (when (not (eq (vertical-motion -1) -1))
+            ;; If we hit the beginning of buffer, stop.
+            (setq hit-beginning-of-buffer t
+                  arg 0))
+          (cl-incf display-lines-scrolled)
+          ;; If the line we stopped at is an image, we don't want to
+          ;; show it completely, instead, modify vscroll and only
+          ;; show a bottom strip of it. If we are at the beginning
+          ;; of the buffer and `vertical-motion' returns 0, we don't
+          ;; want to do this.
+          (let ((img-height (line-pixel-height)))
+            (if (>= img-height (* 2 (default-line-height)))
+                (setq scroll-amount (- img-height (default-line-height)))
+              (setq scroll-amount nil)))))
+      (cl-decf arg))
+    ;; 2) Apply result.
+    (set-window-start nil (point) t)
+    (if scroll-amount
+        (set-window-vscroll nil scroll-amount t)
+      (set-window-vscroll nil 0 t))
+    ;; 3) Misc
+    ;;
+    ;; HACK: There is no fast and reliable way to get the last visible
+    ;; point, hence this hack: move point up until it is visible.
+    (goto-char original-point)
+    ;; Checking point > window-start is important, otherwise we could
+    ;; fall into infinite loop. E.g., when point = window-start and
+    ;; under the point is an image that is not completely visible.
+    (while (and (> (point) (window-start))
+                (not (pos-visible-in-window-p (point))))
+      (setq preserve-screen-pos nil)
+      (vertical-motion -2))
+    (when (and preserve-screen-pos (not hit-beginning-of-buffer))
+      (vertical-motion (- display-lines-scrolled)))
+    (when hit-beginning-of-buffer
+      (message "%s" (error-message-string '(beginning-of-buffer))))
+    display-lines-scrolled))
+
+(defvar iscroll--goal-column nil
+  "Goal column when scrolling.")
+
+(defun iscroll--current-column ()
+  "Return the current column of point in current screen line.
+‘current-column’ counts columns from logical line beginning, this
+function counts from visual line beginning."
+  (save-excursion
+    (let ((col (current-column)))
+      ;; Go to visual line beginning.
+      (vertical-motion 0)
+      (- col (current-column)))))
+
+(defun iscroll-forward-line (&optional arg)
+  "Smooth `forward-line'.
+ARG is the number of lines to move."
+  (interactive "p")
+  (let* ((arg (or arg 1))
+         (abs-arg (abs arg))
+         (step (if (> arg 0) 1 -1))
+         (scroll-fn (if (> arg 0)
+                        #'iscroll-up
+                      #'iscroll-down))
+         (old-point (point))
+         (first-command-p (not (memq last-command
+                                     '(iscroll-next-line
+                                       iscroll-previous-line))))
+         ;; Calculate the goal column. The goal column is either
+         ;; inherited from previous calls to this command, or
+         ;; calculated by visual column.
+         (goal-column (if (or first-command-p (not iscroll--goal-column))
+                          (setq iscroll--goal-column
+                                (iscroll--current-column))
+                        (or iscroll--goal-column 0)))
+         ;; We don't want to preserve screen position when moving point.
+         (iscroll-preserve-screen-position nil)
+         hit-boundary)
+    ;; Because in most cases we move into visible portions, we move
+    ;; first and check after, this should be faster than check first
+    ;; and move after.
+    (while (> abs-arg 0)
+      ;; Move point. `move-to-column' counts columns from logical line
+      ;; beginnings and `vertical-motion' counts columns from visual
+      ;; beginnings. So `vertical-motion' works with line-wrapping but
+      ;; `move-to-column' does not.
+      (when (not (eq (vertical-motion (cons iscroll--goal-column step))
+                     step))
+        ;; If we hit beginning or end of buffer, stop.
+        (setq hit-boundary t
+              abs-arg 0))
+      (when (not (pos-visible-in-window-p (point)))
+        ;; The new point is not fully visible! Scroll up/down one line
+        ;; to try to accommodate that line.
+        (funcall scroll-fn 1))
+      ;; We scrolled one line but that line is still not fully
+      ;; visible, move the point back so that redisplay doesn’t force
+      ;; the whole line into visible region. Partially visible is ok,
+      ;; completely invisible is not ok.
+      (when (and (not (pos-visible-in-window-p (point)))
+                 ;; If the image is taller than the window and is the
+                 ;; first row of the window, it is ok to leave point
+                 ;; on it.
+                 (<= (line-pixel-height) (window-text-height nil t)))
+        (goto-char old-point)
+        (setq hit-boundary nil))
+      (cl-decf abs-arg))
+    ;; If we hit buffer boundary and didn’t back off, show “error
+    ;; message”.
+    (when hit-boundary
+      (message "%s" (error-message-string
+                     (list (if (> arg 0)
+                               'end-of-buffer
+                             'beginning-of-buffer)))))))
+
+(defun iscroll-next-line (&optional arg _)
+  "Smooth `next-line'.
+ARG is the number of lines to move."
+  (interactive "p")
+  (iscroll-forward-line arg))
+
+(defun iscroll-previous-line (&optional arg _)
+  "Smooth `previous-line'.
+ARG is the number of lines to move."
+  (interactive "p")
+  (iscroll-forward-line (- (or arg 1))))
+
+(defvar iscroll-mode-map (make-sparse-keymap)
+  "Minor mode map for `iscroll-mode'.")
+
+;;;###autoload
+(define-minor-mode iscroll-mode
+  "Smooth scrolling over images."
+  :lighter " IS"
+  :keymap iscroll-mode-map
+  :group 'scrolling
+  (if iscroll-mode
+      (progn
+        (setq-local mwheel-scroll-up-function #'iscroll-up
+                    mwheel-scroll-down-function #'iscroll-down)
+        ;; We don’t remap next/previous-line in the minor mode map
+        ;; because that shallows ivy’s binding.
+        (local-set-key [remap next-line] #'iscroll-next-line)
+        (local-set-key [remap previous-line] #'iscroll-previous-line))
+    (kill-local-variable 'mwheel-scroll-up-function)
+    (kill-local-variable 'mwheel-scroll-down-function)
+    (local-set-key [remap next-line] nil)
+    (local-set-key [remap previous-line] nil)))
+
+(provide 'iscroll)
+
+;;; iscroll.el ends here

lisp/versions

@@ -49,6 +49,7 @@
 | htmlize.el                  | melpa   |            1.56 |    20200816.746 |             1.56 |   20191111.2130 |                                                                                                     |
 | hydra                       | melpa   |          0.15.0 |   20201115.1055 |           0.15.0 |   20200608.1528 | required by org-ref                                                                                 |
 | indent-guide.el             | melpa   |           2.3.1 |    20191106.240 |                  |                 |                                                                                                     |
+| iscroll.el                  | melpa   |           1.0.0 |   20210128.1938 |                  |                 |                                                                                                     |
 | ivy                         | melpa   |          0.13.0 |   20210105.2002 |           0.13.0 |   20200624.1140 |                                                                                                     |
 | ivy-bibtex                  | melpa   |           1.0.1 |    20201014.803 |            1.0.1 |   20200429.1606 |                                                                                                     |
 | js2-mode                    | melpa   |        20201220 |   20201220.1718 |         20200610 |   20200610.1339 |                                                                                                     |

settings/gui-settings.el

@@ -46,49 +46,26 @@
   ;; `scroll-bar-mode' sets for all frames and all windows
   ;; use `set-window-scroll-bars' for windows only
   (scroll-bar-mode 0)  ;; 1st deactivate scrolling
-  (add-hook 'visual-line-mode-hook 'my-visual-line-mode-hook)
+  (defun my-window-scroll-function (window display-start)
-  (defun my-visual-line-mode-hook ()
+    "This function
-    "no `horizontal-scroll-bar' if `visual-line-mode'"
+- is listed in `window-scroll-functions' which is called by
-    (if visual-line-mode
+  `set-window-buffer' before running `window-configuration-change-hook'
-        (set-window-scroll-bars (frame-selected-window) nil t nil nil)
+  and therefore will be run on every vertical scroll event
-      (set-window-scroll-bars (frame-selected-window) nil t nil 'bottom)
+- will activate vertical scoll bar if not whole buffer height is
-      ))
+  visible
-  (add-hook 'window-state-change-hook
+
-            (lambda () (my-window-state-change (window-buffer))))
+WINDOW: `window' object, its string will look like #<window 3 on gui-settings.el> and
-  (defun my-window-state-change (frame-or-window)
+DISPLAY-START: `integer', e.g. 3820"
-    (let (window
+    ;; (message "%s" window)
-          (vertical-type nil)
+    (let ((vertical-type nil)
-          (horizontal-type nil)
+          (horizontal-type nil))
-          buffer
+      (unless (string-equal (format-mode-line "%p") "All")
-          buffer-name)
+        (setq vertical-type 'right))
-      (when (framep frame-or-window)
+      ;; `scroll-bar-mode' not used bc/ it's global, therefore:
-        (setq window (frame-selected-window frame-or-window)))
+      (set-window-scroll-bars
-      (setq buffer (window-buffer window))
+       window nil vertical-type nil horizontal-type nil)))
-      (setq buffer-name (buffer-name buffer))
+  (add-to-list 'window-scroll-functions #'my-window-scroll-function)
-      ;; turn scrolling on
+  )  ;; end of use-package emacs
-      (when visual-line-mode
-        (setq vertical-type 'right)
-        (setq horizontal-type nil))
-      (when truncate-lines
-        (setq vertical-type 'right)
-        (setq horizontal-type 'bottom))
-      ;; turn off
-      (cond
-       ((or (minibufferp buffer)
-            (string-equal major-mode "doc-view-mode")
-            (string-equal buffer-name " *Org tags*"))
-        (setq vertical-type nil)
-        (setq horizontal-type nil))
-       ((string-prefix-p "*mu4e" buffer-name)
-        (setq vertical-type 'right)))
-      ;; (message "%s %s %s %s %s"
-      ;;          buffer-name
-      ;;          visual-line-mode
-      ;;          truncate-lines
-      ;;          vertical-type
-      ;;          horizontal-type)
-      (set-window-scroll-bars window nil vertical-type nil horizontal-type)))
-  )
 
 (use-package tab-bar
   :defer 0.5
@@ -471,6 +448,9 @@ See also `dashboard-insert-section'."
   :commands focus-mode
   :custom-face (focus-unfocused ((t :inherit shadow))))
 
+(use-package iscroll
+  :hook ((special-mode text-mode) . iscroll-mode))
+
 (use-package virtual-auto-fill
   :delight (virtual-auto-fill-mode "Ⓥｆ")
   :commands virtual-auto-fill-mode