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"))
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
34 "Customization group for beacon."
38 (defvar beacon--timer nil)
40 (defcustom beacon-push-mark nil
41 "Should the mark be pushed before long movements?"
44 (defcustom beacon-blink-when-point-moves nil
45 "Should the beacon blink when changing buffer?
46 If nil, don't blink due to plain movement.
47 If non-nil, this should be an integer, which is the minimum
48 movement distance (in lines) that triggers a beacon blink."
49 :type '(choice integer (const nil)))
51 (defcustom beacon-blink-when-buffer-changes t
52 "Should the beacon blink when changing buffer?"
55 (defcustom beacon-blink-when-window-scrolls t
56 "Should the beacon blink when the window scrolls?"
59 (defcustom beacon-blink-duration 0.3
60 "Time, in seconds, that the blink should last."
63 (defcustom beacon-blink-delay 0.3
64 "Time, in seconds, before starting to fade the beacon."
67 (defcustom beacon-size 30
68 "Size of the beacon in characters."
71 (defcustom beacon-brightness 0.4
72 "Brightness as a float between 0 and 1."
77 (defvar beacon--ovs nil)
79 (defun beacon--colored-overlay (color)
80 "Put an overlay at point with background COLOR."
81 (let ((ov (make-overlay (point) (1+ (point)))))
82 (overlay-put ov 'face (list :background color))
83 (overlay-put ov 'beacon t)
84 (push ov beacon--ovs)))
86 (defun beacon--ov-at-point ()
87 (car (cl-member-if (lambda (o) (overlay-get o 'beacon))
88 (overlays-at (point)))))
90 (defun beacon--vanish ()
91 "Turn off the beacon."
92 (when (timerp beacon--timer)
93 (cancel-timer beacon--timer))
94 (mapc #'delete-overlay beacon--ovs)
95 (setq beacon--ovs nil))
99 (defun beacon--int-range (a b)
100 "Return a list of integers between A inclusive and B exclusive.
101 Only returns `beacon-size' elements."
102 (let ((d (/ (- b a) beacon-size))
104 (dotimes (_ (1- beacon-size))
105 (push (+ (car out) d) out))
108 (defun beacon--color-range ()
109 "Return a list of background colors for the beacon."
110 (let ((bg (color-values (face-attribute 'default :background))))
111 (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b))
112 (if (< (color-distance "black" bg)
113 (color-distance "white" bg))
114 (mapcar (lambda (n) (butlast (beacon--int-range (* beacon-brightness 65535) n))) bg)
115 (mapcar (lambda (n) (cdr (beacon--int-range (* (- 1 beacon-brightness) 65535) n))) bg)))))
119 (defun beacon--shine ()
120 "Shine a beacon at point."
121 (let ((colors (beacon--color-range)))
126 ;; (beacon--after-string)
128 (beacon--colored-overlay (pop colors))
129 (forward-char 1))))))
131 (defun beacon--dec ()
132 "Decrease the beacon brightness by one."
133 (let ((o (beacon--ov-at-point)))
138 (while (progn (forward-char 1)
139 (setq o (beacon--ov-at-point)))
140 (move-overlay o (1- (point)) (point)))))))
142 (defun beacon-blink ()
143 "Blink the beacon at the position of the cursor."
148 (run-at-time beacon-blink-delay
149 (/ beacon-blink-duration 1.0 beacon-size)
153 ;;; Movement detection
154 (defvar beacon--previous-place nil)
155 (defvar beacon--previous-window-start nil)
156 (defvar beacon--previous-mark-head nil)
158 (defun beacon--maybe-push-mark ()
159 "Push mark if it seems to be safe."
160 (when (and beacon-push-mark
162 (let ((head (car mark-ring)))
163 (when (and (eq beacon--previous-mark-head head)
164 (not (equal head beacon--previous-place)))
165 (push-mark beacon--previous-place)))))
167 (defun beacon--post-command ()
168 "Blink if point moved very far."
170 ((not (markerp beacon--previous-place))
172 ;; Blink because we changed buffer.
173 ((not (equal (marker-buffer beacon--previous-place)
175 (when beacon-blink-when-buffer-changes
176 (unless (window-minibuffer-p)
178 ;; Blink for scrolling.
179 ((and beacon-blink-when-window-scrolls
181 (not (equal beacon--previous-window-start (window-start)))))
182 (beacon--maybe-push-mark)
184 ;; Blink for movement
185 ((and beacon-blink-when-point-moves
186 (> (abs (- (point) beacon--previous-place))
187 beacon-blink-when-point-moves)
188 (> (count-screen-lines (min (point) beacon--previous-place)
189 (max (point) beacon--previous-place))))
190 (beacon--maybe-push-mark)
192 ;; Even if we don't blink, vanish any previous beacon.
193 (t (beacon--vanish)))
194 (unless (window-minibuffer-p)
195 (setq beacon--previous-window-start (window-start))
196 (setq beacon--previous-mark-head (car mark-ring))
197 (setq beacon--previous-place (point-marker))))
201 (defcustom beacon-lighter (cond
202 ((char-displayable-p ?💡) "💡")
203 ((char-displayable-p ?Λ) "Λ")
205 "Lighter string used on the mode-line."
209 (define-minor-mode beacon-mode
210 nil nil beacon-lighter nil
213 (add-hook 'post-command-hook #'beacon--post-command)
214 (remove-hook 'post-command-hook #'beacon--post-command)))
217 ;;; beacon.el ends here