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: ((cl-lib "0.5") (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
35 "Customization group for beacon."
39 (defvar beacon--timer nil)
41 (defcustom beacon-push-mark nil
42 "Should the mark be pushed before long movements?
43 If nil, `beacon' will not push the mark.
44 Otherwise this should be a number, and `beacon' will push the
45 mark whenever point moves more than that many lines."
46 :type '(choice integer (const nil)))
48 (defcustom beacon-blink-when-point-moves nil
49 "Should the beacon blink when moving a long distance?
50 If nil, don't blink due to plain movement.
51 If non-nil, this should be an integer, which is the minimum
52 movement distance (in lines) that triggers a beacon blink."
53 :type '(choice integer (const nil)))
55 (defcustom beacon-blink-when-buffer-changes t
56 "Should the beacon blink when changing buffer?"
59 (defcustom beacon-blink-when-window-scrolls t
60 "Should the beacon blink when the window scrolls?"
63 (defcustom beacon-blink-duration 0.3
64 "Time, in seconds, that the blink should last."
67 (defcustom beacon-blink-delay 0.3
68 "Time, in seconds, before starting to fade the beacon."
71 (defcustom beacon-size 40
72 "Size of the beacon in characters."
75 (defcustom beacon-color 0.5
77 This can be a string or a number.
79 If it is a number, the color is taken to be white or
80 black (depending on the current theme's background) and this
81 number is a float between 0 and 1 specifing the brightness.
83 If it is a string, it is a color name or specification,
85 :type '(choice number color))
89 (defvar beacon--ovs nil)
91 (defun beacon--colored-overlay (color)
92 "Put an overlay at point with background COLOR."
93 (let ((ov (make-overlay (point) (1+ (point)))))
94 (overlay-put ov 'face (list :background color))
95 (overlay-put ov 'beacon t)
96 (push ov beacon--ovs)))
98 (defun beacon--ov-put-after-string (overlay colors)
99 "Add an after-string property to OVERLAY.
100 The property's value is a string of spaces with background
101 COLORS applied to each one."
103 (delete-overlay overlay)
104 (overlay-put overlay 'beacon-colors colors)
105 (overlay-put overlay 'after-string
107 (mapconcat (lambda (c) (propertize " " 'face (list :background c)))
112 (defun beacon--after-string-overlay (colors)
113 "Put an overlay at point with an after-string property.
114 The property's value is a string of spaces with background
115 COLORS applied to each one."
116 (let ((ov (make-overlay (point) (point)))
117 ;; The after-string must not be longer than the remaining columns from
118 ;; point to right window-end else it will be wrapped around (assuming
119 ;; truncate-lines is nil) introducing an ugly wrap-around for a
120 ;; fraction of a second.
121 (colors (seq-take colors (- (window-width) (current-column)))))
122 (beacon--ov-put-after-string ov colors)
123 (overlay-put ov 'beacon t)
124 (push ov beacon--ovs)))
126 (defun beacon--ov-at-point ()
127 (car (or (cl-member-if (lambda (o) (overlay-get o 'beacon))
128 (overlays-in (point) (point)))
129 (cl-member-if (lambda (o) (overlay-get o 'beacon))
130 (overlays-at (point))))))
132 (defun beacon--vanish ()
133 "Turn off the beacon."
134 (when (timerp beacon--timer)
135 (cancel-timer beacon--timer))
136 (mapc #'delete-overlay beacon--ovs)
137 (setq beacon--ovs nil))
141 (defun beacon--int-range (a b)
142 "Return a list of integers between A inclusive and B exclusive.
143 Only returns `beacon-size' elements."
144 (let ((d (/ (- b a) beacon-size))
146 (dotimes (_ (1- beacon-size))
147 (push (+ (car out) d) out))
150 (defun beacon--color-range ()
151 "Return a list of background colors for the beacon."
152 (let* ((bg (color-values (face-attribute 'default :background)))
154 ((stringp beacon-color) (color-values beacon-color))
155 ((< (color-distance "black" bg)
156 (color-distance "white" bg))
157 (make-list 3 (* beacon-color 65535)))
158 (t (make-list 3 (* (- 1 beacon-color) 65535))))))
159 (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b))
160 (mapcar (lambda (n) (butlast (beacon--int-range (elt fg n) (elt bg n))))
165 (defun beacon--shine ()
166 "Shine a beacon at point."
167 (let ((colors (beacon--color-range)))
172 (beacon--after-string-overlay colors)
174 (beacon--colored-overlay (pop colors))
175 (forward-char 1))))))
177 (defun beacon--dec ()
178 "Decrease the beacon brightness by one."
179 (pcase (beacon--ov-at-point)
180 (`nil (beacon--vanish))
181 ((and o (let c (overlay-get o 'beacon-colors)) (guard c))
182 (beacon--ov-put-after-string o (cdr c)))
186 (while (progn (forward-char 1)
187 (setq o (beacon--ov-at-point)))
188 (let ((colors (overlay-get o 'beacon-colors)))
190 (move-overlay o (1- (point)) (point))
192 (beacon--colored-overlay (pop colors))
193 (beacon--ov-put-after-string o colors)
194 (forward-char 1))))))))
196 (defun beacon-blink ()
197 "Blink the beacon at the position of the cursor."
202 (run-at-time beacon-blink-delay
203 (/ beacon-blink-duration 1.0 beacon-size)
207 ;;; Movement detection
208 (defvar beacon--previous-place nil)
209 (defvar beacon--previous-window-start nil)
210 (defvar beacon--previous-mark-head nil)
212 (defun beacon--movement-> (delta)
213 "Return non-nil if latest point movement is > DELTA.
214 If DELTA is nil, return nil."
216 (markerp beacon--previous-place)
217 (equal (marker-buffer beacon--previous-place)
219 (> (abs (- (point) beacon--previous-place))
221 (> (count-screen-lines (min (point) beacon--previous-place)
222 (max (point) beacon--previous-place))
225 (defun beacon--maybe-push-mark ()
226 "Push mark if it seems to be safe."
227 (when (and (not mark-active)
228 (beacon--movement-> beacon-push-mark))
229 (let ((head (car mark-ring)))
230 (when (and (eq beacon--previous-mark-head head)
231 (not (equal head beacon--previous-place)))
232 (push-mark beacon--previous-place)))))
234 (defun beacon--post-command ()
235 "Blink if point moved very far."
237 ((not (markerp beacon--previous-place))
239 ;; Blink because we changed buffer.
240 ((not (equal (marker-buffer beacon--previous-place)
242 (when beacon-blink-when-buffer-changes
243 (unless (window-minibuffer-p)
245 ;; Blink for scrolling.
246 ((and beacon-blink-when-window-scrolls
248 (not (equal beacon--previous-window-start (window-start)))))
250 ;; Blink for movement
251 ((beacon--movement-> beacon-blink-when-point-moves)
253 ;; Even if we don't blink, vanish any previous beacon.
254 (t (beacon--vanish)))
255 (beacon--maybe-push-mark)
256 (unless (window-minibuffer-p)
257 (setq beacon--previous-window-start (window-start))
258 (setq beacon--previous-mark-head (car mark-ring))
259 (setq beacon--previous-place (point-marker))))
263 (defcustom beacon-lighter (cond
264 ((char-displayable-p ?💡) " 💡")
265 ((char-displayable-p ?Λ) " Λ")
267 "Lighter string used on the mode-line."
271 (define-minor-mode beacon-mode
272 nil nil beacon-lighter nil
275 (add-hook 'post-command-hook #'beacon--post-command)
276 (remove-hook 'post-command-hook #'beacon--post-command)))
279 ;;; beacon.el ends here