daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

add iscroll and change vertical scroll bar configuration

Browse Source
This commit is contained in:
Daniel Weschke
2021-02-13 13:12:55 +01:00
parent 05bee89af1
commit 09e44e084b
3 changed files with 336 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

312
lisp/iscroll.el Normal file
View File

@@ -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

1
lisp/versions
View File

@@ -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 | |

66
settings/gui-settings.el
View File

@@ -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 #<window 3 on gui-settings.el> 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 "Ⓥｆ")
:commands virtual-auto-fill-mode