1 ;;; beacon.el --- Highlight the cursor whenever it moves long distances -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2015 Artur Malabarba
5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
6 ;; URL: https://github.com/Malabarba/beacon
7 ;; Keywords: convenience
9 ;; Package-Requires: ((seq "1.9"))
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
26 ;; This is a global minor-mode. Turn it on everywhere with:
31 ;; Whenever the window scrolls or the buffer changes a light will shine on
32 ;; top of your cursor so you know where it is.
40 ;; • To customize the appearance of the beacon, configure `beacon-size'
41 ;; and `beacon-color'.
43 ;; • To customize how long it lasts, configure `beacon-blink-duration'
44 ;; and `beacon-blink-delay'.
46 ;; • To customize /when/ it is used at all, configure
47 ;; `beacon-blink-when-window-scrolls',
48 ;; `beacon-blink-when-buffer-changes', and
49 ;; `beacon-blink-when-point-moves'.
56 "Customization group for beacon."
60 (defvar beacon--timer nil)
62 (defcustom beacon-push-mark nil
63 "Should the mark be pushed before long movements?
64 If nil, `beacon' will not push the mark.
65 Otherwise this should be a number, and `beacon' will push the
66 mark whenever point moves more than that many lines."
67 :type '(choice integer (const nil)))
69 (defcustom beacon-blink-when-point-moves nil
70 "Should the beacon blink when moving a long distance?
71 If nil, don't blink due to plain movement.
72 If non-nil, this should be an integer, which is the minimum
73 movement distance (in lines) that triggers a beacon blink."
74 :type '(choice integer (const nil)))
76 (defcustom beacon-blink-when-buffer-changes t
77 "Should the beacon blink when changing buffer?"
80 (defcustom beacon-blink-when-window-scrolls t
81 "Should the beacon blink when the window scrolls?"
84 (defcustom beacon-blink-duration 0.3
85 "Time, in seconds, that the blink should last."
88 (defcustom beacon-blink-delay 0.3
89 "Time, in seconds, before starting to fade the beacon."
92 (defcustom beacon-size 40
93 "Size of the beacon in characters."
96 (defcustom beacon-color 0.5
98 This can be a string or a number.
100 If it is a number, the color is taken to be white or
101 black (depending on the current theme's background) and this
102 number is a float between 0 and 1 specifing the brightness.
104 If it is a string, it is a color name or specification,
106 :type '(choice number color))
110 (defvar beacon--ovs nil)
112 (defun beacon--colored-overlay (color)
113 "Put an overlay at point with background COLOR."
114 (let ((ov (make-overlay (point) (1+ (point)))))
115 (overlay-put ov 'face (list :background color))
116 (overlay-put ov 'beacon t)
117 (push ov beacon--ovs)))
119 (defun beacon--ov-put-after-string (overlay colors)
120 "Add an after-string property to OVERLAY.
121 The property's value is a string of spaces with background
122 COLORS applied to each one."
124 (delete-overlay overlay)
125 (overlay-put overlay 'beacon-colors colors)
126 (overlay-put overlay 'after-string
128 (mapconcat (lambda (c) (propertize " " 'face (list :background c)))
133 (defun beacon--after-string-overlay (colors)
134 "Put an overlay at point with an after-string property.
135 The property's value is a string of spaces with background
136 COLORS applied to each one."
137 (let ((ov (make-overlay (point) (point)))
138 ;; The after-string must not be longer than the remaining columns from
139 ;; point to right window-end else it will be wrapped around (assuming
140 ;; truncate-lines is nil) introducing an ugly wrap-around for a
141 ;; fraction of a second.
142 (colors (seq-take colors (- (window-width) (current-column)))))
143 (beacon--ov-put-after-string ov colors)
144 (overlay-put ov 'beacon t)
145 (push ov beacon--ovs)))
147 (defun beacon--ov-at-point ()
148 (car (or (seq-filter (lambda (o) (overlay-get o 'beacon))
149 (overlays-in (point) (point)))
150 (seq-filter (lambda (o) (overlay-get o 'beacon))
151 (overlays-at (point))))))
153 (defun beacon--vanish ()
154 "Turn off the beacon."
155 (when (timerp beacon--timer)
156 (cancel-timer beacon--timer))
157 (mapc #'delete-overlay beacon--ovs)
158 (setq beacon--ovs nil))
162 (defun beacon--int-range (a b)
163 "Return a list of integers between A inclusive and B exclusive.
164 Only returns `beacon-size' elements."
165 (let ((d (/ (- b a) beacon-size))
167 (dotimes (_ (1- beacon-size))
168 (push (+ (car out) d) out))
171 (defun beacon--color-range ()
172 "Return a list of background colors for the beacon."
173 (let* ((bg (color-values (face-attribute 'default :background)))
175 ((stringp beacon-color) (color-values beacon-color))
176 ((< (color-distance "black" bg)
177 (color-distance "white" bg))
178 (make-list 3 (* beacon-color 65535)))
179 (t (make-list 3 (* (- 1 beacon-color) 65535))))))
180 (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b))
181 (mapcar (lambda (n) (butlast (beacon--int-range (elt fg n) (elt bg n))))
186 (defun beacon--shine ()
187 "Shine a beacon at point."
188 (let ((colors (beacon--color-range)))
193 (beacon--after-string-overlay colors)
195 (beacon--colored-overlay (pop colors))
196 (forward-char 1))))))
198 (defun beacon--dec ()
199 "Decrease the beacon brightness by one."
200 (pcase (beacon--ov-at-point)
201 (`nil (beacon--vanish))
202 ((and o (let c (overlay-get o 'beacon-colors)) (guard c))
203 (beacon--ov-put-after-string o (cdr c)))
207 (while (progn (forward-char 1)
208 (setq o (beacon--ov-at-point)))
209 (let ((colors (overlay-get o 'beacon-colors)))
211 (move-overlay o (1- (point)) (point))
213 (beacon--colored-overlay (pop colors))
214 (beacon--ov-put-after-string o colors)
215 (forward-char 1))))))))
217 (defun beacon-blink ()
218 "Blink the beacon at the position of the cursor."
223 (run-at-time beacon-blink-delay
224 (/ beacon-blink-duration 1.0 beacon-size)
228 ;;; Movement detection
229 (defvar beacon--window-scrolled nil)
230 (defvar beacon--previous-place nil)
231 (defvar beacon--previous-mark-head nil)
233 (defun beacon--movement-> (delta)
234 "Return non-nil if latest point movement is > DELTA.
235 If DELTA is nil, return nil."
237 (markerp beacon--previous-place)
238 (equal (marker-buffer beacon--previous-place)
240 (> (abs (- (point) beacon--previous-place))
242 (> (count-screen-lines (min (point) beacon--previous-place)
243 (max (point) beacon--previous-place))
246 (defun beacon--maybe-push-mark ()
247 "Push mark if it seems to be safe."
248 (when (and (not mark-active)
249 (beacon--movement-> beacon-push-mark))
250 (let ((head (car mark-ring)))
251 (when (and (eq beacon--previous-mark-head head)
252 (not (equal head beacon--previous-place)))
253 (push-mark beacon--previous-place)))))
255 (defun beacon--post-command ()
256 "Blink if point moved very far."
258 ((not (markerp beacon--previous-place))
260 ;; Blink because we changed buffer.
261 ((not (equal (marker-buffer beacon--previous-place)
263 (when beacon-blink-when-buffer-changes
264 (unless (window-minibuffer-p)
266 ;; Blink for scrolling.
267 ((and beacon-blink-when-window-scrolls
268 beacon--window-scrolled
269 (equal beacon--window-scrolled (selected-window)))
271 (setq beacon--window-scrolled nil))
272 ;; Blink for movement
273 ((beacon--movement-> beacon-blink-when-point-moves)
275 ;; Even if we don't blink, vanish any previous beacon.
276 (t (beacon--vanish)))
277 (beacon--maybe-push-mark)
278 (unless (window-minibuffer-p)
279 (setq beacon--previous-mark-head (car mark-ring))
280 (setq beacon--previous-place (point-marker))))
282 (defun beacon--window-scroll-function (win _start-pos)
283 "Blink the beacon or record that window has been scrolled.
284 If invoked during the command loop, record the current window so
285 that it may be blinked on post-command. This is because the
286 scrolled window might not be active, but we only know that at
289 If invoked outside the command loop, `post-command-hook' would be
290 unreliable, so just blink immediately."
292 (setq beacon--window-scrolled win)
297 (defcustom beacon-lighter
299 ((char-displayable-p ?💡) " 💡")
300 ((char-displayable-p ?Λ) " Λ")
302 "Lighter string used on the mode-line."
306 (define-minor-mode beacon-mode
307 nil nil beacon-lighter nil
311 (add-hook 'window-scroll-functions #'beacon--window-scroll-function)
312 (add-hook 'post-command-hook #'beacon--post-command))
313 (remove-hook 'window-scroll-functions #'beacon--window-scroll-function)
314 (remove-hook 'post-command-hook #'beacon--post-command)))
317 ;;; beacon.el ends here