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: 1661 bytes --]

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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 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