Download
(require 'cl)
(defgroup atim-unscroll nil
"Go to the position of cursor befor scrolling command"
:group 'editing
:version "23")
(defcustom atim-unscroll-max-ring-length 10
"Length of the unscroll ring."
:type 'integer
:group 'atim-unscroll)
(setq atim-unscroll--advise-commands-list
'(scroll-up
scroll-down
scroll-left
scroll-right
beginning-of-buffer
end-of-buffer
scroll-bar-toolkit-scroll))
(setq atim-unscroll--unscrollable-commands-list
(append '(mwheel-scroll
cua-scroll-up
cua-scroll-down)
atim-unscroll--advise-commands-list))
(defvar atim-unscroll-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [M-up] 'atim-unscroll-up)
(define-key map [M-down] 'atim-unscroll-down)
map)
"Keymap for atim-unscroll minor mode.")
(defvar atim-unscroll-point
nil
"Text positions for next call of `atim-unscroll--unscroll'.")
(defvar atim-unscroll-window-start
nil
"Window start for next call of `atim-unscroll--unscroll'.")
(defvar atim-unscroll-hscroll
nil
"Window start for next call of `atim-unscroll--unscroll'.")
(defvar atim-unscroll-ring-pos
0
"Current position in the unscroll ring.")
(defun atim-unscroll-up ()
"Revert to `atim-unscroll-point' and `atim-unscroll-window-start'
by going up in the unscroll ring"
(interactive)
(if (or (eq last-command 'atim-unscroll-up)
(eq last-command 'atim-unscroll-down))
(if (< 0 atim-unscroll-ring-pos)
(setq atim-unscroll-ring-pos (1- atim-unscroll-ring-pos))
(error "No previous marker in the unscroll ring"))
(setq atim-unscroll-ring-pos 0))
(atim-unscroll--unscroll))
(defun atim-unscroll-down ()
"Revert to `atim-unscroll-point' and `atim-unscroll-window-start'
by going down in the unscroll ring"
(interactive)
(if (or (eq last-command 'atim-unscroll-up)
(eq last-command 'atim-unscroll-down))
(if (> (ring-length atim-unscroll-point) (1+ atim-unscroll-ring-pos))
(setq atim-unscroll-ring-pos (1+ atim-unscroll-ring-pos))
(error "No further marker in the unscroll ring"))
(setq atim-unscroll-ring-pos 0))
(atim-unscroll--unscroll))
(defun atim-unscroll--unscroll ()
"Revert to `atim-unscroll-point' and `atim-unscroll-window-start'."
(if (ring-empty-p atim-unscroll-point)
(error "Unscroll ring is empty")
(progn
(goto-char (ring-ref atim-unscroll-point atim-unscroll-ring-pos))
(set-window-start nil (ring-ref atim-unscroll-window-start
atim-unscroll-ring-pos))
(set-window-hscroll nil (ring-ref atim-unscroll-hscroll
atim-unscroll-ring-pos)))))
(defun atim-unscroll--maybe-remember ()
"Remeber positions before scroll command."
(if (not (get last-command 'unscrollable))
(progn
(ring-insert atim-unscroll-point (point-marker))
(save-excursion
(progn
(goto-char (window-start))
(ring-insert atim-unscroll-window-start (point-marker))))
(ring-insert atim-unscroll-hscroll (window-hscroll)))))
(define-globalized-minor-mode atim-unscroll-global-mode
atim-unscroll-mode
atim-unscroll-on)
(defun atim-unscroll-on ()
(unless atim-unscroll-dont-activate (atim-unscroll-mode t)))
(defvar atim-unscroll-dont-activate nil
"If non-nil function `atim-unscroll-global-mode' does not activate in buffer.")
(make-variable-buffer-local 'atim-unscroll-dont-activate)
(define-minor-mode atim-unscroll-mode
"atim-unscroll minor mode.
\nKey bindings:
\\{atim-unscroll-mode-map}"
:init-value nil
:lighter " uscrl"
:group 'atim-unscroll
:keymap atim-unscroll-mode-map
(if atim-unscroll-mode
(progn
(make-variable-buffer-local 'atim-unscroll-point)
(setq atim-unscroll-point (make-ring atim-unscroll-max-ring-length))
(make-variable-buffer-local 'atim-unscroll-window-start)
(setq atim-unscroll-window-start (make-ring atim-unscroll-max-ring-length))
(make-variable-buffer-local 'atim-unscroll-hscroll)
(setq atim-unscroll-hscroll (make-ring atim-unscroll-max-ring-length))
(make-variable-buffer-local 'atim-unscroll-ring-pos)
(mapcar (lambda (x)
(put x 'unscrollable t))
atim-unscroll--unscrollable-commands-list)
(loop for f in atim-unscroll--advise-commands-list
do (eval `(defadvice ,f (before
atim-remember-for-unscroll
activate
compile)
"Remember where we started from, for atim-unscroll"
(atim-unscroll--maybe-remember)))))
(progn
(kill-local-variable 'atim-unscroll-point)
(kill-local-variable 'atim-unscroll-window-start)
(kill-local-variable 'atim-unscroll-hscroll)
(kill-local-variable 'atim-unscroll-ring-pos)
(mapcar (lambda (x)
(put x 'unscrollable nil))
atim-unscroll--unscrollable-commands-list)
(loop for f in atim-unscroll--advise-commands-list
do (eval `(ad-disable-advice f 'before 'atim-remember-for-unscroll)))
(loop for f in atim-scroll-commands_list
do (eval `(ad-activate f))))))
(provide 'atim-unscroll)