5 changed files with 428 additions and 1 deletions
@ -0,0 +1,2 @@
@@ -0,0 +1,2 @@
|
||||
;;; -*- no-byte-compile: t -*- |
||||
(define-package "smooth-scrolling" "20161002.1949" "Make emacs scroll smoothly" 'nil :commit "2462c13640aa4c75ab3ddad443fedc29acf68f84" :keywords '("convenience") :authors '(("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") :url "http://github.com/aspiers/smooth-scrolling/") |
||||
@ -0,0 +1,329 @@
@@ -0,0 +1,329 @@
|
||||
;;; 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 |
||||
;; Package-Version: 20161002.1949 |
||||
;; Package-Commit: 2462c13640aa4c75ab3ddad443fedc29acf68f84 |
||||
;; 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 |
||||
Binary file not shown.
Loading…
Reference in new issue