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?
42 If nil, `beacon' will not push the mark.
43 Otherwise this should be a number, and `beacon' will push the
44 mark whenever point moves more than that many lines."
45 :type '(choice integer (const nil)))
47 (defcustom beacon-blink-when-point-moves nil
48 "Should the beacon blink when moving a long distance?
49 If nil, don't blink due to plain movement.
50 If non-nil, this should be an integer, which is the minimum
51 movement distance (in lines) that triggers a beacon blink."
52 :type '(choice integer (const nil)))
54 (defcustom beacon-blink-when-buffer-changes t
55 "Should the beacon blink when changing buffer?"
58 (defcustom beacon-blink-when-window-scrolls t
59 "Should the beacon blink when the window scrolls?"
62 (defcustom beacon-blink-duration 0.3
63 "Time, in seconds, that the blink should last."
66 (defcustom beacon-blink-delay 0.3
67 "Time, in seconds, before starting to fade the beacon."
70 (defcustom beacon-size 40
71 "Size of the beacon in characters."
74 (defcustom beacon-brightness 0.4
75 "Brightness as a float between 0 and 1."
80 (defvar beacon--ovs nil)
82 (defun beacon--colored-overlay (color)
83 "Put an overlay at point with background COLOR."
84 (let ((ov (make-overlay (point) (1+ (point)))))
85 (overlay-put ov 'face (list :background color))
86 (overlay-put ov 'beacon t)
87 (push ov beacon--ovs)))
89 (defun beacon--ov-at-point ()
90 (car (cl-member-if (lambda (o) (overlay-get o 'beacon))
91 (overlays-at (point)))))
93 (defun beacon--vanish ()
94 "Turn off the beacon."
95 (when (timerp beacon--timer)
96 (cancel-timer beacon--timer))
97 (mapc #'delete-overlay beacon--ovs)
98 (setq beacon--ovs nil))
102 (defun beacon--int-range (a b)
103 "Return a list of integers between A inclusive and B exclusive.
104 Only returns `beacon-size' elements."
105 (let ((d (/ (- b a) beacon-size))
107 (dotimes (_ (1- beacon-size))
108 (push (+ (car out) d) out))
111 (defun beacon--color-range ()
112 "Return a list of background colors for the beacon."
113 (let ((bg (color-values (face-attribute 'default :background))))
114 (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b))
115 (if (< (color-distance "black" bg)
116 (color-distance "white" bg))
117 (mapcar (lambda (n) (butlast (beacon--int-range (* beacon-brightness 65535) n))) bg)
118 (mapcar (lambda (n) (cdr (beacon--int-range (* (- 1 beacon-brightness) 65535) n))) bg)))))
122 (defun beacon--shine ()
123 "Shine a beacon at point."
124 (let ((colors (beacon--color-range)))
129 ;; (beacon--after-string)
131 (beacon--colored-overlay (pop colors))
132 (forward-char 1))))))
134 (defun beacon--dec ()
135 "Decrease the beacon brightness by one."
136 (let ((o (beacon--ov-at-point)))
141 (while (progn (forward-char 1)
142 (setq o (beacon--ov-at-point)))
143 (move-overlay o (1- (point)) (point)))))))
145 (defun beacon-blink ()
146 "Blink the beacon at the position of the cursor."
151 (run-at-time beacon-blink-delay
152 (/ beacon-blink-duration 1.0 beacon-size)
156 ;;; Movement detection
157 (defvar beacon--previous-place nil)
158 (defvar beacon--previous-window-start nil)
159 (defvar beacon--previous-mark-head nil)
161 (defun beacon--movement-> (delta)
162 "Return non-nil if latest point movement is > DELTA.
163 If DELTA is nil, return nil."
165 (equal (marker-buffer beacon--previous-place)
167 (> (abs (- (point) beacon--previous-place))
169 (> (count-screen-lines (min (point) beacon--previous-place)
170 (max (point) beacon--previous-place))
173 (defun beacon--maybe-push-mark ()
174 "Push mark if it seems to be safe."
175 (when (and (not mark-active)
176 (beacon--movement-> beacon-push-mark))
177 (let ((head (car mark-ring)))
178 (when (and (eq beacon--previous-mark-head head)
179 (not (equal head beacon--previous-place)))
180 (push-mark beacon--previous-place)))))
182 (defun beacon--post-command ()
183 "Blink if point moved very far."
185 ((not (markerp beacon--previous-place))
187 ;; Blink because we changed buffer.
188 ((not (equal (marker-buffer beacon--previous-place)
190 (when beacon-blink-when-buffer-changes
191 (unless (window-minibuffer-p)
193 ;; Blink for scrolling.
194 ((and beacon-blink-when-window-scrolls
196 (not (equal beacon--previous-window-start (window-start)))))
198 ;; Blink for movement
199 ((beacon--movement-> beacon-blink-when-point-moves)
201 ;; Even if we don't blink, vanish any previous beacon.
202 (t (beacon--vanish)))
203 (beacon--maybe-push-mark)
204 (unless (window-minibuffer-p)
205 (setq beacon--previous-window-start (window-start))
206 (setq beacon--previous-mark-head (car mark-ring))
207 (setq beacon--previous-place (point-marker))))
211 (defcustom beacon-lighter (cond
212 ((char-displayable-p ?💡) "💡")
213 ((char-displayable-p ?Λ) "Λ")
215 "Lighter string used on the mode-line."
219 (define-minor-mode beacon-mode
220 nil nil beacon-lighter nil
223 (add-hook 'post-command-hook #'beacon--post-command)
224 (remove-hook 'post-command-hook #'beacon--post-command)))
227 ;;; beacon.el ends here