1 ;;; scroll-restore.el --- restore original position after scrolling -*- lexical-binding:t -*-
3 ;; Copyright (C) 2007,2014 Free Software Foundation, Inc.
5 ;; Time-stamp: "2007-12-05 10:44:11 martin"
6 ;; Author: Martin Rudalics <rudalics@gmx.at>
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)
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.
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/>.
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.
31 ;; The following additional options are provided:
33 ;; - Recenter the window when restoring the original position, see
34 ;; `scroll-restore-recenter'.
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
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'.
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.
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).
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.
65 ;; - Scroll Restore mode should handle `make-cursor-line-fully-visible'
66 ;; but there might be problems.
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.
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."
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.
85 (defgroup scroll-restore nil
86 "Restore original position after scrolling."
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)))
96 (defcustom scroll-restore-commands
97 ;; FIXME: How 'bout using the `scroll-command' property?
98 '(handle-select-window handle-switch-frame
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))))
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."
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.
134 Alternatively you may consider binding the command
135 `scroll-restore-jump-back' to a key of your choice."
137 :set #'scroll-restore--set)
140 (defvar scroll-restore-buffer nil
141 "Buffer for `scroll-restore-cursor-type'.")
143 ;; Note: nil is a valid cursor-type.
144 (defvar scroll-restore-buffer-cursor-type 'invalid
145 "Original cursor-type of `scroll-restore-buffer'.")
147 (defvar scroll-restore-frame nil
148 "Frame for `scroll-restore-cursor-color'.")
150 (defvar scroll-restore-frame-cursor-color nil
151 "Original cursor-color of `scroll-restore-frame'.")
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."
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)
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
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
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."
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)
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
193 Observe that when Emacs changes the color of the cursor, the
194 change applies to all windows on the associated frame.
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
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."
206 :set #'scroll-restore--set)
210 ;; FIXME: We should try to use pre-redisplay-function instead.
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)
217 "Overlay used for highlighting the region.")
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
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'.
233 If you mark the region via `mouse-drag-region', setting this
234 option has no effect since Scroll Restore mode cannot track mouse
237 :set #'scroll-restore--set)
239 (defface scroll-restore-region
240 '((t :inherit region))
241 "Face for Scroll Restore region when `scroll-restore-handle-region' is
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'\).")
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.
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)))
283 (when (and scroll-restore-jump-back
284 (not (get this-command 'scroll-restore)))
285 (let ((entry (assq (selected-window) scroll-restore-alist)))
287 (let ((window (car entry))
288 ;; (buffer (nth 1 entry))
290 (set-window-point window pos)
291 ;; We are on-screen now.
292 (setcdr (nthcdr 2 entry) (list nil))))))
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)))
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))
306 (when (or all (not (window-live-p window))
307 (not (eq (window-buffer window) buffer))
308 (not (markerp pos)) (not (marker-position pos)))
310 (set-marker pos nil))
311 (setq scroll-restore-alist
312 (assq-delete-all window scroll-restore-alist))))))
314 (defun scroll-restore-add ()
315 "Add new entries to `scroll-restore-alist'."
318 (unless (assq window scroll-restore-alist)
319 (let ((buffer (window-buffer window)))
320 (setq scroll-restore-alist
324 (with-current-buffer buffer
325 (copy-marker (window-point window)))
327 scroll-restore-alist)))))
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
335 (when (eq window (selected-window))
336 (with-current-buffer buffer
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)))
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)))
350 (when (and scroll-restore-handle-cursor
351 (memq how '(on-off off-off))
352 ;; Change cursor iff there was a visible cursor.
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)))))))
367 (defun scroll-restore-post-command ()
368 "Scroll Restore mode post-command function."
369 (scroll-restore-remove)
371 (dolist (entry scroll-restore-alist)
372 (let ((window (car entry))
373 (buffer (nth 1 entry))
376 (if (get this-command 'scroll-restore)
377 ;; A scroll restore command.
379 ;; `pos' was off-screen.
380 (if (pos-visible-in-window-p (marker-position pos) window)
381 ;; `pos' is on-screen now.
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.
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.
418 (list (move-marker pos (window-point window)) nil)))
419 (scroll-restore-update t window buffer pos)))))
421 (when recenter (recenter recenter))))
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.
428 This command does not push the mark."
430 (let ((entry (assq (selected-window) scroll-restore-alist)))
432 (goto-char (nth 2 entry))
433 (error "No jump-back position available"))))
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
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
448 - recenter the window when you scroll back to the original
449 position, see the option `scroll-restore-recenter',
451 - aggressively jump back to the original position before
452 executing a command not in `scroll-restore-commands', see
453 `scroll-restore-jump-back',
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',
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'."
463 :group 'scroll-restore
465 :link '(emacs-commentary-link "scroll-restore.el")
466 (if scroll-restore-mode
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)))
477 (provide 'scroll-restore)
478 ;;; scroll-restore.el ends here