1 ;;; beacon.el --- Highlight the cursor whenever the window scrolls -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
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 a light will shine on top of your cursor so
32 ;; you know where it is.
36 ;; See the accompanying Readme.org for configuration details.
43 "Customization group for beacon."
47 (defvar beacon--timer nil)
49 (defcustom beacon-push-mark 35
50 "Should the mark be pushed before long movements?
51 If nil, `beacon' will not push the mark.
52 Otherwise this should be a number, and `beacon' will push the
53 mark whenever point moves more than that many lines."
54 :type '(choice integer (const nil)))
56 (defcustom beacon-blink-when-point-moves-vertically nil
57 "Should the beacon blink when moving a long distance vertically?
58 If nil, don't blink due to vertical movement.
59 If non-nil, this should be an integer, which is the minimum
60 movement distance (in lines) that triggers a beacon blink."
61 :type '(choice integer (const nil)))
63 (defcustom beacon-blink-when-point-moves-horizontally nil
64 "Should the beacon blink when moving a long distance horizontally?
65 If nil, don't blink due to horizontal movement.
66 If non-nil, this should be an integer, which is the minimum
67 movement distance (in columns) that triggers a beacon blink."
68 :type '(choice integer (const nil)))
70 (defcustom beacon-blink-when-buffer-changes t
71 "Should the beacon blink when changing buffer?"
74 (defcustom beacon-blink-when-window-scrolls t
75 "Should the beacon blink when the window scrolls?"
78 (defcustom beacon-blink-when-window-changes t
79 "Should the beacon blink when the window changes?"
82 (defcustom beacon-blink-when-focused nil
83 "Should the beacon blink when Emacs gains focus?
84 Note that, due to a limitation of `focus-in-hook', this might
85 trigger false positives on some systems."
87 :package-version '(beacon . "0.2"))
89 (defcustom beacon-blink-duration 0.3
90 "Time, in seconds, that the blink should last."
93 (defcustom beacon-blink-delay 0.3
94 "Time, in seconds, before starting to fade the beacon."
97 (defcustom beacon-size 40
98 "Size of the beacon in characters."
101 (defcustom beacon-color 0.5
102 "Color of the beacon.
103 This can be a string or a number.
105 If it is a number, the color is taken to be white or
106 black (depending on the current theme's background) and this
107 number is a float between 0 and 1 specifing the brightness.
109 If it is a string, it is a color name or specification,
111 :type '(choice number color))
113 (defface beacon-fallback-background
114 '((((class color) (background light)) (:background "black"))
115 (((class color) (background dark)) (:background "white")))
116 "Fallback beacon background color.
117 Used in cases where the color can't be determined by Emacs.
118 Only the background of this face is used.")
120 (defvar beacon-dont-blink-predicates nil
121 "A list of predicates that prevent the beacon blink.
122 These predicate functions are called in order, with no
123 arguments, before blinking the beacon. If any returns
124 non-nil, the beacon will not blink.
126 For instance, if you want to disable beacon on buffers where
127 `hl-line-mode' is on, you can do:
129 (add-hook \\='beacon-dont-blink-predicates
130 (lambda () (bound-and-true-p hl-line-mode)))")
132 (add-hook 'beacon-dont-blink-predicates #'window-minibuffer-p)
134 (defcustom beacon-dont-blink-major-modes '(magit-status-mode magit-popup-mode)
135 "A list of major-modes where the beacon won't blink.
136 Whenever the current buffer satisfies `derived-mode-p' for
137 one of the major-modes on this list, the beacon will not
139 :type '(repeat symbol))
141 (defcustom beacon-dont-blink-commands '(recenter-top-bottom)
142 "A list of commands that should not make the beacon blink.
143 Use this for commands that scroll the window in very
144 predictable ways, when the blink would be more distracting
146 :type '(repeat symbol))
149 ;;; Internal variables
150 (defvar beacon--window-scrolled nil)
151 (defvar beacon--previous-place nil)
152 (defvar beacon--previous-mark-head nil)
153 (defvar beacon--previous-window nil)
154 (defvar beacon--previous-window-start 0)
156 (defun beacon--record-vars ()
157 (unless (window-minibuffer-p)
158 (setq beacon--previous-mark-head (car mark-ring))
159 (setq beacon--previous-place (point-marker))
160 (setq beacon--previous-window (selected-window))
161 (setq beacon--previous-window-start (window-start))))
165 (defvar beacon--ovs nil)
167 (defconst beacon-overlay-priority (/ most-positive-fixnum 2)
168 "Priotiy used on all of our overlays.")
170 (defun beacon--make-overlay (length &rest properties)
171 "Put an overlay at point with background COLOR."
172 (let ((ov (make-overlay (point) (+ length (point)))))
173 (overlay-put ov 'beacon t)
174 ;; Our overlay is very temporary, so we take the liberty of giving
175 ;; it a high priority.
176 (overlay-put ov 'priority beacon-overlay-priority)
177 (overlay-put ov 'window (selected-window))
179 (overlay-put ov (pop properties) (pop properties)))
180 (push ov beacon--ovs)
183 (defun beacon--colored-overlay (color)
184 "Put an overlay at point with background COLOR."
185 (beacon--make-overlay 1 'face (list :background color)))
187 (defun beacon--ov-put-after-string (overlay colors)
188 "Add an after-string property to OVERLAY.
189 The property's value is a string of spaces with background
190 COLORS applied to each one.
191 If COLORS is nil, OVERLAY is deleted!"
193 (when (overlayp overlay)
194 (delete-overlay overlay))
195 (overlay-put overlay 'beacon-colors colors)
196 (overlay-put overlay 'after-string
198 (mapconcat (lambda (c) (propertize " " 'face (list :background c)))
203 (defun beacon--after-string-overlay (colors)
204 "Put an overlay at point with an after-string property.
205 The property's value is a string of spaces with background
206 COLORS applied to each one."
207 ;; The after-string must not be longer than the remaining columns
208 ;; from point to right window-end else it will be wrapped around.
209 (let ((colors (seq-take colors (- (window-width) (current-column)))))
210 (beacon--ov-put-after-string (beacon--make-overlay 0) colors)))
212 (defun beacon--ov-at-point ()
213 (car (or (seq-filter (lambda (o) (overlay-get o 'beacon))
214 (overlays-in (point) (point)))
215 (seq-filter (lambda (o) (overlay-get o 'beacon))
216 (overlays-at (point))))))
218 (defun beacon--vanish ()
219 "Turn off the beacon."
220 (when (timerp beacon--timer)
221 (cancel-timer beacon--timer))
222 (mapc #'delete-overlay beacon--ovs)
223 (setq beacon--ovs nil))
227 (defun beacon--int-range (a b)
228 "Return a list of integers between A inclusive and B exclusive.
229 Only returns `beacon-size' elements."
230 (let ((d (/ (- b a) beacon-size))
232 (dotimes (_ (1- beacon-size))
233 (push (+ (car out) d) out))
236 (defun beacon--color-range ()
237 "Return a list of background colors for the beacon."
238 (let* ((default-bg (face-attribute 'default :background))
239 (bg (color-values (if (string-match "\\`unspecified-" default-bg)
240 (face-attribute 'beacon-fallback-background :background)
243 ((stringp beacon-color) (color-values beacon-color))
244 ((< (color-distance "black" bg)
245 (color-distance "white" bg))
246 (make-list 3 (* beacon-color 65535)))
247 (t (make-list 3 (* (- 1 beacon-color) 65535))))))
248 (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b))
249 (mapcar (lambda (n) (butlast (beacon--int-range (elt fg n) (elt bg n))))
254 (defun beacon--shine ()
255 "Shine a beacon at point."
256 (let ((colors (beacon--color-range)))
261 (beacon--after-string-overlay colors)
263 (beacon--colored-overlay (pop colors))
264 (forward-char 1))))))
266 (defun beacon--dec ()
267 "Decrease the beacon brightness by one."
268 (pcase (beacon--ov-at-point)
269 (`nil (beacon--vanish))
270 ((and o (let c (overlay-get o 'beacon-colors)) (guard c))
271 (beacon--ov-put-after-string o (cdr c)))
275 (while (progn (forward-char 1)
276 (setq o (beacon--ov-at-point)))
277 (let ((colors (overlay-get o 'beacon-colors)))
279 (move-overlay o (1- (point)) (point))
281 (beacon--colored-overlay (pop colors))
282 (beacon--ov-put-after-string o colors)
283 (forward-char 1))))))))
285 (defun beacon-blink ()
286 "Blink the beacon at the position of the cursor."
289 ;; Record vars here in case something is blinking outside the
291 (beacon--record-vars)
292 (unless (or (not beacon-mode)
293 (run-hook-with-args-until-success 'beacon-dont-blink-predicates)
294 (seq-find #'derived-mode-p beacon-dont-blink-major-modes)
295 (memq (or this-command last-command) beacon-dont-blink-commands))
298 (run-at-time beacon-blink-delay
299 (/ beacon-blink-duration 1.0 beacon-size)
303 ;;; Movement detection
304 (defun beacon--movement-> (delta-y &optional delta-x)
305 "Return non-nil if latest vertical movement is > DELTA-Y.
306 If DELTA-Y is nil, return nil.
307 The same is true for DELTA-X and horizonta movement."
309 (markerp beacon--previous-place)
310 (equal (marker-buffer beacon--previous-place)
312 ;; Quick check that prevents running the code below in very
313 ;; short movements (like typing).
314 (> (abs (- (point) beacon--previous-place))
318 (> (abs (- (current-column)
320 (goto-char beacon--previous-place)
323 ;; Check if the movement was >= DELTA lines by moving DELTA
324 ;; lines. `count-screen-lines' is too slow if the movement had
325 ;; thousands of lines.
328 (goto-char (min beacon--previous-place p))
329 (vertical-motion delta-y)
330 (> (max p beacon--previous-place)
331 (line-beginning-position)))))))
333 (defun beacon--maybe-push-mark ()
334 "Push mark if it seems to be safe."
335 (when (and (not mark-active)
336 (beacon--movement-> beacon-push-mark))
337 (let ((head (car mark-ring)))
338 (when (and (eq beacon--previous-mark-head head)
339 (not (equal head beacon--previous-place)))
340 (push-mark beacon--previous-place)))))
342 (defun beacon--post-command ()
343 "Blink if point moved very far."
345 ((not (markerp beacon--previous-place))
347 ;; Blink for switching windows.
348 ((and beacon-blink-when-window-changes
349 (not (eq beacon--previous-window (selected-window))))
351 ;; Blink for scrolling.
352 ((and beacon--window-scrolled
353 (equal beacon--window-scrolled (selected-window)))
355 ;; Blink for movement
356 ((beacon--movement-> beacon-blink-when-point-moves-vertically
357 beacon-blink-when-point-moves-horizontally)
359 ;; Even if we don't blink, vanish any previous beacon.
360 (t (beacon--vanish)))
361 (beacon--maybe-push-mark)
362 (setq beacon--window-scrolled nil))
364 (defun beacon--window-scroll-function (win start-pos)
365 "Blink the beacon or record that window has been scrolled.
366 If invoked during the command loop, record the current window so
367 that it may be blinked on post-command. This is because the
368 scrolled window might not be active, but we only know that at
371 If invoked outside the command loop, `post-command-hook' would be
372 unreliable, so just blink immediately."
373 (unless (or (and (equal beacon--previous-window-start start-pos)
374 (equal beacon--previous-window win))
375 (not beacon-blink-when-window-scrolls))
377 (setq beacon--window-scrolled win)
378 (setq beacon--window-scrolled nil)
381 (defun beacon--blink-on-focus ()
382 "Blink if `beacon-blink-when-focused' is non-nil"
383 (when beacon-blink-when-focused
388 (defcustom beacon-lighter
390 ;; ((char-displayable-p ?💡) " 💡")
391 ;; ((char-displayable-p ?Λ) " Λ")
393 "Lighter string used on the mode-line."
397 (define-minor-mode beacon-mode
398 nil nil beacon-lighter nil
402 (add-hook 'window-scroll-functions #'beacon--window-scroll-function)
403 (add-hook 'focus-in-hook #'beacon--blink-on-focus)
404 (add-hook 'post-command-hook #'beacon--post-command)
405 (add-hook 'pre-command-hook #'beacon--record-vars)
406 (add-hook 'pre-command-hook #'beacon--vanish))
407 (remove-hook 'focus-in-hook #'beacon--blink-on-focus)
408 (remove-hook 'window-scroll-functions #'beacon--window-scroll-function)
409 (remove-hook 'post-command-hook #'beacon--post-command)
410 (remove-hook 'pre-command-hook #'beacon--record-vars)
411 (remove-hook 'pre-command-hook #'beacon--vanish)))
414 ;;; beacon.el ends here
417 ;; indent-tabs-mode: nil