bug#63569: 30.0.50; ERC 5.6: Add automatic nickname highlighting to ERC

["J.P." <jp@neverwas.me>]

[-- Attachment #1: Type: text/plain, Size: 2547 bytes --]

"J.P." <jp@neverwas.me> writes:

> Currently, users on a non-graphical, non 24-bit Emacs who provide their
> own `erc-nicks-colors' pool must ensure those colors fall within
> `erc-nicks-contrast-range' and `erc-nicks-saturation-range' (assuming a
> non-nil `erc-nicks-color-adjustments', the default). Otherwise, their
> pool is subject to culling without warning on module init, which they
> may find frustrating even though this behavior is documented. If people
> believe this to be a grave enough annoyance, we can do something like
> the attached, which offers a couple alternate pool-prep approaches that
> "pre-treat" candidates with `erc-nicks-color-adjustments' and coerce
> them to predefined system palette members, thus effectively culling by
> way of deduping.
>
> If actually doing this, we'd likely have to add a public-facing knob
> for selecting between various fixed-pool filtering styles, such as:
>
>  - cull (current)
>  - treat, coerce, and cull
>  - treat and coerce
>
> The latter two differ in that the first rechecks if the remapped
> "defined" value still falls within specified tolerances, and drops it if
> it doesn't, while the last approach turns a blind eye. IMO, the first is
> of limited value unless we were to make it try repeatedly to find a
> satisfactory match. Although these only run on init, folks may find them
> too sluggish (both are already quadratic). We could instead make them
> interactive commands (or `custom-set' functions) that users can use to
> populate `erc-nicks-colors' while configuring.
>
> Personally, I'm not affected by the current behavior because I use
> graphical Emacs or a 24-bit terminal emulator with ERC. However, I'm
> open to doing this if others think it worthwhile. Thanks.

A user on Libera requested some time ago that pool-creation facilities
like the ones mentioned above be added to erc-nicks. The attached patch
does this but in a simplified manner that avoids adding additional user
options. Instead, it defaults to the "blind eye" approach mentioned
above since (IMO) it's likeliest to meet user expectations.

The patch also adds two ready-made Custom choice variants to the option
`erc-nick-colors': `font-lock' and `ansi-color'. These are predefined
sets of candidates for the (repeat string) :type variant. As may be
obvious, ERC interprets these symbols as palettes to be populated from
the :foreground colors of whatever font-lock- and ansi-color-related
faces exist for the current theme.

There's also a minor bug fix involving initialization ordering.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 15007 bytes --]

From 9aff22914d85d92ca2665c6fc5b3359217b5d766 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 7 Nov 2023 02:03:27 -0800
Subject: [PATCH 0/1] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (1):
  [5.6] Offer alternate pool-creation strategies in erc-nicks

 lisp/erc/erc-nicks.el            | 87 +++++++++++++++++++++++++++-----
 test/lisp/erc/erc-nicks-tests.el | 79 ++++++++++++++++++++---------
 2 files changed, 129 insertions(+), 37 deletions(-)

Interdiff:
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index 3e5bf2b8d3f..d512455090b 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -102,7 +102,10 @@ erc-nicks-bg-color
   (frame-parameter (selected-frame) 'background-color)
   "Background color for calculating contrast.
 Set this explicitly when the background color isn't discoverable,
-which may be the case in terminal Emacs."
+which may be the case in terminal Emacs.  Even when automatically
+initialized, this value may need adjustment mid-session, such as
+after loading a new theme.  Remember to run \\[erc-nicks-refresh]
+after doing so."
   :type 'string)
 
 (defcustom erc-nicks-color-adjustments
@@ -153,9 +156,13 @@ erc-nicks-colors
 single symbol representing a set of colors, like that produced by
 the function `defined-colors', which ERC associates with the
 symbol `defined'.  Similarly, `all' tells ERC to use any 24-bit
-color.  When specifying a list, users may want to set the option
-`erc-nicks-color-adjustments' to nil to prevent unwanted culling."
-  :type '(choice (const all) (const defined) (repeat string)))
+color.  To change the value mid-session, try
+\\[erc-nicks-refresh]."
+  :type `(choice (const :tag "All 24-bit colors" all)
+                 (const :tag "Defined terminal colors" defined)
+                 (const :tag "Font Lock faces" font-lock)
+                 (const :tag "ANSI color faces" ansi-color)
+                 (repeat :tag "User-provided list" string)))
 
 (defcustom erc-nicks-key-suffix-format "@%n"
   "Template for latter portion of keys to generate colors from.
@@ -227,6 +234,7 @@ erc-nicks--bg-mode
 
 ;; https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html
 (defun erc-nicks--adjust-contrast (color target &optional decrease)
+  (cl-assert erc-nicks--fg-rgb)
   (let* ((lum-bg (or erc-nicks--bg-luminance
                      (setq erc-nicks--bg-luminance
                            (erc-nicks--get-luminance erc-nicks-bg-color))))
@@ -356,51 +364,26 @@ erc-nicks--reduce
                      erc-nicks-color-adjustments
                      (if (stringp color) (color-name-to-rgb color) color))))
 
-(defvar erc-nicks--create-pool-function #'erc-nicks--create-adjusted-pool)
-
-(defun erc-nicks--create-adjusted-pool (adjustments colors)
-  "Return COLORS that fall within parameters indicated by ADJUSTMENTS.
-Apply adjustments before replacing COLORS with the nearest
-defined, and then cull those that still don't meet the grade.
-Expect to operate on user-provided lists of `erc-nicks-colors'
-rather than all those `defined' by the system."
-  (let* ((seen (make-hash-table :test #'equal))
-         (valmax (float (car (color-values "#ffffffffffff"))))
-         (erc-nicks-color-adjustments adjustments)
-         addp capp satp pool)
-    (dolist (adjustment adjustments)
-      (pcase adjustment
-        ((or 'erc-nicks-invert 'erc-nicks-add-contrast) (setq addp t))
-        ('erc-nicks-cap-contrast (setq capp t))
-        ('erc-nicks-ensaturate (setq satp t))))
-    (dolist (color colors)
-      (pcase-let ((`(,quantized ,_ . ,vals)
-                   (tty-color-approximate (color-values
-                                           (erc-nicks--reduce color)))))
-        (if (gethash quantized seen)
-            (when erc-nicks--colors-rejects
-              (push color erc-nicks--colors-rejects))
-          (let* ((rgb (mapcar (lambda (x) (/ x valmax)) vals))
-                 (contrast (and (or addp capp) (erc-nicks--get-contrast rgb))))
-            (if (or (and addp (< contrast (car erc-nicks-contrast-range)))
-                    (and capp (> contrast (cdr erc-nicks-contrast-range)))
-                    (and-let* ((satp)
-                               (s (cadr (apply #'color-rgb-to-hsl rgb))))
-                      (or (< s (car erc-nicks-saturation-range))
-                          (> s (cdr erc-nicks-saturation-range)))))
-                (when erc-nicks--colors-rejects
-                  (push color erc-nicks--colors-rejects))
-              (push quantized pool)
-              (puthash quantized color seen))))))
-    (nreverse pool)))
+(defvar erc-nicks--create-pool-function #'erc-nicks--create-coerced-pool
+  "Filter function for initializing the pool of colors.
+Takes a list of adjustment functions, such as those named in
+`erc-nicks-color-adjustments', and a list of colors.  Returns
+another list whose members need not be among the original
+candidates.  Users should note that this variable, along with its
+predefined function values, `erc-nicks--create-coerced-pool' and
+`erc-nicks--create-culled-pool', can be made public in a future
+version of this module, perhaps as a single user option, given
+sufficient demand.")
 
 (defun erc-nicks--create-coerced-pool (adjustments colors)
-  "Return COLORS that fall within parameters indicated by ADJUSTMENTS.
-Rather than culling, apply adjustments and then dedupe after
-first replacing adjusted values with the nearest defined.  Unlike
-`erc-nicks--create-adjusted-pool', don't recheck after adjusting.
-Rather, tolerate values that may fall slightly outside desired
-parameters, thus yielding a larger pool."
+  "Return COLORS that fall within parameters heeded by ADJUSTMENTS.
+Apply ADJUSTMENTS and dedupe after replacing adjusted values with
+those nearest defined for the terminal.  Only perform one pass.
+That is, accept the nearest initially found as \"close enough,\"
+knowing that values may fall outside desired parameters and thus
+yield a larger pool than simple culling might produce.  When
+debugging, add candidates to `erc-nicks--colors-rejects' that map
+to the same output color as some prior candidate."
   (let* ((seen (make-hash-table :test #'equal))
          (erc-nicks-color-adjustments adjustments)
          pool)
@@ -414,7 +397,7 @@ erc-nicks--create-coerced-pool
           (puthash quantized color seen))))
     (nreverse pool)))
 
-(defun erc-nicks--create-pool (adjustments colors)
+(defun erc-nicks--create-culled-pool (adjustments colors)
   "Return COLORS that fall within parameters indicated by ADJUSTMENTS."
   (let (addp capp satp pool)
     (dolist (adjustment adjustments)
@@ -440,6 +423,9 @@ erc-nicks--init-pool
   "Initialize colors and optionally display faces or color palette."
   (unless (eq erc-nicks-colors 'all)
     (let* ((colors (or (and (listp erc-nicks-colors) erc-nicks-colors)
+                       (and (memq erc-nicks-colors '(font-lock ansi-color))
+                            (erc-nicks--colors-from-faces
+                             (format "%s-" erc-nicks-colors)))
                        (defined-colors)))
            (pool (funcall erc-nicks--create-pool-function
                           erc-nicks-color-adjustments colors)))
@@ -546,7 +532,8 @@ nicks
                " Toggling it in individual target buffers is unsupported.")
              (erc-nicks-mode +1))) ; but do it anyway
          (setq erc-nicks--downcased-skip-nicks
-               (mapcar #'erc-downcase erc-nicks-skip-nicks))
+               (mapcar #'erc-downcase erc-nicks-skip-nicks)
+               erc-nicks--fg-rgb (erc-with-server-buffer erc-nicks--fg-rgb))
          (add-function :filter-return (local 'erc-button--modify-nick-function)
                        #'erc-nicks--highlight-button '((depth . 80)))
          (erc-button--phantom-users-mode +1))
@@ -564,14 +551,14 @@ nicks
           "Module `nicks' unable to determine background color.  Setting to \""
           temp "\" globally.  Please see `erc-nicks-bg-color'.")
          (custom-set-variables (list 'erc-nicks-bg-color temp))))
+     (setq erc-nicks--fg-rgb
+           (or (color-name-to-rgb
+                (face-foreground 'erc-default-face nil 'default))
+               (color-name-to-rgb
+                (readable-foreground-color erc-nicks-bg-color))))
      (erc-nicks--init-pool)
      (erc--restore-initialize-priors erc-nicks-mode
        erc-nicks--face-table (make-hash-table :test #'equal)))
-   (setq erc-nicks--fg-rgb
-         (or (color-name-to-rgb
-              (face-foreground 'erc-default-face nil 'default))
-             (color-name-to-rgb
-              (readable-foreground-color erc-nicks-bg-color))))
    (setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal)
          #'erc-nicks-customize-face)
    (advice-add 'widget-create-child-and-convert :filter-args
@@ -658,8 +645,10 @@ erc-nicks-list-faces
 
 (defun erc-nicks-refresh (debug)
   "Recompute faces for all nicks on current network.
-With DEBUG, review affected faces or colors.  Which one depends
-on the value of `erc-nicks-colors'."
+With DEBUG, review affected faces or colors.  Exactly which of
+the two depends on the value of `erc-nicks-colors'.  Note that
+the list of rejected faces may include duplicates of accepted
+ones."
   (interactive "P")
   (unless (derived-mode-p 'erc-mode)
     (user-error "Not an ERC buffer"))
@@ -695,6 +684,15 @@ erc-nicks-refresh
                             (cadr (apply #'color-rgb-to-hsl
                                          (color-name-to-rgb c))))))))))))))
 
+(defun erc-nicks--colors-from-faces (prefix)
+  "Extract foregrounds from faces with PREFIX
+Expect PREFIX to be something like \"ansi-color-\" or \"font-lock-\"."
+  (let (out)
+    (dolist (face (face-list) (nreverse out))
+      (when-let (((string-prefix-p prefix (symbol-name face)))
+                 (color (face-foreground face)))
+        (push color out)))))
+
 (provide 'erc-nicks)
 
 ;;; erc-nicks.el ends here
diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el
index 3e5804734ec..35264a23caa 100644
--- a/test/lisp/erc/erc-nicks-tests.el
+++ b/test/lisp/erc/erc-nicks-tests.el
@@ -493,7 +493,7 @@ erc-nicks--gen-key-from-format-spec
     (should (equal (erc-nicks--gen-key-from-format-spec "bob")
                    "bob@Libera.Chat/tester"))))
 
-(ert-deftest erc-nicks--create-pool ()
+(ert-deftest erc-nicks--create-culled-pool ()
   (let ((erc-nicks--bg-luminance 1.0)
         (erc-nicks--bg-mode-value 'light)
         (erc-nicks--fg-rgb '(0.0 0.0 0.0))
@@ -502,37 +502,70 @@ erc-nicks--create-pool
         (erc-nicks--colors-rejects '(t)))
 
     ;; Reject
-    (should-not (erc-nicks--create-pool '(erc-nicks-invert) '("white")))
+    (should-not (erc-nicks--create-culled-pool '(erc-nicks-invert) '("white")))
     (should (equal (pop erc-nicks--colors-rejects) "white")) ; too close
-    (should-not (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("black")))
+    (should-not
+     (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast) '("black")))
     (should (equal (pop erc-nicks--colors-rejects) "black")) ; too far
-    (should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("white")))
+    (should-not
+     (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("white")))
     (should (equal (pop erc-nicks--colors-rejects) "white")) ; lacks color
-    (should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("red")))
+    (should-not
+     (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("red")))
     (should (equal (pop erc-nicks--colors-rejects) "red")) ; too much color
 
     ;; Safe
-    (should
-     (equal (erc-nicks--create-pool '(erc-nicks-invert) '("black"))
-            '("black")))
-    (should
-     (equal (erc-nicks--create-pool '(erc-nicks-add-contrast) '("black"))
-            '("black")))
-    (should
-     (equal (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("white"))
-            '("white")))
+    (should (equal (erc-nicks--create-culled-pool '(erc-nicks-invert)
+                                                  '("black"))
+                   '("black")))
+    (should (equal (erc-nicks--create-culled-pool '(erc-nicks-add-contrast)
+                                                  '("black"))
+                   '("black")))
+    (should (equal (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast)
+                                                  '("white"))
+                   '("white")))
     (let ((erc-nicks-saturation-range '(0.5 . 1.0)))
-      (should
-       (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("green"))
-              '("green"))))
+      (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+                                                    '("green"))
+                     '("green"))))
     (let ((erc-nicks-saturation-range '(0.0 . 0.5)))
-      (should
-       (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("gray"))
-              '("gray"))))
+      (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+                                                    '("gray"))
+                     '("gray"))))
     (unless noninteractive
-      (should
-       (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("firebrick"))
-              '("firebrick"))))
+      (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+                                                    '("firebrick"))
+                     '("firebrick"))))
+    (should (equal erc-nicks--colors-rejects '(t)))))
+
+(ert-deftest erc-nicks--create-coerced-pool ()
+  (let ((erc-nicks--bg-luminance 1.0)
+        (erc-nicks--bg-mode-value 'light)
+        (erc-nicks--fg-rgb '(0.0 0.0 0.0))
+        (erc-nicks-bg-color "white")
+        (num-colors (length (defined-colors)))
+        ;;
+        (erc-nicks--colors-rejects '(t)))
+
+    ;; Deduplication.
+    (when (= 8 num-colors)
+      (should (equal (erc-nicks--create-coerced-pool '(erc-nicks-ensaturate)
+                                                     '("#ee0000" "#f80000"))
+                     '("red")))
+      (should (equal (pop erc-nicks--colors-rejects) "#f80000")))
+
+    ;; "Coercion" in Xterm.
+    (unless noninteractive
+      (when (= 665 num-colors)
+        (pcase-dolist (`(,adjustments ,candidates ,result)
+                       '(((erc-nicks-invert) ("white") ("gray10"))
+                         ((erc-nicks-cap-contrast) ("black") ("gray20"))
+                         ((erc-nicks-ensaturate) ("white") ("lavenderblush2"))
+                         ((erc-nicks-ensaturate) ("red") ("firebrick"))))
+          (should (equal (erc-nicks--create-coerced-pool adjustments
+                                                         candidates)
+                         result)))))
+
     (should (equal erc-nicks--colors-rejects '(t)))))
 
 ;;; erc-nicks-tests.el ends here
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Offer-alternate-pool-creation-strategies-in-erc-.patch --]
[-- Type: text/x-patch, Size: 14748 bytes --]

From 9aff22914d85d92ca2665c6fc5b3359217b5d766 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 3 Sep 2023 16:05:59 -0700
Subject: [PATCH 1/1] [5.6] Offer alternate pool-creation strategies in
 erc-nicks

* lisp/erc/erc-nicks.el (erc-nicks-bg-color): Expand doc string.
(erc-nicks-colors): Add new choices `font-lock' and `ansi-color'.
(erc-nicks--adjust-contrast): Add
assertion.
(erc-nicks--create-pool-function): New function-valued variable to
specify a pool creation strategy.  Note in doc string that this could
form the basis for a possible user option should the need arise.
(erc-nicks--create-coerced-pool): New function for filtering
user-provided `erc-nicks-color' values.
(erc-nicks--create-pool, erc-nicks--create-culled-pool): Rename former
to latter.
(erc-nicks--init-pool): Call `erc-nicks--create-pool-function' to
actually create pool.  Account for new `erc-nicks-colors' values.
(erc-nicks-enable, erc-nicks-mode): Set `erc-nicks--fg-rgb' before
`erc-nicks--init-pool' to prevent type error in filters that depend on
that variable being initialized.  This is a bug fix.
(erc-nicks-refresh): Provide helpful user error instead of letting
`arith-error' propagate due to an empty pool.
(erc-nicks--colors-from-faces): New function.
* test/lisp/erc/erc-nicks-tests.el (erc-nicks--create-pool,
erc-nicks--create-culled-pool): Rename test from former to latter.
(erc-nicks--create-coerced-pool): New test.  (Bug#63569)
---
 lisp/erc/erc-nicks.el            | 87 +++++++++++++++++++++++++++-----
 test/lisp/erc/erc-nicks-tests.el | 79 ++++++++++++++++++++---------
 2 files changed, 129 insertions(+), 37 deletions(-)

diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index a7d0b0769f2..d512455090b 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -102,7 +102,10 @@ erc-nicks-bg-color
   (frame-parameter (selected-frame) 'background-color)
   "Background color for calculating contrast.
 Set this explicitly when the background color isn't discoverable,
-which may be the case in terminal Emacs."
+which may be the case in terminal Emacs.  Even when automatically
+initialized, this value may need adjustment mid-session, such as
+after loading a new theme.  Remember to run \\[erc-nicks-refresh]
+after doing so."
   :type 'string)
 
 (defcustom erc-nicks-color-adjustments
@@ -153,9 +156,13 @@ erc-nicks-colors
 single symbol representing a set of colors, like that produced by
 the function `defined-colors', which ERC associates with the
 symbol `defined'.  Similarly, `all' tells ERC to use any 24-bit
-color.  When specifying a list, users may want to set the option
-`erc-nicks-color-adjustments' to nil to prevent unwanted culling."
-  :type '(choice (const all) (const defined) (repeat string)))
+color.  To change the value mid-session, try
+\\[erc-nicks-refresh]."
+  :type `(choice (const :tag "All 24-bit colors" all)
+                 (const :tag "Defined terminal colors" defined)
+                 (const :tag "Font Lock faces" font-lock)
+                 (const :tag "ANSI color faces" ansi-color)
+                 (repeat :tag "User-provided list" string)))
 
 (defcustom erc-nicks-key-suffix-format "@%n"
   "Template for latter portion of keys to generate colors from.
@@ -227,6 +234,7 @@ erc-nicks--bg-mode
 
 ;; https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html
 (defun erc-nicks--adjust-contrast (color target &optional decrease)
+  (cl-assert erc-nicks--fg-rgb)
   (let* ((lum-bg (or erc-nicks--bg-luminance
                      (setq erc-nicks--bg-luminance
                            (erc-nicks--get-luminance erc-nicks-bg-color))))
@@ -356,7 +364,40 @@ erc-nicks--reduce
                      erc-nicks-color-adjustments
                      (if (stringp color) (color-name-to-rgb color) color))))
 
-(defun erc-nicks--create-pool (adjustments colors)
+(defvar erc-nicks--create-pool-function #'erc-nicks--create-coerced-pool
+  "Filter function for initializing the pool of colors.
+Takes a list of adjustment functions, such as those named in
+`erc-nicks-color-adjustments', and a list of colors.  Returns
+another list whose members need not be among the original
+candidates.  Users should note that this variable, along with its
+predefined function values, `erc-nicks--create-coerced-pool' and
+`erc-nicks--create-culled-pool', can be made public in a future
+version of this module, perhaps as a single user option, given
+sufficient demand.")
+
+(defun erc-nicks--create-coerced-pool (adjustments colors)
+  "Return COLORS that fall within parameters heeded by ADJUSTMENTS.
+Apply ADJUSTMENTS and dedupe after replacing adjusted values with
+those nearest defined for the terminal.  Only perform one pass.
+That is, accept the nearest initially found as \"close enough,\"
+knowing that values may fall outside desired parameters and thus
+yield a larger pool than simple culling might produce.  When
+debugging, add candidates to `erc-nicks--colors-rejects' that map
+to the same output color as some prior candidate."
+  (let* ((seen (make-hash-table :test #'equal))
+         (erc-nicks-color-adjustments adjustments)
+         pool)
+    (dolist (color colors)
+      (let ((quantized (car (tty-color-approximate
+                             (color-values (erc-nicks--reduce color))))))
+        (if (gethash quantized seen)
+            (when erc-nicks--colors-rejects
+              (push color erc-nicks--colors-rejects))
+          (push quantized pool)
+          (puthash quantized color seen))))
+    (nreverse pool)))
+
+(defun erc-nicks--create-culled-pool (adjustments colors)
   "Return COLORS that fall within parameters indicated by ADJUSTMENTS."
   (let (addp capp satp pool)
     (dolist (adjustment adjustments)
@@ -382,8 +423,12 @@ erc-nicks--init-pool
   "Initialize colors and optionally display faces or color palette."
   (unless (eq erc-nicks-colors 'all)
     (let* ((colors (or (and (listp erc-nicks-colors) erc-nicks-colors)
+                       (and (memq erc-nicks-colors '(font-lock ansi-color))
+                            (erc-nicks--colors-from-faces
+                             (format "%s-" erc-nicks-colors)))
                        (defined-colors)))
-           (pool (erc-nicks--create-pool erc-nicks-color-adjustments colors)))
+           (pool (funcall erc-nicks--create-pool-function
+                          erc-nicks-color-adjustments colors)))
       (setq erc-nicks--colors-pool pool
             erc-nicks--colors-len (length pool)))))
 
@@ -487,7 +532,8 @@ nicks
                " Toggling it in individual target buffers is unsupported.")
              (erc-nicks-mode +1))) ; but do it anyway
          (setq erc-nicks--downcased-skip-nicks
-               (mapcar #'erc-downcase erc-nicks-skip-nicks))
+               (mapcar #'erc-downcase erc-nicks-skip-nicks)
+               erc-nicks--fg-rgb (erc-with-server-buffer erc-nicks--fg-rgb))
          (add-function :filter-return (local 'erc-button--modify-nick-function)
                        #'erc-nicks--highlight-button '((depth . 80)))
          (erc-button--phantom-users-mode +1))
@@ -505,14 +551,14 @@ nicks
           "Module `nicks' unable to determine background color.  Setting to \""
           temp "\" globally.  Please see `erc-nicks-bg-color'.")
          (custom-set-variables (list 'erc-nicks-bg-color temp))))
+     (setq erc-nicks--fg-rgb
+           (or (color-name-to-rgb
+                (face-foreground 'erc-default-face nil 'default))
+               (color-name-to-rgb
+                (readable-foreground-color erc-nicks-bg-color))))
      (erc-nicks--init-pool)
      (erc--restore-initialize-priors erc-nicks-mode
        erc-nicks--face-table (make-hash-table :test #'equal)))
-   (setq erc-nicks--fg-rgb
-         (or (color-name-to-rgb
-              (face-foreground 'erc-default-face nil 'default))
-             (color-name-to-rgb
-              (readable-foreground-color erc-nicks-bg-color))))
    (setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal)
          #'erc-nicks-customize-face)
    (advice-add 'widget-create-child-and-convert :filter-args
@@ -599,8 +645,10 @@ erc-nicks-list-faces
 
 (defun erc-nicks-refresh (debug)
   "Recompute faces for all nicks on current network.
-With DEBUG, review affected faces or colors.  Which one depends
-on the value of `erc-nicks-colors'."
+With DEBUG, review affected faces or colors.  Exactly which of
+the two depends on the value of `erc-nicks-colors'.  Note that
+the list of rejected faces may include duplicates of accepted
+ones."
   (interactive "P")
   (unless (derived-mode-p 'erc-mode)
     (user-error "Not an ERC buffer"))
@@ -608,6 +656,8 @@ erc-nicks-refresh
     (unless erc-nicks-mode (user-error "Module `nicks' disabled"))
     (let ((erc-nicks--colors-rejects (and debug (list t))))
       (erc-nicks--init-pool)
+      (unless erc-nicks--colors-pool
+        (user-error "Pool empty: all colors rejected"))
       (dolist (nick (hash-table-keys erc-nicks--face-table))
         ;; User-tuned faces do not have an `erc-nicks--key' property.
         (when-let ((face (gethash nick erc-nicks--face-table))
@@ -634,6 +684,15 @@ erc-nicks-refresh
                             (cadr (apply #'color-rgb-to-hsl
                                          (color-name-to-rgb c))))))))))))))
 
+(defun erc-nicks--colors-from-faces (prefix)
+  "Extract foregrounds from faces with PREFIX
+Expect PREFIX to be something like \"ansi-color-\" or \"font-lock-\"."
+  (let (out)
+    (dolist (face (face-list) (nreverse out))
+      (when-let (((string-prefix-p prefix (symbol-name face)))
+                 (color (face-foreground face)))
+        (push color out)))))
+
 (provide 'erc-nicks)
 
 ;;; erc-nicks.el ends here
diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el
index 3e5804734ec..35264a23caa 100644
--- a/test/lisp/erc/erc-nicks-tests.el
+++ b/test/lisp/erc/erc-nicks-tests.el
@@ -493,7 +493,7 @@ erc-nicks--gen-key-from-format-spec
     (should (equal (erc-nicks--gen-key-from-format-spec "bob")
                    "bob@Libera.Chat/tester"))))
 
-(ert-deftest erc-nicks--create-pool ()
+(ert-deftest erc-nicks--create-culled-pool ()
   (let ((erc-nicks--bg-luminance 1.0)
         (erc-nicks--bg-mode-value 'light)
         (erc-nicks--fg-rgb '(0.0 0.0 0.0))
@@ -502,37 +502,70 @@ erc-nicks--create-pool
         (erc-nicks--colors-rejects '(t)))
 
     ;; Reject
-    (should-not (erc-nicks--create-pool '(erc-nicks-invert) '("white")))
+    (should-not (erc-nicks--create-culled-pool '(erc-nicks-invert) '("white")))
     (should (equal (pop erc-nicks--colors-rejects) "white")) ; too close
-    (should-not (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("black")))
+    (should-not
+     (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast) '("black")))
     (should (equal (pop erc-nicks--colors-rejects) "black")) ; too far
-    (should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("white")))
+    (should-not
+     (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("white")))
     (should (equal (pop erc-nicks--colors-rejects) "white")) ; lacks color
-    (should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("red")))
+    (should-not
+     (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("red")))
     (should (equal (pop erc-nicks--colors-rejects) "red")) ; too much color
 
     ;; Safe
-    (should
-     (equal (erc-nicks--create-pool '(erc-nicks-invert) '("black"))
-            '("black")))
-    (should
-     (equal (erc-nicks--create-pool '(erc-nicks-add-contrast) '("black"))
-            '("black")))
-    (should
-     (equal (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("white"))
-            '("white")))
+    (should (equal (erc-nicks--create-culled-pool '(erc-nicks-invert)
+                                                  '("black"))
+                   '("black")))
+    (should (equal (erc-nicks--create-culled-pool '(erc-nicks-add-contrast)
+                                                  '("black"))
+                   '("black")))
+    (should (equal (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast)
+                                                  '("white"))
+                   '("white")))
     (let ((erc-nicks-saturation-range '(0.5 . 1.0)))
-      (should
-       (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("green"))
-              '("green"))))
+      (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+                                                    '("green"))
+                     '("green"))))
     (let ((erc-nicks-saturation-range '(0.0 . 0.5)))
-      (should
-       (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("gray"))
-              '("gray"))))
+      (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+                                                    '("gray"))
+                     '("gray"))))
     (unless noninteractive
-      (should
-       (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("firebrick"))
-              '("firebrick"))))
+      (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+                                                    '("firebrick"))
+                     '("firebrick"))))
+    (should (equal erc-nicks--colors-rejects '(t)))))
+
+(ert-deftest erc-nicks--create-coerced-pool ()
+  (let ((erc-nicks--bg-luminance 1.0)
+        (erc-nicks--bg-mode-value 'light)
+        (erc-nicks--fg-rgb '(0.0 0.0 0.0))
+        (erc-nicks-bg-color "white")
+        (num-colors (length (defined-colors)))
+        ;;
+        (erc-nicks--colors-rejects '(t)))
+
+    ;; Deduplication.
+    (when (= 8 num-colors)
+      (should (equal (erc-nicks--create-coerced-pool '(erc-nicks-ensaturate)
+                                                     '("#ee0000" "#f80000"))
+                     '("red")))
+      (should (equal (pop erc-nicks--colors-rejects) "#f80000")))
+
+    ;; "Coercion" in Xterm.
+    (unless noninteractive
+      (when (= 665 num-colors)
+        (pcase-dolist (`(,adjustments ,candidates ,result)
+                       '(((erc-nicks-invert) ("white") ("gray10"))
+                         ((erc-nicks-cap-contrast) ("black") ("gray20"))
+                         ((erc-nicks-ensaturate) ("white") ("lavenderblush2"))
+                         ((erc-nicks-ensaturate) ("red") ("firebrick"))))
+          (should (equal (erc-nicks--create-coerced-pool adjustments
+                                                         candidates)
+                         result)))))
+
     (should (equal erc-nicks--colors-rejects '(t)))))
 
 ;;; erc-nicks-tests.el ends here
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0001-POC-Offer-alternate-pool-creation-strategies-in-erc-.patch --]
[-- Type: text/x-patch, Size: 5197 bytes --]

From ef97b82a7d38e4a61a54cfb7be7444bc8293261b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 3 Sep 2023 16:05:59 -0700
Subject: [PATCH] [POC] Offer alternate pool-creation strategies in erc-nicks

(erc-nicks--create-pool-function): New function-valued variable to
allow for changing fixed-pool creation strategy.
(erc-nicks--create-adjusted-pool,
erc-nicks--create-coerced-pool): New functions for filtering
user-provided `erc-nicks-color' values.
(erc-nicks--init-pool): Call `erc-nicks--create-pool-function'.
(erc-nicks-refresh): Provide helpful user error instead of letting
`arith-error' propagate due to an empty pool.  (Bug#63569)
---
 lisp/erc/erc-nicks.el | 63 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 62 insertions(+), 1 deletion(-)

diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index a7d0b0769f2..3e5bf2b8d3f 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -356,6 +356,64 @@ erc-nicks--reduce
                      erc-nicks-color-adjustments
                      (if (stringp color) (color-name-to-rgb color) color))))
 
+(defvar erc-nicks--create-pool-function #'erc-nicks--create-adjusted-pool)
+
+(defun erc-nicks--create-adjusted-pool (adjustments colors)
+  "Return COLORS that fall within parameters indicated by ADJUSTMENTS.
+Apply adjustments before replacing COLORS with the nearest
+defined, and then cull those that still don't meet the grade.
+Expect to operate on user-provided lists of `erc-nicks-colors'
+rather than all those `defined' by the system."
+  (let* ((seen (make-hash-table :test #'equal))
+         (valmax (float (car (color-values "#ffffffffffff"))))
+         (erc-nicks-color-adjustments adjustments)
+         addp capp satp pool)
+    (dolist (adjustment adjustments)
+      (pcase adjustment
+        ((or 'erc-nicks-invert 'erc-nicks-add-contrast) (setq addp t))
+        ('erc-nicks-cap-contrast (setq capp t))
+        ('erc-nicks-ensaturate (setq satp t))))
+    (dolist (color colors)
+      (pcase-let ((`(,quantized ,_ . ,vals)
+                   (tty-color-approximate (color-values
+                                           (erc-nicks--reduce color)))))
+        (if (gethash quantized seen)
+            (when erc-nicks--colors-rejects
+              (push color erc-nicks--colors-rejects))
+          (let* ((rgb (mapcar (lambda (x) (/ x valmax)) vals))
+                 (contrast (and (or addp capp) (erc-nicks--get-contrast rgb))))
+            (if (or (and addp (< contrast (car erc-nicks-contrast-range)))
+                    (and capp (> contrast (cdr erc-nicks-contrast-range)))
+                    (and-let* ((satp)
+                               (s (cadr (apply #'color-rgb-to-hsl rgb))))
+                      (or (< s (car erc-nicks-saturation-range))
+                          (> s (cdr erc-nicks-saturation-range)))))
+                (when erc-nicks--colors-rejects
+                  (push color erc-nicks--colors-rejects))
+              (push quantized pool)
+              (puthash quantized color seen))))))
+    (nreverse pool)))
+
+(defun erc-nicks--create-coerced-pool (adjustments colors)
+  "Return COLORS that fall within parameters indicated by ADJUSTMENTS.
+Rather than culling, apply adjustments and then dedupe after
+first replacing adjusted values with the nearest defined.  Unlike
+`erc-nicks--create-adjusted-pool', don't recheck after adjusting.
+Rather, tolerate values that may fall slightly outside desired
+parameters, thus yielding a larger pool."
+  (let* ((seen (make-hash-table :test #'equal))
+         (erc-nicks-color-adjustments adjustments)
+         pool)
+    (dolist (color colors)
+      (let ((quantized (car (tty-color-approximate
+                             (color-values (erc-nicks--reduce color))))))
+        (if (gethash quantized seen)
+            (when erc-nicks--colors-rejects
+              (push color erc-nicks--colors-rejects))
+          (push quantized pool)
+          (puthash quantized color seen))))
+    (nreverse pool)))
+
 (defun erc-nicks--create-pool (adjustments colors)
   "Return COLORS that fall within parameters indicated by ADJUSTMENTS."
   (let (addp capp satp pool)
@@ -383,7 +441,8 @@ erc-nicks--init-pool
   (unless (eq erc-nicks-colors 'all)
     (let* ((colors (or (and (listp erc-nicks-colors) erc-nicks-colors)
                        (defined-colors)))
-           (pool (erc-nicks--create-pool erc-nicks-color-adjustments colors)))
+           (pool (funcall erc-nicks--create-pool-function
+                          erc-nicks-color-adjustments colors)))
       (setq erc-nicks--colors-pool pool
             erc-nicks--colors-len (length pool)))))
 
@@ -608,6 +667,8 @@ erc-nicks-refresh
     (unless erc-nicks-mode (user-error "Module `nicks' disabled"))
     (let ((erc-nicks--colors-rejects (and debug (list t))))
       (erc-nicks--init-pool)
+      (unless erc-nicks--colors-pool
+        (user-error "Pool empty: all colors rejected"))
       (dolist (nick (hash-table-keys erc-nicks--face-table))
         ;; User-tuned faces do not have an `erc-nicks--key' property.
         (when-let ((face (gethash nick erc-nicks--face-table))
-- 
2.41.0