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 ;; Keywords: convenience
8 ;; Package-Requires: ((cl-lib "0.5"))
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;; This is a global minor-mode. Turn it on everywhere with
33 "Customization group for beacon."
37 (defvar beacon--timer nil)
39 (defcustom beacon-minimum-distance 15
40 "Minimum movement distance in lines to blink the beacon."
43 (defcustom beacon-push-mark nil
44 "Should the mark be pushed before long movements?"
47 (defcustom beacon-blink-when-buffer-changes t
48 "Should the beacon blink when changing buffer?"
51 (defcustom beacon-blink-duration 0.3
52 "Time, in seconds, that the blink should last."
55 (defcustom beacon-blink-delay 0.3
56 "Time, in seconds, before starting to fade the beacon."
59 (defcustom beacon-size 30
60 "Size of the beacon in characters."
63 (defcustom beacon-brightness 0.5
64 "Brightness as a float between 0 and 1."
69 (defvar beacon--ovs nil)
71 (defun beacon--colored-overlay (color)
72 "Put an overlay at point with background COLOR."
73 (let ((ov (make-overlay (point) (1+ (point)))))
74 (overlay-put ov 'face (list :background color))
75 (overlay-put ov 'beacon t)
76 (push ov beacon--ovs)))
78 (defun beacon--ov-at-point ()
79 (car (cl-member-if (lambda (o) (overlay-get o 'beacon))
80 (overlays-at (point)))))
82 (defun beacon--vanish ()
83 "Turn off the beacon."
84 (when (timerp beacon--timer)
85 (cancel-timer beacon--timer))
86 (mapc #'delete-overlay beacon--ovs)
87 (setq beacon--ovs nil))
91 (defun beacon--int-range (a b)
92 "Return a list of integers between A inclusive and B exclusive.
93 Only returns `beacon-size' elements."
94 (let ((d (/ (- b a) beacon-size))
96 (dotimes (_ (1- beacon-size))
97 (push (+ (car out) d) out))
100 (defun beacon--color-range ()
101 "Return a list of background colors for the beacon."
102 (let ((bg (color-values (face-attribute 'default :background))))
103 (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b))
104 (if (< (color-distance "black" bg)
105 (color-distance "white" bg))
106 (mapcar (lambda (n) (butlast (beacon--int-range (* beacon-brightness 65535) n))) bg)
107 (mapcar (lambda (n) (cdr (beacon--int-range (* (- 1 beacon-brightness) 65535) n))) bg)))))
111 (defun beacon--shine ()
112 "Shine a beacon at point."
113 (let ((colors (beacon--color-range)))
118 ;; (beacon--after-string)
120 (beacon--colored-overlay (pop colors))
121 (forward-char 1))))))
123 (defun beacon--dec ()
124 "Decrease the beacon brightness by one."
125 (let ((o (beacon--ov-at-point)))
130 (while (progn (forward-char 1)
131 (setq o (beacon--ov-at-point)))
132 (move-overlay o (1- (point)) (point)))))))
134 (defun beacon-blink ()
135 "Blink the beacon at the position of the cursor."
140 (run-at-time beacon-blink-delay
141 (/ beacon-blink-duration 1.0 beacon-size)
145 ;;; Movement detection
146 (defvar beacon--previous-place nil)
147 (defvar beacon--previous-mark-head nil)
149 (defun beacon--maybe-push-mark ()
150 "Push mark if it seems to be safe."
151 (when (and beacon-push-mark
153 (let ((head (car mark-ring)))
154 (when (and (eq beacon--previous-mark-head head)
155 (not (equal head beacon--previous-place)))
156 (push-mark beacon--previous-place)))))
158 (defun beacon--post-command ()
159 "Blink if point moved very far."
161 ((not (markerp beacon--previous-place))
163 ;; Blink because we changed buffer.
164 ((not (equal (marker-buffer beacon--previous-place)
166 (when beacon-blink-when-buffer-changes
167 (unless (window-minibuffer-p)
169 ;; Blink for distance movement
170 ((and (> (abs (- (point) beacon--previous-place))
171 beacon-minimum-distance)
172 (> (count-screen-lines (min (point) beacon--previous-place)
173 (max (point) beacon--previous-place))
174 beacon-minimum-distance))
175 (beacon--maybe-push-mark)
177 ;; Even if we don't blink, vanish any previous beacon.
178 (t (beacon--vanish)))
179 (unless (window-minibuffer-p)
180 (setq beacon--previous-mark-head (car mark-ring))
181 (setq beacon--previous-place (point-marker))))
185 (defcustom beacon-lighter (cond
186 ((char-displayable-p ?💡) "💡")
187 ((char-displayable-p ?Λ) "Λ")
189 "Lighter string used on the mode-line."
193 (define-minor-mode beacon-mode
194 nil nil beacon-lighter nil
197 (add-hook 'post-command-hook #'beacon--post-command)
198 (remove-hook 'post-command-hook #'beacon--post-command)))
201 ;;; beacon.el ends here