diff --git a/lisp/iscroll.el b/lisp/iscroll.el new file mode 100644 index 00000000..6b18f122 --- /dev/null +++ b/lisp/iscroll.el @@ -0,0 +1,312 @@ +;;; iscroll.el --- Smooth scrolling over images -*- lexical-binding: t; -*- + +;; Author: Yuan Fu +;; Maintainer: Yuan Fu +;; 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 . + +;;; 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 diff --git a/lisp/versions b/lisp/versions index d8f7be08..e02cb95f 100644 --- a/lisp/versions +++ b/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 | | diff --git a/settings/gui-settings.el b/settings/gui-settings.el index c728b22c..99a47864 100644 --- a/settings/gui-settings.el +++ b/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-visual-line-mode-hook () - "no `horizontal-scroll-bar' if `visual-line-mode'" - (if visual-line-mode - (set-window-scroll-bars (frame-selected-window) nil t nil nil) - (set-window-scroll-bars (frame-selected-window) nil t nil 'bottom) - )) - (add-hook 'window-state-change-hook - (lambda () (my-window-state-change (window-buffer)))) - (defun my-window-state-change (frame-or-window) - (let (window - (vertical-type nil) - (horizontal-type nil) - buffer - buffer-name) - (when (framep frame-or-window) - (setq window (frame-selected-window frame-or-window))) - (setq buffer (window-buffer window)) - (setq buffer-name (buffer-name buffer)) - ;; turn scrolling on - (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))) - ) + (defun my-window-scroll-function (window display-start) + "This function +- is listed in `window-scroll-functions' which is called by + `set-window-buffer' before running `window-configuration-change-hook' + and therefore will be run on every vertical scroll event +- will activate vertical scoll bar if not whole buffer height is + visible + +WINDOW: `window' object, its string will look like # and +DISPLAY-START: `integer', e.g. 3820" + ;; (message "%s" window) + (let ((vertical-type nil) + (horizontal-type nil)) + (unless (string-equal (format-mode-line "%p") "All") + (setq vertical-type 'right)) + ;; `scroll-bar-mode' not used bc/ it's global, therefore: + (set-window-scroll-bars + window nil vertical-type nil horizontal-type nil))) + (add-to-list 'window-scroll-functions #'my-window-scroll-function) + ) ;; end of use-package emacs (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 "Ⓥf") :commands virtual-auto-fill-mode