unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: "J.P." <jp@neverwas.me>
To: 63569@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#63569: 30.0.50; ERC 5.6: Add automatic nickname highlighting to ERC
Date: Tue, 30 May 2023 07:24:56 -0700	[thread overview]
Message-ID: <87wn0p6gnb.fsf__8976.16626914299$1685456794$gmane$org@neverwas.me> (raw)
In-Reply-To: <87ilcp1za1.fsf@neverwas.me> (J. P.'s message of "Thu, 18 May 2023 07:37:26 -0700")

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

v3. Spin off nick-popup business to separate patch. Fix existing bug
concerning truncated transmission of KICK "reason". Change "strategy"
function type from operating on strings to normalized RGB triplets. Fix
perceived bug in invert strategy and have it consult contrast knob. Add
new saturation strategy and knob. Redo front matter for anticipated
inclusion of other authors.

                                 . . .

For anyone following this bug, there's been some movement regarding the
possible official incorporation (or adaptation) of erc-hl-nicks by David
Leatherman. How exactly that's to occur will be up for discussion in due
course. These developments do mean that this feature may not be ready in
time for ERC 5.6, so I may end up renaming this bug at some point (just
a heads up). Thanks.


[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 32772 bytes --]

From a7d23ce4ca9f3b09c03b65d074ad0915d88a6da1 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 30 May 2023 07:01:48 -0700
Subject: [PATCH 0/2] *** NOT A PATCH ***

*** BLURB HERE ***

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

F. Jason Park (1):
  [5.6] Allow ERC modules to extend erc-nick-popup-alist

 doc/misc/erc.texi                |   4 +
 etc/ERC-NEWS                     |  26 +-
 lisp/erc/erc-button.el           |  64 +++--
 lisp/erc/erc-nicks.el            | 442 +++++++++++++++++++++++++++++++
 lisp/erc/erc.el                  |   1 +
 test/lisp/erc/erc-nicks-tests.el | 303 +++++++++++++++++++++
 test/lisp/erc/erc-tests.el       |   2 +-
 7 files changed, 818 insertions(+), 24 deletions(-)
 create mode 100644 lisp/erc/erc-nicks.el
 create mode 100644 test/lisp/erc/erc-nicks-tests.el

Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index a1279526015..e312ec38ca3 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -32,11 +32,11 @@ started.
 
 ** A new module for nickname highlighting has joined ERC.
 Automatic nickname coloring has come to ERC core.  Users familiar with
-the excellent 'erc-hl-nicks' by David Leatherman, from which this new
-addition draws heavily, 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.
+'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
@@ -124,13 +124,19 @@ asking users who've customized this option to switch to
 that some other solution, like automatic migration, is justified,
 please make that known on the bug list.
 
-** The 'nicknames' entry in 'erc-button-alist' is officially exceptional.
+** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
 It's no secret that the 'buttons' module treats potential nicknames
-specially.  To simplify ERC's move to next-gen "rich UI" extensions,
-this special treatment is being canonized.  From now on, all values
-other than the symbol 'erc-button-buttonize-nicks' appearing in the
-"FORM" field (third element) of this entry are considered deprecated
-and will incur a warning.
+specially.  This is perhaps most evident in its treatment of the
+'nicknames' entry in 'erc-button-alist'.  Indeed, to simplify ERC's
+move to next-gen "rich UI" extensions, this special treatment is being
+canonized.  From now on, all values other than the symbol
+'erc-button-buttonize-nicks' appearing in the "FORM" field (third
+element) of this entry are considered deprecated and will incur a
+warning.  Relatedly, the option 'erc-nick-popup-alist' now favors
+functions, which ERC calls non-interactively, over arbitrary
+s-expressions, which ERC will continue to honor.  Although the default
+lineup remains functionally equivalent, its members have all been
+updated accordingly.
 
 ** Option 'erc-query-on-unjoined-chan-privmsg' restored and renamed.
 This option was accidentally removed from the default client in ERC
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index c79b4e11f71..9c84de6720a 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -660,20 +660,20 @@ erc-browse-emacswiki-lisp
 ;;; Nickname buttons:
 
 (defcustom erc-nick-popup-alist
-  '(("DeOp"  . (erc-cmd-DEOP nick))
-    ("Kick"  . (erc-cmd-KICK (concat nick " "
-                                     (read-from-minibuffer
-                                      (concat "Kick " nick ", reason: ")))))
-    ("Msg"   . (erc-cmd-MSG (concat nick " "
-                                    (read-from-minibuffer
-                                     (concat "Message to " nick ": ")))))
-    ("Op"    . (erc-cmd-OP nick))
-    ("Query" . (erc-cmd-QUERY nick))
-    ("Whois" . (erc-cmd-WHOIS nick))
-    ("Lastlog" . (erc-cmd-LASTLOG nick)))
+  '(("DeOp"  . erc-cmd-DEOP)
+    ("Kick"  . erc-button-cmd-KICK)
+    ("Msg"   . erc-button-cmd-MSG)
+    ("Op"    . erc-cmd-OP)
+    ("Query" . erc-cmd-QUERY)
+    ("Whois" . erc-cmd-WHOIS)
+    ("Lastlog" . erc-cmd-LASTLOG))
   "An alist of possible actions to take on a nickname.
-An entry looks like (\"Action\" . SEXP) where SEXP is evaluated with
-the variable `nick' bound to the nick in question.
+For all entries (ACTION . FUNC), ERC offers ACTION as a possible
+completion item and calls the selected entry's FUNC with the
+buttonized nickname at point as the only argument.  For
+historical reasons, FUNC can also be an arbitrary sexp, in which
+case, ERC binds the nick in question to the variable `nick' and
+evaluates the expression.
 
 Examples:
  (\"DebianDB\" .
@@ -681,15 +681,39 @@ erc-nick-popup-alist
    (format
     \"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\"
     nick)))"
+  :package-version '(ERC . "5.6") ; FIXME sync on release
   :type '(repeat (cons (string :tag "Op")
-                       sexp)))
-
-(defvar-local erc--nick-popup-alist nil
+                       (choice function sexp))))
+
+(defun erc-button-cmd-KICK (nick)
+  "Prompt for a reason, then kick NICK via `erc-cmd-KICK'.
+In server buffers, also prompt for a channel."
+  (erc-cmd-KICK
+   (or (and erc--target (erc-default-target))
+       (let ((targets (mapcar (lambda (b)
+                                (cons (erc--target-string
+                                       (buffer-local-value 'erc--target b))
+                                      b))
+                              (erc-channel-list erc-server-process))))
+         (completing-read (format "Channel (%s): " (caar targets))
+                          targets (pcase-lambda (`(,_ . ,buf))
+                                    (with-current-buffer buf
+                                      (erc-get-channel-user nick)))
+                          t nil t (caar targets))))
+   nick
+   (read-from-minibuffer "Reason: ")))
+
+(defun erc-button-cmd-MSG (nick)
+  "Prompt for a message to NICK, and send it via `erc-cmd-MSG'."
+  (let ((msg (read-from-minibuffer (concat "Message to " nick ": "))))
+    (erc-cmd-MSG (concat nick " " msg))))
+
+(defvar-local erc-button--nick-popup-alist nil
   "Internally controlled items for `erc-nick-popup-alist'.")
 
 (defun erc-nick-popup (nick)
   (let* ((completion-ignore-case t)
-         (alist (append erc-nick-popup-alist erc--nick-popup-alist))
+         (alist (append erc-nick-popup-alist erc-button--nick-popup-alist))
          (action (completing-read (format-message
                                    "What action to take on `%s'? " nick)
                                   alist))
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index 85d182f9a09..0e0a481d453 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -2,6 +2,9 @@
 
 ;; 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
@@ -19,16 +22,39 @@
 
 ;;; Commentary:
 
-;; This module is heavily influenced by the lovely and more featureful
-;;
-;;   `erc-hl-nicks' by David Leatherman
-;;    <http://www.github.com/leathekd/erc-nicks>
-;;
-;; which itself is based on
-;;
-;;   `erc-highlight-nicknames' by André Riemann, Andy Stewart, and
-;;    others <https://www.emacswiki.org/emacs/ErcHighlightNicknames>
+;; 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.  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-nicks>
+;; [2] <https://www.emacswiki.org/emacs/ErcHighlightNicknames>
 
 ;;; Code:
 
@@ -40,19 +66,20 @@ erc-nicks
   :package-version '(ERC . "5.6") ; FIXME sync on release
   :group 'erc)
 
-(defcustom erc-nicks-ignore-chars-regexp
-  (cons (rx bot (+ (any ",`'_-"))) (rx (+ (any ",`'_-")) eot))
-  "Characters surrounding a nick to ignore while highlighting.
-Regexps should be suitable for `string-trim'."
-  :type '(choice (cons regexp regexp) (const nil)))
+(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 a la `erc-nick-uniquifier' to secure a nickname
+after a rejection.  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 not highlight."
+  "Nicks to avoid highlighting."
   :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)
+(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))
 
@@ -67,40 +94,42 @@ erc-nicks-bg-color
 which may be the case in terminal Emacs."
   :type 'string)
 
-(defcustom erc-nicks-color-contrast-strategy
-  '(erc-nicks-add-contrast erc-nicks-cap-contrast)
-  "Treatments applied to colors for increasing visibility.
-A value of `erc-nicks-invert' inverts a nick when it's too close
-to the background.  A value of `erc-nicks-add-contrast'
+(defcustom erc-nicks-color-adjustments
+  '(erc-nicks-add-contrast 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.  This option can also be a list, in which case,
-members will be applied in the order they appear.  For example,
-
-  \\='(erc-nicks-invert erc-nicks-add-contrast)
-
-will invert as needed and likewise adjust the contrast.  Note
-that anything specified by this option will still be applied when
-`erc-nicks-colors' is a user-defined list of colors."
-  :type '(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)
-                 (repeat function)
-                 (const nil)
-                 function))
-
-(defcustom erc-nicks-contrast-ratio '(3.5 . 12.5)
+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."
+  :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.0 . 12.5)
   "Desired range of contrast as a cons of (MIN . MAX).
-For this to matter, `erc-nicks-color-contrast-strategy' must be
-set to `erc-nicks-add-contrast' or `erc-nicks-cap-contrast' or
-contain at least one if that option is a list.  If adding
-contrast, MIN specifies the minimum amount allowed between a
-buffer's background color and the foreground colors specified by
-`erc-nicks-colors'.  The closer the number to the possible
-maximum of 21(:1), the greater the contrast.  Depending on the
-background, nicks are either tinted in pastel or muted with dark
-gray.  MAX works similarly for reducing contrast."
+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.  Values 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))
+
+;; 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
@@ -114,7 +143,8 @@ erc-nicks--face-table
 ;; 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."
+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)))
@@ -124,6 +154,20 @@ erc-nicks--get-luminance
                           (/ 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 ()
@@ -137,12 +181,8 @@ erc-nicks--bg-mode
                      '(frame-parameter (selected-frame) 'background-mode))))))
 
 (defvar erc-nicks--grad-steps 9)
-(defvar-local erc-nicks--bg-luminance nil)
 
 ;; https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html
-;;
-;; We could cache results, which may help when `erc-nicks-colors' is
-;; set to `defined'.
 
 (defun erc-nicks--adjust-contrast (color target &optional decrease)
   (let* ((lum-bg (or erc-nicks--bg-luminance
@@ -151,17 +191,17 @@ erc-nicks--adjust-contrast
          (stop (if (eq (if decrease 'light 'dark) (erc-nicks--bg-mode))
                    '(1.0 1.0 1.0)
                  '(0.0 0.0 0.0)))
-         (start (color-name-to-rgb color))
          ;; From `color-gradient' in color.el
-         (r (nth 0 start))
-         (g (nth 1 start))
-         (b (nth 2 start))
+         (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))
@@ -182,34 +222,40 @@ erc-nicks--adjust-contrast
                    g (min 1.0 (max 0 g))
                    b (min 1.0 (max 0 b)))
              (not (zerop (cl-decf maxtries)))))
-    (color-rgb-to-hex r g b)))
+    (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-ratio'."
-  (erc-nicks--adjust-contrast color (car erc-nicks-contrast-ratio)))
+`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-ratio'."
-  (erc-nicks--adjust-contrast color (cdr erc-nicks-contrast-ratio) 'remove))
-
-;; Inversion thresholds for dark and light, respectively.
-(defvar erc-nicks--min-lum (/ 1 3.0))
-(defvar erc-nicks--max-lum (/ 2 3.0))
+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 luminance and background."
-  (if (pcase (erc-nicks--bg-mode)
-        ('dark (< (erc-nicks--get-luminance color) erc-nicks--min-lum))
-        ('light (> (erc-nicks--get-luminance color) erc-nicks--max-lum)))
-      (pcase-let ((`(,r ,g ,b) (color-values color)))
-        (format "#%04x%04x%04x" (- 65535 r) (- 65535 g) (- 65535 b)))
+  "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)
+
 ;; 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.
@@ -266,6 +312,13 @@ erc-nicks--redirect-face-widget-link
              (cddr args) plist))))
   args)
 
+(defun erc-nicks--reduce (color-string)
+  "Fold contrast strategies over COLOR-STRING."
+  (apply #'color-rgb-to-hex
+         (seq-reduce (lambda (color strategy) (funcall strategy color))
+                     erc-nicks-color-adjustments
+                     (color-name-to-rgb color-string))))
+
 (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."
@@ -277,9 +330,7 @@ erc-nicks--get-face
                                               (erc-network-name) "-face")))
                    ((or (and (facep face) face)
                         (erc-nicks--revive face face nick (erc-network))))))
-        (let ((color (seq-reduce
-                      (lambda (color strategy) (funcall strategy color))
-                      (erc-list erc-nicks-color-contrast-strategy)
+        (let ((color (erc-nicks--reduce
                       (pcase erc-nicks-colors
                         ('all (format "#%012x" (erc-nicks--hash key)))
                         ((or 'defined v)
@@ -305,10 +356,11 @@ erc-nicks--highlight
   (when-let*
       ((nick-object)
        (server-user (erc-button--nick-user nick-object))
-       (trimmed (if erc-nicks-ignore-chars-regexp
-                    (string-trim (erc-server-user-nickname server-user)
-                                 (car erc-nicks-ignore-chars-regexp)
-                                 (cdr erc-nicks-ignore-chars-regexp))
+       (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
@@ -352,7 +404,7 @@ nicks
           temp "\" globally.  Please see `erc-nicks-bg-color'.")
          (custom-set-variables (list 'erc-nicks-bg-color temp))))
      (setq erc-nicks--face-table (make-hash-table :test #'equal)))
-   (setf (alist-get "Edit face" erc--nick-popup-alist nil nil #'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))
@@ -364,7 +416,8 @@ nicks
      (erc-button--phantom-users-mode -1))
    (remove-function (local 'erc-button--modify-nick-function)
                     #'erc-nicks--highlight)
-   (setf (alist-get "Edit face" erc--nick-popup-alist nil 'remove #'equal)
+   (setf (alist-get "Edit face"
+                    erc-button--nick-popup-alist nil 'remove #'equal)
          nil))
   'local)
 
diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el
index e0a5691b073..e84a2fea6ce 100644
--- a/test/lisp/erc/erc-nicks-tests.el
+++ b/test/lisp/erc/erc-nicks-tests.el
@@ -19,6 +19,9 @@
 
 ;;; 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
@@ -30,6 +33,19 @@
 (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")))
@@ -50,36 +66,149 @@ erc-nicks--get-luminance
     (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 ()
-  (let ((erc-nicks--bg-mode-value 'dark))
-    (should (equal (erc-nicks-invert "white") "white"))
-    (should (equal (erc-nicks-invert "black") "#ffffffffffff"))
-    (should (equal (erc-nicks-invert "green") "green")))
-  (let ((erc-nicks--bg-mode-value 'light))
-    (should (equal (erc-nicks-invert "white") "#000000000000"))
-    (should (equal (erc-nicks-invert "black") "black"))
-    (should (equal (erc-nicks-invert "green") "#ffff0000ffff"))))
+(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 ((result (funcall fn color))
-        (fg (if (eq 'dark erc-nicks--bg-mode-value) "white" "black"))
-        (start (point)))
+  (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 (+ start 32) 'face
-                       (list :foreground fg))
     (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))))
 
@@ -108,7 +237,7 @@ erc-nicks-add-contrast
         (kill-buffer)))))
 
 (ert-deftest erc-nicks-cap-contrast ()
-  (should (= 12.5 (cdr erc-nicks-contrast-ratio)))
+  (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
-- 
2.40.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Allow-ERC-modules-to-extend-erc-nick-popup-alist.patch --]
[-- Type: text/x-patch, Size: 6777 bytes --]

From 1fc18ed7a18fecaa492a831150af0f27696c1c7a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 1/2] [5.6] Allow ERC modules to extend erc-nick-popup-alist

* etc/ERC-NEWS: Mention superficial changes to `erc-nick-popup-alist'.
* lisp/erc/erc-button.el (erc-nick-popup-alist): Accept alternate
shape for type with strings associated with functions instead of
arbitrary sexps.
(erc-button-cmd-KICK, erc-button-cmd-MSG): New functions to serve as
wrappers for `erc-cmd-KICK' and `erc-cmd-MSG', respectively.  The
first also fixes a bug in which all but the first token of a given
"reason" would be omitted from the ":trailing" portion of an outgoing
KICK message.
(erc-button--nick-popup-alist): New variable to help built-in modules
expose special actions to `erc-nick-popup' without touching
`erc-nick-popup-alist'.
(erc-nick-popup): Present both `erc--nick-popup-alist' and
`erc-nick-popup-alist' to the invoking user.  Accommodate functions as
well as arbitrary sexps.  (bug#63569)
---
 etc/ERC-NEWS           | 18 ++++++++----
 lisp/erc/erc-button.el | 64 +++++++++++++++++++++++++++++++-----------
 2 files changed, 59 insertions(+), 23 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index e9ec9e2caab..840ac64f963 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -116,13 +116,19 @@ asking users who've customized this option to switch to
 that some other solution, like automatic migration, is justified,
 please make that known on the bug list.
 
-** The 'nicknames' entry in 'erc-button-alist' is officially exceptional.
+** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
 It's no secret that the 'buttons' module treats potential nicknames
-specially.  To simplify ERC's move to next-gen "rich UI" extensions,
-this special treatment is being canonized.  From now on, all values
-other than the symbol 'erc-button-buttonize-nicks' appearing in the
-"FORM" field (third element) of this entry are considered deprecated
-and will incur a warning.
+specially.  This is perhaps most evident in its treatment of the
+'nicknames' entry in 'erc-button-alist'.  Indeed, to simplify ERC's
+move to next-gen "rich UI" extensions, this special treatment is being
+canonized.  From now on, all values other than the symbol
+'erc-button-buttonize-nicks' appearing in the "FORM" field (third
+element) of this entry are considered deprecated and will incur a
+warning.  Relatedly, the option 'erc-nick-popup-alist' now favors
+functions, which ERC calls non-interactively, over arbitrary
+s-expressions, which ERC will continue to honor.  Although the default
+lineup remains functionally equivalent, its members have all been
+updated accordingly.
 
 ** Option 'erc-query-on-unjoined-chan-privmsg' restored and renamed.
 This option was accidentally removed from the default client in ERC
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 33b93ff6744..9c84de6720a 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -660,20 +660,20 @@ erc-browse-emacswiki-lisp
 ;;; Nickname buttons:
 
 (defcustom erc-nick-popup-alist
-  '(("DeOp"  . (erc-cmd-DEOP nick))
-    ("Kick"  . (erc-cmd-KICK (concat nick " "
-                                     (read-from-minibuffer
-                                      (concat "Kick " nick ", reason: ")))))
-    ("Msg"   . (erc-cmd-MSG (concat nick " "
-                                    (read-from-minibuffer
-                                     (concat "Message to " nick ": ")))))
-    ("Op"    . (erc-cmd-OP nick))
-    ("Query" . (erc-cmd-QUERY nick))
-    ("Whois" . (erc-cmd-WHOIS nick))
-    ("Lastlog" . (erc-cmd-LASTLOG nick)))
+  '(("DeOp"  . erc-cmd-DEOP)
+    ("Kick"  . erc-button-cmd-KICK)
+    ("Msg"   . erc-button-cmd-MSG)
+    ("Op"    . erc-cmd-OP)
+    ("Query" . erc-cmd-QUERY)
+    ("Whois" . erc-cmd-WHOIS)
+    ("Lastlog" . erc-cmd-LASTLOG))
   "An alist of possible actions to take on a nickname.
-An entry looks like (\"Action\" . SEXP) where SEXP is evaluated with
-the variable `nick' bound to the nick in question.
+For all entries (ACTION . FUNC), ERC offers ACTION as a possible
+completion item and calls the selected entry's FUNC with the
+buttonized nickname at point as the only argument.  For
+historical reasons, FUNC can also be an arbitrary sexp, in which
+case, ERC binds the nick in question to the variable `nick' and
+evaluates the expression.
 
 Examples:
  (\"DebianDB\" .
@@ -681,18 +681,48 @@ erc-nick-popup-alist
    (format
     \"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\"
     nick)))"
+  :package-version '(ERC . "5.6") ; FIXME sync on release
   :type '(repeat (cons (string :tag "Op")
-                       sexp)))
+                       (choice function sexp))))
+
+(defun erc-button-cmd-KICK (nick)
+  "Prompt for a reason, then kick NICK via `erc-cmd-KICK'.
+In server buffers, also prompt for a channel."
+  (erc-cmd-KICK
+   (or (and erc--target (erc-default-target))
+       (let ((targets (mapcar (lambda (b)
+                                (cons (erc--target-string
+                                       (buffer-local-value 'erc--target b))
+                                      b))
+                              (erc-channel-list erc-server-process))))
+         (completing-read (format "Channel (%s): " (caar targets))
+                          targets (pcase-lambda (`(,_ . ,buf))
+                                    (with-current-buffer buf
+                                      (erc-get-channel-user nick)))
+                          t nil t (caar targets))))
+   nick
+   (read-from-minibuffer "Reason: ")))
+
+(defun erc-button-cmd-MSG (nick)
+  "Prompt for a message to NICK, and send it via `erc-cmd-MSG'."
+  (let ((msg (read-from-minibuffer (concat "Message to " nick ": "))))
+    (erc-cmd-MSG (concat nick " " msg))))
+
+(defvar-local erc-button--nick-popup-alist nil
+  "Internally controlled items for `erc-nick-popup-alist'.")
 
 (defun erc-nick-popup (nick)
   (let* ((completion-ignore-case t)
+         (alist (append erc-nick-popup-alist erc-button--nick-popup-alist))
          (action (completing-read (format-message
                                    "What action to take on `%s'? " nick)
-                                  erc-nick-popup-alist))
-         (code (cdr (assoc action erc-nick-popup-alist))))
+                                  alist))
+         (code (cdr (assoc action alist))))
     (when code
       (erc-set-active-buffer (current-buffer))
-      (eval code `((nick . ,nick))))))
+      (if (functionp code)
+          (funcall code nick)
+        (eval code `((nick . ,nick)))))))
 
 ;;; Callback functions
 (defun erc-button-describe-symbol (symbol-name)
-- 
2.40.1


[-- Attachment #4: 0002-5.6-Add-module-for-colorizing-nicknames-to-ERC.patch --]
[-- Type: text/x-patch, Size: 38789 bytes --]

From a7d23ce4ca9f3b09c03b65d074ad0915d88a6da1 Mon Sep 17 00:00:00 2001
From: David Leatherman <leathekd@gmail.com>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 2/2] [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>
Co-authored-by: F. Jason Park <jp@neverwas.me>
---
 doc/misc/erc.texi                |   4 +
 etc/ERC-NEWS                     |   8 +
 lisp/erc/erc-nicks.el            | 442 +++++++++++++++++++++++++++++++
 lisp/erc/erc.el                  |   1 +
 test/lisp/erc/erc-nicks-tests.el | 303 +++++++++++++++++++++
 test/lisp/erc/erc-tests.el       |   2 +-
 6 files changed, 759 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 14c6a457654..c18931b5f43 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 840ac64f963..e312ec38ca3 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..0e0a481d453
--- /dev/null
+++ b/lisp/erc/erc-nicks.el
@@ -0,0 +1,442 @@
+;;; 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.  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-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 a la `erc-nick-uniquifier' to secure a nickname
+after a rejection.  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."
+  :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-add-contrast 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.  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."
+  :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.0 . 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.  Values 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))
+
+;; 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."
+  :type '(choice (const all) (const defined) (list string)))
+
+(defvar-local erc-nicks--face-table nil
+  "Hash table containing unique nick faces.")
+
+;; 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
+
+(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))))
+         (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)
+
+;; 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))
+
+(defvar-local erc-nicks--colors-len nil)
+(defvar-local erc-nicks--custom-keywords '(:group erc-nicks :group erc-faces))
+
+(defun erc-nicks--revive (new-face old-face nick net)
+  (put new-face 'erc-nicks--custom-nick (cons nick net))
+  (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-string)
+  "Fold contrast strategies over COLOR-STRING."
+  (apply #'color-rgb-to-hex
+         (seq-reduce (lambda (color strategy) (funcall strategy color))
+                     erc-nicks-color-adjustments
+                     (color-name-to-rgb color-string))))
+
+(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))))
+    (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 (format "#%012x" (erc-nicks--hash 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)))))
+              (new-face (make-symbol (concat "erc-nicks-" nick "-face"))))
+          (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)))))
+
+(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."
+  (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 (seq-some (lambda (f) (memq f erc-nicks-skip-faces))
+                       (erc-list face)))) ; cl-notany
+       ;; 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)))))
+  nick-object)
+
+(define-erc-module nicks nil
+  "Uniquely colorize nicknames in target buffers."
+  ((if erc--target
+       (progn
+         (add-function :filter-return (local 'erc-button--modify-nick-function)
+                       #'erc-nicks--highlight '((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))))
+     (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)
+   (when (fboundp 'erc-button--phantom-users-mode)
+     (erc-button--phantom-users-mode -1))
+   (remove-function (local 'erc-button--modify-nick-function)
+                    #'erc-nicks--highlight)
+   (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-downcase (substring-no-properties nick)))
+  (let* ((net (erc-network))
+         (key (concat nick (and net (format "%9s" net))))
+         (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)))
+
+(provide 'erc-nicks)
+
+;;; erc-nicks.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5a91285c1d1..26e81c1ce69 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2028,6 +2028,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..e84a2fea6ce
--- /dev/null
+++ b/test/lisp/erc/erc-nicks-tests.el
@@ -0,0 +1,303 @@
+;;; 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)))))
+
+;; 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))))
+
+;;; erc-nicks-tests.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 1c75f35e1b5..38b0e16db86 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -2052,7 +2052,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


  parent reply	other threads:[~2023-05-30 14:24 UTC|newest]

Thread overview: 15+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <87ilcp1za1.fsf@neverwas.me>
2023-05-23 13:37 ` bug#63569: 30.0.50; ERC 5.6: Add automatic nickname highlighting to ERC J.P.
2023-05-30 14:24 ` J.P. [this message]
2023-06-13  4:07 ` J.P.
     [not found] ` <87r0qgknt1.fsf@neverwas.me>
2023-06-16  3:07   ` Richard Stallman
     [not found]   ` <E1q9zoC-0003PO-Jf@fencepost.gnu.org>
2023-06-16  5:12     ` J.P.
     [not found]     ` <87h6r8j8ie.fsf@neverwas.me>
2023-06-18  2:13       ` Richard Stallman
2023-06-22 13:47 ` J.P.
     [not found] ` <871qi3boca.fsf@neverwas.me>
2023-06-23 13:38   ` J.P.
     [not found]   ` <87wmzu8fjg.fsf@neverwas.me>
2023-06-26 13:44     ` J.P.
2023-07-01  3:31 ` J.P.
2023-07-14  2:37 ` J.P.
2023-09-07 13:31 ` J.P.
     [not found] ` <87zg1yjeib.fsf@neverwas.me>
2023-11-07 16:28   ` J.P.
     [not found]   ` <87r0l1frzc.fsf@neverwas.me>
2023-11-13 20:06     ` J.P.
2023-05-18 14:37 J.P.

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='87wn0p6gnb.fsf__8976.16626914299$1685456794$gmane$org@neverwas.me' \
    --to=jp@neverwas.me \
    --cc=63569@debbugs.gnu.org \
    --cc=emacs-erc@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).