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

v5. Simplify integration with internal buttons API. Factor out common
utilities for nick trimming, key generation, etc. Improve user
experience in dealing with predefined color palettes.

Note that these changes break those currently on offer in bug#63595. But
since things are still pretty fluid, I'm going to hold off on updating
those for a bit. Thanks.



[-- Attachment #2: 0000-v4-v5.diff --]
[-- Type: text/x-patch, Size: 21919 bytes --]

From 88fbd206ed296ddd99ce84696a5e45d3d4cf5ead Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 22 Jun 2023 05:51:15 -0700
Subject: [PATCH 0/1] *** NOT A PATCH ***

*** BLURB HERE ***

David Leatherman (1):
  [5.6] Add module for colorizing nicknames to ERC

 doc/misc/erc.texi                |   4 +
 etc/ERC-NEWS                     |   8 +
 lisp/erc/erc-nicks.el            | 554 +++++++++++++++++++++++++++++++
 lisp/erc/erc.el                  |   1 +
 test/lisp/erc/erc-nicks-tests.el | 315 ++++++++++++++++++
 test/lisp/erc/erc-tests.el       |   2 +-
 6 files changed, 883 insertions(+), 1 deletion(-)
 create mode 100644 lisp/erc/erc-nicks.el
 create mode 100644 test/lisp/erc/erc-nicks-tests.el

Interdiff:
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index ad4fca523d2..cd78ac15e22 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -37,8 +37,13 @@
 ;;; History:
 
 ;; This module has enjoyed a number of contributors across several
-;; variants over the years.  To those not mentioned, your efforts are
-;; no less appreciated.
+;; variants over the years, including:
+;;
+;;   Thibault Polge <thibault@thb.lt>,
+;;   Jay Kamat <jaygkamat@gmail.com>,
+;;   Alex Kost <alezost@gmail.com>
+;;
+;; To those not mentioned, your efforts are no less appreciated.
 
 ;; 2023/05 - erc-nicks
 ;;           Rewrite using internal API, and rebrand for ERC 5.6
@@ -53,7 +58,7 @@
 ;; 2007/09 - erc-highlight-nicknames.el
 ;;           Initial release by by André Riemann
 
-;; [1] <http://www.github.com/leathekd/erc-nicks>
+;; [1] <http://www.github.com/leathekd/erc-hl-nicks>
 ;; [2] <https://www.emacswiki.org/emacs/ErcHighlightNicknames>
 
 ;;; Code:
@@ -76,7 +81,9 @@ erc-nicks-ignore-chars
                  (const :tag "Don't trim" nil)))
 
 (defcustom erc-nicks-skip-nicks nil
-  "Nicks to avoid highlighting."
+  "Nicks to avoid highlighting.
+ERC only considers this option during module activation, so users
+should adjust it before connecting."
   :type '(repeat string))
 
 (defcustom erc-nicks-skip-faces '( erc-notice-face erc-current-nick-face
@@ -101,9 +108,15 @@ erc-nicks-color-adjustments
 For example, the function `erc-nicks-invert' inverts a nick when
 it's too close to the background, and `erc-nicks-add-contrast'
 attempts to find a decent contrast ratio by brightening or
-darkening.  Note that ERC still applies adjustments when
-`erc-nicks-colors' is a user-defined list of colors.  Specify a
-value of nil to prevent that."
+darkening.  When `erc-nicks-colors' is set to the symbol
+`defined' or a user-provided list of colors, ERC uses this option
+as a guide for culling any colors that don't fall within
+`erc-nicks-contrast-range' or `erc-nicks-saturation-range', as
+appropriate.  For example, if `erc-nicks-cap-contrast' is present
+in this option's value, and a color's contrast exceeds the CDR of
+`erc-nicks-contrast-range', ERC will purge that color from its
+rolls when initializing this module.  Specify a value of nil to
+inhibit this process."
   :type '(repeat
           (choice (function-item :tag "Invert" erc-nicks-invert)
                   (function-item :tag "Add contrast" erc-nicks-add-contrast)
@@ -131,16 +144,19 @@ erc-nicks-saturation-range
 `erc-nicks-ensaturate' appears in `erc-nicks-color-adjustments'."
   :type '(cons float float))
 
-;; Should we also accept a list of faces?
 (defcustom erc-nicks-colors 'all
   "Pool of colors.
-This can be a list of hexes or color names, such as those
-provided by `defined-colors', which can itself be used when the
-value is the symbol `defined'.  With `all', use any 24-bit color."
+List colors as strings (hex or named) or, alternatively, a 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) (list string)))
 
 (defvar-local erc-nicks--face-table nil
-  "Hash table containing unique nick faces.")
+  "Hash table mapping nicks to unique, named faces.
+Keys need not be valid nicks.")
 
 ;; https://stackoverflow.com/questions/596216#answer-56678483
 (defun erc-nicks--get-luminance (color)
@@ -261,25 +277,6 @@ erc-nicks-ensaturate
           ((< s min) (setq color (color-hsl-to-rgb h min l)))))
   color)
 
-;; http://www.cse.yorku.ca/~oz/hash.html
-;; See also gui_nick_hash_djb2_64 in weechat/src/gui/gui-nick.c,
-;; which is originally from https://savannah.nongnu.org/patch/?8062.
-;;
-;; Short strings of the same length and those differing only in their
-;; low order bits tend to land in neighboring buckets, which are often
-;; similar in color.  Padding on the right with at least nine added
-;; chars seems to scramble things sufficiently enough for our needs.
-
-(defun erc-nicks--hash (s &optional nchoices)
-  (let ((h 5381) ; seed and multiplier (33) hardcoded for now
-        (p (or nchoices 281474976710656)) ; 48-bits (expt 2 48)
-        (i 0)
-        (n (length s)))
-    (while (< (setq h (% (+ (* h 33) (aref s i)) p)
-                    i (1+ i))
-              n))
-    h))
-
 ;; From https://elpa.gnu.org/packages/ement.  The resolution has been
 ;; scaled up to try and avoid components being exactly 0.0, which our
 ;; contrast function doesn't seem to like.  Hopefully, that's OK.
@@ -291,11 +288,13 @@ erc-nicks--gen-color-ement
           (/ (float (ash (logand color-num #xffff0000) -16)) #xffff)
           (/ (float (ash (logand color-num #xffff00000000) -32)) #xffff))))
 
-(defvar-local erc-nicks--colors-len nil)
 (defvar-local erc-nicks--custom-keywords '(:group erc-nicks :group erc-faces))
 
+;; This doesn't add an entry to the face table because "@" faces are
+;; interned in the global `obarray' and thus easily accessible.
 (defun erc-nicks--revive (new-face old-face nick net)
   (put new-face 'erc-nicks--custom-nick (cons nick net))
+  (put old-face 'erc-nicks--key nil)
   (apply #'custom-declare-face new-face (face-user-default-spec old-face)
          (format "Persistent `erc-nicks' color for %s on %s." nick net)
          erc-nicks--custom-keywords))
@@ -336,45 +335,88 @@ erc-nicks--reduce
                      erc-nicks-color-adjustments
                      (if (stringp color) (color-name-to-rgb color) color))))
 
+(defvar-local erc-nicks--colors-len nil)
+(defvar-local erc-nicks--colors-pool nil)
+
+(defun erc-nicks--create-pool (adjustments colors &optional debug)
+  "Return COLORS that fall within parameters indicated by ADJUSTMENTS."
+  (let (addp capp satp pool rejects)
+    (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)
+      (let* ((rgb (color-name-to-rgb color))
+             (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 debug
+              (push color rejects))
+          (push color pool))))
+    (when-let
+        ((debug)
+         (cb (lambda (c) (message "contrast: %.3f :saturation: %.3f"
+                                  (erc-nicks--get-contrast c)
+                                  (cadr (apply #'color-rgb-to-hsl
+                                               (color-name-to-rgb c)))))))
+      (save-excursion
+        (when pool (list-colors-display pool "*erc-nicks-pool*" cb))
+        (when rejects (list-colors-display rejects "*erc-nicks-rejects*" cb))))
+    (nreverse pool)))
+
+(defun erc-nicks--init-pool (&optional debug)
+  (if (or (eq erc-nicks-colors 'all) (null erc-nicks-color-adjustments))
+      (setq erc-nicks--colors-pool nil
+            erc-nicks--colors-len nil)
+    (let* ((colors (or (and (listp erc-nicks-colors) erc-nicks-colors)
+                       (defined-colors)))
+           (pool (erc-nicks--create-pool erc-nicks-color-adjustments colors
+                                         debug)))
+      (setq erc-nicks--colors-pool pool
+            erc-nicks--colors-len (length pool)))))
+
+(defun erc-nicks--determine-color (key)
+  (if (eq erc-nicks-colors 'all)
+      (erc-nicks--reduce (erc-nicks--gen-color-ement key))
+    (let ((pool (erc-with-server-buffer erc-nicks--colors-pool))
+          (len (erc-with-server-buffer erc-nicks--colors-len)))
+      (nth (% (abs (sxhash key)) len) pool))))
+
 (defun erc-nicks--get-face (nick key)
-  "Retrieve or create a face for NICK, stored locally under KEY.
-But favor a custom erc-nicks-NICK@NETWORK-face, when defined."
-  (setq nick (erc-downcase nick))
-  (let ((table (buffer-local-value 'erc-nicks--face-table
-                                   (erc-server-buffer))))
+  "Retrieve a face for trimmed and downcased NICK.
+If NICK is new, use KEY to derive color, and store under NICK.
+Favor a custom erc-nicks-NICK@NETWORK-face when defined."
+  (let ((table (erc-with-server-buffer erc-nicks--face-table)))
     (or (gethash nick table)
         (and-let* ((face (intern-soft (concat "erc-nicks-" nick "@"
                                               (erc-network-name) "-face")))
                    ((or (and (facep face) face)
                         (erc-nicks--revive face face nick (erc-network))))))
-        (let ((color (erc-nicks--reduce
-                      (pcase erc-nicks-colors
-                        ('all (erc-nicks--gen-color-ement key))
-                        ((or 'defined v)
-                         (unless v (setq v (defined-colors (selected-frame))))
-                         (unless erc-nicks--colors-len
-                           (setq erc-nicks--colors-len (length v)))
-                         (nth (erc-nicks--hash key erc-nicks--colors-len)
-                              v)))))
+        (let ((color (erc-nicks--determine-color key))
               (new-face (make-symbol (concat "erc-nicks-" nick "-face"))))
+          (put new-face 'erc-nicks--key key)
           (face-spec-set new-face `((t :foreground ,color)) 'face-defface-spec)
           (set-face-documentation
            new-face (format "Internal face for %s on %s." nick (erc-network)))
           (puthash nick new-face table)))))
 
 (define-inline erc-nicks--anon-face-p (face)
-  (inline-quote (and (consp ,face)
-                     (pcase (car ,face)
-                       ((pred keywordp) t)
-                       ('foreground-color t)
-                       ('background-color t)))))
+  (inline-quote (and (consp ,face) (pcase (car ,face)
+                                     ((pred keywordp) t)
+                                     ('foreground-color t)
+                                     ('background-color t)))))
 
 (defvar erc-nicks--max-skip-search 3 ; make this an option?
   "Max number of faces to visit when testing `erc-nicks-skip-faces'.")
 
 (defun erc-nicks--skip-p (prop option limit)
   "Return non-nil if a face in PROP appears in OPTION.
-But abandon search after examining LIMIT faces."
+Abandon search after examining LIMIT faces."
   (setq prop (if (erc-nicks--anon-face-p prop) (list prop) (ensure-list prop)))
   (catch 'found
     (while-let (((> limit 0))
@@ -388,49 +430,59 @@ erc-nicks--skip-p
         (when (if (symbolp elem) (memq elem option) (member elem option))
           (throw 'found elem))))))
 
-(defvar erc-nicks--phony-face nil
-  "Face to pretend is propertizing the nick at point.
-Modules needing to colorize nicks outside of a buttonizing
-context can use this instead of setting fictitious bounds on the
-`erc-button--nick' object passed to `erc-nicks--highlight'.")
-
-(defun erc-nicks--highlight (nick-object)
-  "Possibly highlight a single nick."
+(defvar-local erc-nicks--downcased-skip-nicks nil
+  "Case-mapped copy of `erc-nicks-skip-nicks'.")
+
+(defun erc-nicks--trim (nickname)
+  "Return downcased NICKNAME sans trailing `erc-nicks-ignore-chars'."
+  (erc-downcase
+   (if erc-nicks-ignore-chars
+       (string-trim-right nickname
+                          (rx-to-string
+                           `(: (+ (any ,erc-nicks-ignore-chars)) eot)))
+     nickname)))
+
+(defvar erc-nicks--key-function #'erc-nicks--gen-key-with-network
+  "Function for generating a key to determine nick color.
+Called with a trimmed and case-mapped nickname.")
+
+(defun erc-nicks--gen-key-with-network (nickname)
+  "Generate key for NICKNAME with @network suffix."
+  (concat nickname (and erc-network "@") (and erc-network (erc-network-name))))
+
+(defun erc-nicks--highlight (nickname &optional base-face)
+  "Return face for NICKNAME unless it or BASE-FACE is blacklisted."
+  (when-let* ((trimmed (erc-nicks--trim nickname))
+              ((not (member trimmed erc-nicks--downcased-skip-nicks)))
+              ((not (and base-face
+                         (erc-nicks--skip-p base-face erc-nicks-skip-faces
+                                            erc-nicks--max-skip-search))))
+              (key (funcall erc-nicks--key-function trimmed))
+              (out (erc-nicks--get-face trimmed key)))
+    (if (or (null erc-nicks-nickname-face)
+            (eq base-face erc-nicks-nickname-face))
+        out
+      (cons out (erc-list erc-nicks-nickname-face)))))
+
+(defun erc-nicks--highlight-button (nick-object)
+  "Possibly add face to `erc-button--nick-user' NICK-OBJECT."
   (when-let*
       ((nick-object)
-       (server-user (erc-button--nick-user nick-object))
-       (trimmed (if erc-nicks-ignore-chars
-                    (string-trim-right (erc-server-user-nickname server-user)
-                                       (rx-to-string
-                                        `(: (+ (any ,erc-nicks-ignore-chars))
-                                            eot)))
-                  (erc-server-user-nickname server-user)))
-       ((not (member trimmed erc-nicks-skip-nicks)))
-       (face (or erc-nicks--phony-face
-                 (get-text-property (car (erc-button--nick-bounds nick-object))
-                                    'font-lock-face)))
-       ((not (erc-nicks--skip-p face erc-nicks-skip-faces
-                                erc-nicks--max-skip-search)))
-       ;; Ensure nicks are colored uniquely (per network) by padding
-       ;; from the right, as mentioned above in `erc-nicks--hash'.
-       (key (concat (erc-button--nick-downcased nick-object)
-                    (and-let* ((net (erc-network))) (format "%9s" net))))
-       (out (erc-nicks--get-face trimmed key)))
-    ;; `font-lock-prepend-text-property' could also work if preserving
-    ;; history isn't needed (in which case this var should be nil).
-    (setf (erc-button--nick-erc-button-nickname-face nick-object)
-          (if (or (not erc-nicks-nickname-face)
-                  (eq face erc-nicks-nickname-face))
-              out
-            (cons out (erc-list erc-nicks-nickname-face)))))
+       (face (get-text-property (car (erc-button--nick-bounds nick-object))
+                                'font-lock-face))
+       (nick (erc-server-user-nickname (erc-button--nick-user nick-object)))
+       (out (erc-nicks--highlight nick face)))
+    (setf (erc-button--nick-erc-button-nickname-face nick-object) out))
   nick-object)
 
 (define-erc-module nicks nil
   "Uniquely colorize nicknames in target buffers."
   ((if erc--target
        (progn
+         (setq erc-nicks--downcased-skip-nicks
+               (mapcar #'erc-downcase erc-nicks-skip-nicks))
          (add-function :filter-return (local 'erc-button--modify-nick-function)
-                       #'erc-nicks--highlight '((depth . 80)))
+                       #'erc-nicks--highlight-button '((depth . 80)))
          (erc-button--phantom-users-mode +1))
      (unless erc-button-mode
        (unless (memq 'button erc-modules)
@@ -446,6 +498,7 @@ 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))))
+     (erc-nicks--init-pool)
      (setq erc-nicks--face-table (make-hash-table :test #'equal)))
    (setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal)
          #'erc-nicks-customize-face)
@@ -455,10 +508,12 @@ nicks
    (kill-local-variable 'erc-nicks--bg-mode-value)
    (kill-local-variable 'erc-nicks--bg-luminance)
    (kill-local-variable 'erc-nicks--colors-len)
+   (kill-local-variable 'erc-nicks--colors-pool)
+   (kill-local-variable 'erc-nicks--downcased-skip-nicks)
    (when (fboundp 'erc-button--phantom-users-mode)
      (erc-button--phantom-users-mode -1))
    (remove-function (local 'erc-button--modify-nick-function)
-                    #'erc-nicks--highlight)
+                    #'erc-nicks--highlight-button)
    (setf (alist-get "Edit face"
                     erc-button--nick-popup-alist nil 'remove #'equal)
          nil))
@@ -469,9 +524,9 @@ erc-nicks-customize-face
   (interactive (list (or (car (get-text-property (point) 'erc-data))
                          (completing-read "nick: " (or erc-channel-users
                                                        erc-server-users)))))
-  (setq nick (erc-downcase (substring-no-properties nick)))
+  (setq nick (erc-nicks--trim (substring-no-properties nick)))
   (let* ((net (erc-network))
-         (key (concat nick (and net (format "%9s" net))))
+         (key (funcall erc-nicks--key-function nick))
          (old-face (erc-nicks--get-face nick key))
          (new-face (intern (format "erc-nicks-%s@%s-face" nick net))))
     (unless (eq new-face old-face)
@@ -480,6 +535,20 @@ erc-nicks-customize-face
       (set-face-attribute old-face nil :inherit new-face))
     (customize-face new-face)))
 
+(defun erc-nicks-refresh (debug-pool)
+  "Recompute faces for all nicks on current network.
+With DEBUG-POOL, list available colors and, in another buffer,
+those culled (only applies when `erc-nicks-colors' is set to
+something other than `all')."
+  (interactive "P")
+  (erc-with-server-buffer
+    (unless erc-nicks-mode (user-error "Module `nicks' disabled"))
+    (erc-nicks--init-pool debug-pool)
+    (dolist (nick (hash-table-keys erc-nicks--face-table))
+      (when-let* ((face (gethash nick erc-nicks--face-table))
+                  (key (get face 'erc-nicks--key)))
+        (set-face-foreground face (erc-nicks--determine-color key))))))
+
 (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 0d640ad59c3..d8ddaef72e5 100644
--- a/test/lisp/erc/erc-nicks-tests.el
+++ b/test/lisp/erc/erc-nicks-tests.el
@@ -265,41 +265,6 @@ erc-nicks-cap-contrast
       (when noninteractive
         (kill-buffer)))))
 
-;; Here is an example of how filters can steer us wrong (don't always
-;; DTRT).  Two keys with similar names hash to very different values:
-;;
-;;   1) "awbLibera.Chat" -> #x1e3b5ca4edbc ; deep blue
-;;   2) "twbLibera.Chat" -> #xdeb4c26934af ; yellow/orange
-;;
-;; But on a dark bg, (1) falls below `erc-nicks-invert's min threshold
-;; and thus gets treated, becoming #xe1c4a35b1243, which is quite
-;; close to and thus easily confused with (2).
-
-(ert-deftest erc-nicks--hash ()
-  (with-current-buffer (get-buffer-create "*erc-nicks--hash*")
-    ;; Here, we're just using `erc-nicks-tests--show-contrast' for show.
-    (let ((show (lambda (c) (erc-nicks-tests--print-contrast #'identity c))))
-
-      ;; Similar nicks yielding similar colors is likely undesirable.
-      (should (= (erc-nicks--hash "00000000") #xe4deaa6df385))
-      (should (= (erc-nicks--hash "00000001") #xe4deaa6df386))
-      (funcall show "#e4deaa6df385")
-      (funcall show "#e4deaa6df386")
-
-      ;; So we currently pad from the right to avoid this.
-      (should (= (erc-nicks--hash "0Libera.Chat") #x32fdc0d63a92))
-      (should (= (erc-nicks--hash "1Libera.Chat") #xc2c4f1c997f3))
-      (funcall show "#32fdc0d63a92")
-      (funcall show "#c2c4f1c997f3")
-
-      (should (= (erc-nicks--hash "0       OFTC") #x6805b7521261))
-      (should (= (erc-nicks--hash "1       OFTC") #xf7cce8456fc2))
-      (funcall show "#6805b7521261")
-      (funcall show "#f7cce8456fc2"))
-
-    (when noninteractive
-      (kill-buffer))))
-
 (ert-deftest erc-nicks--skip-p ()
   ;; Baseline
   (should-not (erc-nicks--skip-p 'bold nil 10000000))
@@ -337,4 +302,14 @@ erc-nicks--skip-p
   (should (erc-nicks--skip-p '((default italic) (bold shadow)) '(bold) 3))
   (should (erc-nicks--skip-p '(italic (default (bold shadow))) '(bold) 3)))
 
+(ert-deftest erc-nicks--trim ()
+  (should (equal (erc-nicks--trim "Bob`") "bob"))
+  (should (equal (erc-nicks--trim "Bob``") "bob"))
+
+  ;; `erc--casemapping-rfc1459'
+  (let ((erc-nicks-ignore-chars "^"))
+    (should (equal (erc-nicks--trim "Bob~") "bob^"))
+    (should (equal (erc-nicks--trim "Bob^") "bob"))))
+
+
 ;;; erc-nicks-tests.el ends here
-- 
2.40.1


[-- Attachment #3: 0001-5.6-Add-module-for-colorizing-nicknames-to-ERC.patch --]
[-- Type: text/x-patch, Size: 44856 bytes --]

From 88fbd206ed296ddd99ce84696a5e45d3d4cf5ead Mon Sep 17 00:00:00 2001
From: David Leatherman <leathekd@gmail.com>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 1/1] [5.6] Add module for colorizing nicknames to ERC

* doc/misc/erc.texi: Add `nicks' to module lineup.
* etc/ERC-NEWS: Mention new module `nicks'.
* lisp/erc/erc-nicks.el: New file.
* lisp/erc/erc.el: (erc-modules): Add `nicks'.
* test/lisp/erc/erc-nicks-tests.el: New file.
* test/lisp/erc/erc-tests (erc-tests--modules): Add
`nicks'.  (Bug#63569)

Co-authored-by: Andy Stewart <lazycat.manatee@gmail.com>
---
 doc/misc/erc.texi                |   4 +
 etc/ERC-NEWS                     |   8 +
 lisp/erc/erc-nicks.el            | 554 +++++++++++++++++++++++++++++++
 lisp/erc/erc.el                  |   1 +
 test/lisp/erc/erc-nicks-tests.el | 315 ++++++++++++++++++
 test/lisp/erc/erc-tests.el       |   2 +-
 6 files changed, 883 insertions(+), 1 deletion(-)
 create mode 100644 lisp/erc/erc-nicks.el
 create mode 100644 test/lisp/erc/erc-nicks-tests.el

diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index e848ed21a50..07484122e4b 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -459,6 +459,10 @@ Modules
 @item netsplit
 Detect netsplits
 
+@cindex modules, nicks
+@item nicks
+Automatically colorize nicks
+
 @cindex modules, noncommands
 @item noncommands
 Don't display non-IRC commands after evaluation
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 68f1083621c..d6383b72557 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -30,6 +30,14 @@ helper called 'erc-fill-wrap-nudge' allows for dynamic "refilling" of
 buffers on the fly.  Set 'erc-fill-function' to 'erc-fill-wrap' to get
 started.
 
+** A new module for nickname highlighting has joined ERC.
+Automatic nickname coloring has come to ERC core.  Users familiar with
+'erc-hl-nicks', from which this module directly descends, will already
+be familiar with its suite of handy options.  By default, each
+nickname in an ERC session receives a unique face with a unique (or
+evenly dealt) foreground color.  Add 'nicks' to 'erc-modules' to get
+started.
+
 ** A unified interactive entry point.
 New users are often dismayed to discover that M-x ERC doesn't connect
 to its default network, Libera.Chat, over TLS.  Though perhaps a
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
new file mode 100644
index 00000000000..cd78ac15e22
--- /dev/null
+++ b/lisp/erc/erc-nicks.el
@@ -0,0 +1,554 @@
+;;; erc-nicks.el -- Nick colors for ERC  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: David Leatherman <leathekd@gmail.com>
+;;         Andy Stewart <lazycat.manatee@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides the `nicks' module for automatic nickname
+;; highlighting.  Add `nicks' to `erc-modules' to get started.
+;;
+;; To change the color of a nickname in a target buffer, click on it
+;; and choose "Edit face" from the completion interface, and then
+;; perform your adjustments in the resulting Customize menu.
+;; Non-Customize users can persist their changes permanently by
+;; clicking on the face's "location" hyperlink and copying the
+;; generated code snippet (`defface' or `use-package') to their
+;; init.el.  Customize users need only click "Apply and Save", as
+;; usual.
+
+;;; History:
+
+;; This module has enjoyed a number of contributors across several
+;; variants over the years, including:
+;;
+;;   Thibault Polge <thibault@thb.lt>,
+;;   Jay Kamat <jaygkamat@gmail.com>,
+;;   Alex Kost <alezost@gmail.com>
+;;
+;; To those not mentioned, your efforts are no less appreciated.
+
+;; 2023/05 - erc-nicks
+;;           Rewrite using internal API, and rebrand for ERC 5.6
+;; 2020/03 - erc-hl-nicks 1.3.4
+;;           Final release, see [1] for intervening history
+;; 2014/05 - erc-highlight-nicknames.el
+;;           Final release, see [2] for intervening history
+;; 2011/08 - erc-hl-nicks 1.0
+;;           Initial release forked from erc-highlight-nicknames.el
+;; 2008/12 - erc-highlight-nicknames.el
+;;           First release from Andy Stewart
+;; 2007/09 - erc-highlight-nicknames.el
+;;           Initial release by by André Riemann
+
+;; [1] <http://www.github.com/leathekd/erc-hl-nicks>
+;; [2] <https://www.emacswiki.org/emacs/ErcHighlightNicknames>
+
+;;; Code:
+
+(require 'erc-button)
+(require 'color)
+
+(defgroup erc-nicks nil
+  "Colorize nicknames in ERC buffers."
+  :package-version '(ERC . "5.6") ; FIXME sync on release
+  :group 'erc)
+
+(defcustom erc-nicks-ignore-chars ",`'_-"
+  "Trailing characters in a nick to ignore while highlighting.
+Value should be a string containing characters typically appended
+by IRC clients to secure a nickname after a rejection (see option
+`erc-nick-uniquifier').  A value of nil means don't trim
+anything."
+  :type '(choice (string :tag "Chars to trim")
+                 (const :tag "Don't trim" nil)))
+
+(defcustom erc-nicks-skip-nicks nil
+  "Nicks to avoid highlighting.
+ERC only considers this option during module activation, so users
+should adjust it before connecting."
+  :type '(repeat string))
+
+(defcustom erc-nicks-skip-faces '( erc-notice-face erc-current-nick-face
+                                   erc-my-nick-face erc-pal-face erc-fool-face)
+  "Faces to avoid highlighting atop."
+  :type  '(repeat symbol))
+
+(defcustom erc-nicks-nickname-face erc-button-nickname-face
+  "Face to mix with generated one for emphasizing non-speakers."
+  :type '(choice face (const nil)))
+
+(defcustom 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."
+  :type 'string)
+
+(defcustom erc-nicks-color-adjustments
+  '(erc-nicks-invert erc-nicks-cap-contrast erc-nicks-ensaturate)
+  "Treatments applied to improve aesthetics or visibility.
+For example, the function `erc-nicks-invert' inverts a nick when
+it's too close to the background, and `erc-nicks-add-contrast'
+attempts to find a decent contrast ratio by brightening or
+darkening.  When `erc-nicks-colors' is set to the symbol
+`defined' or a user-provided list of colors, ERC uses this option
+as a guide for culling any colors that don't fall within
+`erc-nicks-contrast-range' or `erc-nicks-saturation-range', as
+appropriate.  For example, if `erc-nicks-cap-contrast' is present
+in this option's value, and a color's contrast exceeds the CDR of
+`erc-nicks-contrast-range', ERC will purge that color from its
+rolls when initializing this module.  Specify a value of nil to
+inhibit this process."
+  :type '(repeat
+          (choice (function-item :tag "Invert" erc-nicks-invert)
+                  (function-item :tag "Add contrast" erc-nicks-add-contrast)
+                  (function-item :tag "Cap contrast" erc-nicks-cap-contrast)
+                  (function-item :tag "Bound saturation" erc-nicks-ensaturate)
+                  function)))
+
+(defcustom erc-nicks-contrast-range '(4.3 . 12.5)
+  "Desired range of contrast as a cons of (MIN . MAX).
+When `erc-nicks-add-contrast' and/or `erc-nicks-invert' appear in
+`erc-nicks-color-adjustments', MIN specifies the minimum amount
+of contrast allowed between a buffer's background and its
+foreground colors.  Depending on the background, nicks may appear
+tinted in pastels or shaded with muted grays.  MAX works
+similarly for reducing contrast, but only when
+`erc-nicks-cap-contrast' is active.  Users with lighter
+backgrounds may want to lower MAX significantly.  Either value
+can range from 1.0 to 21.0(:1) but may produce unsatisfactory
+results toward either extreme."
+  :type '(cons float float))
+
+(defcustom erc-nicks-saturation-range '(0.2 . 0.8)
+  "Desired range for constraining saturation.
+Expressed as a cons of decimal proportions.  Only matters when
+`erc-nicks-ensaturate' appears in `erc-nicks-color-adjustments'."
+  :type '(cons float float))
+
+(defcustom erc-nicks-colors 'all
+  "Pool of colors.
+List colors as strings (hex or named) or, alternatively, a 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) (list string)))
+
+(defvar-local erc-nicks--face-table nil
+  "Hash table mapping nicks to unique, named faces.
+Keys need not be valid nicks.")
+
+;; https://stackoverflow.com/questions/596216#answer-56678483
+(defun erc-nicks--get-luminance (color)
+  "Return relative luminance of COLOR.
+COLOR can be a list of normalized values or a name.  This is the
+same as the Y component returned by `color-srgb-to-xyz'."
+  (let ((out 0)
+        (coefficients '(0.2126 0.7152 0.0722))
+        (chnls (if (stringp color) (color-name-to-rgb color) color)))
+    (dolist (ch chnls out)
+      (cl-incf out (* (pop coefficients)
+                      (if (<= ch 0.04045)
+                          (/ ch 12.92)
+                        (expt (/ (+ ch 0.055) 1.055) 2.4)))))))
+
+(defvar-local erc-nicks--bg-luminance nil)
+
+(defun erc-nicks--get-contrast (fg &optional bg)
+  "Return a float between 1 and 21 for colors FG and BG.
+If FG or BG are floats, interpret them as luminance values."
+  (let* ((lum-fg (if (numberp fg) fg (erc-nicks--get-luminance fg)))
+         (lum-bg (if bg
+                     (if (numberp bg) bg (erc-nicks--get-luminance bg))
+                   (or erc-nicks--bg-luminance
+                       (setq erc-nicks--bg-luminance
+                             (erc-nicks--get-luminance erc-nicks-bg-color))))))
+    (when (< lum-fg lum-bg) (cl-rotatef lum-fg lum-bg))
+    (/ (+ 0.05 lum-fg) (+ 0.05 lum-bg))))
+
+(defvar-local erc-nicks--bg-mode-value nil)
+
+(defmacro erc-nicks--bg-mode ()
+  `(or erc-nicks--bg-mode-value
+       (setq erc-nicks--bg-mode-value
+             ,(cond ((fboundp 'frame--current-background-mode)
+                     '(frame--current-background-mode (selected-frame)))
+                    ((fboundp 'frame--current-backround-mode)
+                     '(frame--current-backround-mode (selected-frame)))
+                    (t
+                     '(frame-parameter (selected-frame) 'background-mode))))))
+
+(defvar erc-nicks--grad-steps 9)
+
+;; https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html
+;;
+;; TODO see implementation in https://elpa.gnu.org/packages/ement and
+;; maybe copy that instead.
+(defun erc-nicks--adjust-contrast (color target &optional decrease)
+  (let* ((lum-bg (or erc-nicks--bg-luminance
+                     (setq erc-nicks--bg-luminance
+                           (erc-nicks--get-luminance erc-nicks-bg-color))))
+         ;; Shouldn't this use the actual bg color instead of b+w?
+         (stop (if (eq (if decrease 'light 'dark) (erc-nicks--bg-mode))
+                   '(1.0 1.0 1.0)
+                 '(0.0 0.0 0.0)))
+         ;; From `color-gradient' in color.el
+         (r (nth 0 color))
+         (g (nth 1 color))
+         (b (nth 2 color))
+         (interval (float (1+ (expt 2 erc-nicks--grad-steps))))
+         (r-step (/ (- (nth 0 stop) r) interval))
+         (g-step (/ (- (nth 1 stop) g) interval))
+         (b-step (/ (- (nth 2 stop) b) interval))
+         (maxtries erc-nicks--grad-steps)
+         started)
+    ;; FIXME stop when sufficiently close instead of exhausting.
+    (while (let* ((lum-fg (erc-nicks--get-luminance (list r g b)))
+                  (darker (if (< lum-bg lum-fg) lum-bg lum-fg))
+                  (lighter (if (= darker lum-bg) lum-fg lum-bg))
+                  (cur (/ (+ 0.05 lighter) (+ 0.05 darker)))
+                  (scale (expt 2 maxtries)))
+             (cond ((if decrease (> cur target) (< cur target))
+                    (setq r (+ r (* r-step scale))
+                          g (+ g (* g-step scale))
+                          b (+ b (* b-step scale))))
+                   (started
+                    (setq r (- r (* r-step scale))
+                          g (- g (* g-step scale))
+                          b (- b (* b-step scale))))
+                   (t (setq maxtries 1)))
+             (unless started
+               (setq started t))
+             (setq r (min 1.0 (max 0 r))
+                   g (min 1.0 (max 0 g))
+                   b (min 1.0 (max 0 b)))
+             (not (zerop (cl-decf maxtries)))))
+    (list r g b)))
+
+(defun erc-nicks-add-contrast (color)
+  "Increase COLOR's contrast by blending it with white or black.
+Unless sufficient contrast exists between COLOR and the
+background, raise it to somewhere around the lower bound of
+`erc-nicks-contrast-range'."
+  (erc-nicks--adjust-contrast color (car erc-nicks-contrast-range)))
+
+(defun erc-nicks-cap-contrast (color)
+  "Reduce COLOR's contrast by blending it with white or black.
+If excessive contrast exists between COLOR and the background,
+lower it to the upper bound of `erc-nicks-contrast-range'."
+  (erc-nicks--adjust-contrast color (cdr erc-nicks-contrast-range) 'remove))
+
+(defun erc-nicks-invert (color)
+  "Invert COLOR based on the CAR of `erc-nicks-contrast-range'.
+Don't bother if the inverted color has less contrast than the
+input."
+  (if-let ((con-input (erc-nicks--get-contrast color))
+           ((< con-input (car erc-nicks-contrast-range)))
+           (flipped (mapcar (lambda (c) (- 1.0 c)) color))
+           ((> (erc-nicks--get-contrast flipped) con-input)))
+      flipped
+    color))
+
+(defun erc-nicks-ensaturate (color)
+  "Ensure COLOR falls within `erc-nicks-saturation-range'."
+  (pcase-let ((`(,min . ,max) erc-nicks-saturation-range)
+              (`(,h ,s ,l) (apply #'color-rgb-to-hsl color)))
+    (cond ((> s max) (setq color (color-hsl-to-rgb h max l)))
+          ((< s min) (setq color (color-hsl-to-rgb h min l)))))
+  color)
+
+;; From https://elpa.gnu.org/packages/ement.  The resolution has been
+;; scaled up to try and avoid components being exactly 0.0, which our
+;; contrast function doesn't seem to like.  Hopefully, that's OK.
+(defun erc-nicks--gen-color-ement (string)
+  "Generate normalized RGB color from STRING."
+  (let* ((ratio (/ (float (abs (sxhash string))) (float most-positive-fixnum)))
+         (color-num (round (* (* #xffff #xffff #xffff) ratio))))
+    (list (/ (float (logand color-num #xffff)) #xffff)
+          (/ (float (ash (logand color-num #xffff0000) -16)) #xffff)
+          (/ (float (ash (logand color-num #xffff00000000) -32)) #xffff))))
+
+(defvar-local erc-nicks--custom-keywords '(:group erc-nicks :group erc-faces))
+
+;; This doesn't add an entry to the face table because "@" faces are
+;; interned in the global `obarray' and thus easily accessible.
+(defun erc-nicks--revive (new-face old-face nick net)
+  (put new-face 'erc-nicks--custom-nick (cons nick net))
+  (put old-face 'erc-nicks--key nil)
+  (apply #'custom-declare-face new-face (face-user-default-spec old-face)
+         (format "Persistent `erc-nicks' color for %s on %s." nick net)
+         erc-nicks--custom-keywords))
+
+(defun erc-nicks--create-defface-template (face)
+  (pop-to-buffer (get-buffer-create (format "*New face %s*" face)))
+  (erase-buffer)
+  (lisp-interaction-mode)
+  (insert ";; If you *don't* use Customize, put something like this in your\n"
+          (substitute-command-keys
+           ";; init.el and use \\[eval-last-sexp] to apply any edits.\n\n")
+          (format "(defface %s\n  '%S\n  %S"
+                  face (face-user-default-spec face) (face-documentation face))
+          (cl-loop for (k v) on erc-nicks--custom-keywords by #'cddr
+                   concat (format "\n  %s %S" k (list 'quote v)))
+          ")\n\n;; Or, if you use use-package\n(use-package erc-nicks\n"
+          "  :custom-face\n"
+          (format "  (%s %S)" face (face-user-default-spec face))
+          ")\n"))
+
+(defun erc-nicks--redirect-face-widget-link (args)
+  (pcase args
+    (`(,widget face-link . ,plist)
+     (when-let* ((face (widget-value widget))
+                 ((get face 'erc-nicks--custom-nick)))
+       (unless (symbol-file face)
+         (setf (plist-get plist :action)
+               (lambda (&rest _) (erc-nicks--create-defface-template face))))
+       (setf (plist-get plist :help-echo) "Create or edit `defface'."
+             (cddr args) plist))))
+  args)
+
+(defun erc-nicks--reduce (color)
+  "Fold contrast strategies over COLOR, a string or normalized triple.
+Return a hex string."
+  (apply #'color-rgb-to-hex
+         (seq-reduce (lambda (color strategy) (funcall strategy color))
+                     erc-nicks-color-adjustments
+                     (if (stringp color) (color-name-to-rgb color) color))))
+
+(defvar-local erc-nicks--colors-len nil)
+(defvar-local erc-nicks--colors-pool nil)
+
+(defun erc-nicks--create-pool (adjustments colors &optional debug)
+  "Return COLORS that fall within parameters indicated by ADJUSTMENTS."
+  (let (addp capp satp pool rejects)
+    (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)
+      (let* ((rgb (color-name-to-rgb color))
+             (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 debug
+              (push color rejects))
+          (push color pool))))
+    (when-let
+        ((debug)
+         (cb (lambda (c) (message "contrast: %.3f :saturation: %.3f"
+                                  (erc-nicks--get-contrast c)
+                                  (cadr (apply #'color-rgb-to-hsl
+                                               (color-name-to-rgb c)))))))
+      (save-excursion
+        (when pool (list-colors-display pool "*erc-nicks-pool*" cb))
+        (when rejects (list-colors-display rejects "*erc-nicks-rejects*" cb))))
+    (nreverse pool)))
+
+(defun erc-nicks--init-pool (&optional debug)
+  (if (or (eq erc-nicks-colors 'all) (null erc-nicks-color-adjustments))
+      (setq erc-nicks--colors-pool nil
+            erc-nicks--colors-len nil)
+    (let* ((colors (or (and (listp erc-nicks-colors) erc-nicks-colors)
+                       (defined-colors)))
+           (pool (erc-nicks--create-pool erc-nicks-color-adjustments colors
+                                         debug)))
+      (setq erc-nicks--colors-pool pool
+            erc-nicks--colors-len (length pool)))))
+
+(defun erc-nicks--determine-color (key)
+  (if (eq erc-nicks-colors 'all)
+      (erc-nicks--reduce (erc-nicks--gen-color-ement key))
+    (let ((pool (erc-with-server-buffer erc-nicks--colors-pool))
+          (len (erc-with-server-buffer erc-nicks--colors-len)))
+      (nth (% (abs (sxhash key)) len) pool))))
+
+(defun erc-nicks--get-face (nick key)
+  "Retrieve a face for trimmed and downcased NICK.
+If NICK is new, use KEY to derive color, and store under NICK.
+Favor a custom erc-nicks-NICK@NETWORK-face when defined."
+  (let ((table (erc-with-server-buffer erc-nicks--face-table)))
+    (or (gethash nick table)
+        (and-let* ((face (intern-soft (concat "erc-nicks-" nick "@"
+                                              (erc-network-name) "-face")))
+                   ((or (and (facep face) face)
+                        (erc-nicks--revive face face nick (erc-network))))))
+        (let ((color (erc-nicks--determine-color key))
+              (new-face (make-symbol (concat "erc-nicks-" nick "-face"))))
+          (put new-face 'erc-nicks--key key)
+          (face-spec-set new-face `((t :foreground ,color)) 'face-defface-spec)
+          (set-face-documentation
+           new-face (format "Internal face for %s on %s." nick (erc-network)))
+          (puthash nick new-face table)))))
+
+(define-inline erc-nicks--anon-face-p (face)
+  (inline-quote (and (consp ,face) (pcase (car ,face)
+                                     ((pred keywordp) t)
+                                     ('foreground-color t)
+                                     ('background-color t)))))
+
+(defvar erc-nicks--max-skip-search 3 ; make this an option?
+  "Max number of faces to visit when testing `erc-nicks-skip-faces'.")
+
+(defun erc-nicks--skip-p (prop option limit)
+  "Return non-nil if a face in PROP appears in OPTION.
+Abandon search after examining LIMIT faces."
+  (setq prop (if (erc-nicks--anon-face-p prop) (list prop) (ensure-list prop)))
+  (catch 'found
+    (while-let (((> limit 0))
+                (elem (pop prop)))
+      (while (and (consp elem) (not (erc-nicks--anon-face-p elem)))
+        (when (cdr elem)
+          (push (cdr elem) prop))
+        (setq elem (car elem)))
+      (when elem
+        (cl-decf limit)
+        (when (if (symbolp elem) (memq elem option) (member elem option))
+          (throw 'found elem))))))
+
+(defvar-local erc-nicks--downcased-skip-nicks nil
+  "Case-mapped copy of `erc-nicks-skip-nicks'.")
+
+(defun erc-nicks--trim (nickname)
+  "Return downcased NICKNAME sans trailing `erc-nicks-ignore-chars'."
+  (erc-downcase
+   (if erc-nicks-ignore-chars
+       (string-trim-right nickname
+                          (rx-to-string
+                           `(: (+ (any ,erc-nicks-ignore-chars)) eot)))
+     nickname)))
+
+(defvar erc-nicks--key-function #'erc-nicks--gen-key-with-network
+  "Function for generating a key to determine nick color.
+Called with a trimmed and case-mapped nickname.")
+
+(defun erc-nicks--gen-key-with-network (nickname)
+  "Generate key for NICKNAME with @network suffix."
+  (concat nickname (and erc-network "@") (and erc-network (erc-network-name))))
+
+(defun erc-nicks--highlight (nickname &optional base-face)
+  "Return face for NICKNAME unless it or BASE-FACE is blacklisted."
+  (when-let* ((trimmed (erc-nicks--trim nickname))
+              ((not (member trimmed erc-nicks--downcased-skip-nicks)))
+              ((not (and base-face
+                         (erc-nicks--skip-p base-face erc-nicks-skip-faces
+                                            erc-nicks--max-skip-search))))
+              (key (funcall erc-nicks--key-function trimmed))
+              (out (erc-nicks--get-face trimmed key)))
+    (if (or (null erc-nicks-nickname-face)
+            (eq base-face erc-nicks-nickname-face))
+        out
+      (cons out (erc-list erc-nicks-nickname-face)))))
+
+(defun erc-nicks--highlight-button (nick-object)
+  "Possibly add face to `erc-button--nick-user' NICK-OBJECT."
+  (when-let*
+      ((nick-object)
+       (face (get-text-property (car (erc-button--nick-bounds nick-object))
+                                'font-lock-face))
+       (nick (erc-server-user-nickname (erc-button--nick-user nick-object)))
+       (out (erc-nicks--highlight nick face)))
+    (setf (erc-button--nick-erc-button-nickname-face nick-object) out))
+  nick-object)
+
+(define-erc-module nicks nil
+  "Uniquely colorize nicknames in target buffers."
+  ((if erc--target
+       (progn
+         (setq erc-nicks--downcased-skip-nicks
+               (mapcar #'erc-downcase erc-nicks-skip-nicks))
+         (add-function :filter-return (local 'erc-button--modify-nick-function)
+                       #'erc-nicks--highlight-button '((depth . 80)))
+         (erc-button--phantom-users-mode +1))
+     (unless erc-button-mode
+       (unless (memq 'button erc-modules)
+         (erc--warn-once-before-connect 'erc-nicks-mode
+           "Enabling default global module `button' needed by local"
+           " module `nicks'. This will impact \C-]all\C-] ERC"
+           " sessions. Add `nicks' to `erc-modules' to avoid this"
+           " warning. See Info:\"(erc) Modules\" for more."))
+       (erc-button-mode +1))
+     (when (equal erc-nicks-bg-color "unspecified-bg")
+       (let ((temp (if (eq (erc-nicks--bg-mode) 'light) "white" "black")))
+         (erc-button--display-error-notice-with-keys
+          "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))))
+     (erc-nicks--init-pool)
+     (setq erc-nicks--face-table (make-hash-table :test #'equal)))
+   (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
+               #'erc-nicks--redirect-face-widget-link))
+  ((kill-local-variable 'erc-nicks--face-table)
+   (kill-local-variable 'erc-nicks--bg-mode-value)
+   (kill-local-variable 'erc-nicks--bg-luminance)
+   (kill-local-variable 'erc-nicks--colors-len)
+   (kill-local-variable 'erc-nicks--colors-pool)
+   (kill-local-variable 'erc-nicks--downcased-skip-nicks)
+   (when (fboundp 'erc-button--phantom-users-mode)
+     (erc-button--phantom-users-mode -1))
+   (remove-function (local 'erc-button--modify-nick-function)
+                    #'erc-nicks--highlight-button)
+   (setf (alist-get "Edit face"
+                    erc-button--nick-popup-alist nil 'remove #'equal)
+         nil))
+  'local)
+
+(defun erc-nicks-customize-face (nick)
+  "Customize or create persistent face for NICK."
+  (interactive (list (or (car (get-text-property (point) 'erc-data))
+                         (completing-read "nick: " (or erc-channel-users
+                                                       erc-server-users)))))
+  (setq nick (erc-nicks--trim (substring-no-properties nick)))
+  (let* ((net (erc-network))
+         (key (funcall erc-nicks--key-function nick))
+         (old-face (erc-nicks--get-face nick key))
+         (new-face (intern (format "erc-nicks-%s@%s-face" nick net))))
+    (unless (eq new-face old-face)
+      (erc-nicks--revive new-face old-face nick net)
+      (set-face-attribute old-face nil :foreground 'unspecified)
+      (set-face-attribute old-face nil :inherit new-face))
+    (customize-face new-face)))
+
+(defun erc-nicks-refresh (debug-pool)
+  "Recompute faces for all nicks on current network.
+With DEBUG-POOL, list available colors and, in another buffer,
+those culled (only applies when `erc-nicks-colors' is set to
+something other than `all')."
+  (interactive "P")
+  (erc-with-server-buffer
+    (unless erc-nicks-mode (user-error "Module `nicks' disabled"))
+    (erc-nicks--init-pool debug-pool)
+    (dolist (nick (hash-table-keys erc-nicks--face-table))
+      (when-let* ((face (gethash nick erc-nicks--face-table))
+                  (key (get face 'erc-nicks--key)))
+        (set-face-foreground face (erc-nicks--determine-color key))))))
+
+(provide 'erc-nicks)
+
+;;; erc-nicks.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a1538962602..7b54b5db276 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2017,6 +2017,7 @@ erc-modules
            move-to-prompt)
     (const :tag "netsplit: Detect netsplits" netsplit)
     (const :tag "networks: Provide data about IRC networks" networks)
+    (const :tag "nicks: Uniquely colorize nicknames in target buffers" nicks)
     (const :tag "noncommands: Don't display non-IRC commands after evaluation"
            noncommands)
     (const :tag "notifications: Desktop alerts on PRIVMSG or mentions"
diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el
new file mode 100644
index 00000000000..d8ddaef72e5
--- /dev/null
+++ b/test/lisp/erc/erc-nicks-tests.el
@@ -0,0 +1,315 @@
+;;; erc-nicks-tests.el --- Tests for erc-nicks  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unlike most of ERC's tests, the ones in this file can be run
+;; interactively in the same session.
+
+;; TODO:
+;;
+;; * Add mock session (or scenario) with buffer snapshots, like those
+;;   in erc-fill-tests.el.  (Should probably move helpers to a common
+;;   library under ./resources.)
+
+;;; Code:
+
+(require 'ert)
+(require 'erc-nicks)
+
+;; This function replicates the behavior of older "invert" strategy
+;; implementations from EmacsWiki, etc.  The values for the lower and
+;; upper bounds (0.33 and 0.66) are likewise inherited.  See
+;; `erc-nicks--invert-classic--dark' below for one reason its results
+;; may not be plainly obvious.
+(defun erc-nicks-tests--invert-classic (color)
+  (if (pcase (erc-nicks--bg-mode)
+        ('dark (< (erc-nicks--get-luminance color) (/ 1 3.0)))
+        ('light (> (erc-nicks--get-luminance color) (/ 2 3.0))))
+      (list (- 1.0 (nth 0 color)) (- 1.0 (nth 1 color)) (- 1.0 (nth 2 color)))
+    color))
+
+
+(ert-deftest erc-nicks--get-luminance ()
+  (should (eql 0.0 (erc-nicks--get-luminance "black")))
+  (should (eql 1.0 (erc-nicks--get-luminance "white")))
+  (should (eql 21.0 (/ (+ 0.05 1.0) (+ 0.05 0.0))))
+
+  ;; RGB floats from a `display-graphic-p' session.
+  (let ((a (erc-nicks--get-luminance ; #9439ad
+            '(0.5803921568627451 0.2235294117647059 0.6784313725490196)))
+        (b (erc-nicks--get-luminance ; #ae54c7
+            '(0.6823529411764706 0.32941176470588235 0.7803921568627451)))
+        (c (erc-nicks--get-luminance ; #d19ddf
+            '(0.8196078431372549 0.615686274509804 0.8745098039215686)))
+        (d (erc-nicks--get-luminance ; #f5e8f8
+            '(0.9607843137254902 0.9098039215686274 0.9725490196078431))))
+    ;; Low, med, high contrast comparisons against known values from
+    ;; an external source.
+    (should (eql 1.42 (/ (round (* 100 (/ (+ 0.05 b) (+ 0.05 a)))) 100.0)))
+    (should (eql 2.78 (/ (round (* 100 (/ (+ 0.05 c) (+ 0.05 a)))) 100.0)))
+    (should (eql 5.16 (/ (round (* 100 (/ (+ 0.05 d) (+ 0.05 a)))) 100.0)))))
+
+(ert-deftest erc-nicks-invert--classic ()
+  (let ((convert (lambda (n) (apply #'color-rgb-to-hex
+                                    (erc-nicks-tests--invert-classic
+                                     (color-name-to-rgb n))))))
+    (let ((erc-nicks--bg-mode-value 'dark))
+      (should (equal (funcall convert "white") "#ffffffffffff"))
+      (should (equal (funcall convert "black") "#ffffffffffff"))
+      (should (equal (funcall convert "green") "#0000ffff0000")))
+    (let ((erc-nicks--bg-mode-value 'light))
+      (should (equal (funcall convert "white") "#000000000000"))
+      (should (equal (funcall convert "black") "#000000000000"))
+      (should (equal (funcall convert "green") "#ffff0000ffff")))))
+
+(ert-deftest erc-nicks--get-contrast ()
+  (should (= 21.0 (erc-nicks--get-contrast "white" "black")))
+  (should (= 21.0 (erc-nicks--get-contrast "black" "white")))
+  (should (= 1.0 (erc-nicks--get-contrast "black" "black")))
+  (should (= 1.0 (erc-nicks--get-contrast "white" "white"))))
+
+(defun erc-nicks-tests--print-contrast (fn color)
+  (let* ((erc-nicks-color-adjustments (list fn))
+         (result (erc-nicks--reduce color))
+         (start (point)))
+    (insert (format "%16s%-16s%16s%-16s\n"
+                    (concat color "-")
+                    (concat ">" result)
+                    (concat color " ")
+                    (concat " " result)))
+    (put-text-property (+ start 32) (+ start 48) 'face
+                       (list :background color :foreground result))
+    (put-text-property (+ start 48) (+ start 64) 'face
+                       (list :background result :foreground color))
+    result))
+
+(ert-deftest erc-nicks--invert-classic--light ()
+  (let ((erc-nicks--bg-luminance 1.0)
+        (erc-nicks--bg-mode-value 'light)
+        (show (lambda (c) (erc-nicks-tests--print-contrast
+                           #'erc-nicks-tests--invert-classic c))))
+
+    (with-current-buffer (get-buffer-create
+                          "*erc-nicks--invert-classic--light*")
+      (should (equal "#000000000000" (funcall show "white")))
+      (should (equal "#000000000000" (funcall show "black")))
+      (should (equal "#ffff00000000" (funcall show "red")))
+      (should (equal "#ffff0000ffff" (funcall show "green"))) ; magenta
+      (should (equal "#00000000ffff" (funcall show "blue")))
+
+      (unless noninteractive
+        (should (equal "#bbbbbbbbbbbb" (funcall show "#bbbbbbbbbbbb")))
+        (should (equal "#cccccccccccc" (funcall show "#cccccccccccc")))
+        (should (equal "#222122212221" (funcall show "#dddddddddddd")))
+        (should (equal "#111011101110" (funcall show "#eeeeeeeeeeee"))))
+
+      (when noninteractive
+        (kill-buffer)))))
+
+;; This shows that the output can be darker (have less contrast) than
+;; the input.
+(ert-deftest erc-nicks--invert-classic--dark ()
+  (let ((erc-nicks--bg-luminance 0.0)
+        (erc-nicks--bg-mode-value 'dark)
+        (show (lambda (c) (erc-nicks-tests--print-contrast
+                           #'erc-nicks-tests--invert-classic c))))
+
+    (with-current-buffer (get-buffer-create
+                          "*erc-nicks--invert-classic--dark*")
+      (should (equal "#ffffffffffff" (funcall show "white")))
+      (should (equal "#ffffffffffff" (funcall show "black")))
+      (should (equal "#0000ffffffff" (funcall show "red"))) ; cyan
+      (should (equal "#0000ffff0000" (funcall show "green")))
+      (should (equal "#ffffffff0000" (funcall show "blue"))) ; yellow
+
+      (unless noninteractive
+        (should (equal "#aaaaaaaaaaaa" (funcall show "#555555555555")))
+        (should (equal "#999999999999" (funcall show "#666666666666")))
+        (should (equal "#888888888888" (funcall show "#777777777777")))
+        (should (equal "#777777777777" (funcall show "#888888888888")))
+        (should (equal "#666666666666" (funcall show "#999999999999")))
+        (should (equal "#aaaaaaaaaaaa" (funcall show "#aaaaaaaaaaaa"))))
+
+      (when noninteractive
+        (kill-buffer)))))
+
+;; These are the same as the legacy version but work in terms of
+;; contrast ratios.  Converting the original bounds to contrast ratios
+;; (assuming pure white and black backgrounds) gives:
+;;
+;;   min-lum of 0.33 ~~> 1.465
+;;   max-lum of 0.66 ~~> 7.666
+;;
+(ert-deftest erc-nicks-invert--light ()
+  (let ((erc-nicks--bg-luminance 1.0)
+        (erc-nicks--bg-mode-value 'light)
+        (erc-nicks-contrast-range '(1.465))
+        (show (lambda (c) (erc-nicks-tests--print-contrast
+                           #'erc-nicks-invert c))))
+
+    (with-current-buffer (get-buffer-create
+                          "*erc-nicks--invert-classic--light*")
+      (should (equal "#000000000000" (funcall show "white")))
+      (should (equal "#000000000000" (funcall show "black")))
+      (should (equal "#ffff00000000" (funcall show "red")))
+      (should (equal "#ffff0000ffff" (funcall show "green"))) ; magenta
+      (should (equal "#00000000ffff" (funcall show "blue")))
+
+      (unless noninteractive
+        (should (equal "#bbbbbbbbbbbb" (funcall show "#bbbbbbbbbbbb")))
+        (should (equal "#cccccccccccc" (funcall show "#cccccccccccc")))
+        (should (equal "#222122212221" (funcall show "#dddddddddddd")))
+        (should (equal "#111011101110" (funcall show "#eeeeeeeeeeee"))))
+
+      (when noninteractive
+        (kill-buffer)))))
+
+(ert-deftest erc-nicks-invert--dark ()
+  (let ((erc-nicks--bg-luminance 0.0)
+        (erc-nicks--bg-mode-value 'dark)
+        (erc-nicks-contrast-range '(7.666))
+        (show (lambda (c) (erc-nicks-tests--print-contrast
+                           #'erc-nicks-invert c))))
+
+    (with-current-buffer (get-buffer-create "*erc-nicks-invert--dark*")
+      (should (equal "#ffffffffffff" (funcall show "white")))
+      (should (equal "#ffffffffffff" (funcall show "black")))
+      (should (equal "#0000ffffffff" (funcall show "red"))) ; cyan
+      (should (equal "#0000ffff0000" (funcall show "green")))
+      (should (equal "#ffffffff0000" (funcall show "blue"))) ; yellow
+
+      (unless noninteractive
+        (should (equal "#aaaaaaaaaaaa" (funcall show "#555555555555")))
+        (should (equal "#999999999999" (funcall show "#666666666666")))
+        (should (equal "#888888888888" (funcall show "#777777777777")))
+        (should (equal "#888888888888" (funcall show "#888888888888")))
+        (should (equal "#999999999999" (funcall show "#999999999999"))))
+
+      (when noninteractive
+        (kill-buffer)))))
+
+(ert-deftest erc-nicks-add-contrast ()
+  (let ((erc-nicks--bg-luminance 1.0)
+        (erc-nicks--bg-mode-value 'light)
+        (erc-nicks-contrast-range '(3.5))
+        (show (lambda (c) (erc-nicks-tests--print-contrast
+                           #'erc-nicks-add-contrast c))))
+
+    (with-current-buffer (get-buffer-create "*erc-nicks-add-contrast*")
+      (should (equal "#893a893a893a" (funcall show "white")))
+      (should (equal "#893a893a893a" (funcall show "#893a893a893a")))
+      (should (equal "#000000000000" (funcall show "black")))
+      (should (equal "#ffff00000000" (funcall show "red")))
+      (should (equal "#0000a12e0000" (funcall show "green")))
+      (should (equal "#00000000ffff" (funcall show "blue")))
+
+      ;; When the input is already near the desired ratio, the result
+      ;; may not be in bounds, only close.  But the difference is
+      ;; usually imperceptible.
+      (unless noninteractive
+        ;; Well inside (light slate gray)
+        (should (equal "#777788889999" (funcall show "#777788889999")))
+        ;; Slightly outside -> just outside
+        (should (equal "#7c498bd39b5c" (funcall show "#88889999aaaa")))
+        ;; Just outside -> just inside
+        (should (equal "#7bcc8b479ac0" (funcall show "#7c498bd39b5c")))
+        ;; Just inside
+        (should (equal "#7bcc8b479ac0" (funcall show "#7bcc8b479ac0"))))
+
+      (when noninteractive
+        (kill-buffer)))))
+
+(ert-deftest erc-nicks-cap-contrast ()
+  (should (= 12.5 (cdr erc-nicks-contrast-range)))
+  (let ((erc-nicks--bg-luminance 1.0)
+        (erc-nicks--bg-mode-value 'light)
+        (show (lambda (c) (erc-nicks-tests--print-contrast
+                           #'erc-nicks-cap-contrast c))))
+
+    (with-current-buffer (get-buffer-create "*erc-nicks-remove-contrast*")
+      (should (equal (funcall show "black") "#34e534e534e5" )) ; 21.0 -> 12.14
+      (should ; 12.32 -> 12.32 (same)
+       (equal (funcall show "#34e534e534e5") "#34e534e534e5"))
+      (should (equal (funcall show "white") "#ffffffffffff"))
+
+      (unless noninteractive
+        (should (equal (funcall show "DarkRed") "#8b8b00000000"))
+        (should (equal (funcall show "DarkGreen") "#000064640000"))
+        ;; 15.29 -> 12.38
+        (should (equal (funcall show "DarkBlue") "#1cf11cf198b5"))
+
+        ;; 12.50 -> 12.22
+        (should (equal (funcall show "#33e033e033e0") "#34ab34ab34ab"))
+        ;; 12.57 -> 12.28
+        (should (equal (funcall show "#338033803380") "#344c344c344c"))
+        ;; 12.67 -> 12.37
+        (should (equal (funcall show "#330033003300") "#33cc33cc33cc")))
+
+      (when noninteractive
+        (kill-buffer)))))
+
+(ert-deftest erc-nicks--skip-p ()
+  ;; Baseline
+  (should-not (erc-nicks--skip-p 'bold nil 10000000))
+  (should-not (erc-nicks--skip-p '(bold) nil 10000000))
+  (should-not (erc-nicks--skip-p nil '(bold) 10000000))
+  (should-not (erc-nicks--skip-p 'bold '(bold) 0))
+  (should-not (erc-nicks--skip-p '(bold) '(bold) 0))
+  (should-not (erc-nicks--skip-p 'bold '(foo bold) 0))
+  (should-not (erc-nicks--skip-p '((:inherit bold)) '(bold) 1))
+  (should (erc-nicks--skip-p 'bold '(bold) 1))
+  (should (erc-nicks--skip-p 'bold '(fake bold) 1))
+  (should (erc-nicks--skip-p 'bold '(foo bar bold) 1))
+  (should (erc-nicks--skip-p '(bold) '(bold) 1))
+  (should (erc-nicks--skip-p '((bold)) '(bold) 1))
+  (should (erc-nicks--skip-p '((((bold)))) '(bold) 1))
+  (should (erc-nicks--skip-p '(bold) '(foo bold) 1))
+  (should (erc-nicks--skip-p '(:inherit bold) '((:inherit bold)) 1))
+  (should (erc-nicks--skip-p '((:inherit bold)) '((:inherit bold)) 1))
+  (should (erc-nicks--skip-p '(((:inherit bold))) '((:inherit bold)) 1))
+
+  ;; Composed
+  (should-not (erc-nicks--skip-p '(italic bold) '(bold) 1))
+  (should-not (erc-nicks--skip-p '((italic) bold) '(bold) 1))
+  (should-not (erc-nicks--skip-p '(italic (bold)) '(bold) 1))
+  (should (erc-nicks--skip-p '(italic bold) '(bold) 2))
+  (should (erc-nicks--skip-p '((italic) bold) '(bold) 2))
+  (should (erc-nicks--skip-p '(italic (bold)) '(bold) 2))
+
+  (should-not (erc-nicks--skip-p '(italic default bold) '(bold) 2))
+  (should-not (erc-nicks--skip-p '((default italic) bold) '(bold) 2))
+  (should-not (erc-nicks--skip-p '(italic (default bold)) '(bold) 2))
+  (should-not (erc-nicks--skip-p '((default italic) (bold shadow)) '(bold) 2))
+  (should (erc-nicks--skip-p '((default italic) bold) '(bold) 3))
+  (should (erc-nicks--skip-p '(italic (default bold)) '(bold) 3))
+  (should (erc-nicks--skip-p '((default italic) (bold shadow)) '(bold) 3))
+  (should (erc-nicks--skip-p '(italic (default (bold shadow))) '(bold) 3)))
+
+(ert-deftest erc-nicks--trim ()
+  (should (equal (erc-nicks--trim "Bob`") "bob"))
+  (should (equal (erc-nicks--trim "Bob``") "bob"))
+
+  ;; `erc--casemapping-rfc1459'
+  (let ((erc-nicks-ignore-chars "^"))
+    (should (equal (erc-nicks--trim "Bob~") "bob^"))
+    (should (equal (erc-nicks--trim "Bob^") "bob"))))
+
+
+;;; erc-nicks-tests.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index f3489a16386..ebe49bcece2 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -2057,7 +2057,7 @@ erc-handle-irc-url
 (defconst erc-tests--modules
   '( autoaway autojoin button capab-identify completion dcc fill identd
      imenu irccontrols keep-place list log match menu move-to-prompt netsplit
-     networks noncommands notifications notify page readonly
+     networks nicks noncommands notifications notify page readonly
      replace ring sasl scrolltobottom services smiley sound
      spelling stamp track truncate unmorse xdcc))
 
-- 
2.40.1