code.delx.au - gnu-emacs-elpa/blob - packages/scroll-restore/scroll-restore.el

   1 ;;; scroll-restore.el --- restore original position after scrolling  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2007,2014  Free Software Foundation, Inc.
   4
   5 ;; Time-stamp: "2007-12-05 10:44:11 martin"
   6 ;; Author: Martin Rudalics <rudalics@gmx.at>
   7 ;; Keywords: scrolling
   8 ;; Version: 1.0
   9
  10 ;; scroll-restore.el is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; scroll-restore.el is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Scroll Restore mode is a minor mode to restore the position of
  26 ;; `point' in a sequence of scrolling commands whenever that position
  27 ;; has gone off-screen and becomes visible again.  The user option
  28 ;; `scroll-restore-commands' specifies the set of commands that may
  29 ;; constitute such a sequence.
  30
  31 ;; The following additional options are provided:
  32
  33 ;; - Recenter the window when restoring the original position, see
  34 ;;   `scroll-restore-recenter'.
  35
  36 ;; - Jump back to the original position before executing a command not
  37 ;;   in `scroll-restore-commands', see `scroll-restore-jump-back'.  The
  38 ;;   resulting behavior is similar to that provided by a number of word
  39 ;;   processors.
  40
  41 ;; - Change the appearance of the cursor in the selected window to
  42 ;;   indicate that the original position is off-screen, see
  43 ;;   `scroll-restore-handle-cursor'.
  44
  45 ;; - With `transient-mark-mode' non-nil Emacs highlights the region
  46 ;;   between `point' and `mark' when the mark is active.  If you scroll
  47 ;;   `point' off-screen, Emacs relocates `point' _and_ the region.
  48 ;;   Customizing `scroll-restore-handle-region' permits to highlight the
  49 ;;   original region as long as the original position of `point' is
  50 ;;   off-screen, and restore the original region whenever the original
  51 ;;   position of `point' becomes visible again.
  52
  53
  54 ;; Caveats:
  55
  56 ;; - Scroll Restore mode does not handle `switch-frame' and
  57 ;;   `vertical-scroll-bar' events executed within the loops in
  58 ;;   `mouse-show-mark' and `scroll-bar-drag' (these don't call
  59 ;;   `post-command-hook' as needed by Scroll Restore mode).
  60
  61 ;; - Scroll Restore mode may disregard your customizations of
  62 ;;   `scroll-margin'.  Handling `scroll-margin' on the Elisp level is
  63 ;;   tedious and might not work correctly.
  64
  65 ;; - Scroll Restore mode should handle `make-cursor-line-fully-visible'
  66 ;;   but there might be problems.
  67
  68 ;; - Scroll Restore mode can handle region and cursor only in the
  69 ;;   selected window.  This makes a difference when you have set
  70 ;;   `highlight-nonselected-windows' to a non-nil value.
  71
  72 ;; - Scroll Restore mode has not been tested with emulation modes like
  73 ;;   `cua-mode' or `pc-selection-mode'.  In particular, the former's
  74 ;;   handling of `cursor-type' and `cursor-color' might be affected by
  75 ;;   Scroll Restore mode."
  76
  77 ;; - Scroll Restore mode might interact badly with `follow-mode'.  For
  78 ;;   example, the latter may deliberately select a window A when the
  79 ;;   original position of a window B appears in it.  This won't restore
  80 ;;   the appearance of the cursor when Scroll Restore mode handles it.
  81
  82
  83 ;;; Code:
  84
  85 (defgroup scroll-restore nil
  86   "Restore original position after scrolling."
  87   :version "23.1"
  88   :group 'windows)
  89
  90 (defcustom scroll-restore-commands
  91   '(handle-select-window handle-switch-frame
  92     scroll-up scroll-down
  93     scroll-bar-toolkit-scroll mwheel-scroll
  94     scroll-other-window scroll-other-window-down
  95     scroll-bar-scroll-up scroll-bar-scroll-down scroll-bar-drag)
  96   "Commands handled by Scroll Restore mode.
  97 Scroll Restore mode will try to restore the original position of
  98 `point' after executing a sequence of any of these commands."
  99   :type '(repeat symbol)
 100   :set #'(lambda (symbol value)
 101            (when (boundp 'scroll-restore-commands)
 102              (dolist (cmd scroll-restore-commands)
 103                (put cmd 'scroll-restore nil)))
 104            (set-default symbol value)
 105            (dolist (cmd scroll-restore-commands)
 106              (put cmd 'scroll-restore t)))
 107   :group 'scroll-restore)
 108
 109 ;; Recenter.
 110 (defcustom scroll-restore-recenter nil
 111   "Non-nil means scrolling back recenters the original position.
 112 Setting this to a non-nil value can be useful to detect the original
 113 position more easily and coherently when scrolling back."
 114   :type 'boolean
 115   :group 'scroll-restore)
 116
 117 ;; Jump back.
 118 (defcustom scroll-restore-jump-back nil
 119   "Non-nil means jump back to original position after scrolling.
 120 When this option is non-nil, Scroll Restore mode resets `point'
 121 to the original position when scrolling has moved that position
 122 off-screen and a command not in `scroll-restore-commands' shall
 123 be executed.  The resulting behavior is similar to that of some
 124 word processors.  You probably want to remove commands like
 125 `scroll-up' and `scroll-down' from `scroll-restore-commands' when
 126 activating this option.
 127
 128 Alternatively you may consider binding the command
 129 `scroll-restore-jump-back' to a key of your choice."
 130   :type 'boolean
 131   :set #'(lambda (symbol value)
 132            (set-default symbol value)
 133            (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
 134              (scroll-restore-restart)))
 135   :group 'scroll-restore)
 136
 137 ;;; Cursor handling.
 138 (defvar scroll-restore-buffer nil
 139   "Buffer for `scroll-restore-cursor-type'.")
 140
 141 ;; Note: nil is a valid cursor-type.
 142 (defvar scroll-restore-buffer-cursor-type 'invalid
 143   "Original cursor-type of `scroll-restore-buffer'.")
 144
 145 (defvar scroll-restore-frame nil
 146   "Frame for `scroll-restore-cursor-color'.")
 147
 148 (defvar scroll-restore-frame-cursor-color nil
 149   "Original cursor-color of `scroll-restore-frame'.")
 150
 151 (defcustom scroll-restore-handle-cursor nil
 152   "Non-nil means Scroll Restore mode may change appearance of cursor.
 153 Scroll Restore mode can change the appearance of the cursor in
 154 the selected window while the original position is off-screen.
 155 Customize `scroll-restore-cursor-type' to change the type of the
 156 cursor and `scroll-restore-cursor-color' to change its color."
 157   :type '(choice
 158           (const :tag "Off" nil)
 159           (const :tag "Cursor type" type)
 160           (const :tag "Cursor color" color)
 161           (const :tag "Type and color" t))
 162   :set #'(lambda (symbol value)
 163            (set-default symbol value)
 164            (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
 165              (scroll-restore-restart)))
 166   :group 'scroll-restore)
 167
 168 (defcustom scroll-restore-cursor-type 'box
 169   "Type of cursor when original position is off-screen.
 170 Applied if and only if `scroll-restore-handle-cursor' is either
 171 'type or t.
 172
 173 Be careful when another application uses that type.  Otherwise,
 174 you might get unexpected results when Scroll Restore mode resets
 175 the cursor type to its \"original\" value after a sequence of
 176 scrolling commands and the application has changed the cursor
 177 type in between.
 178
 179 To guard against unexpected results, Scroll Restore mode does not
 180 reset the type of the cursor whenever its value does not equal
 181 the value of scroll-restore-cursor-type."
 182   :type '(choice
 183           (const :tag "No cursor" nil)
 184           (const :tag "Filled box" box)
 185           (const :tag "Hollow box" hollow)
 186           (const :tag "Vertical bar" bar)
 187           (const :tag "Horizontal bar" hbar))
 188   :set #'(lambda (symbol value)
 189            (set-default symbol value)
 190            (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
 191              (scroll-restore-restart)))
 192   :group 'scroll-restore)
 193
 194 (defcustom scroll-restore-cursor-color "DarkCyan"
 195   "Background color of cursor when original position is off-screen.
 196 Applied if and only if `scroll-restore-handle-cursor' is either
 197 'color or t.
 198
 199 Observe that when Emacs changes the color of the cursor, the
 200 change applies to all windows on the associated frame.
 201
 202 Be careful when another application is allowed to change the
 203 cursor-color.  Otherwise, you might get unexpected results when
 204 Scroll Restore mode resets the cursor color to its \"original\"
 205 value and the application has changed the cursor color in
 206 between.
 207
 208 To guard against unexpected results Scroll Restore mode does not
 209 reset the color of the cursor whenever its value does not equal
 210 the value of scroll-restore-cursor-color."
 211   :type 'color
 212   :set #'(lambda (symbol value)
 213            (set-default symbol value)
 214            (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
 215              (scroll-restore-restart)))
 216   :group 'scroll-restore)
 217
 218 ;;; Region handling.
 219 (defvar scroll-restore-region-overlay
 220   (let ((overlay (make-overlay (point-min) (point-min))))
 221     (overlay-put overlay 'face 'scroll-restore-region)
 222     (delete-overlay overlay)
 223     overlay)
 224   "Overlay used for highlighting the region.")
 225
 226 (defcustom scroll-restore-handle-region nil
 227   "Non-nil means Scroll Restore mode handles the region.
 228 This affects the behavior of Emacs in `transient-mark-mode' only.
 229 In particular, Emacs will suppress highlighting the region as
 230 long as the original position of `point' is off-screen.  Rather,
 231 Emacs will highlight the original region \(the region before
 232 scrolling started\) in `scroll-restore-region' face.  Scrolling
 233 back to the original position will restore the region to its
 234 original state.
 235
 236 Note that Scroll Restore mode does not deactivate the mark during
 237 scrolling.  Hence any operation on the region will not use the
 238 original but the _actual_ value of `point'.
 239
 240 If you mark the region via `mouse-drag-region', setting this
 241 option has no effect since Scroll Restore mode cannot track mouse
 242 drags."
 243   :type 'boolean
 244   :set #'(lambda (symbol value)
 245            (set-default symbol value)
 246            (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
 247              (scroll-restore-restart)))
 248   :group 'scroll-restore)
 249
 250 (defface scroll-restore-region
 251   '((t :inherit region))
 252   "Face for Scroll Restore region when `scroll-restore-handle-region' is
 253 non-nil."
 254   :group 'scroll-restore)
 255
 256 ;; Note: We can't use `point-before-scroll' for our purposes because
 257 ;; that variable is buffer-local.  We need a variable that recorded
 258 ;; `window-point' before a sequence of scroll operations.  Also
 259 ;; `point-before-scroll' is not handled by mwheel.el and some other
 260 ;; commands that do implicit scrolling.  hence, the original position is
 261 ;; handled, among others, by the following alist.
 262 (defvar scroll-restore-alist nil
 263   "List of <window, buffer, point> quadruples.
 264 `window' is the window affected, `buffer' its buffer.  `pos' is
 265 the original position of `point' in that window.  `off' non-nil
 266 means `pos' was off-screen \(didn't appear in `window'\).")
 267
 268 (defun scroll-restore-pre-command ()
 269   "Scroll Restore's pre-command function."
 270   (let ((overlay-buffer (overlay-buffer scroll-restore-region-overlay)))
 271     ;; Handle region overlay.
 272     (when overlay-buffer
 273       ;; Remove `transient-mark-mode' binding in any case.
 274       (with-current-buffer overlay-buffer
 275         (kill-local-variable 'transient-mark-mode))
 276       (delete-overlay scroll-restore-region-overlay)))
 277   ;; Handle cursor-type.
 278   (when (and scroll-restore-buffer
 279              (not (eq scroll-restore-buffer-cursor-type 'invalid))
 280              (with-current-buffer scroll-restore-buffer
 281                (eq cursor-type scroll-restore-cursor-type)))
 282     (with-current-buffer scroll-restore-buffer
 283       (setq cursor-type scroll-restore-buffer-cursor-type)
 284       (setq scroll-restore-buffer-cursor-type 'invalid)))
 285   ;; Handle cursor-color.
 286   (when (and scroll-restore-frame scroll-restore-frame-cursor-color
 287              (eq (frame-parameter scroll-restore-frame 'cursor-color)
 288                  scroll-restore-cursor-color))
 289     (let ((frame (selected-frame)))
 290       (select-frame scroll-restore-frame)
 291       (set-cursor-color scroll-restore-frame-cursor-color)
 292       (setq scroll-restore-frame-cursor-color nil)
 293       (select-frame frame)))
 294   ;; Handle jumping.
 295   (when (and scroll-restore-jump-back
 296              (not (get this-command 'scroll-restore)))
 297     (let ((entry (assq (selected-window) scroll-restore-alist)))
 298       (when entry
 299         (let ((window (car entry))
 300               ;; (buffer (nth 1 entry))
 301               (pos (nth 2 entry)))
 302           (set-window-point window pos)
 303           ;; We are on-screen now.
 304           (setcdr (nthcdr 2 entry) (list nil))))))
 305   ;; Paranoia.
 306   (unless (or scroll-restore-jump-back scroll-restore-handle-region
 307               scroll-restore-handle-cursor)
 308     ;; Should be never reached.
 309     (remove-hook 'pre-command-hook 'scroll-restore-pre-command)))
 310
 311 (defun scroll-restore-remove (&optional all)
 312   "Remove stale entries from `scroll-restore-alist'.
 313 Optional argument ALL non-nil means remove them all."
 314   (dolist (entry scroll-restore-alist)
 315     (let ((window (car entry))
 316           (buffer (nth 1 entry))
 317           (pos (nth 2 entry)))
 318       (when (or all (not (window-live-p window))
 319                 (not (eq (window-buffer window) buffer))
 320                 (not (markerp pos)) (not (marker-position pos)))
 321         (when (markerp pos)
 322           (set-marker pos nil))
 323         (setq scroll-restore-alist
 324               (assq-delete-all window scroll-restore-alist))))))
 325
 326 (defun scroll-restore-add ()
 327   "Add new entries to `scroll-restore-alist'."
 328   (walk-windows
 329    (lambda (window)
 330      (unless (assq window scroll-restore-alist)
 331        (let ((buffer (window-buffer window)))
 332              (setq scroll-restore-alist
 333                    (cons
 334                     (list
 335                      window buffer
 336                      (with-current-buffer buffer
 337                        (copy-marker (window-point window)))
 338                      nil)
 339                     scroll-restore-alist)))))
 340    'no-mini t))
 341
 342 (defun scroll-restore-update (how window buffer pos)
 343   "Update various things in `scroll-restore-post-command'.
 344 HOW must be either on-off, on-on, off-off, off-on, or t.  WINDOW
 345 and BUFFER are affected window and buffer.  POS is the original
 346 position."
 347   (when (eq window (selected-window))
 348     (with-current-buffer buffer
 349       ;; Handle region.
 350       (when scroll-restore-handle-region
 351         (if (and transient-mark-mode mark-active
 352                  (not deactivate-mark)
 353                  (memq how '(on-off off-off)))
 354             (progn
 355               (move-overlay scroll-restore-region-overlay
 356                             (min pos (mark)) (max pos (mark)) buffer)
 357               (overlay-put scroll-restore-region-overlay 'window window)
 358               ;; Temporarily disable `transient-mark-mode' in this buffer.
 359               (set (make-local-variable 'transient-mark-mode) nil))
 360           (delete-overlay scroll-restore-region-overlay)))
 361       ;; Handle cursor.
 362       (when (and scroll-restore-handle-cursor
 363                  (memq how '(on-off off-off))
 364                  ;; Change cursor iff there was a visible cursor.
 365                  cursor-type)
 366         (when (memq scroll-restore-handle-cursor '(type t))
 367           (setq scroll-restore-buffer buffer)
 368           (setq scroll-restore-buffer-cursor-type cursor-type)
 369           (setq cursor-type scroll-restore-cursor-type))
 370         (when (memq scroll-restore-handle-cursor '(color t))
 371           (setq scroll-restore-frame (window-frame window))
 372           (setq scroll-restore-frame-cursor-color
 373                 (frame-parameter scroll-restore-frame 'cursor-color))
 374           (let ((frame (selected-frame)))
 375             (select-frame scroll-restore-frame)
 376             (set-cursor-color scroll-restore-cursor-color)
 377             (select-frame frame)))))))
 378
 379 (defun scroll-restore-post-command ()
 380   "Scroll Restore mode post-command function."
 381   (scroll-restore-remove)
 382   (let (recenter)
 383     (dolist (entry scroll-restore-alist)
 384       (let ((window (car entry))
 385             (buffer (nth 1 entry))
 386             (pos (nth 2 entry))
 387             (off (nth 3 entry)))
 388         (if (get this-command 'scroll-restore)
 389             ;; A scroll restore command.
 390             (if off
 391                 ;; `pos' was off-screen.
 392                 (if (pos-visible-in-window-p (marker-position pos) window)
 393                     ;; `pos' is on-screen now.
 394                     (progn
 395                       ;; Move cursor to original position.
 396                       (set-window-point window pos)
 397                       ;; Recenter if desired.
 398                       (when (and scroll-restore-recenter
 399                                  (eq window (selected-window)))
 400                         (setq recenter (/ (window-height window) 2)))
 401                       ;; Record on-screen status.
 402                       (setcdr (nthcdr 2 entry) (list nil))
 403                       (scroll-restore-update 'off-on window buffer pos))
 404                   ;; `pos' is still off-screen
 405                   (scroll-restore-update 'off-off window buffer pos))
 406               ;; `pos' was on-screen.
 407               (if (pos-visible-in-window-p pos window)
 408                   ;; `pos' is still on-screen.
 409                   (progn
 410                     ;; Occasionally Emacs deliberately changes
 411                     ;; `window-point' during scrolling even when
 412                     ;; it's visible.  Maybe this is due to
 413                     ;; `make-cursor-line-fully-visible' maybe due to
 414                     ;; `scroll-margin' maybe due to something else.
 415                     ;; We override that behavior here.
 416                     (unless (= (window-point) pos)
 417                       (set-window-point window pos))
 418                     (scroll-restore-update 'on-on window buffer pos))
 419                 ;; `pos' moved off-screen.
 420                 ;; Record off-screen state.
 421                 (setcdr (nthcdr 2 entry) (list t))
 422                 (scroll-restore-update 'on-off window buffer pos)))
 423           ;; Not a scroll-restore command.
 424           (let ((window-point (window-point window)))
 425                   (when (and (eq window (selected-window))
 426                              (or (/= window-point pos) off))
 427                     ;; Record position and on-screen status.
 428                     (setcdr
 429                      (nthcdr 1 entry)
 430                      (list (move-marker pos (window-point window)) nil)))
 431                   (scroll-restore-update t window buffer pos)))))
 432     (scroll-restore-add)
 433     (when recenter (recenter recenter))))
 434
 435 (defun scroll-restore-jump-back ()
 436   "Jump back to original position.
 437 The orginal position is the value of `window-point' in the
 438 selected window before you started scrolling.
 439
 440 This command does not push the mark."
 441   (interactive)
 442   (let ((entry (assq (selected-window) scroll-restore-alist)))
 443     (if entry
 444         (goto-char (nth 2 entry))
 445       (error "No jump-back position available"))))
 446
 447 (define-minor-mode scroll-restore-mode
 448   "Toggle Scroll Restore mode.
 449 With arg, turn Scroll Restore mode on if arg is positive, off
 450 otherwise.
 451
 452 In Scroll Restore mode Emacs attempts to restore the original
 453 position that existed before executing a sequence of scrolling
 454 commands whenever that position becomes visible again.  The
 455 option `scroll-restore-commands' permits to specify the set of
 456 commands that may constitute such a sequence.  In addition you
 457 can
 458
 459 - recenter the window when you scroll back to the original
 460   position, see the option `scroll-restore-recenter',
 461
 462 - aggressively jump back to the original position before
 463   executing a command not in `scroll-restore-commands', see
 464   `scroll-restore-jump-back',
 465
 466 - change the appearance of the cursor in the selected window
 467   while the original position is off-screen, see the option
 468   `scroll-restore-handle-cursor',
 469
 470 - change the appearance of the region in the selected window
 471   while the original position is off-screen, see the option
 472   `scroll-restore-handle-region'."
 473   :global t
 474   :group 'scroll-restore
 475   :init-value nil
 476   :link '(emacs-commentary-link "scroll-restore.el")
 477   (if scroll-restore-mode
 478       (progn
 479         (scroll-restore-add)
 480         (when (or scroll-restore-jump-back scroll-restore-handle-region
 481                   scroll-restore-handle-cursor)
 482           (add-hook 'pre-command-hook 'scroll-restore-pre-command))
 483         (add-hook 'post-command-hook 'scroll-restore-post-command t))
 484     (scroll-restore-remove 'all)
 485     (remove-hook 'pre-command-hook 'scroll-restore-pre-command)
 486     (remove-hook 'post-command-hook 'scroll-restore-post-command)))
 487
 488 (defun scroll-restore-restart ()
 489   "Restart Scroll Restore mode."
 490   (scroll-restore-mode -1)
 491   (scroll-restore-mode 1))
 492
 493 (provide 'scroll-restore)
 494 ;;; scroll-restore.el ends here