bug#67767: 30.0.50; ERC 5.6: Add track integration to the nicks module

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

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

v3. Make default behavior of `erc-nicks-track-faces' more intuitive. Fix
issue with detection of obsolete button face in `track' options. Make
`erc-track--select-mode-line-face' more convenient to modify.


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

From e14973511bf0c845ceaac2121c95cc47c6b17ae5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 13 Dec 2023 00:00:42 -0800
Subject: [PATCH 0/5] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (5):
  [5.6] Include rather than combine erc-nicks-backing-face
  [5.6] Fix Custom :type of erc-track-faces-normal-list
  [5.7] Promote "normal" faces in erc-track
  [5.7] Cache shortened channel names in erc-track
  [5.7] Add erc-track integration to erc-nicks

 etc/ERC-NEWS                     |  39 +++++
 lisp/erc/erc-button.el           |  49 +++---
 lisp/erc/erc-nicks.el            |  95 ++++++++++-
 lisp/erc/erc-track.el            | 270 +++++++++++++++++++++++++++----
 lisp/erc/erc.el                  |   8 +-
 test/lisp/erc/erc-nicks-tests.el |   2 +-
 test/lisp/erc/erc-track-tests.el | 166 +++++++++++++++++++
 7 files changed, 570 insertions(+), 59 deletions(-)

Interdiff:
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index 92dd03912e6..0b1e5e0c050 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -173,9 +173,19 @@ erc-nicks-key-suffix-format
 like \"@%-012n\"."
   :type 'string)
 
-(defcustom erc-nicks-track-faces t
-  "Show nick faces in the `track' module's portion of the mode line."
-  :type 'boolean)
+(defcustom erc-nicks-track-faces 'prioritize
+  "Show nick faces in the `track' module's portion of the mode line.
+A value of nil means don't show nick faces at all.  A value of
+`defer' means have `track' consider nick faces only after those
+ranked faces in `erc-track-faces-normal-list'.  This has the
+effect of \"alternating\" between a ranked \"normal\" and a nick.
+The value `prioritize' means have `track' consider nick faces to
+be \"normal\" unless the current speaker is the same as the
+previous one, in which case pretend the value is `defer'.  Like
+most options in this module, updating the value mid-session is
+not officially supported, although cycling \\[erc-nicks-mode] may
+be worth a shot."
+  :type '(choice (const nil) (const defer) (const prioritize)))
 
 (defvar erc-nicks--max-skip-search 3 ; make this an option?
   "Max number of faces to visit when testing `erc-nicks-skip-faces'.")
@@ -568,9 +578,8 @@ nicks
        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)
-   (unless erc-nicks-track-faces
-     (erc-nicks--setup-track-integration)
-     (add-hook 'erc-track-mode #'erc-nicks--setup-track-integration 50 t))
+   (erc-nicks--setup-track-integration)
+   (add-hook 'erc-track-mode #'erc-nicks--setup-track-integration 50 t)
    (advice-add 'widget-create-child-and-convert :filter-args
                #'erc-nicks--redirect-face-widget-link))
   ((kill-local-variable 'erc-nicks--face-table)
@@ -586,6 +595,8 @@ nicks
                     #'erc-nicks--reject-uninterned-faces)
    (remove-function (local 'erc-button--modify-nick-function)
                     #'erc-nicks--highlight-button)
+   (remove-function (local 'erc-track--alt-normals-function)
+                    #'erc-nicks--check-normals)
    (setf (alist-get "Edit face"
                     erc-button--nick-popup-alist nil 'remove #'equal)
          nil)
@@ -713,12 +724,42 @@ erc-nicks--reject-uninterned-faces
     (setq candidate (cdr candidate)))
   (if (and (consp candidate) (not (cdr candidate))) (car candidate) candidate))
 
+(define-inline erc-nicks--oursp (face)
+  (inline-quote
+   (and-let* ((sym (car-safe ,face))
+              ((symbolp sym))
+              ((get sym 'erc-nicks--key)))
+     sym)))
+
+(defun erc-nicks--check-normals (current contender contenders normals)
+  "Return a viable `nicks'-owned face from NORMALS in CONTENDERS.
+But only do so if the CURRENT face is also one of ours and in
+NORMALS and if the highest ranked CONTENDER among new faces is
+`erc-default-face', the lowest ranking default priority face."
+  (defvar erc-track--normal-faces)
+  (cl-assert erc-track--normal-faces)
+  (and-let* (((eq contender 'erc-default-face))
+             ((gethash current normals))
+             (spkr (erc-nicks--oursp current)))
+    (catch 'contender
+      (dolist (candidate (cdr contenders) contender)
+        (when-let (((not (equal candidate current)))
+                   ((gethash candidate normals))
+                   (s (erc-nicks--oursp candidate))
+                   ((not (eq s spkr))))
+          (throw 'contender candidate))))))
+
 (defun erc-nicks--setup-track-integration ()
   "Restore traditional \"alternating normal\" face functionality to mode-line."
-  (cl-assert (not erc-nicks-track-faces))
   (when (bound-and-true-p erc-track-mode)
-    (add-function :override (local 'erc-track--face-reject-function)
-                  #'erc-nicks--reject-uninterned-faces)))
+    (pcase erc-nicks-track-faces
+      ;; Variant `defer' is handled elsewhere.
+      ('prioritize
+       (add-function :override (local 'erc-track--alt-normals-function)
+                     #'erc-nicks--check-normals))
+      ('nil
+       (add-function :override (local 'erc-track--face-reject-function)
+                     #'erc-nicks--reject-uninterned-faces)))))
 
 (defun erc-nicks--remember-face-for-track (face)
   "Add FACE to local hash table maintained by `track' module."
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 4c3c7ca49a5..a6a1539b044 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -166,20 +166,25 @@ erc-track-use-faces
 ;; (erc-nick-default-face erc-pal-face).  However, since at least
 ;; Emacs 27, `match' has done its damage after `button' in
 ;; `erc-insert-modify-hook', meaning such permutations cannot exist.
-(defvar erc-track--old-nick-button-faces
-  '((erc-nick-default-face erc-default-face))
-  "List of obsolete nick button faces.")
-
-(defun erc-track--massage-nick-button-faces (val)
-  "Update members of face list VAL to have the default nick button face.
-In ERC 5.7, it changed from `erc-current-nick-face' to
-`erc-button-nick-default-face'."
-  (mapcar (lambda (f)
-            (if (and (eq (car-safe f) 'erc-nick-default-face)
-                     (member f erc-track--old-nick-button-faces))
-                (cons 'erc-button-nick-default-face (cdr f))
-              f))
-          val))
+(defun erc-track--massage-nick-button-faces (sym val &optional set-fn)
+  "Transform VAL of face-list option SYM to have new defaults.
+Use `set'-compatible SET-FN when given.  If an update was
+performed, stash a copy of the replaced VAL member in the symbol
+property `erc-track--obsolete-faces' of SYM."
+  (let* ((changedp nil)
+         (new (mapcar
+               (lambda (f)
+                 (if (and (eq (car-safe f) 'erc-nick-default-face)
+                          (equal f '(erc-nick-default-face erc-default-face)))
+                     (progn
+                       (setq changedp t)
+                       (put sym 'erc-track--obsolete-faces t)
+                       (cons 'erc-button-nick-default-face (cdr f)))
+                   f))
+               val)))
+    (if set-fn
+        (funcall set-fn sym (if changedp new val))
+      (set-default sym (if changedp new val)))))
 
 (defcustom erc-track-faces-priority-list
   '(erc-error-face
@@ -205,8 +210,7 @@ erc-track-faces-priority-list
 Note that ERC prioritizes certain faces reserved for critical
 messages regardless of this option's value."
   :package-version '(ERC . "5.7") ; FIXME sync on release
-  :set (lambda (sym val)
-         (set-default sym (erc-track--massage-nick-button-faces val)))
+  :set #'erc-track--massage-nick-button-faces
   :type (erc--with-dependent-type-match
          (repeat (choice face (repeat :tag "Combination" face)))
          erc-button))
@@ -248,10 +252,10 @@ erc-track-faces-normal-list
 
 The effect may be disabled by setting this variable to nil."
   :package-version '(ERC . "5.7") ; FIXME sync on release
-  :set (lambda (sym val)
-         (set-default sym (erc-track--massage-nick-button-faces val)))
-  :type '(repeat (choice face
-			 (repeat :tag "Combination" face))))
+  :set #'erc-track--massage-nick-button-faces
+  :type (erc--with-dependent-type-match
+         (repeat (choice face (repeat :tag "Combination" face)))
+         erc-button))
 
 (defvar erc-track-ignore-normal-contenders-p nil
   "Compatibility flag to promote only exclusively new \"normal\" faces.
@@ -649,30 +653,29 @@ erc-track--setup
       (let ((existing (erc-with-server-buffer erc-track--normal-faces))
             (localp (and erc--target
                          (local-variable-p 'erc-track-faces-normal-list)))
+            (opts '(erc-track-faces-normal-list erc-track-faces-priority-list))
             warnp table)
+        ;; Don't bother warning users who've disabled `button'.
         (unless (or erc--target (not (or (bound-and-true-p erc-button-mode)
                                          (memq 'button erc-modules))))
-          (dolist (opt '(erc-track-faces-normal-list
-                         erc-track-faces-priority-list))
-            (when (seq-some
-                   (lambda (f)
-                     (and (eq (car-safe f) 'erc-nick-default-face)
-                          (member f erc-track--old-nick-button-faces)))
-                   (symbol-value opt))
+          (when (or localp (local-variable-p 'erc-track-faces-priority-list))
+            (dolist (opt opts)
+              (erc-track--massage-nick-button-faces opt (symbol-value opt)
+                                                    #'set)))
+          (dolist (opt opts)
+            (when (get opt 'erc-track--obsolete-faces)
               (push opt warnp)
-              (set opt (erc-track--massage-nick-button-faces
-                        (symbol-value opt)))))
+              (put opt 'erc-track--obsolete-faces nil)))
           (when warnp
             (erc--warn-once-before-connect 'erc-track-mode
               (if (cdr warnp) "Options " "Option ")
               (mapconcat (lambda (o) (format "`%S'" o)) warnp " and ")
               (if (cdr warnp) " contain" " contains")
-              " obsolete list-style faces intended to match buttonized"
-              " nicknames. To silence this warning, please update members"
-              " with `%S' at their head, like %S, by converting them to %S."
-              " ERC has done this for you for this session."
-              'erc-nick-default-face '(erc-nick-default-face foo)
-              '(erc-button-nick-default-face foo))))
+              " an obsolete item, %S, intended to match buttonized nicknames."
+              " ERC has changed it to %S for the current session."
+              " Please save the current value to silence this message."
+              '(erc-nick-default-face erc-default-face)
+              '(erc-button-nick-default-face erc-default-face))))
         (when (or (null existing) localp)
           (setq table (map-into (mapcar (lambda (f) (cons f f))
                                         erc-track-faces-normal-list)
@@ -913,12 +916,12 @@ erc-track-select-mode-line-face
               choice))
         choice))))
 
-(define-inline erc-track--gett (table-or-function key)
-  "Look up KEY via TABLE-OR-FUNCTION."
-  (inline-quote
-   (if (functionp ,table-or-function)
-       (funcall ,table-or-function ,key)
-     (gethash ,key ,table-or-function))))
+(defvar erc-track--alt-normals-function nil
+  "A function to possibly elect a \"normal\" face.
+Called with the current incumbent and the worthiest new contender
+followed by all new contending faces and so-called \"normal\"
+faces.  See `erc-track--select-mode-line-face' for their meanings
+and expected types.  This function should return a face or nil.")
 
 (defun erc-track--select-mode-line-face (cur-face new-faces ranks normals)
   "Return CUR-FACE or a replacement for displaying in the mode-line, or nil.
@@ -929,12 +932,12 @@ erc-track--select-mode-line-face
 If NEW-FACES has a cdr, expect it to be its car's contents
 ordered from most recently seen (later in the buffer) to
 earliest.  In general, act like `erc-track-select-mode-line-face'
-except reconsider NEW-FACES when CUR-FACE outranks all its
-members.  That is, choose the highest RANKS among NEW-FACES not
-equal to CUR-FACE.  Failing that, choose the first face in
-NORMALS to appear anywhere in NEW-FACES, but only if NEW-FACES
-has a cdr.  If NORMALS is a function, call it with the name of a
-face to query membership."
+except appeal to `erc-track--alt-normals-function' if it's
+non-nil, falling back on reconsidering NEW-FACES when CUR-FACE
+outranks all its members.  That is, choose the first among RANKS
+in NEW-FACES not equal to CUR-FACE.  Failing that, choose the
+first face in NEW-FACES that's also in NORMALS, assuming
+NEW-FACES has a cdr."
   (cl-check-type erc-track-ignore-normal-contenders-p null)
   (cl-check-type new-faces cons)
   (when-let ((choice (catch 'face
@@ -942,21 +945,23 @@ erc-track--select-mode-line-face
                          (when (or (equal candidate cur-face)
                                    (gethash candidate (car new-faces)))
                            (throw 'face candidate))))))
-    (when-let (((equal choice cur-face))
-               ((erc-track--gett normals choice))
-               (contender (catch 'face
-                            (progn
-                              (dolist (candidate ranks)
-                                (when (and (not (equal candidate choice))
-                                           (gethash candidate (car new-faces))
-                                           (erc-track--gett normals candidate))
-                                  (throw 'face candidate)))
-                              (dolist (f (cdr new-faces))
-                                (when (and (not (equal f choice))
-                                           (erc-track--gett normals f))
-                                  (throw 'face f)))))))
-      (setq choice contender))
-    choice))
+    (or (and erc-track--alt-normals-function
+             (funcall erc-track--alt-normals-function
+                      cur-face choice new-faces normals))
+        (and (equal choice cur-face)
+             (gethash choice normals)
+             (catch 'face
+               (progn
+                 (dolist (candidate ranks)
+                   (when (and (not (equal candidate choice))
+                              (gethash candidate (car new-faces))
+                              (gethash choice normals))
+                     (throw 'face candidate)))
+                 (dolist (candidate (cdr new-faces))
+                   (when (and (not (equal candidate choice))
+                              (gethash candidate normals))
+                     (throw 'face candidate))))))
+        choice)))
 
 (defvar erc-track--skipped-msgs '(datestamp)
   "Values of `erc-msg' text prop to ignore.")
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Include-rather-than-combine-erc-nicks-backing-fa.patch --]
[-- Type: text/x-patch, Size: 2792 bytes --]

From 8f3926d0dd13a430bf4d8492e0e418e9677c8091 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Dec 2023 20:24:17 -0800
Subject: [PATCH 1/5] [5.6] Include rather than combine erc-nicks-backing-face

* lisp/erc/erc-nicks.el (erc-nicks--get-face): Make generated face
:inherit from `erc-nicks-backing-face'.
(erc-nicks--highlight): Just return the generated face instead of
combining it with `erc-nicks-backing-face' or the existing face in the
buffer.
* test/lisp/erc/erc-nicks-tests.el (erc-nicks-list-faces): Skip
"Inherit: " button.
---
 lisp/erc/erc-nicks.el            | 12 +++++-------
 test/lisp/erc/erc-nicks-tests.el |  2 +-
 2 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index fcd3afdbbc4..2f0c3261266 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -454,7 +454,9 @@ erc-nicks--get-face
           (put new-face 'erc-nicks--nick nick)
           (put new-face 'erc-nicks--netid erc-networks--id)
           (put new-face 'erc-nicks--key key)
-          (face-spec-set new-face `((t :foreground ,color)) 'face-defface-spec)
+          (face-spec-set new-face `((t :foreground ,color
+                                       :inherit ,erc-nicks-backing-face))
+                         'face-defface-spec)
           (set-face-documentation
            new-face (format "Internal face for %s on %s." nick (erc-network)))
           (puthash nick new-face table)))))
@@ -503,12 +505,8 @@ erc-nicks--highlight
              ((not (and base-face
                         (erc-nicks--skip-p base-face erc-nicks-skip-faces
                                            erc-nicks--max-skip-search))))
-             (key (erc-nicks--gen-key-from-format-spec trimmed))
-             (out (erc-nicks--get-face trimmed key)))
-    (if (or (null erc-nicks-backing-face)
-            (eq base-face erc-nicks-backing-face))
-        out
-      (cons out (erc-list erc-nicks-backing-face)))))
+             (key (erc-nicks--gen-key-from-format-spec trimmed)))
+    (erc-nicks--get-face trimmed key)))
 
 (defun erc-nicks--highlight-button (nick-object)
   "Possibly add face to `erc-button--nick-user' NICK-OBJECT."
diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el
index 35264a23caa..54882278139 100644
--- a/test/lisp/erc/erc-nicks-tests.el
+++ b/test/lisp/erc/erc-nicks-tests.el
@@ -409,7 +409,7 @@ erc-nicks-list-faces
              (push-button)
              (should (search-forward-regexp
                       (rx "Foreground: #" (group (+ xdigit)) eol)))
-             (forward-button 1)
+             (forward-button 2) ; skip Inherit:...
              (push-button))
 
            (ert-info ("First entry's sample is rendered correctly")
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Fix-Custom-type-of-erc-track-faces-normal-list.patch --]
[-- Type: text/x-patch, Size: 1165 bytes --]

From be105b8d876c4e0bace6049726302bde1cae7cdd Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 12 Dec 2023 19:04:12 -0800
Subject: [PATCH 2/5] [5.6] Fix Custom :type of erc-track-faces-normal-list

* lisp/erc/erc-track.el (erc-modified-channels-object):
Load `erc-button' during validation so that Customize chooses the
correct UI instead of a generic field with "(mismatch)" printed
alongside the "STATE" button.
---
 lisp/erc/erc-track.el | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index a36b781e04d..db10063cafe 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -225,8 +225,9 @@ erc-track-faces-normal-list
 are occurring in these channels.
 
 The effect may be disabled by setting this variable to nil."
-  :type '(repeat (choice face
-			 (repeat :tag "Combination" face))))
+  :type (erc--with-dependent-type-match
+         (repeat (choice face (repeat :tag "Combination" face)))
+         erc-button))
 
 (defcustom erc-track-position-in-mode-line 'before-modes
   "Where to show modified channel information in the mode-line.
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.7-Promote-normal-faces-in-erc-track.patch --]
[-- Type: text/x-patch, Size: 28781 bytes --]

From 60e297cf14c873bd55a73e80bb77c71a78f6a5e3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 10 Dec 2023 05:33:48 -0800
Subject: [PATCH 3/5] [5.7] Promote "normal" faces in erc-track

* etc/ERC-NEWS: Add entry for new behavior involving the option
`erc-track-faces-normal-list'.
* lisp/erc/erc-button.el (erc-button-nick-default-face): New face to
serve as default for `erc-button-nickname-face'.
(erc-button-nickname-face): Change default value to
`erc-button-nick-default-face'.
* lisp/erc/erc-track.el (erc-track--massage-nick-button-faces): New
function to serve as Custom :set function for priority and "normal"
face-list options.
(erc-track-faces-priority-list, erc-track-faces-normal-list): Change
values for `match' module faces to feature
`erc-button-nick-default-face' instead of `erc-nick-default-face'.
Use :set function to massage saved user values.
(erc-track-ignore-normal-contenders-p): New compatibility switch to
access pre-5.6 behavior, in which faces in
`erc-track-faces-normal-list' were only considered for promotion to
the mode line if the current face occupying that pole position wasn't
present.
(erc-track-mode, erc-track-enable, erc-track-disable): Add FIXME
comments regarding perceived futility of `erc-server-001-functions and
likely unneeded hook removal.  Run common buffer-local setup and
teardown.
(erc-track--normal-faces): New local variable, a snapshot of
`erc-track-faces-normal-list'.
(erc-track--setup): New function to stash
`erc-track-faces-normal-list' on init.
(erc-track-select-mode-line-face): Offer alternate explanation of
certain particulars in doc string.
(erc-track--alt-normals-function): New function-valued variable to
allow other modules to intervene in deciding whether to pursue and
promote a "normal" contending face.
(erc-track--select-mode-line-face): New function similar to its public
namesake except that it considers other viable candidates among the
"normal" alternatives.
(erc-track-modified-channels): Only run face selection portion when
faces are actually found.  Use `erc-track--select-mode-line-face'
instead of `erc-track-select-mode-line-face'.
* test/lisp/erc/erc-track-tests.el
(erc-track-select-mode-line-face): New test.
(erc-track-tests--select-mode-line-face): New function.
(erc-track--select-mode-line-face): New test.  (Bug#67767)
---
 etc/ERC-NEWS                     |  39 ++++++
 lisp/erc/erc-button.el           |   8 +-
 lisp/erc/erc-track.el            | 223 ++++++++++++++++++++++++++++---
 test/lisp/erc/erc-track-tests.el | 130 ++++++++++++++++++
 4 files changed, 377 insertions(+), 23 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 4642c742b0f..40e3d5d5638 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -170,6 +170,19 @@ options, like 'erc-command-indicator', have moved to the 'erc-goodies'
 library, although their Custom groups remain the same.  Add
 'command-indicator' to 'erc-modules' to get started.
 
+** Option 'erc-track-faces-normal-list' slightly more influential.
+This option has always been a source of confusion for users, mainly
+because its influence rode heavily on the makeup of faces in a given
+message.  Historically, when a buffer's current mode-line face was a
+member of this option's value, ERC would only swap it out for a fellow
+"normal" if it was absent from message being processed.  Beginning
+with this release, ERC now looks to other ranked and (if necessary)
+unranked "normals" instead of sustaining the same face between
+messages.  This was done to better honor the stated purpose of the
+option, which is to provide consistent visual feedback when buffer
+activity occurs.  If you experience problems with this development,
+see the compatibility flag 'erc-track-ignore-normal-contenders-p'.
+
 ** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
 It's no secret that the 'buttons' module treats potential nicknames
 specially.  This is perhaps most evident in its treatment of the
@@ -184,6 +197,23 @@ s-expressions, which ERC will continue to honor.  Although the default
 lineup remains functionally equivalent, its members have all been
 updated accordingly.
 
+** 'erc-track-faces-priority-list' and 'erc-track-faces-normal-list' slimmed.
+These options have been purged of certain 'button'-related face
+combinations.  Originally added in ERC 5.3, these combinations
+described the effect of "buttonizing" atop faces added by the 'match'
+module, like '(erc-nick-default-face erc-pal-face)'.  However, since
+at least Emacs 27, 'match' has run before 'button' in
+'erc-insert-modify-hook', meaning such permutations aren't possible.
+
+More importantly, users who've customized either of these options
+should update them with the new default value of the option
+'erc-button-nickname-face'.  Like 'erc-nick-default-face', which it
+replaces, the new 'erc-button-nick-default-face' is also a "real"
+face.  Its sole reason for existing is to make it easier for users and
+modules to distinguish between basic buttonized faces and
+'erc-nick-default-face', which is now reserved to mean the base
+"speaker" face.
+
 ** Option 'erc-query-on-unjoined-chan-privmsg' restored and renamed.
 This option was accidentally removed from the default client in ERC
 5.5 and was thus prevented from influencing PRIVMSG routing.  It's now
@@ -306,6 +336,15 @@ from 't' to the more useful 'erc-prompt', although the property of the
 same name has been retained and now has a value of 'hidden' when
 disconnected.
 
+*** Lists of faces in buttonized text are no longer nested.
+Previously, when "buttonizing" a new region, ERC would combine faces
+by blindly consing the new onto the existing.  In theory, this kept a
+nice record of all modifications to a given region.  However, it also
+complicated life for other modules wanting to analyze and operate on
+these regions.  Beginning with this release, ERC now merges combined
+faces together when creating buttons, although the odd nested list may
+still crop up here and there.
+
 *** Members of insert- and send-related hooks have been reordered.
 As anyone reading this is no doubt aware, both built-in and
 third-party modules rely on certain hooks for adjusting incoming and
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index e1c10be53f6..f10d7a2fce7 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -70,6 +70,11 @@ erc-button
   "ERC button face."
   :group 'erc-faces)
 
+(defface erc-button-nick-default-face '((t :inherit erc-nick-default-face))
+  "Default face for a buttonized nickname."
+  :package-version '(ERC . "5.7") ; FIXME sync on release
+  :group 'erc-faces)
+
 (defcustom erc-button-face 'erc-button
   "Face used for highlighting buttons in ERC buffers.
 
@@ -78,8 +83,9 @@ erc-button-face
   :type 'face
   :group 'erc-faces)
 
-(defcustom erc-button-nickname-face 'erc-nick-default-face
+(defcustom erc-button-nickname-face 'erc-button-nick-default-face
   "Face used for ERC nickname buttons."
+  :package-version '(ERC . "5.7") ; FIXME sync on release
   :type 'face
   :group 'erc-faces)
 
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index db10063cafe..490fc52d42c 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -161,23 +161,44 @@ erc-track-use-faces
 \(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
   :type 'boolean)
 
+;; Historically, `erc-track-faces-priority-list' had members
+;; describing the effect of buttonizing atop faces from `match', e.g.,
+;; (erc-nick-default-face erc-pal-face).  However, since at least
+;; Emacs 27, `match' has done its damage after `button' in
+;; `erc-insert-modify-hook', meaning such permutations cannot exist.
+(defun erc-track--massage-nick-button-faces (sym val &optional set-fn)
+  "Transform VAL of face-list option SYM to have new defaults.
+Use `set'-compatible SET-FN when given.  If an update was
+performed, stash a copy of the replaced VAL member in the symbol
+property `erc-track--obsolete-faces' of SYM."
+  (let* ((changedp nil)
+         (new (mapcar
+               (lambda (f)
+                 (if (and (eq (car-safe f) 'erc-nick-default-face)
+                          (equal f '(erc-nick-default-face erc-default-face)))
+                     (progn
+                       (setq changedp t)
+                       (put sym 'erc-track--obsolete-faces t)
+                       (cons 'erc-button-nick-default-face (cdr f)))
+                   f))
+               val)))
+    (if set-fn
+        (funcall set-fn sym (if changedp new val))
+      (set-default sym (if changedp new val)))))
+
 (defcustom erc-track-faces-priority-list
   '(erc-error-face
-    (erc-nick-default-face erc-current-nick-face)
     erc-current-nick-face
     erc-keyword-face
-    (erc-nick-default-face erc-pal-face)
     erc-pal-face
     erc-nick-msg-face
     erc-direct-msg-face
     (erc-button erc-default-face)
-    (erc-nick-default-face erc-dangerous-host-face)
     erc-dangerous-host-face
     erc-nick-default-face
-    (erc-nick-default-face erc-default-face)
+    (erc-button-nick-default-face erc-default-face)
     erc-default-face
     erc-action-face
-    (erc-nick-default-face erc-fool-face)
     erc-fool-face
     erc-notice-face
     erc-input-face
@@ -188,6 +209,8 @@ erc-track-faces-priority-list
 
 Note that ERC prioritizes certain faces reserved for critical
 messages regardless of this option's value."
+  :package-version '(ERC . "5.7") ; FIXME sync on release
+  :set #'erc-track--massage-nick-button-faces
   :type (erc--with-dependent-type-match
          (repeat (choice face (repeat :tag "Combination" face)))
          erc-button))
@@ -209,10 +232,9 @@ erc-track-priority-faces-only
 
 (defcustom erc-track-faces-normal-list
   '((erc-button erc-default-face)
-    (erc-nick-default-face erc-dangerous-host-face)
     erc-dangerous-host-face
     erc-nick-default-face
-    (erc-nick-default-face erc-default-face)
+    (erc-button-nick-default-face erc-default-face)
     erc-default-face
     erc-action-face)
   "A list of faces considered to be part of normal conversations.
@@ -224,11 +246,26 @@ erc-track-faces-normal-list
 message.  This gives a rough indication that active conversations
 are occurring in these channels.
 
+Note that ERC makes a copy of this option when initializing the
+module.  To see your changes reflected mid-session, cycle
+\\[erc-track-mode].
+
 The effect may be disabled by setting this variable to nil."
+  :package-version '(ERC . "5.7") ; FIXME sync on release
+  :set #'erc-track--massage-nick-button-faces
   :type (erc--with-dependent-type-match
          (repeat (choice face (repeat :tag "Combination" face)))
          erc-button))
 
+(defvar erc-track-ignore-normal-contenders-p nil
+  "Compatibility flag to promote only exclusively new \"normal\" faces.
+When non-nil, revert to pre-5.6 behavior in which a current
+mode-line face that both outranks and is absent from the current
+message is eligible for replacement with a fellow face from
+`erc-track-faces-normal-list' that does appear in the message.
+By extension, when enabled, never replace the current, reigning
+mode-line face if it's present in the current message.")
+
 (defcustom erc-track-position-in-mode-line 'before-modes
   "Where to show modified channel information in the mode-line.
 
@@ -519,6 +556,9 @@ track
 	 (progn
 	   (add-hook 'window-configuration-change-hook #'erc-user-is-active)
 	   (add-hook 'erc-send-completed-hook #'erc-user-is-active)
+           ;; FIXME find out why this uses `erc-server-001-functions'.
+           ;; `erc-user-is-active' runs when `erc-server-connected' is
+           ;; non-nil.  But this hook usually only runs when it's nil.
 	   (add-hook 'erc-server-001-functions #'erc-user-is-active))
        (erc-track-add-to-mode-line erc-track-position-in-mode-line)
        (erc-update-mode-line)
@@ -529,6 +569,8 @@ track
      ;; enable the tracking keybindings
      (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
      (erc-track-minor-mode-maybe))
+   (add-hook 'erc-mode-hook #'erc-track--setup)
+   (unless erc--updating-modules-p (erc-buffer-do #'erc-track--setup))
    (add-hook 'erc-networks--copy-server-buffer-functions
              #'erc-track--replace-killed-buffer))
   ;; Disable:
@@ -540,6 +582,7 @@ track
 			#'erc-user-is-active)
 	   (remove-hook 'erc-send-completed-hook #'erc-user-is-active)
 	   (remove-hook 'erc-server-001-functions #'erc-user-is-active)
+           ;; FIXME remove this if unused.
 	   (remove-hook 'erc-timer-hook #'erc-user-is-active))
        (remove-hook 'window-configuration-change-hook
 		    #'erc-window-configuration-change)
@@ -549,9 +592,12 @@ track
      (remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
      (when erc-track-minor-mode
        (erc-track-minor-mode -1)))
+   (remove-hook 'erc-mode-hook #'erc-track--setup)
+   (erc-buffer-do #'erc-track--setup)
    (remove-hook 'erc-networks--copy-server-buffer-functions
                 #'erc-track--replace-killed-buffer)))
 
+;; FIXME move this above the module definition.
 (defcustom erc-track-when-inactive nil
   "Enable channel tracking even for visible buffers, if you are inactive."
   :type 'boolean
@@ -563,6 +609,51 @@ erc-track-when-inactive
 	       (erc-track-enable))
 	   (set sym val))))
 
+(defvar-local erc-track--normal-faces nil
+  "Local copy of `erc-track-faces-normal-list' as a hash table.")
+
+(defun erc-track--setup ()
+  "Initialize a buffer for use with the `track' module.
+If this is a server buffer or `erc-track-faces-normal-list' is
+locally bound, create a new `erc-track--normal-faces' for the
+current buffer.  Otherwise, set the local value to the server
+buffer's."
+  (if erc-track-mode
+      (let ((existing (erc-with-server-buffer erc-track--normal-faces))
+            (localp (and erc--target
+                         (local-variable-p 'erc-track-faces-normal-list)))
+            (opts '(erc-track-faces-normal-list erc-track-faces-priority-list))
+            warnp table)
+        ;; Don't bother warning users who've disabled `button'.
+        (unless (or erc--target (not (or (bound-and-true-p erc-button-mode)
+                                         (memq 'button erc-modules))))
+          (when (or localp (local-variable-p 'erc-track-faces-priority-list))
+            (dolist (opt opts)
+              (erc-track--massage-nick-button-faces opt (symbol-value opt)
+                                                    #'set)))
+          (dolist (opt opts)
+            (when (get opt 'erc-track--obsolete-faces)
+              (push opt warnp)
+              (put opt 'erc-track--obsolete-faces nil)))
+          (when warnp
+            (erc--warn-once-before-connect 'erc-track-mode
+              (if (cdr warnp) "Options " "Option ")
+              (mapconcat (lambda (o) (format "`%S'" o)) warnp " and ")
+              (if (cdr warnp) " contain" " contains")
+              " an obsolete item, %S, intended to match buttonized nicknames."
+              " ERC has changed it to %S for the current session."
+              " Please save the current value to silence this message."
+              '(erc-nick-default-face erc-default-face)
+              '(erc-button-nick-default-face erc-default-face))))
+        (when (or (null existing) localp)
+          (setq table (map-into (mapcar (lambda (f) (cons f f))
+                                        erc-track-faces-normal-list)
+                                '(hash-table :test equal :weakness value))))
+        (setq erc-track--normal-faces (or table existing))
+        (unless (or localp existing)
+          (erc-with-server-buffer (setq erc-track--normal-faces table))))
+    (kill-local-variable 'erc-track--normal-faces)))
+
 ;;; Visibility
 
 (defvar erc-buffer-activity nil
@@ -767,7 +858,12 @@ erc-track-select-mode-line-face
 face, if a member of `erc-track-faces-normal-list', to be
 replaced with another with lower priority face from NEW-FACES, if
 that face with highest priority in NEW-FACES is also a member of
-`erc-track-faces-normal-list'."
+`erc-track-faces-normal-list'.
+
+To put it another way, when CUR-FACE outranks all NEW-FACES and
+doesn't appear among them, it's eligible to be replaced with a
+fellow \"normal\" from NEW-FACES.  But if it does appear among
+them, it can't be replaced."
   (let ((choice (catch 'face
                   (dolist (candidate erc-track-faces-priority-list)
                     (when (or (equal candidate cur-face)
@@ -786,6 +882,53 @@ erc-track-select-mode-line-face
               choice))
         choice))))
 
+(defvar erc-track--alt-normals-function nil
+  "A function to possibly elect a \"normal\" face.
+Called with the current incumbent and the worthiest new contender
+followed by all new contending faces and so-called \"normal\"
+faces.  See `erc-track--select-mode-line-face' for their meanings
+and expected types.  This function should return a face or nil.")
+
+(defun erc-track--select-mode-line-face (cur-face new-faces ranks normals)
+  "Return CUR-FACE or a replacement for displaying in the mode-line, or nil.
+Expect RANKS to be a list of faces and both NORMALS and the car
+of NEW-FACES to be hash tables mapping faces to non-nil values.
+Assume the latter's makeup and that of RANKS to resemble
+`erc-track-face-normal-list' and `erc-track-faces-priority-list'.
+If NEW-FACES has a cdr, expect it to be its car's contents
+ordered from most recently seen (later in the buffer) to
+earliest.  In general, act like `erc-track-select-mode-line-face'
+except appeal to `erc-track--alt-normals-function' if it's
+non-nil, falling back on reconsidering NEW-FACES when CUR-FACE
+outranks all its members.  That is, choose the first among RANKS
+in NEW-FACES not equal to CUR-FACE.  Failing that, choose the
+first face in NEW-FACES that's also in NORMALS, assuming
+NEW-FACES has a cdr."
+  (cl-check-type erc-track-ignore-normal-contenders-p null)
+  (cl-check-type new-faces cons)
+  (when-let ((choice (catch 'face
+                       (dolist (candidate ranks)
+                         (when (or (equal candidate cur-face)
+                                   (gethash candidate (car new-faces)))
+                           (throw 'face candidate))))))
+    (or (and erc-track--alt-normals-function
+             (funcall erc-track--alt-normals-function
+                      cur-face choice new-faces normals))
+        (and (equal choice cur-face)
+             (gethash choice normals)
+             (catch 'face
+               (progn
+                 (dolist (candidate ranks)
+                   (when (and (not (equal candidate choice))
+                              (gethash candidate (car new-faces))
+                              (gethash choice normals))
+                     (throw 'face candidate)))
+                 (dolist (candidate (cdr new-faces))
+                   (when (and (not (equal candidate choice))
+                              (gethash candidate normals))
+                     (throw 'face candidate))))))
+        choice)))
+
 (defvar erc-track--skipped-msgs '(datestamp)
   "Values of `erc-msg' text prop to ignore.")
 
@@ -820,31 +963,43 @@ erc-track-modified-channels
 	;; (in the car), change its face attribute (in the cddr) if
 	;; necessary.  See `erc-modified-channels-alist' for the
 	;; exact data structure used.
-        (let ((faces (erc-faces-in (buffer-string)))
-              (erc-track-faces-priority-list
-               `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)))
-	  (unless (and
-		   (or (eq erc-track-priority-faces-only 'all)
-		       (member this-channel erc-track-priority-faces-only))
-		   (not (catch 'found
-			  (dolist (f faces)
-			    (when (member f erc-track-faces-priority-list)
-			      (throw 'found t))))))
+        (when-let
+            ((faces (if erc-track-ignore-normal-contenders-p
+                        (erc-faces-in (buffer-string))
+                      (erc-track--get-faces-in-current-message)))
+             (normals erc-track--normal-faces)
+             (erc-track-faces-priority-list
+              `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))
+             (ranks erc-track-faces-priority-list)
+             ((not (and
+                    (or (eq erc-track-priority-faces-only 'all)
+                        (member this-channel erc-track-priority-faces-only))
+                    (not (catch 'found
+                           (dolist (f ranks)
+                             (when (gethash f (or (car-safe faces) faces))
+                               (throw 'found t)))))))))
+          (progn ; FIXME remove `progn' on next major edit
 	    (if (not (assq (current-buffer) erc-modified-channels-alist))
 		;; Add buffer, faces and counts
 		(setq erc-modified-channels-alist
 		      (cons (cons (current-buffer)
 				  (cons
-                                   1 (erc-track-select-mode-line-face
-                                      nil faces)))
+                                   1 (if erc-track-ignore-normal-contenders-p
+                                         (erc-track-select-mode-line-face
+                                          nil faces)
+                                       (erc-track--select-mode-line-face
+                                        nil faces ranks normals))))
 			    erc-modified-channels-alist))
 	      ;; Else modify the face for the buffer, if necessary.
 	      (when faces
 		(let* ((cell (assq (current-buffer)
 				   erc-modified-channels-alist))
 		       (old-face (cddr cell))
-		       (new-face (erc-track-select-mode-line-face
-                                  old-face faces)))
+                       (new-face (if erc-track-ignore-normal-contenders-p
+                                     (erc-track-select-mode-line-face
+                                      old-face faces)
+                                   (erc-track--select-mode-line-face
+                                    old-face faces ranks normals))))
 		  (setcdr cell (cons (1+ (cadr cell)) new-face)))))
 	    ;; And display it
 	    (erc-modified-channels-display)))
@@ -873,6 +1028,30 @@ erc-faces-in
 	   (push cur faces)))
     faces))
 
+(defvar erc-track--face-reject-function nil
+  "Function called with face in current buffer to massage or reject.")
+
+(defun erc-track--get-faces-in-current-message ()
+  "Collect all faces in the narrowed buffer.
+Return a cons of a hash table and a list ordered from most
+recently seen to earliest seen."
+  (let ((i (text-property-not-all (point-min) (point-max) 'font-lock-face nil))
+        (seen (make-hash-table :test #'equal))
+        ;;
+        (rfaces ())
+        (faces (make-hash-table :test #'equal)))
+    (while-let ((i)
+                (cur (get-text-property i 'face)))
+      (unless (gethash cur seen)
+        (puthash cur t seen)
+        (when erc-track--face-reject-function
+          (setq cur (funcall erc-track--face-reject-function cur)))
+        (when cur
+          (push cur rfaces)
+          (puthash cur t faces)))
+      (setq i (next-single-property-change i 'font-lock-face)))
+    (cons faces rfaces)))
+
 ;;; Buffer switching
 
 (defvar erc-track-last-non-erc-buffer nil
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index ab8d708b721..4477727be8a 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -120,4 +120,134 @@ erc-track--erc-faces-in
     (should (erc-faces-in str0))
     (should (erc-faces-in str1)) ))
 
+;; This simulates an alternating bold/non-bold [#c] in the mode-line,
+;; i.e., an `erc-modified-channels-alist' that vacillates between
+;;
+;;   ((#<buffer #chan> 42 . erc-default-face))
+;;
+;; and
+;;
+;;   ((#<buffer #chan> 42 erc-nick-default-face erc-default-face))
+;;
+;; This is a fairly typical scenario where consecutive messages
+;; feature speaker and addressee button highlighting and otherwise
+;; plain message bodies.  This mapping of phony to real faces
+;; describes the picture in 5.6:
+;;
+;;   `1': (erc-button erc-default-face)                 ; URL
+;;   `2': (erc-nick-default-face erc-default-face)      ; mention
+;;   `3': erc-default-face                              ; body
+;;   `_': (erc-nick-default-face erc-nick-default-face) ; speaker
+;;
+;; The `_' represents a commonly occurring face (a <speaker>) that's
+;; not present in either option's default (standard) value.  It's a
+;; no-op from the POV of `erc-track-select-mode-line-face'.
+
+(ert-deftest erc-track-select-mode-line-face ()
+
+  ;; Observed (see key above).
+  (let ((erc-track-faces-priority-list '(1 2 3))
+        (erc-track-faces-normal-list   '(1 2 3)))
+
+    (should (equal 2 (erc-track-select-mode-line-face 3 '(2 _ 3))))
+    (should (equal 2 (erc-track-select-mode-line-face 2 '(2 _ 3))))
+    (should (equal 3 (erc-track-select-mode-line-face 2 '(_ 3))))
+    (should (equal 2 (erc-track-select-mode-line-face 3 '(2 3))))
+    (should (equal 3 (erc-track-select-mode-line-face 2 '(3))))
+
+    (should (equal 1 (erc-track-select-mode-line-face 1 '(2 1 3))))
+    (should (equal 1 (erc-track-select-mode-line-face 1 '(1 3))))
+    (should (equal 1 (erc-track-select-mode-line-face 1 '(1 3 2))))
+    (should (equal 1 (erc-track-select-mode-line-face 1 '(3 1)))))
+
+  ;; When the current face outranks all new faces and doesn't appear
+  ;; among them, it's eligible to be replaced with a fellow "normal"
+  ;; from those new faces.  But if it does appear among them, it's
+  ;; never replaced.
+  (let ((erc-track-faces-priority-list '(a b))
+        (erc-track-faces-normal-list   '(a b)))
+
+    (should (equal 'a (erc-track-select-mode-line-face 'a '(b a))))
+    (should (equal 'a (erc-track-select-mode-line-face 'a '(a b))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(b a))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(a b))))
+
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(a))))
+    (should (equal 'b (erc-track-select-mode-line-face 'a '(b)))))
+
+  ;; The ordering of the "normal" list doesn't matter.
+  (let ((erc-track-faces-priority-list '(a b))
+        (erc-track-faces-normal-list   '(b a)))
+
+    (should (equal 'a (erc-track-select-mode-line-face 'a '(b a))))
+    (should (equal 'a (erc-track-select-mode-line-face 'a '(a b))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(b a))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(a b))))))
+
+(defun erc-track-tests--select-mode-line-face (ranked normals cases)
+  (setq normals (map-into (mapcar (lambda (f) (cons f t)) normals)
+                          '(hash-table :test equal)))
+  (pcase-dolist (`(,want ,cur-face ,new-faces) cases)
+
+    (ert-info ((format "Observed: {cur: %S, new: %S, want: %S}"
+                       cur-face new-faces want))
+      (setq new-faces (cons (map-into
+                             (mapcar (lambda (f) (cons f t)) new-faces)
+                             '(hash-table :test equal))
+                            (reverse new-faces)))
+      (should (equal want (funcall #'erc-track--select-mode-line-face
+                                   cur-face new-faces ranked normals))))))
+
+;; The main difference between these variants is that with the above,
+;; when given alternating lines like
+;;
+;;  CUR      NEW                          CHOICE
+;;   text     (mention $speaker text)  =>   mention
+;;   mention  ($speaker text)          =>   text
+;;
+;; we see the effect of alternating faces in the indicator.  But when
+;; given consecutive lines with a similar composition, like
+;;
+;;   text     (mention $speaker text)  =>   mention
+;;   text     (mention $speaker text)  =>   mention
+;;
+;; we lose the effect.  With the variant below, we get
+;;
+;;   text     (mention $speaker text)  =>   mention
+;;   text     (mention $speaker text)  =>   text
+;;
+
+(ert-deftest erc-track--select-mode-line-face ()
+  (should-not erc-track-ignore-normal-contenders-p)
+
+  ;; These are the same test cases from the previous test.  The syntax
+  ;; is (expected cur-face new-faces).
+  (erc-track-tests--select-mode-line-face
+   '(1 2 3) '(1 2 3)
+   '((2 3 (2 _ 3))
+     (3 2 (2 _ 3))
+     (3 2 (_ 3))
+     (2 3 (2 3))
+     (3 2 (3))
+     (2 1 (2 1 3))
+     (3 1 (1 3))
+     (2 1 (1 3 2))
+     (3 1 (3 1))))
+
+  (erc-track-tests--select-mode-line-face
+   '(a b) '(a b)
+   '((b a (b a))
+     (b a (a b))
+     (a b (b a))
+     (a b (a b))
+     (a b (a))
+     (b a (b))))
+
+  (erc-track-tests--select-mode-line-face
+   '(a b) '(b a)
+   '((b a (b a))
+     (b a (a b))
+     (a b (b a))
+     (a b (a b)))))
+
 ;;; erc-track-tests.el ends here
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.7-Cache-shortened-channel-names-in-erc-track.patch --]
[-- Type: text/x-patch, Size: 5798 bytes --]

From 105d66146f71f7d1060d845255d81c4fb9b9919d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 13 Jun 2022 00:26:22 -0700
Subject: [PATCH 4/5] [5.7] Cache shortened channel names in erc-track

* lisp/erc/erc-track.el (erc-track--shortened-names): New variable to
stash both the latest inputs and most recent result of
`erc-track-shorten-function'.
(erc-track--shortened-names-current-hash,
erc-track--shortened-names-set, erc-track--shortened-names-get): New
pair of generalized-variable functions and helper variable for
accessing and mutating `erc-track--shorten-prefixes'.
(erc-modified-channels-display): Avoid redundant calls to
`erc-track-shorten-function'.  Mainly for use during batch processing.
* test/lisp/erc/erc-track-tests.el
(erc-track--shortened-names): New test.  (Bug#67767)
---
 lisp/erc/erc-track.el            | 42 +++++++++++++++++++++++++++++---
 test/lisp/erc/erc-track-tests.el | 36 +++++++++++++++++++++++++++
 2 files changed, 74 insertions(+), 4 deletions(-)

diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 490fc52d42c..a6a1539b044 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -382,6 +382,37 @@ erc-track-add-to-mode-line
 
 ;;; Shortening of names
 
+(defvar erc-track--shortened-names nil
+  "A cons of the last novel name-shortening params and the result.
+The CAR is a hash of environmental inputs such as options and
+parameters passed to `erc-track-shorten-function'.  Its effect is
+only really noticeable during batch processing.")
+
+(defvar erc-track--shortened-names-current-hash nil)
+
+(defun erc-track--shortened-names-set (_ shortened)
+  "Remember SHORTENED names with hash of contextual params."
+  (cl-assert erc-track--shortened-names-current-hash)
+  (setq erc-track--shortened-names
+        (cons erc-track--shortened-names-current-hash shortened)))
+
+(defun erc-track--shortened-names-get (channel-names)
+  "Cache CHANNEL-NAMES with various contextual parameters.
+For now, omit relevant options like `erc-track-shorten-start' and
+friends, even though they do affect the outcome, because they
+likely change too infrequently to matter over sub-second
+intervals and are unlikely to be let-bound or set locally."
+  (when-let ((hash (setq erc-track--shortened-names-current-hash
+                         (sxhash-equal (list channel-names
+                                             (buffer-list)
+                                             erc-track-shorten-function))))
+             (erc-track--shortened-names)
+             ((= hash (car erc-track--shortened-names))))
+    (cdr erc-track--shortened-names)))
+
+(gv-define-simple-setter erc-track--shortened-names-get
+                         erc-track--shortened-names-set)
+
 (defun erc-track-shorten-names (channel-names)
   "Call `erc-unique-channel-names' with the correct parameters.
 This function is a good value for `erc-track-shorten-function'.
@@ -797,10 +828,13 @@ erc-modified-channels-display
                                            (or (buffer-name buf)
                                                ""))
 					 buffers))
-		     (short-names (if (functionp erc-track-shorten-function)
-				      (funcall erc-track-shorten-function
-					       long-names)
-				    long-names))
+                     (erc-track--shortened-names-current-hash nil)
+                     (short-names
+                      (if (functionp erc-track-shorten-function)
+                          (with-memoization
+                              (erc-track--shortened-names-get long-names)
+                            (funcall erc-track-shorten-function long-names))
+                        long-names))
 		     strings)
 		(while buffers
 		  (when (car short-names)
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index 4477727be8a..ed3d190928f 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -104,6 +104,42 @@ erc-track--shorten-aggressive-max
                                       '("#emacs" "#vi"))
             '("#e" "#v"))) ))
 
+(ert-deftest erc-track--shortened-names ()
+  (let (erc-track--shortened-names
+        erc-track--shortened-names-current-hash
+        results)
+
+    (with-memoization (erc-track--shortened-names-get
+                       '("apple" "banana" "cherries"))
+      '("a" "b" "c"))
+    (should (integerp (car erc-track--shortened-names)))
+    (should (equal (cdr erc-track--shortened-names) '("a" "b" "c")))
+    (push erc-track--shortened-names results)
+
+    ;; Redundant call doesn't run.
+    (with-memoization (erc-track--shortened-names-get
+                       '("apple" "banana" "cherries"))
+      (should-not 'run)
+      '("a" "b" "c"))
+    (should (equal erc-track--shortened-names (car results)))
+
+    ;; Change in environment or context forces run.
+    (with-temp-buffer
+      (with-memoization (erc-track--shortened-names-get
+                         '("apple" "banana" "cherries"))
+        '("x" "y" "z")))
+    (should (and (integerp (car erc-track--shortened-names))
+                 (/= (car erc-track--shortened-names) (caar results))))
+    (should (equal (cdr erc-track--shortened-names) '("x" "y" "z")))
+    (push erc-track--shortened-names results)
+
+    (with-memoization (erc-track--shortened-names-get
+                       '("apple" "banana" "cherries"))
+      '("1" "2" "3"))
+    (should (and (integerp (car erc-track--shortened-names))
+                 (/= (car erc-track--shortened-names) (caar results))))
+    (should (equal (cdr erc-track--shortened-names) '("1" "2" "3")))))
+
 (ert-deftest erc-track--erc-faces-in ()
   "`erc-faces-in' should pick up both 'face and 'font-lock-face properties."
   (let ((str0 (copy-sequence "is bold"))
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.7-Add-erc-track-integration-to-erc-nicks.patch --]
[-- Type: text/x-patch, Size: 13091 bytes --]

From e14973511bf0c845ceaac2121c95cc47c6b17ae5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Dec 2023 01:30:48 -0800
Subject: [PATCH 5/5] [5.7] Add erc-track integration to erc-nicks

* lisp/erc/erc-button.el (erc-button--nick): Add `face-cache' slot.
(erc-button-add-nickname-buttons): Pass `erc-button--nick' object, if
created' as the boolean NICK-P parameter when calling
`erc-button-add-button'.  Keeping the latter ignorant
`erc-button--nick' is of course preferable, but some coordination is
now required to convey and use the face cache.  We could introduce an
abstraction, like a local variable, if this becomes an issue.
(erc-button-add-button): Use `erc--merge-prop' instead of
`erc-button-add-face' to apply button faces.  Hold off on deprecating
the latter because it provides unique functionality for nesting faces.
Also, consult NICK-P if it's an `erc-button--nick' object for the
various overriding faces it knows about.
* lisp/erc/erc-nicks.el (erc-nicks-track-faces): New option.
(erc-nicks--highlight-button): Set the `face-cache' slot of the
`erc-button--nick' object when `track' is loaded and initialized.
(erc-nicks-mode, erc-nicks-enable, erc-nicks-disable): Add and remove
`track' integration.
(erc-nicks--reject-uninterned-faces): New function to remove faces
created by `nicks' from buttonized speakers and mentions.  Conform
to `erc-track--face-reject-function' interface.
(erc-nicks--ourps, erc-nicks--check-normals): New function and helper
for `erc-track--alt-normals-function' interface.
(erc-nicks--setup-track-integration): New function.
(erc-nicks--remember-face-for-track): New function to cache
nick faces owned by this module.  (Bug#67767)
---
 lisp/erc/erc-button.el | 41 +++++++++++----------
 lisp/erc/erc-nicks.el  | 83 +++++++++++++++++++++++++++++++++++++++++-
 lisp/erc/erc.el        |  8 +++-
 3 files changed, 110 insertions(+), 22 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index f10d7a2fce7..fc2511bad42 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -369,7 +369,8 @@ erc-button--nick
   ( nickname-face erc-button-nickname-face :type symbol
     :documentation "Temp `erc-button-nickname-face' while buttonizing.")
   ( mouse-face erc-button-mouse-face :type symbol
-    :documentation "Temp `erc-button-mouse-face' while buttonizing."))
+    :documentation "Function to return possibly cached face.")
+  ( face-cache nil :type (or null function)))
 
 ;; This variable is intended to serve as a "core" to be wrapped by
 ;; (built-in) modules during setup.  It's unclear whether
@@ -460,8 +461,7 @@ erc-button-add-nickname-buttons
                      (erc-bounds-of-word-at-point)))
          (word (buffer-substring-no-properties (car bounds) (cdr bounds)))
          (down (erc-downcase word)))
-      (let* ((erc-button-mouse-face erc-button-mouse-face)
-             (erc-button-nickname-face erc-button-nickname-face)
+      (let* ((nick-obj t)
              (cuser (and erc-channel-users
                          (or (gethash down erc-channel-users)
                              (funcall erc-button--fallback-cmem-function
@@ -470,19 +470,15 @@ erc-button-add-nickname-buttons
                        (and erc-server-users (gethash down erc-server-users))))
              (data (list word)))
         (when (or (not (functionp form))
-                  (and-let* ((user)
-                             (obj (funcall form (make-erc-button--nick
-                                                 :bounds bounds :data data
-                                                 :downcased down :user user
-                                                 :cuser (cdr cuser)))))
-                    (setq erc-button-mouse-face ; might be null
-                          (erc-button--nick-mouse-face obj)
-                          erc-button-nickname-face ; might be null
-                          (erc-button--nick-nickname-face obj)
-                          data (erc-button--nick-data obj)
-                          bounds (erc-button--nick-bounds obj))))
+                  (and user
+                       (setq nick-obj (funcall form (make-erc-button--nick
+                                                     :bounds bounds :data data
+                                                     :downcased down :user user
+                                                     :cuser (cdr cuser)))
+                             data (erc-button--nick-data nick-obj)
+                             bounds (erc-button--nick-bounds nick-obj))))
           (erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry)
-                                 'nickp data))))))
+                                 nick-obj data))))))
 
 (defun erc-button-add-buttons-1 (regexp entry)
   "Search through the buffer for matches to ENTRY and add buttons."
@@ -541,13 +537,20 @@ erc-button-add-button
           (move-marker pos (point))))))
   (if nick-p
       (when erc-button-nickname-face
-        (erc-button-add-face from to erc-button-nickname-face))
+        (erc--merge-prop from to 'font-lock-face
+                         (or (and (erc-button--nick-p nick-p)
+                                  (erc-button--nick-nickname-face nick-p))
+                             erc-button-nickname-face)
+                         nil (and (erc-button--nick-p nick-p)
+                                  (erc-button--nick-face-cache nick-p))))
     (when erc-button-face
-      (erc-button-add-face from to erc-button-face)))
+      (erc--merge-prop from to 'font-lock-face erc-button-face)))
   (add-text-properties
    from to
-   (nconc (and erc-button-mouse-face
-               (list 'mouse-face erc-button-mouse-face))
+   (nconc (and-let* ((face (or (and (erc-button--nick-p nick-p)
+                                    (erc-button--nick-mouse-face nick-p))
+                               erc-button-mouse-face)))
+            (list 'mouse-face face))
           (list 'erc-callback fun)
           (list 'keymap erc-button-keymap)
           (list 'rear-nonsticky t)
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index 2f0c3261266..0b1e5e0c050 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -173,6 +173,20 @@ erc-nicks-key-suffix-format
 like \"@%-012n\"."
   :type 'string)
 
+(defcustom erc-nicks-track-faces 'prioritize
+  "Show nick faces in the `track' module's portion of the mode line.
+A value of nil means don't show nick faces at all.  A value of
+`defer' means have `track' consider nick faces only after those
+ranked faces in `erc-track-faces-normal-list'.  This has the
+effect of \"alternating\" between a ranked \"normal\" and a nick.
+The value `prioritize' means have `track' consider nick faces to
+be \"normal\" unless the current speaker is the same as the
+previous one, in which case pretend the value is `defer'.  Like
+most options in this module, updating the value mid-session is
+not officially supported, although cycling \\[erc-nicks-mode] may
+be worth a shot."
+  :type '(choice (const nil) (const defer) (const prioritize)))
+
 (defvar erc-nicks--max-skip-search 3 ; make this an option?
   "Max number of faces to visit when testing `erc-nicks-skip-faces'.")
 
@@ -516,7 +530,12 @@ erc-nicks--highlight-button
                                 'font-lock-face))
        (nick (erc-server-user-nickname (erc-button--nick-user nick-object)))
        (out (erc-nicks--highlight nick face)))
-    (setf (erc-button--nick-nickname-face nick-object) out))
+    (setf (erc-button--nick-nickname-face nick-object) out
+          ;;
+          (erc-button--nick-face-cache nick-object)
+          (and erc-nicks-track-faces
+               (bound-and-true-p erc-track--normal-faces)
+               #'erc-nicks--remember-face-for-track)))
   nick-object)
 
 (define-erc-module nicks nil
@@ -559,6 +578,8 @@ nicks
        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)
+   (erc-nicks--setup-track-integration)
+   (add-hook 'erc-track-mode #'erc-nicks--setup-track-integration 50 t)
    (advice-add 'widget-create-child-and-convert :filter-args
                #'erc-nicks--redirect-face-widget-link))
   ((kill-local-variable 'erc-nicks--face-table)
@@ -570,8 +591,12 @@ nicks
    (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-track--face-reject-function)
+                    #'erc-nicks--reject-uninterned-faces)
    (remove-function (local 'erc-button--modify-nick-function)
                     #'erc-nicks--highlight-button)
+   (remove-function (local 'erc-track--alt-normals-function)
+                    #'erc-nicks--check-normals)
    (setf (alist-get "Edit face"
                     erc-button--nick-popup-alist nil 'remove #'equal)
          nil)
@@ -691,6 +716,62 @@ erc-nicks--colors-from-faces
                  (color (face-foreground face)))
         (push color out)))))
 
+(defun erc-nicks--reject-uninterned-faces (candidate)
+  "Remove own faces from CANDIDATE if it's a combination of faces."
+  (while-let ((next (car-safe candidate))
+              ((facep next))
+              ((not (intern-soft next))))
+    (setq candidate (cdr candidate)))
+  (if (and (consp candidate) (not (cdr candidate))) (car candidate) candidate))
+
+(define-inline erc-nicks--oursp (face)
+  (inline-quote
+   (and-let* ((sym (car-safe ,face))
+              ((symbolp sym))
+              ((get sym 'erc-nicks--key)))
+     sym)))
+
+(defun erc-nicks--check-normals (current contender contenders normals)
+  "Return a viable `nicks'-owned face from NORMALS in CONTENDERS.
+But only do so if the CURRENT face is also one of ours and in
+NORMALS and if the highest ranked CONTENDER among new faces is
+`erc-default-face', the lowest ranking default priority face."
+  (defvar erc-track--normal-faces)
+  (cl-assert erc-track--normal-faces)
+  (and-let* (((eq contender 'erc-default-face))
+             ((gethash current normals))
+             (spkr (erc-nicks--oursp current)))
+    (catch 'contender
+      (dolist (candidate (cdr contenders) contender)
+        (when-let (((not (equal candidate current)))
+                   ((gethash candidate normals))
+                   (s (erc-nicks--oursp candidate))
+                   ((not (eq s spkr))))
+          (throw 'contender candidate))))))
+
+(defun erc-nicks--setup-track-integration ()
+  "Restore traditional \"alternating normal\" face functionality to mode-line."
+  (when (bound-and-true-p erc-track-mode)
+    (pcase erc-nicks-track-faces
+      ;; Variant `defer' is handled elsewhere.
+      ('prioritize
+       (add-function :override (local 'erc-track--alt-normals-function)
+                     #'erc-nicks--check-normals))
+      ('nil
+       (add-function :override (local 'erc-track--face-reject-function)
+                     #'erc-nicks--reject-uninterned-faces)))))
+
+(defun erc-nicks--remember-face-for-track (face)
+  "Add FACE to local hash table maintained by `track' module."
+  (defvar erc-track--normal-faces)
+  (cl-assert erc-track--normal-faces)
+  (or (gethash face erc-track--normal-faces)
+      (if-let ((sym (or (car-safe face) face))
+               ((symbolp sym))
+               ((get sym 'erc-nicks--key)))
+          (puthash face face erc-track--normal-faces)
+        face)))
+
 (provide 'erc-nicks)
 
 ;;; erc-nicks.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 62fdc0ad6e8..2734c602fa2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3351,12 +3351,14 @@ erc--merge-text-properties-p
 ;; values and optionally dispense archetypal constants in their place
 ;; in order to ensure all occurrences of some list (a b) across all
 ;; text-properties in all ERC buffers are actually the same object.
-(defun erc--merge-prop (from to prop val &optional object)
+(defun erc--merge-prop (from to prop val &optional object cache-fn)
   "Combine existing PROP values with VAL between FROM and TO in OBJECT.
 For spans where PROP is non-nil, cons VAL onto the existing
 value, ensuring a proper list.  Otherwise, just set PROP to VAL.
 When VAL is itself a list, prepend its members onto an existing
-value.  See also `erc-button-add-face'."
+value.  Call CACHE-FN, when given, with the new value for prop.
+It must return a suitable replacement or the same value.  See
+also `erc-button-add-face'."
   (let ((old (get-text-property from prop object))
         (pos from)
         (end (next-single-property-change from prop object to))
@@ -3370,6 +3372,8 @@ erc--merge-prop
                           (append val (ensure-list old))
                         (cons val (ensure-list old))))
                   val))
+      (when cache-fn
+        (setq new (funcall cache-fn new)))
       (put-text-property pos end prop new object)
       (setq pos end
             old (get-text-property pos prop object)
-- 
2.42.0