Make beacon color customizable

[gnu-emacs-elpa] / beacon.el

diff --git a/beacon.el b/beacon.el
index 66e6d20fb4679cf6120d13df3555175e64128fce..18d48190817cb666be024ca872ee6962871ffa10 100644 (file)
--- a/beacon.el
+++ b/beacon.el
@@ -38,11 +38,14 @@
 (defvar beacon--timer nil)
 
 (defcustom beacon-push-mark nil
-  "Should the mark be pushed before long movements?"
-  :type 'boolean)
+  "Should the mark be pushed before long movements?
+If nil, `beacon' will not push the mark.
+Otherwise this should be a number, and `beacon' will push the
+mark whenever point moves more than that many lines."
+  :type '(choice integer (const nil)))
 
 (defcustom beacon-blink-when-point-moves nil
-  "Should the beacon blink when changing buffer?
+  "Should the beacon blink when moving a long distance?
 If nil, don't blink due to plain movement.
 If non-nil, this should be an integer, which is the minimum
 movement distance (in lines) that triggers a beacon blink."
@@ -64,13 +67,21 @@ movement distance (in lines) that triggers a beacon blink."
   "Time, in seconds, before starting to fade the beacon."
   :type 'number)
 
-(defcustom beacon-size 30
+(defcustom beacon-size 40
   "Size of the beacon in characters."
   :type 'number)
 
-(defcustom beacon-brightness 0.4
-  "Brightness as a float between 0 and 1."
-  :type 'number)
+(defcustom beacon-color 0.5
+  "Color of the beacon.
+This can be a string or a number.
+
+If it is a number, the color is taken to be white or
+black (depending on the current theme's background) and this
+number is a float between 0 and 1 specifing the brightness.
+
+If it is a string, it is a color name or specification,
+e.g. \"#666600\"."
+  :type '(choice number color))
 
 \f
 ;;; Overlays
@@ -107,12 +118,16 @@ Only returns `beacon-size' elements."
 
 (defun beacon--color-range ()
   "Return a list of background colors for the beacon."
-  (let ((bg (color-values (face-attribute 'default :background))))
-    (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b))
-           (if (< (color-distance "black" bg)
+  (let* ((bg (color-values (face-attribute 'default :background)))
+         (fg (cond
+              ((stringp beacon-color) (color-values beacon-color))
+              ((< (color-distance "black" bg)
                   (color-distance "white" bg))
-               (mapcar (lambda (n) (butlast (beacon--int-range (* beacon-brightness 65535) n))) bg)
-             (mapcar (lambda (n) (cdr (beacon--int-range (* (- 1 beacon-brightness) 65535) n))) bg)))))
+               (make-list 3 (* beacon-color 65535)))
+              (t (make-list 3 (* (- 1 beacon-color) 65535))))))
+    (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b))
+           (mapcar (lambda (n) (butlast (beacon--int-range (elt fg n) (elt bg n))))
+                   [0 1 2]))))
 
 \f
 ;;; Blinking
@@ -155,10 +170,22 @@ Only returns `beacon-size' elements."
 (defvar beacon--previous-window-start nil)
 (defvar beacon--previous-mark-head nil)
 
+(defun beacon--movement-> (delta)
+  "Return non-nil if latest point movement is > DELTA.
+If DELTA is nil, return nil."
+  (and delta
+       (equal (marker-buffer beacon--previous-place)
+              (current-buffer))
+       (> (abs (- (point) beacon--previous-place))
+          delta)
+       (> (count-screen-lines (min (point) beacon--previous-place)
+                              (max (point) beacon--previous-place))
+          delta)))
+
 (defun beacon--maybe-push-mark ()
   "Push mark if it seems to be safe."
-  (when (and beacon-push-mark
-             (not mark-active))
+  (when (and (not mark-active)
+             (beacon--movement-> beacon-push-mark))
     (let ((head (car mark-ring)))
       (when (and (eq beacon--previous-mark-head head)
                  (not (equal head beacon--previous-place)))
@@ -179,18 +206,13 @@ Only returns `beacon-size' elements."
    ((and beacon-blink-when-window-scrolls
          (progn (redisplay)
                 (not (equal beacon--previous-window-start (window-start)))))
-    (beacon--maybe-push-mark)
     (beacon-blink))
    ;; Blink for movement
-   ((and beacon-blink-when-point-moves
-         (> (abs (- (point) beacon--previous-place))
-            beacon-blink-when-point-moves)
-         (> (count-screen-lines (min (point) beacon--previous-place)
-                                (max (point) beacon--previous-place))))
-    (beacon--maybe-push-mark)
+   ((beacon--movement-> beacon-blink-when-point-moves)
     (beacon-blink))
    ;; Even if we don't blink, vanish any previous beacon.
    (t (beacon--vanish)))
+  (beacon--maybe-push-mark)
   (unless (window-minibuffer-p)
     (setq beacon--previous-window-start (window-start))
     (setq beacon--previous-mark-head (car mark-ring))