Fix #39 - Allow for the absence of a background color

[gnu-emacs-elpa] / beacon.el

diff --git a/beacon.el b/beacon.el
index fa1e603b60e5b7752eebfd99b9b6d5e17ce8859a..3ae584d39af5774a86965345c3fb7b85eb488ac0 100644 (file)
--- a/beacon.el
+++ b/beacon.el
@@ -5,8 +5,8 @@
 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
 ;; URL: https://github.com/Malabarba/beacon
 ;; Keywords: convenience
-;; Version: 0.3
-;; Package-Requires: ((seq "1.9") (cl-lib "0.5"))
+;; Version: 0.5.1
+;; Package-Requires: ((seq "1.11"))
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -38,7 +38,24 @@
 ;;; Code:
 
 (require 'seq)
-(require 'cl-lib)
+(require 'faces)
+(unless (fboundp 'seq-mapn)
+  ;; This is for people who are on outdated Emacs snapshots. Will be
+  ;; deleted in a couple of weeks.
+  (defun seq-mapn (function sequence &rest sequences)
+    "Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
+The arity of FUNCTION must match the number of SEQUENCES, and the
+mapping stops on the shortest sequence.
+Return a list of the results.
+
+\(fn FUNCTION SEQUENCES...)"
+    (let ((result nil)
+          (sequences (seq-map (lambda (s) (seq-into s 'list))
+                            (cons sequence sequences))))
+      (while (not (memq nil sequences))
+        (push (apply function (seq-map #'car sequences)) result)
+        (setq sequences (seq-map #'cdr sequences)))
+      (nreverse result))))
 
 (defgroup beacon nil
   "Customization group for beacon."
@@ -132,14 +149,16 @@ For instance, if you want to disable beacon on buffers where
 
 (add-hook 'beacon-dont-blink-predicates #'window-minibuffer-p)
 
-(defcustom beacon-dont-blink-major-modes '(magit-status-mode magit-popup-mode)
+(defcustom beacon-dont-blink-major-modes '(t magit-status-mode magit-popup-mode
+                                       gnus-summary-mode gnus-group-mode)
   "A list of major-modes where the beacon won't blink.
 Whenever the current buffer satisfies `derived-mode-p' for
 one of the major-modes on this list, the beacon will not
 blink."
   :type '(repeat symbol))
 
-(defcustom beacon-dont-blink-commands '(recenter-top-bottom)
+(defcustom beacon-dont-blink-commands '(next-line previous-line
+                                            forward-line)
   "A list of commands that should not make the beacon blink.
 Use this for commands that scroll the window in very
 predictable ways, when the blink would be more distracting
@@ -236,17 +255,23 @@ Only returns `beacon-size' elements."
 
 (defun beacon--color-range ()
   "Return a list of background colors for the beacon."
-  (let* ((default-bg (face-attribute 'default :background))
+  (let* ((default-bg (or (save-excursion
+                           (unless (eobp)
+                             (forward-line 1)
+                             (unless (bobp) (forward-char -1)))
+                           (background-color-at-point))
+                         (face-background 'default)))
          (bg (color-values (if (string-match "\\`unspecified-" default-bg)
                                (face-attribute 'beacon-fallback-background :background)
                              default-bg)))
          (fg (cond
               ((stringp beacon-color) (color-values beacon-color))
-              ((< (color-distance "black" bg)
-                  (color-distance "white" bg))
+              ((and (stringp bg)
+                    (< (color-distance "black" bg)
+                       (color-distance "white" 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))
+    (apply #'seq-mapn (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]))))
 
@@ -338,7 +363,7 @@ The same is true for DELTA-X and horizonta movement."
     (let ((head (car mark-ring)))
       (when (and (eq beacon--previous-mark-head head)
                  (not (equal head beacon--previous-place)))
-        (push-mark beacon--previous-place)))))
+        (push-mark beacon--previous-place 'silent)))))
 
 (defun beacon--post-command ()
   "Blink if point moved very far."