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 (defun scroll-restore--set (symbol value)
  91   (set-default symbol value)
  92   (when (and (boundp 'scroll-restore-mode) scroll-restore-mode)
  93     (scroll-restore-mode -1)
  94     (scroll-restore-mode 1)))
  95
  96 (defcustom scroll-restore-commands
  97   ;; FIXME: How 'bout using the `scroll-command' property?
  98   '(handle-select-window handle-switch-frame
  99     scroll-up scroll-down
 100     scroll-up-command scroll-down-command
 101     scroll-bar-toolkit-scroll mwheel-scroll
 102     scroll-other-window scroll-other-window-down
 103     scroll-bar-scroll-up scroll-bar-scroll-down scroll-bar-drag)
 104   "Commands handled by Scroll Restore mode.
 105 Scroll Restore mode will try to restore the original position of
 106 `point' after executing a sequence of any of these commands."
 107   :type '(repeat symbol)
 108   :set #'(lambda (symbol value)
 109            (when (boundp 'scroll-restore-commands)
 110              (dolist (cmd scroll-restore-commands)
 111                (put cmd 'scroll-restore nil)))
 112            (set-default symbol value)
 113            (dolist (cmd scroll-restore-commands)
 114              (put cmd 'scroll-restore t))))
 115
 116 ;; Recenter.
 117 (defcustom scroll-restore-recenter nil
 118   "Non-nil means scrolling back recenters the original position.
 119 Setting this to a non-nil value can be useful to detect the original
 120 position more easily and coherently when scrolling back."
 121   :type 'boolean)
 122
 123 ;; Jump back.
 124 (defcustom scroll-restore-jump-back nil
 125   "Non-nil means jump back to original position after scrolling.
 126 When this option is non-nil, Scroll Restore mode resets `point'
 127 to the original position when scrolling has moved that position
 128 off-screen and a command not in `scroll-restore-commands' shall
 129 be executed.  The resulting behavior is similar to that of some
 130 word processors.  You probably want to remove commands like
 131 `scroll-up' and `scroll-down' from `scroll-restore-commands' when
 132 activating this option.
 133
 134 Alternatively you may consider binding the command
 135 `scroll-restore-jump-back' to a key of your choice."
 136   :type 'boolean
 137   :set #'scroll-restore--set)
 138
 139 ;;; Cursor handling.
 140 (defvar scroll-restore-buffer nil
 141   "Buffer for `scroll-restore-cursor-type'.")
 142
 143 ;; Note: nil is a valid cursor-type.
 144 (defvar scroll-restore-buffer-cursor-type 'invalid
 145   "Original cursor-type of `scroll-restore-buffer'.")
 146
 147 (defvar scroll-restore-frame nil
 148   "Frame for `scroll-restore-cursor-color'.")
 149
 150 (defvar scroll-restore-frame-cursor-color nil
 151   "Original cursor-color of `scroll-restore-frame'.")
 152
 153 (defcustom scroll-restore-handle-cursor nil
 154   "Non-nil means Scroll Restore mode may change appearance of cursor.
 155 Scroll Restore mode can change the appearance of the cursor in
 156 the selected window while the original position is off-screen.
 157 Customize `scroll-restore-cursor-type' to change the type of the
 158 cursor and `scroll-restore-cursor-color' to change its color."
 159   :type '(choice
 160           (const :tag "Off" nil)
 161           (const :tag "Cursor type" type)
 162           (const :tag "Cursor color" color)
 163           (const :tag "Type and color" t))
 164   :set #'scroll-restore--set)
 165
 166 (defcustom scroll-restore-cursor-type 'box
 167   "Type of cursor when original position is off-screen.
 168 Applied if and only if `scroll-restore-handle-cursor' is either
 169 'type or t.
 170
 171 Be careful when another application uses that type.  Otherwise,
 172 you might get unexpected results when Scroll Restore mode resets
 173 the cursor type to its \"original\" value after a sequence of
 174 scrolling commands and the application has changed the cursor
 175 type in between.
 176
 177 To guard against unexpected results, Scroll Restore mode does not
 178 reset the type of the cursor whenever its value does not equal
 179 the value of scroll-restore-cursor-type."
 180   :type '(choice
 181           (const :tag "No cursor" nil)
 182           (const :tag "Filled box" box)
 183           (const :tag "Hollow box" hollow)
 184           (const :tag "Vertical bar" bar)
 185           (const :tag "Horizontal bar" hbar))
 186   :set #'scroll-restore--set)
 187
 188 (defcustom scroll-restore-cursor-color "DarkCyan"
 189   "Background color of cursor when original position is off-screen.
 190 Applied if and only if `scroll-restore-handle-cursor' is either
 191 'color or t.
 192
 193 Observe that when Emacs changes the color of the cursor, the
 194 change applies to all windows on the associated frame.
 195
 196 Be careful when another application is allowed to change the
 197 cursor-color.  Otherwise, you might get unexpected results when
 198 Scroll Restore mode resets the cursor color to its \"original\"
 199 value and the application has changed the cursor color in
 200 between.
 201
 202 To guard against unexpected results Scroll Restore mode does not
 203 reset the color of the cursor whenever its value does not equal
 204 the value of scroll-restore-cursor-color."
 205   :type 'color
 206   :set #'scroll-restore--set)
 207
 208 ;;; Region handling.
 209
 210 ;; FIXME: We should try to use pre-redisplay-function instead.
 211
 212 (defvar scroll-restore-region-overlay
 213   (let ((overlay (make-overlay (point-min) (point-min))))
 214     (overlay-put overlay 'face 'scroll-restore-region)
 215     (delete-overlay overlay)
 216     overlay)
 217   "Overlay used for highlighting the region.")
 218
 219 (defcustom scroll-restore-handle-region nil
 220   "Non-nil means Scroll Restore mode handles the region.
 221 This affects the behavior of Emacs in `transient-mark-mode' only.
 222 In particular, Emacs will suppress highlighting the region as
 223 long as the original position of `point' is off-screen.  Rather,
 224 Emacs will highlight the original region \(the region before
 225 scrolling started\) in `scroll-restore-region' face.  Scrolling
 226 back to the original position will restore the region to its
 227 original state.
 228
 229 Note that Scroll Restore mode does not deactivate the mark during
 230 scrolling.  Hence any operation on the region will not use the
 231 original but the _actual_ value of `point'.
 232
 233 If you mark the region via `mouse-drag-region', setting this
 234 option has no effect since Scroll Restore mode cannot track mouse
 235 drags."
 236   :type 'boolean
 237   :set #'scroll-restore--set)
 238
 239 (defface scroll-restore-region
 240   '((t :inherit region))
 241   "Face for Scroll Restore region when `scroll-restore-handle-region' is
 242 non-nil.")
 243
 244 ;; Note: We can't use `point-before-scroll' for our purposes because
 245 ;; that variable is buffer-local.  We need a variable that recorded
 246 ;; `window-point' before a sequence of scroll operations.  Also
 247 ;; `point-before-scroll' is not handled by mwheel.el and some other
 248 ;; commands that do implicit scrolling.  hence, the original position is
 249 ;; handled, among others, by the following alist.
 250 (defvar scroll-restore-alist nil
 251   "List of <window, buffer, point> quadruples.
 252 `window' is the window affected, `buffer' its buffer.  `pos' is
 253 the original position of `point' in that window.  `off' non-nil
 254 means `pos' was off-screen \(didn't appear in `window'\).")
 255
 256 (defun scroll-restore-pre-command ()
 257   "Scroll Restore's pre-command function."
 258   (let ((overlay-buffer (overlay-buffer scroll-restore-region-overlay)))
 259     ;; Handle region overlay.
 260     (when overlay-buffer
 261       ;; Remove `transient-mark-mode' binding in any case.
 262       (with-current-buffer overlay-buffer
 263         (kill-local-variable 'transient-mark-mode))
 264       (delete-overlay scroll-restore-region-overlay)))
 265   ;; Handle cursor-type.
 266   (when (and scroll-restore-buffer
 267              (not (eq scroll-restore-buffer-cursor-type 'invalid))
 268              (with-current-buffer scroll-restore-buffer
 269                (eq cursor-type scroll-restore-cursor-type)))
 270     (with-current-buffer scroll-restore-buffer
 271       (setq cursor-type scroll-restore-buffer-cursor-type)
 272       (setq scroll-restore-buffer-cursor-type 'invalid)))
 273   ;; Handle cursor-color.
 274   (when (and scroll-restore-frame scroll-restore-frame-cursor-color
 275              (eq (frame-parameter scroll-restore-frame 'cursor-color)
 276                  scroll-restore-cursor-color))
 277     (let ((frame (selected-frame)))
 278       (select-frame scroll-restore-frame)
 279       (set-cursor-color scroll-restore-frame-cursor-color)
 280       (setq scroll-restore-frame-cursor-color nil)
 281       (select-frame frame)))
 282   ;; Handle jumping.
 283   (when (and scroll-restore-jump-back
 284              (not (get this-command 'scroll-restore)))
 285     (let ((entry (assq (selected-window) scroll-restore-alist)))
 286       (when entry
 287         (let ((window (car entry))
 288               ;; (buffer (nth 1 entry))
 289               (pos (nth 2 entry)))
 290           (set-window-point window pos)
 291           ;; We are on-screen now.
 292           (setcdr (nthcdr 2 entry) (list nil))))))
 293   ;; Paranoia.
 294   (unless (or scroll-restore-jump-back scroll-restore-handle-region
 295               scroll-restore-handle-cursor)
 296     ;; Should be never reached.
 297     (remove-hook 'pre-command-hook 'scroll-restore-pre-command)))
 298
 299 (defun scroll-restore-remove (&optional all)
 300   "Remove stale entries from `scroll-restore-alist'.
 301 Optional argument ALL non-nil means remove them all."
 302   (dolist (entry scroll-restore-alist)
 303     (let ((window (car entry))
 304           (buffer (nth 1 entry))
 305           (pos (nth 2 entry)))
 306       (when (or all (not (window-live-p window))
 307                 (not (eq (window-buffer window) buffer))
 308                 (not (markerp pos)) (not (marker-position pos)))
 309         (when (markerp pos)
 310           (set-marker pos nil))
 311         (setq scroll-restore-alist
 312               (assq-delete-all window scroll-restore-alist))))))
 313
 314 (defun scroll-restore-add ()
 315   "Add new entries to `scroll-restore-alist'."
 316   (walk-windows
 317    (lambda (window)
 318      (unless (assq window scroll-restore-alist)
 319        (let ((buffer (window-buffer window)))
 320              (setq scroll-restore-alist
 321                    (cons
 322                     (list
 323                      window buffer
 324                      (with-current-buffer buffer
 325                        (copy-marker (window-point window)))
 326                      nil)
 327                     scroll-restore-alist)))))
 328    'no-mini t))
 329
 330 (defun scroll-restore-update (how window buffer pos)
 331   "Update various things in `scroll-restore-post-command'.
 332 HOW must be either on-off, on-on, off-off, off-on, or t.  WINDOW
 333 and BUFFER are affected window and buffer.  POS is the original
 334 position."
 335   (when (eq window (selected-window))
 336     (with-current-buffer buffer
 337       ;; Handle region.
 338       (when scroll-restore-handle-region
 339         (if (and transient-mark-mode mark-active
 340                  (not deactivate-mark)
 341                  (memq how '(on-off off-off)))
 342             (progn
 343               (move-overlay scroll-restore-region-overlay
 344                             (min pos (mark)) (max pos (mark)) buffer)
 345               (overlay-put scroll-restore-region-overlay 'window window)
 346               ;; Temporarily disable `transient-mark-mode' in this buffer.
 347               (set (make-local-variable 'transient-mark-mode) nil))
 348           (delete-overlay scroll-restore-region-overlay)))
 349       ;; Handle cursor.
 350       (when (and scroll-restore-handle-cursor
 351                  (memq how '(on-off off-off))
 352                  ;; Change cursor iff there was a visible cursor.
 353                  cursor-type)
 354         (when (memq scroll-restore-handle-cursor '(type t))
 355           (setq scroll-restore-buffer buffer)
 356           (setq scroll-restore-buffer-cursor-type cursor-type)
 357           (setq cursor-type scroll-restore-cursor-type))
 358         (when (memq scroll-restore-handle-cursor '(color t))
 359           (setq scroll-restore-frame (window-frame window))
 360           (setq scroll-restore-frame-cursor-color
 361                 (frame-parameter scroll-restore-frame 'cursor-color))
 362           (let ((frame (selected-frame)))
 363             (select-frame scroll-restore-frame)
 364             (set-cursor-color scroll-restore-cursor-color)
 365             (select-frame frame)))))))
 366
 367 (defun scroll-restore-post-command ()
 368   "Scroll Restore mode post-command function."
 369   (scroll-restore-remove)
 370   (let (recenter)
 371     (dolist (entry scroll-restore-alist)
 372       (let ((window (car entry))
 373             (buffer (nth 1 entry))
 374             (pos (nth 2 entry))
 375             (off (nth 3 entry)))
 376         (if (get this-command 'scroll-restore)
 377             ;; A scroll restore command.
 378             (if off
 379                 ;; `pos' was off-screen.
 380                 (if (pos-visible-in-window-p (marker-position pos) window)
 381                     ;; `pos' is on-screen now.
 382                     (progn
 383                       ;; Move cursor to original position.
 384                       (set-window-point window pos)
 385                       ;; Recenter if desired.
 386                       (when (and scroll-restore-recenter
 387                                  (eq window (selected-window)))
 388                         (setq recenter (/ (window-height window) 2)))
 389                       ;; Record on-screen status.
 390                       (setcdr (nthcdr 2 entry) (list nil))
 391                       (scroll-restore-update 'off-on window buffer pos))
 392                   ;; `pos' is still off-screen
 393                   (scroll-restore-update 'off-off window buffer pos))
 394               ;; `pos' was on-screen.
 395               (if (pos-visible-in-window-p pos window)
 396                   ;; `pos' is still on-screen.
 397                   (progn
 398                     ;; Occasionally Emacs deliberately changes
 399                     ;; `window-point' during scrolling even when
 400                     ;; it's visible.  Maybe this is due to
 401                     ;; `make-cursor-line-fully-visible' maybe due to
 402                     ;; `scroll-margin' maybe due to something else.
 403                     ;; We override that behavior here.
 404                     (unless (= (window-point) pos)
 405                       (set-window-point window pos))
 406                     (scroll-restore-update 'on-on window buffer pos))
 407                 ;; `pos' moved off-screen.
 408                 ;; Record off-screen state.
 409                 (setcdr (nthcdr 2 entry) (list t))
 410                 (scroll-restore-update 'on-off window buffer pos)))
 411           ;; Not a scroll-restore command.
 412           (let ((window-point (window-point window)))
 413                   (when (and (eq window (selected-window))
 414                              (or (/= window-point pos) off))
 415                     ;; Record position and on-screen status.
 416                     (setcdr
 417                      (nthcdr 1 entry)
 418                      (list (move-marker pos (window-point window)) nil)))
 419                   (scroll-restore-update t window buffer pos)))))
 420     (scroll-restore-add)
 421     (when recenter (recenter recenter))))
 422
 423 (defun scroll-restore-jump-back ()
 424   "Jump back to original position.
 425 The orginal position is the value of `window-point' in the
 426 selected window before you started scrolling.
 427
 428 This command does not push the mark."
 429   (interactive)
 430   (let ((entry (assq (selected-window) scroll-restore-alist)))
 431     (if entry
 432         (goto-char (nth 2 entry))
 433       (error "No jump-back position available"))))
 434
 435 ;;;###autoload
 436 (define-minor-mode scroll-restore-mode
 437   "Toggle Scroll Restore mode.
 438 With arg, turn Scroll Restore mode on if arg is positive, off
 439 otherwise.
 440
 441 In Scroll Restore mode Emacs attempts to restore the original
 442 position that existed before executing a sequence of scrolling
 443 commands whenever that position becomes visible again.  The
 444 option `scroll-restore-commands' permits to specify the set of
 445 commands that may constitute such a sequence.  In addition you
 446 can
 447
 448 - recenter the window when you scroll back to the original
 449   position, see the option `scroll-restore-recenter',
 450
 451 - aggressively jump back to the original position before
 452   executing a command not in `scroll-restore-commands', see
 453   `scroll-restore-jump-back',
 454
 455 - change the appearance of the cursor in the selected window
 456   while the original position is off-screen, see the option
 457   `scroll-restore-handle-cursor',
 458
 459 - change the appearance of the region in the selected window
 460   while the original position is off-screen, see the option
 461   `scroll-restore-handle-region'."
 462   :global t
 463   :group 'scroll-restore
 464   :init-value nil
 465   :link '(emacs-commentary-link "scroll-restore.el")
 466   (if scroll-restore-mode
 467       (progn
 468         (scroll-restore-add)
 469         (when (or scroll-restore-jump-back scroll-restore-handle-region
 470                   scroll-restore-handle-cursor)
 471           (add-hook 'pre-command-hook 'scroll-restore-pre-command))
 472         (add-hook 'post-command-hook 'scroll-restore-post-command t))
 473     (scroll-restore-remove 'all)
 474     (remove-hook 'pre-command-hook 'scroll-restore-pre-command)
 475     (remove-hook 'post-command-hook 'scroll-restore-post-command)))
 476
 477 (provide 'scroll-restore)
 478 ;;; scroll-restore.el ends here