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
 ;; 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
 
 ;; 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)
 ;;; 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."
 
 (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)
 
 
 (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))
 
   "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
   "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."
 
 (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))
          (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))))))
                (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]))))
 
            (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)))
     (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."
 
 (defun beacon--post-command ()
   "Blink if point moved very far."