summaryrefslogtreecommitdiff
path: root/lisp/smooth-scrolling.el
diff options
context:
space:
mode:
authormattkae <mattkae@protonmail.com>2022-05-11 09:23:58 -0400
committermattkae <mattkae@protonmail.com>2022-05-11 09:23:58 -0400
commit3f4a0d5370ae6c34afe180df96add3b8522f4af1 (patch)
treeae901409e02bde8ee278475f8cf6818f8f680a60 /lisp/smooth-scrolling.el
initial commit
Diffstat (limited to 'lisp/smooth-scrolling.el')
-rw-r--r--lisp/smooth-scrolling.el327
1 files changed, 327 insertions, 0 deletions
diff --git a/lisp/smooth-scrolling.el b/lisp/smooth-scrolling.el
new file mode 100644
index 0000000..98df30e
--- /dev/null
+++ b/lisp/smooth-scrolling.el
@@ -0,0 +1,327 @@
+;;; smooth-scrolling.el --- Make emacs scroll smoothly
+;;
+;; Copyright (c) 2007-2016 Adam Spiers
+;;
+;; Filename: smooth-scrolling.el
+;; Description: Make emacs scroll smoothly
+;; Author: Adam Spiers <emacs-ss@adamspiers.org>
+;; Jeremy Bondeson <jbondeson@gmail.com>
+;; Ryan C. Thompson <rct+github@thompsonclan.org>
+;; Maintainer: Adam Spiers <emacs-ss@adamspiers.org>
+;; Homepage: http://github.com/aspiers/smooth-scrolling/
+;; Version: 2.0.0
+;; Keywords: convenience
+;; GitHub: http://github.com/aspiers/smooth-scrolling/
+
+;; 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 2
+;; 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, 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 smooth-scrolling-mode
+;;
+;; To make the mode permanent, put this in your .emacs:
+;;
+;; (require 'smooth-scrolling)
+;; (smooth-scrolling-mode 1)
+;;
+;; This package offers a global minor mode which make emacs scroll
+;; smoothly. It keeps the point away from the top and bottom of the
+;; current buffer's window in order to keep lines of context around
+;; the point visible as much as possible, whilst minimising the
+;; frequency of sudden scroll jumps which are visually confusing.
+;;
+;; This is a nice alternative to all the native `scroll-*` custom
+;; variables, which unfortunately cannot provide this functionality
+;; perfectly. For example, when using the built-in variables, clicking
+;; with the mouse in the margin will immediately scroll the window to
+;; maintain the margin, so the text that you clicked on will no longer be
+;; under the mouse. This can be disorienting. In contrast, this mode
+;; will not do any scrolling until you actually move up or down a line.
+;;
+;; Also, the built-in margin code does not interact well with small
+;; windows. If the margin is more than half the window height, you get
+;; some weird behavior, because the point is always hitting both the top
+;; and bottom margins. This package auto-adjusts the margin in each
+;; buffer to never exceed half the window height, so the top and bottom
+;; margins never overlap.
+
+;; See the README.md for more details.
+
+;;; Change Log:
+;; 27 Feb 2016 -- v2.0.0
+;; * Converted to global minor mode "smooth-scrolling-mode". This
+;; means that simply loading the file no longer enables smooth
+;; scrolling; you must also enable the mode.
+;; * Internal code restructuring that should improve some edge
+;; cases, but otherwise have no user-visible effects.
+;; 19 Dec 2013 -- v1.0.4
+;; * Disabled scrolling while a keyboard macro is executing in
+;; order to prevent a premature termination of the macro by
+;; the mode throwing an error such as "End of Buffer"
+;; 02 Jun 2013 -- v1.0.3
+;; * Fixed Issue #3 where bounds checking was not being performed
+;; prior to calls to 'count-lines' and 'count-screen-lines'
+;; functions.
+;; 14 Apr 2013 -- v1.0.2
+;; * Adam Spiers GitHub account now houses the canonical
+;; repository.
+;; 06 Dec 2011 -- v1.0.1
+;; * Altered structure to conform to package.el standards.
+;; * Restructured code to group settings changes
+;; * Set "redisplay-dont-pause" to true.
+;; ?? ??? 2007 -- v1.0.0
+;; * Original version from Adam Spiers
+
+;;; Code:
+
+;;;_ + internal variables
+(defvar smooth-scroll-orig-scroll-margin nil)
+
+;;;_ + defcustoms
+
+(defgroup smooth-scrolling nil
+ "Make emacs scroll smoothly"
+ :group 'convenience)
+
+;;;###autoload
+(define-minor-mode smooth-scrolling-mode
+ "Make emacs scroll smoothly"
+ :init-value nil
+ :global t
+ :group 'smooth-scrolling
+ (if smooth-scrolling-mode
+ (setq smooth-scroll-orig-scroll-margin scroll-margin
+ scroll-margin 0)
+ (setq scroll-margin smooth-scroll-orig-scroll-margin
+ smooth-scroll-orig-scroll-margin nil)))
+
+;;;###autoload
+(defcustom smooth-scroll-margin 10
+ "Number of lines of visible margin at the top and bottom of a window.
+If the point is within these margins, then scrolling will occur
+smoothly for `previous-line' at the top of the window, and for
+`next-line' at the bottom.
+
+This is very similar in its goal to `scroll-margin'. However, it
+is implemented by activating `smooth-scroll-down' and
+`smooth-scroll-up' advise via `defadvice' for `previous-line' and
+`next-line' respectively. As a result it avoids problems
+afflicting `scroll-margin', such as a sudden jump and unexpected
+highlighting of a region when the mouse is clicked in the margin.
+
+Scrolling only occurs when the point is closer to the window
+boundary it is heading for (top or bottom) than the middle of the
+window. This is to intelligently handle the case where the
+margins cover the whole buffer (e.g. `smooth-scroll-margin' set
+to 5 and `window-height' returning 10 or less).
+
+See also `smooth-scroll-strict-margins'."
+ :type 'integer
+ :group 'smooth-scrolling)
+
+;;;###autoload
+(defcustom smooth-scroll-strict-margins t
+ "If true, the advice code supporting `smooth-scroll-margin'
+will use `count-screen-lines' to determine the number of
+*visible* lines between the point and the window top/bottom,
+rather than `count-lines' which obtains the number of actual
+newlines. This is because there might be extra newlines hidden
+by a mode such as folding-mode, outline-mode, org-mode etc., or
+fewer due to very long lines being displayed wrapped when
+`truncate-lines' is nil.
+
+However, using `count-screen-lines' can supposedly cause
+performance issues in buffers with extremely long lines. Setting
+`cache-long-line-scans' may be able to address this;
+alternatively you can set this variable to nil so that the advice
+code uses `count-lines', and put up with the fact that sometimes
+the point will be allowed to stray into the margin."
+ :type 'boolean
+ :group 'smooth-scrolling)
+
+;;;_ + helper functions
+(defmacro smooth-scroll-ignore-scroll-errors (&rest body)
+ "Like `progn', but ignores beginning/end of line errors.
+
+If BODY encounters such an error, further evaluation is stopped
+and this form returns nil. Any other error is raised as normal."
+ (declare (indent 0))
+ `(condition-case err
+ (progn ,@body)
+ (end-of-buffer nil)
+ (beginning-of-buffer nil)
+ (error (signal (car err) (cdr err)))))
+
+(defun smooth-scroll-line-beginning-position ()
+ "Return position at beginning of (logical/visual) line.
+
+If `smooth-scroll-strict-margins' is non-nil, this looks to the
+beginning of the visual line. Otherwise it uses the beginning of
+the logical line."
+ (save-excursion
+ ;; Cannot use `line-beginning-position' here because there is no
+ ;; visual-line equivalent.
+ (funcall (if smooth-scroll-strict-margins
+ #'beginning-of-visual-line
+ #'beginning-of-line))
+ (point)))
+
+(defun smooth-scroll-count-lines (start end)
+ "Return number of (logical/visual) lines between START and END.
+
+If `smooth-scroll-strict-margins' is non-nil, this counts visual
+lines. Otherwise it counts logical lines.
+
+If END is less than START, this returns zero, so it is important
+to pass them in order."
+ (if (< end start)
+ 0
+ (funcall (if smooth-scroll-strict-margins
+ #'count-screen-lines
+ #'count-lines)
+ start end)))
+
+(defun smooth-scroll-lines-above-point ()
+ "Return the number of lines in window above point.
+
+This does not include the line that point is on."
+ (smooth-scroll-count-lines (window-start)
+ (smooth-scroll-line-beginning-position)))
+
+(defun smooth-scroll-lines-below-point ()
+ "Return the number of lines in window above point.
+
+This does not include the line that point is on."
+ ;; We don't rely on `window-end' because if we are scrolled near the
+ ;; end of the buffer, it will only give the number of lines
+ ;; remaining in the file, not the number of lines to the bottom of
+ ;; the window.
+ (- (window-height) 2 (smooth-scroll-lines-above-point)))
+
+(defun smooth-scroll-window-allowed-margin ()
+ "Return the maximum allowed margin above or below point.
+
+This only matters for windows whose height is
+`smooth-scroll-margin' * 2 lines or less."
+ ;; We subtract 1 for the modeline, which is counted in
+ ;; `window-height', and one more for the line that point is on. Then
+ ;; we divide by 2, rouding down.
+ (/ (- (window-height) 2) 2))
+
+(defsubst window-is-at-bob-p ()
+ "Returns non-nil if `(window-start)' is 1 (or less)."
+ (<= (window-start) 1))
+
+;;;_ + main function
+(defun do-smooth-scroll ()
+ "Ensure that point is not to close to window edges.
+
+This function scrolls the window until there are at least
+`smooth-scroll-margin' lines between the point and both the top
+and bottom of the window. If this is not possible because the
+window is too small, th window is scrolled such that the point is
+roughly centered within the window."
+ (interactive)
+ (when smooth-scrolling-mode
+ (let* ((desired-margin
+ ;; For short windows, we reduce `smooth-scroll-margin' to
+ ;; half the window height minus 1.
+ (min (smooth-scroll-window-allowed-margin)
+ smooth-scroll-margin))
+ (upper-margin (smooth-scroll-lines-above-point))
+ (lower-margin (smooth-scroll-lines-below-point)))
+ (smooth-scroll-ignore-scroll-errors
+ (cond
+ ((< upper-margin desired-margin)
+ (save-excursion
+ (dotimes (i (- desired-margin upper-margin))
+ (scroll-down 1))))
+ ((< lower-margin desired-margin)
+ (save-excursion
+ (dotimes (i (- desired-margin lower-margin))
+ (scroll-up 1)))))))))
+
+;;;_ + advice setup
+
+;;;###autoload
+(defmacro enable-smooth-scroll-for-function (func)
+ "Define advice on FUNC to do smooth scrolling.
+
+This adds after advice with name `smooth-scroll' to FUNC.
+
+Note that the advice will not have an effect unless
+`smooth-scrolling-mode' is enabled."
+ `(defadvice ,func (after smooth-scroll activate)
+ "Do smooth scrolling after command finishes.
+
+This advice only has an effect when `smooth-scrolling-mode' is
+enabled. See `smooth-scrolling-mode' for details. To remove this
+advice, use `disable-smooth-scroll-for-function'."
+ (do-smooth-scroll)))
+
+(defmacro enable-smooth-scroll-for-function-conditionally (func cond)
+ "Define advice on FUNC to do smooth scrolling conditionally.
+
+This adds after advice with name `smooth-scroll' to FUNC. The
+advice runs smooth scrolling if expression COND evaluates to
+true. COND is included within the advice and therefore has access
+to all of FUNC's arguments.
+
+Note that the advice will not have an effect unless
+`smooth-scrolling-mode' is enabled."
+ (declare (indent 1))
+ `(defadvice ,func (after smooth-scroll activate)
+ ,(format "Do smooth scrolling conditionally after command finishes.
+
+Smooth sccrolling will only be performed if the following
+expression evaluates to true after the function has run:
+
+%s
+This advice only has an effect when `smooth-scrolling-mode' is
+enabled. See `smooth-scrolling-mode' for details. To remove this
+advice, use `disable-smooth-scroll-for-function'."
+ (pp-to-string cond))
+ (when ,cond
+ (do-smooth-scroll))))
+
+(defmacro disable-smooth-scroll-for-function (func)
+ "Delete smooth-scroll advice for FUNC."
+ ;; This doesn't actually need to be a macro, but it is one for
+ ;; consistency with the enabling macro. Errors are ignored in case
+ ;; the advice has already been removed.
+ `(ignore-errors
+ (ad-remove-advice ',func 'after 'smooth-scroll)
+ (ad-activate ',func)))
+
+(progn
+ (enable-smooth-scroll-for-function previous-line)
+ (enable-smooth-scroll-for-function next-line)
+ (enable-smooth-scroll-for-function dired-previous-line)
+ (enable-smooth-scroll-for-function dired-next-line)
+ (enable-smooth-scroll-for-function isearch-repeat)
+ (enable-smooth-scroll-for-function-conditionally scroll-up-command
+ (not (window-is-at-bob-p)))
+ (enable-smooth-scroll-for-function-conditionally scroll-down-command
+ (not (window-is-at-bob-p))))
+
+;;;_ + provide
+(provide 'smooth-scrolling)
+;;; smooth-scrolling.el ends here