Download Git
(require 'mouse-wheel-mode nil 'noerror)
(defgroup centered-cursor nil
"Makes the cursor stay vertically in a defined position (usually centered).
Instead the cursor the text moves around the cursor."
:group 'scrolling
:group 'convenience
:link '(emacs-library-link :tag "Source Lisp File" "centered-cursor-mode.el")
:link '(url-link "http://www.emacswiki.org/cgi-bin/wiki/centered-cursor-mode.el"))
(defcustom ccm-step-size 2
"Step size when animated recentering."
:group 'centered-cursor
:tag "Animation step size"
:type 'integer)
(defcustom ccm-step-delay 0.02
"Delay between animation steps.
If you want a different animation speed."
:group 'centered-cursor
:tag "Animation step delay"
:type 'number)
(defcustom ccm-ignored-commands '(mouse-drag-region
mouse-set-point
widget-button-click
scroll-bar-toolkit-scroll)
"After these commands recentering is ignored.
This is to prevent unintentional jumping (especially when mouse
clicking). Following commands (except the ignored ones) will
cause an animated recentering to give a feedback and not just
jumping to the center."
:group 'centered-cursor
:tag "Ignored commands"
:type '(repeat (symbol :tag "Command")))
(defcustom ccm-vpos-init '(round (window-text-height) 2)
"This is the screen line position where the cursor initially stays."
:group 'centered-cursor
:tag "Vertical cursor position"
:type '(choice (const :tag "Center" (round (window-text-height) 2))
(const :tag "Golden ratio" (round (* 21 (window-text-height)) 34))
(integer :tag "Lines from top" :value 10)))
(make-variable-buffer-local 'ccm-vpos-init)
(defcustom ccm-vpos-inverted 1
"Inverted vertical cursor position.
Defines if the initial vertical position `ccm-vpos-init' is
measured from the bottom instead from the top."
:group 'centered-cursor
:tag "Inverted cursor position"
:type '(choice (const :tag "Inverted" -1)
(const :tag "Not inverted" 1)))
(make-variable-buffer-local 'ccm-vpos-inverted)
(defcustom ccm-recenter-at-end-of-file nil
"Recenter at the end of the file.
If non-nil the end of the file is recentered. If nil the end of
the file stays at the end of the window."
:group 'centered-cursor
:tag "Recenter at EOF"
:type '(choice (const :tag "Don't recenter at the end of the file" nil)
(const :tag "Recenter at the end of the file" t)))
(make-variable-buffer-local 'ccm-recenter-end-of-file)
(defvar ccm-vpos nil
"This is the screen line position where the cursor stays.")
(make-variable-buffer-local 'ccm-vpos)
(defvar animate-first-start-p nil
"Whether or not to animate at first start. It is set to nil, if
centered-cursor-mode is called non-interactively.")
(make-variable-buffer-local 'animate-first-start-p)
(defvar recenter-sequence nil
"Before animated recentering a list is generated first with positions
to successively recenter to")
(make-variable-buffer-local 'recenter-sequence)
(defvar ccm-map
(let ((ccm-map (make-sparse-keymap)))
(define-key ccm-map [(control meta -)] 'ccm-vpos-up)
(define-key ccm-map [(control meta +)] 'ccm-vpos-down)
(define-key ccm-map [(control meta =)] 'ccm-vpos-down)
(define-key ccm-map [(control meta ?0)] 'ccm-vpos-recenter)
(when (and (boundp 'mouse-wheel-mode) mouse-wheel-mode)
(mapc (lambda (key)
(define-key ccm-map key 'ccm-mwheel-scroll))
(list (vector mouse-wheel-up-event)
(vector mouse-wheel-down-event)
(vector (list 'control mouse-wheel-up-event))
(vector (list 'control mouse-wheel-down-event))
(vector (list 'shift mouse-wheel-up-event))
(vector (list 'shift mouse-wheel-down-event)))))
(define-key ccm-map [(meta v)] 'ccm-scroll-down)
(define-key ccm-map [(control v)] 'ccm-scroll-up)
(define-key ccm-map [prior] 'ccm-scroll-down)
(define-key ccm-map [next] 'ccm-scroll-up)
ccm-map)
"Keymap used in centered-cursor-mode.")
(defun ccm-mwheel-scroll (event)
"Very similar to `mwheel-scroll', but does not use `scroll-down'
and `scroll-up' but `previous-line' and `next-line', that is, the
cursor is moved and thus the text in the window is scrolled
due to `recenter'.
The customizable variable `mouse-wheel-scroll-amount' is used to
determine how much to scroll, where nil instead of a number means
the same as in mwheel-scroll, scroll by a near full screen.
This command exists, because mwheel-scroll caused strange
behaviour with automatic recentering."
(interactive "e")
(let* ((mods (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
(amt (assoc mods mouse-wheel-scroll-amount)))
(if amt
(setq amt (or (cdr amt)
(- (window-text-height)
next-screen-context-lines)))
(let ((list-elt mouse-wheel-scroll-amount))
(while (consp (setq amt (pop list-elt))))))
(if mouse-wheel-follow-mouse
(select-window (posn-window (event-start event))))
(let ((button (mwheel-event-button event)))
(cond
((eq button mouse-wheel-down-event)
(forward-line (- amt)))
((eq button mouse-wheel-up-event)
(forward-line amt))
(t (error "Bad binding in ccm-mwheel-scroll"))))))
(defun ccm-scroll-down (&optional arg)
"Replaces `scroll-down' because with scroll-down
`centered-cursor-mode' sometimes doesn't reach the top of the
buffer. This version actually moves the cursor with
`previous-line'. Since with centered-cursor-mode the cursor is in
a fixed position the movement appears as page up."
(interactive "P")
(let ((amt (or arg (- (window-text-height)
next-screen-context-lines))))
(forward-line (- amt))))
(defun ccm-scroll-up (&optional arg)
"Replaces `scroll-up' to be consistent with `ccm-scroll-down'.
This version actually moves the cursor with `previous-line'.
Since with centered-cursor-mode the cursor is in a fixed position
the movement appears as page up."
(interactive "P")
(let ((amt (or arg (- (window-text-height)
next-screen-context-lines))))
(forward-line amt)))
(defun ccm-vpos-down (arg)
"Adjust the value of the screen line (where the cursor stays) by arg.
Negative values for arg are possible. Just the variable ccm-vpos
is set."
(interactive "p")
(or arg (setq arg 1))
(let ((new-pos (if (< ccm-vpos 0)
(- ccm-vpos arg)
(+ ccm-vpos arg)))
(vpos-max (if (< ccm-vpos 0)
-1
(- (window-text-height) 1)))
(vpos-min (if (< ccm-vpos 0)
(- (window-text-height))
0)))
(setq ccm-vpos
(cond
((< new-pos vpos-min)
vpos-min)
((> new-pos vpos-max)
vpos-max)
(t
new-pos)))))
(defun ccm-vpos-up (arg)
"See `ccm-vpos-down'."
(interactive "p")
(or arg (setq arg 1))
(ccm-vpos-down (- arg)))
(defun ccm-vpos-recenter ()
"Set the value of the screen line (where the cursor stays) in
the center. Just the variable ccm-vpos is set."
(interactive)
(if (equal (current-buffer)
(window-buffer (selected-window)))
(setq ccm-vpos (* (eval ccm-vpos-init)
ccm-vpos-inverted))))
(defun ccm-position-cursor ()
"Do the actual recentering at the position `ccm-vpos'."
(unless (member this-command ccm-ignored-commands)
(unless ccm-vpos
(ccm-vpos-recenter))
(unless (minibufferp (current-buffer))
(if (equal (current-buffer)
(window-buffer (selected-window)))
(let* ((current-line
(if (< ccm-vpos 0)
(- (count-lines (point)
(if (> (window-end) 0)
(window-end)
1)))
(+ (count-lines (window-start) (point))
(if (= (current-column) 0) 0 -1))))
(diff (- ccm-vpos current-line))
(step-size ccm-step-size)
(step-delay ccm-step-delay)
(vpos-inverted ccm-vpos-inverted)
(recenter-at-end-of-file ccm-recenter-at-end-of-file))
(let* ((bottom-vpos (if (< ccm-vpos 0)
(- ccm-vpos)
(- (window-text-height) ccm-vpos)))
(correction (save-excursion
(if (or (= (point) (point-max))
(progn
(goto-char (point-max))
(zerop (current-column))))
1 0)))
(window-is-at-bottom (= (window-end) (point-max)))
(bottom-lines (if window-is-at-bottom
(+ (count-lines (point) (point-max))
correction))))
(if (not (and (> (abs diff) 4)
(or (member last-command ccm-ignored-commands)
animate-first-start-p)))
(recenter (if (and window-is-at-bottom
(< bottom-lines bottom-vpos)
(not recenter-at-end-of-file))
(- bottom-lines)
ccm-vpos))
(setq animate-first-start-p nil)
(setq recenter-sequence
(if (and window-is-at-bottom
(< bottom-lines bottom-vpos)
(not recenter-at-end-of-file))
(cdr (reverse (number-sequence
(- bottom-lines)
(if (< ccm-vpos 0)
current-line
(- (- (window-text-height) current-line)))
(* (/ diff (abs diff)) (- step-size)))))
(cdr (reverse (number-sequence
ccm-vpos
current-line
(* (/ diff (abs diff)) (- step-size)))))))
(while recenter-sequence
(recenter (pop recenter-sequence))
(if (car recenter-sequence) (sit-for step-delay t))))))))))
(defun ccm-first-start (animate)
"Called from centered-cursor-mode. Animate at first start, if
centered-cursor-mode is called interactively."
(let ((animate-first-start-p animate))
(ccm-vpos-recenter)
(ccm-position-cursor)))
(define-minor-mode centered-cursor-mode
"Makes the cursor stay vertically in a defined
position (usually centered)."
:init-value nil
:lighter " ¢"
:keymap ccm-map
(cond
(centered-cursor-mode
(ccm-first-start (interactive-p))
(add-hook 'post-command-hook 'ccm-position-cursor t t)
(add-hook 'window-configuration-change-hook 'ccm-vpos-recenter t t))
(t
(remove-hook 'post-command-hook 'ccm-position-cursor t)
(remove-hook 'window-configuration-change-hook 'ccm-vpos-recenter t))))
(define-global-minor-mode global-centered-cursor-mode centered-cursor-mode
centered-cursor-mode)
(provide 'centered-cursor-mode)