diff options
Diffstat (limited to 'lisp/smooth-scrolling.el')
| -rw-r--r-- | lisp/smooth-scrolling.el | 327 |
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 |