monnier pushed a commit to branch master
in repository elpa.
commit ee08c259c35c180f12b950d815864acf55056eb7
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Date: Wed Oct 15 14:51:06 2014 -0400
* scroll-restore: New package.
---
packages/scroll-restore/scroll-restore.el | 494 +++++++++++++++++++++++++++++
1 files changed, 494 insertions(+), 0 deletions(-)
diff --git a/packages/scroll-restore/scroll-restore.el
b/packages/scroll-restore/scroll-restore.el
new file mode 100644
index 0000000..52f471c
--- /dev/null
+++ b/packages/scroll-restore/scroll-restore.el
@@ -0,0 +1,494 @@
+;;; scroll-restore.el --- restore original position after scrolling -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2007,2014 Free Software Foundation, Inc.
+
+;; Time-stamp: "2007-12-05 10:44:11 martin"
+;; Author: Martin Rudalics <rudal...@gmx.at>
+;; Keywords: scrolling
+;; Version: 1.0
+
+;; scroll-restore.el 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, or (at your option)
+;; any later version.
+
+;; scroll-restore.el 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Scroll Restore mode is a minor mode to restore the position of
+;; `point' in a sequence of scrolling commands whenever that position
+;; has gone off-screen and becomes visible again. The user option
+;; `scroll-restore-commands' specifies the set of commands that may
+;; constitute such a sequence.
+
+;; The following additional options are provided:
+
+;; - Recenter the window when restoring the original position, see
+;; `scroll-restore-recenter'.
+
+;; - Jump back to the original position before executing a command not
+;; in `scroll-restore-commands', see `scroll-restore-jump-back'. The
+;; resulting behavior is similar to that provided by a number of word
+;; processors.
+
+;; - Change the appearance of the cursor in the selected window to
+;; indicate that the original position is off-screen, see
+;; `scroll-restore-handle-cursor'.
+
+;; - With `transient-mark-mode' non-nil Emacs highlights the region
+;; between `point' and `mark' when the mark is active. If you scroll
+;; `point' off-screen, Emacs relocates `point' _and_ the region.
+;; Customizing `scroll-restore-handle-region' permits to highlight the
+;; original region as long as the original position of `point' is
+;; off-screen, and restore the original region whenever the original
+;; position of `point' becomes visible again.
+
+
+;; Caveats:
+
+;; - Scroll Restore mode does not handle `switch-frame' and
+;; `vertical-scroll-bar' events executed within the loops in
+;; `mouse-show-mark' and `scroll-bar-drag' (these don't call
+;; `post-command-hook' as needed by Scroll Restore mode).
+
+;; - Scroll Restore mode may disregard your customizations of
+;; `scroll-margin'. Handling `scroll-margin' on the Elisp level is
+;; tedious and might not work correctly.
+
+;; - Scroll Restore mode should handle `make-cursor-line-fully-visible'
+;; but there might be problems.
+
+;; - Scroll Restore mode can handle region and cursor only in the
+;; selected window. This makes a difference when you have set
+;; `highlight-nonselected-windows' to a non-nil value.
+
+;; - Scroll Restore mode has not been tested with emulation modes like
+;; `cua-mode' or `pc-selection-mode'. In particular, the former's
+;; handling of `cursor-type' and `cursor-color' might be affected by
+;; Scroll Restore mode."
+
+;; - Scroll Restore mode might interact badly with `follow-mode'. For
+;; example, the latter may deliberately select a window A when the
+;; original position of a window B appears in it. This won't restore
+;; the appearance of the cursor when Scroll Restore mode handles it.
+
+
+;;; Code:
+
+(defgroup scroll-restore nil
+ "Restore original position after scrolling."
+ :version "23.1"
+ :group 'windows)
+
+(defcustom scroll-restore-commands
+ '(handle-select-window handle-switch-frame
+ scroll-up scroll-down
+ scroll-bar-toolkit-scroll mwheel-scroll
+ scroll-other-window scroll-other-window-down
+ scroll-bar-scroll-up scroll-bar-scroll-down scroll-bar-drag)
+ "Commands handled by Scroll Restore mode.
+Scroll Restore mode will try to restore the original position of
+`point' after executing a sequence of any of these commands."
+ :type '(repeat symbol)
+ :set #'(lambda (symbol value)
+ (when (boundp 'scroll-restore-commands)
+ (dolist (cmd scroll-restore-commands)
+ (put cmd 'scroll-restore nil)))
+ (set-default symbol value)
+ (dolist (cmd scroll-restore-commands)
+ (put cmd 'scroll-restore t)))
+ :group 'scroll-restore)
+
+;; Recenter.
+(defcustom scroll-restore-recenter nil
+ "Non-nil means scrolling back recenters the original position.
+Setting this to a non-nil value can be useful to detect the original
+position more easily and coherently when scrolling back."
+ :type 'boolean
+ :group 'scroll-restore)
+
+;; Jump back.
+(defcustom scroll-restore-jump-back nil
+ "Non-nil means jump back to original position after scrolling.
+When this option is non-nil, Scroll Restore mode resets `point'
+to the original position when scrolling has moved that position
+off-screen and a command not in `scroll-restore-commands' shall
+be executed. The resulting behavior is similar to that of some
+word processors. You probably want to remove commands like
+`scroll-up' and `scroll-down' from `scroll-restore-commands' when
+activating this option.
+
+Alternatively you may consider binding the command
+`scroll-restore-jump-back' to a key of your choice."
+ :type 'boolean
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
+ (scroll-restore-restart)))
+ :group 'scroll-restore)
+
+;;; Cursor handling.
+(defvar scroll-restore-buffer nil
+ "Buffer for `scroll-restore-cursor-type'.")
+
+;; Note: nil is a valid cursor-type.
+(defvar scroll-restore-buffer-cursor-type 'invalid
+ "Original cursor-type of `scroll-restore-buffer'.")
+
+(defvar scroll-restore-frame nil
+ "Frame for `scroll-restore-cursor-color'.")
+
+(defvar scroll-restore-frame-cursor-color nil
+ "Original cursor-color of `scroll-restore-frame'.")
+
+(defcustom scroll-restore-handle-cursor nil
+ "Non-nil means Scroll Restore mode may change appearance of cursor.
+Scroll Restore mode can change the appearance of the cursor in
+the selected window while the original position is off-screen.
+Customize `scroll-restore-cursor-type' to change the type of the
+cursor and `scroll-restore-cursor-color' to change its color."
+ :type '(choice
+ (const :tag "Off" nil)
+ (const :tag "Cursor type" type)
+ (const :tag "Cursor color" color)
+ (const :tag "Type and color" t))
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
+ (scroll-restore-restart)))
+ :group 'scroll-restore)
+
+(defcustom scroll-restore-cursor-type 'box
+ "Type of cursor when original position is off-screen.
+Applied if and only if `scroll-restore-handle-cursor' is either
+'type or t.
+
+Be careful when another application uses that type. Otherwise,
+you might get unexpected results when Scroll Restore mode resets
+the cursor type to its \"original\" value after a sequence of
+scrolling commands and the application has changed the cursor
+type in between.
+
+To guard against unexpected results, Scroll Restore mode does not
+reset the type of the cursor whenever its value does not equal
+the value of scroll-restore-cursor-type."
+ :type '(choice
+ (const :tag "No cursor" nil)
+ (const :tag "Filled box" box)
+ (const :tag "Hollow box" hollow)
+ (const :tag "Vertical bar" bar)
+ (const :tag "Horizontal bar" hbar))
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
+ (scroll-restore-restart)))
+ :group 'scroll-restore)
+
+(defcustom scroll-restore-cursor-color "DarkCyan"
+ "Background color of cursor when original position is off-screen.
+Applied if and only if `scroll-restore-handle-cursor' is either
+'color or t.
+
+Observe that when Emacs changes the color of the cursor, the
+change applies to all windows on the associated frame.
+
+Be careful when another application is allowed to change the
+cursor-color. Otherwise, you might get unexpected results when
+Scroll Restore mode resets the cursor color to its \"original\"
+value and the application has changed the cursor color in
+between.
+
+To guard against unexpected results Scroll Restore mode does not
+reset the color of the cursor whenever its value does not equal
+the value of scroll-restore-cursor-color."
+ :type 'color
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
+ (scroll-restore-restart)))
+ :group 'scroll-restore)
+
+;;; Region handling.
+(defvar scroll-restore-region-overlay
+ (let ((overlay (make-overlay (point-min) (point-min))))
+ (overlay-put overlay 'face 'scroll-restore-region)
+ (delete-overlay overlay)
+ overlay)
+ "Overlay used for highlighting the region.")
+
+(defcustom scroll-restore-handle-region nil
+ "Non-nil means Scroll Restore mode handles the region.
+This affects the behavior of Emacs in `transient-mark-mode' only.
+In particular, Emacs will suppress highlighting the region as
+long as the original position of `point' is off-screen. Rather,
+Emacs will highlight the original region \(the region before
+scrolling started\) in `scroll-restore-region' face. Scrolling
+back to the original position will restore the region to its
+original state.
+
+Note that Scroll Restore mode does not deactivate the mark during
+scrolling. Hence any operation on the region will not use the
+original but the _actual_ value of `point'.
+
+If you mark the region via `mouse-drag-region', setting this
+option has no effect since Scroll Restore mode cannot track mouse
+drags."
+ :type 'boolean
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
+ (scroll-restore-restart)))
+ :group 'scroll-restore)
+
+(defface scroll-restore-region
+ '((t :inherit region))
+ "Face for Scroll Restore region when `scroll-restore-handle-region' is
+non-nil."
+ :group 'scroll-restore)
+
+;; Note: We can't use `point-before-scroll' for our purposes because
+;; that variable is buffer-local. We need a variable that recorded
+;; `window-point' before a sequence of scroll operations. Also
+;; `point-before-scroll' is not handled by mwheel.el and some other
+;; commands that do implicit scrolling. hence, the original position is
+;; handled, among others, by the following alist.
+(defvar scroll-restore-alist nil
+ "List of <window, buffer, point> quadruples.
+`window' is the window affected, `buffer' its buffer. `pos' is
+the original position of `point' in that window. `off' non-nil
+means `pos' was off-screen \(didn't appear in `window'\).")
+
+(defun scroll-restore-pre-command ()
+ "Scroll Restore's pre-command function."
+ (let ((overlay-buffer (overlay-buffer scroll-restore-region-overlay)))
+ ;; Handle region overlay.
+ (when overlay-buffer
+ ;; Remove `transient-mark-mode' binding in any case.
+ (with-current-buffer overlay-buffer
+ (kill-local-variable 'transient-mark-mode))
+ (delete-overlay scroll-restore-region-overlay)))
+ ;; Handle cursor-type.
+ (when (and scroll-restore-buffer
+ (not (eq scroll-restore-buffer-cursor-type 'invalid))
+ (with-current-buffer scroll-restore-buffer
+ (eq cursor-type scroll-restore-cursor-type)))
+ (with-current-buffer scroll-restore-buffer
+ (setq cursor-type scroll-restore-buffer-cursor-type)
+ (setq scroll-restore-buffer-cursor-type 'invalid)))
+ ;; Handle cursor-color.
+ (when (and scroll-restore-frame scroll-restore-frame-cursor-color
+ (eq (frame-parameter scroll-restore-frame 'cursor-color)
+ scroll-restore-cursor-color))
+ (let ((frame (selected-frame)))
+ (select-frame scroll-restore-frame)
+ (set-cursor-color scroll-restore-frame-cursor-color)
+ (setq scroll-restore-frame-cursor-color nil)
+ (select-frame frame)))
+ ;; Handle jumping.
+ (when (and scroll-restore-jump-back
+ (not (get this-command 'scroll-restore)))
+ (let ((entry (assq (selected-window) scroll-restore-alist)))
+ (when entry
+ (let ((window (car entry))
+ ;; (buffer (nth 1 entry))
+ (pos (nth 2 entry)))
+ (set-window-point window pos)
+ ;; We are on-screen now.
+ (setcdr (nthcdr 2 entry) (list nil))))))
+ ;; Paranoia.
+ (unless (or scroll-restore-jump-back scroll-restore-handle-region
+ scroll-restore-handle-cursor)
+ ;; Should be never reached.
+ (remove-hook 'pre-command-hook 'scroll-restore-pre-command)))
+
+(defun scroll-restore-remove (&optional all)
+ "Remove stale entries from `scroll-restore-alist'.
+Optional argument ALL non-nil means remove them all."
+ (dolist (entry scroll-restore-alist)
+ (let ((window (car entry))
+ (buffer (nth 1 entry))
+ (pos (nth 2 entry)))
+ (when (or all (not (window-live-p window))
+ (not (eq (window-buffer window) buffer))
+ (not (markerp pos)) (not (marker-position pos)))
+ (when (markerp pos)
+ (set-marker pos nil))
+ (setq scroll-restore-alist
+ (assq-delete-all window scroll-restore-alist))))))
+
+(defun scroll-restore-add ()
+ "Add new entries to `scroll-restore-alist'."
+ (walk-windows
+ (lambda (window)
+ (unless (assq window scroll-restore-alist)
+ (let ((buffer (window-buffer window)))
+ (setq scroll-restore-alist
+ (cons
+ (list
+ window buffer
+ (with-current-buffer buffer
+ (copy-marker (window-point window)))
+ nil)
+ scroll-restore-alist)))))
+ 'no-mini t))
+
+(defun scroll-restore-update (how window buffer pos)
+ "Update various things in `scroll-restore-post-command'.
+HOW must be either on-off, on-on, off-off, off-on, or t. WINDOW
+and BUFFER are affected window and buffer. POS is the original
+position."
+ (when (eq window (selected-window))
+ (with-current-buffer buffer
+ ;; Handle region.
+ (when scroll-restore-handle-region
+ (if (and transient-mark-mode mark-active
+ (not deactivate-mark)
+ (memq how '(on-off off-off)))
+ (progn
+ (move-overlay scroll-restore-region-overlay
+ (min pos (mark)) (max pos (mark)) buffer)
+ (overlay-put scroll-restore-region-overlay 'window window)
+ ;; Temporarily disable `transient-mark-mode' in this buffer.
+ (set (make-local-variable 'transient-mark-mode) nil))
+ (delete-overlay scroll-restore-region-overlay)))
+ ;; Handle cursor.
+ (when (and scroll-restore-handle-cursor
+ (memq how '(on-off off-off))
+ ;; Change cursor iff there was a visible cursor.
+ cursor-type)
+ (when (memq scroll-restore-handle-cursor '(type t))
+ (setq scroll-restore-buffer buffer)
+ (setq scroll-restore-buffer-cursor-type cursor-type)
+ (setq cursor-type scroll-restore-cursor-type))
+ (when (memq scroll-restore-handle-cursor '(color t))
+ (setq scroll-restore-frame (window-frame window))
+ (setq scroll-restore-frame-cursor-color
+ (frame-parameter scroll-restore-frame 'cursor-color))
+ (let ((frame (selected-frame)))
+ (select-frame scroll-restore-frame)
+ (set-cursor-color scroll-restore-cursor-color)
+ (select-frame frame)))))))
+
+(defun scroll-restore-post-command ()
+ "Scroll Restore mode post-command function."
+ (scroll-restore-remove)
+ (let (recenter)
+ (dolist (entry scroll-restore-alist)
+ (let ((window (car entry))
+ (buffer (nth 1 entry))
+ (pos (nth 2 entry))
+ (off (nth 3 entry)))
+ (if (get this-command 'scroll-restore)
+ ;; A scroll restore command.
+ (if off
+ ;; `pos' was off-screen.
+ (if (pos-visible-in-window-p (marker-position pos) window)
+ ;; `pos' is on-screen now.
+ (progn
+ ;; Move cursor to original position.
+ (set-window-point window pos)
+ ;; Recenter if desired.
+ (when (and scroll-restore-recenter
+ (eq window (selected-window)))
+ (setq recenter (/ (window-height window) 2)))
+ ;; Record on-screen status.
+ (setcdr (nthcdr 2 entry) (list nil))
+ (scroll-restore-update 'off-on window buffer pos))
+ ;; `pos' is still off-screen
+ (scroll-restore-update 'off-off window buffer pos))
+ ;; `pos' was on-screen.
+ (if (pos-visible-in-window-p pos window)
+ ;; `pos' is still on-screen.
+ (progn
+ ;; Occasionally Emacs deliberately changes
+ ;; `window-point' during scrolling even when
+ ;; it's visible. Maybe this is due to
+ ;; `make-cursor-line-fully-visible' maybe due to
+ ;; `scroll-margin' maybe due to something else.
+ ;; We override that behavior here.
+ (unless (= (window-point) pos)
+ (set-window-point window pos))
+ (scroll-restore-update 'on-on window buffer pos))
+ ;; `pos' moved off-screen.
+ ;; Record off-screen state.
+ (setcdr (nthcdr 2 entry) (list t))
+ (scroll-restore-update 'on-off window buffer pos)))
+ ;; Not a scroll-restore command.
+ (let ((window-point (window-point window)))
+ (when (and (eq window (selected-window))
+ (or (/= window-point pos) off))
+ ;; Record position and on-screen status.
+ (setcdr
+ (nthcdr 1 entry)
+ (list (move-marker pos (window-point window)) nil)))
+ (scroll-restore-update t window buffer pos)))))
+ (scroll-restore-add)
+ (when recenter (recenter recenter))))
+
+(defun scroll-restore-jump-back ()
+ "Jump back to original position.
+The orginal position is the value of `window-point' in the
+selected window before you started scrolling.
+
+This command does not push the mark."
+ (interactive)
+ (let ((entry (assq (selected-window) scroll-restore-alist)))
+ (if entry
+ (goto-char (nth 2 entry))
+ (error "No jump-back position available"))))
+
+(define-minor-mode scroll-restore-mode
+ "Toggle Scroll Restore mode.
+With arg, turn Scroll Restore mode on if arg is positive, off
+otherwise.
+
+In Scroll Restore mode Emacs attempts to restore the original
+position that existed before executing a sequence of scrolling
+commands whenever that position becomes visible again. The
+option `scroll-restore-commands' permits to specify the set of
+commands that may constitute such a sequence. In addition you
+can
+
+- recenter the window when you scroll back to the original
+ position, see the option `scroll-restore-recenter',
+
+- aggressively jump back to the original position before
+ executing a command not in `scroll-restore-commands', see
+ `scroll-restore-jump-back',
+
+- change the appearance of the cursor in the selected window
+ while the original position is off-screen, see the option
+ `scroll-restore-handle-cursor',
+
+- change the appearance of the region in the selected window
+ while the original position is off-screen, see the option
+ `scroll-restore-handle-region'."
+ :global t
+ :group 'scroll-restore
+ :init-value nil
+ :link '(emacs-commentary-link "scroll-restore.el")
+ (if scroll-restore-mode
+ (progn
+ (scroll-restore-add)
+ (when (or scroll-restore-jump-back scroll-restore-handle-region
+ scroll-restore-handle-cursor)
+ (add-hook 'pre-command-hook 'scroll-restore-pre-command))
+ (add-hook 'post-command-hook 'scroll-restore-post-command t))
+ (scroll-restore-remove 'all)
+ (remove-hook 'pre-command-hook 'scroll-restore-pre-command)
+ (remove-hook 'post-command-hook 'scroll-restore-post-command)))
+
+(defun scroll-restore-restart ()
+ "Restart Scroll Restore mode."
+ (scroll-restore-mode -1)
+ (scroll-restore-mode 1))
+
+(provide 'scroll-restore)
+;;; scroll-restore.el ends here
