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

Tags: patch

ERC's `nicks' module doesn't currently play nice with `track'. Enabling
it breaks the cycling effect normally occurring among faces in
`erc-track-faces-normal-list' [1]. To address this, I'm proposing we
expose two internal seams:

  1. A function-valued variable for modifying or discarding faces
     gleaned in the narrowed buffer while `track' visits a message.

  2. A buffer-local hash table created on init from the contents of
     `erc-track-faces-normal-list'.

The first brings a small performance penalty and the second a small UX
hiccup [2]. The proposed implementation offsets the first by passing
around more refined data to cut down on some waste during processing.
The second is only currently addressed via doc string, although there's
a public compatibility flag to revert to a related historical behavior,
which dispenses with the issue indirectly.

The only actual addition to the `nicks' module is a user option named
`erc-nicks-track-faces'. It's a boolean that lets you opt out of seeing
nick colors as faces in the mode line indicator. There's also a loosely
related patch that adds some caching to the uniquified name shortening
performed by `track', although it should mainly benefit batch processing
and history playback. Suggestions welcome, as always.

Thanks.


[1] Although, what we typically perceive as this effect is somewhat
    illusory, if not underrealized. See comments preceding the new tests
    in the first patch.

[2] Users will have to toggle the module's minor-mode to update the
    variable mid-session, but we can provide a Custom :set function to
    help with this. Also, there's actually a resource penalty that comes
    with this change too. We can probably use per-server instead of
    per-channel hash tables, or only go per-channel if a local value for
    `erc-track-faces-normal-list' exists on `erc-track-mode' init.


In GNU Emacs 30.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version
 3.24.38, cairo version 1.17.6) of 2023-12-06 built on localhost
Repository revision: d8a00879309a3bf62f6ffcae103aa3bdba776ee9
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 37 (Workstation Edition)

Configured using:
 'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
 'CFLAGS=-O0 -g3'
 PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES
NATIVE_COMP NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3
THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB

Important settings:
  value of $LANG: en_US.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  minibuffer-regexp-mode: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec epa derived epg rfc6068 epg-config
gnus-util time-date mm-decode mm-bodies mm-encode mail-parse rfc2231
mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045 ietf-drums
mm-util mail-prsvr mail-utils compile text-property-search comint
ansi-osc ansi-color ring comp-run comp-common rx erc auth-source cl-seq
eieio eieio-core cl-macs password-cache json subr-x map format-spec
cl-loaddefs cl-lib erc-backend erc-networks byte-opt gv bytecomp
byte-compile erc-common erc-compat erc-loaddefs rmc iso-transl tooltip
cconv eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type
elisp-mode mwheel term/x-win x-win term/common-win x-dnd touch-screen
tool-bar dnd fontset image regexp-opt fringe tabulated-list replace
newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar
rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock
font-lock syntax font-core term/tty-colors frame minibuffer nadvice seq
simple cl-generic indonesian philippine cham georgian utf-8-lang
misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms
cp51932 hebrew greek romanian slovak czech european ethiopic indian
cyrillic chinese composite emoji-zwj charscript charprop case-table
epa-hook jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button
loaddefs theme-loaddefs faces cus-face macroexp files window
text-properties overlay sha1 md5 base64 format env code-pages mule
custom widget keymap hashtable-print-readable backquote threads dbusbind
inotify lcms2 dynamic-setting system-font-setting font-render-setting
cairo gtk x-toolkit xinput2 x multi-tty move-toolbar
make-network-process native-compile emacs)

Memory information:
((conses 16 82762 11177) (symbols 48 9671 0) (strings 32 25958 4639)
 (string-bytes 1 784755) (vectors 16 19276)
 (vector-slots 8 328221 11347) (floats 8 24 28) (intervals 56 260 0)
 (buffers 984 12))


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Always-promote-normal-faces-in-erc-track.patch --]
[-- Type: text/x-patch, Size: 20407 bytes --]

From 1a35b08698dfdfb3cd6568b8dc474ddb45c8da43 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 1/3] [5.6] Always 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-track.el (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--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.
---
 etc/ERC-NEWS                     |  22 +++++
 lisp/erc/erc-track.el            | 143 +++++++++++++++++++++++++++----
 test/lisp/erc/erc-track-tests.el | 130 ++++++++++++++++++++++++++++
 3 files changed, 280 insertions(+), 15 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 4642c742b0f..a5ebdef508e 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
@@ -306,6 +319,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-track.el b/lisp/erc/erc-track.el
index a36b781e04d..a341ea42d24 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -224,10 +224,23 @@ 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."
   :type '(repeat (choice face
 			 (repeat :tag "Combination" face))))
 
+(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.
 
@@ -518,6 +531,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)
@@ -528,6 +544,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:
@@ -539,6 +557,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)
@@ -548,9 +567,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
@@ -562,6 +584,18 @@ 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 erc-track-mode
+      (setq erc-track--normal-faces
+            (map-into (mapcar (lambda (f) (cons f t))
+                              erc-track-faces-normal-list)
+                      '(hash-table :test equal)))
+    (kill-local-variable 'erc-track--normal-faces)))
+
 ;;; Visibility
 
 (defvar erc-buffer-activity nil
@@ -766,7 +800,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)
@@ -785,6 +824,44 @@ erc-track-select-mode-line-face
               choice))
         choice))))
 
+(defun erc-track--select-mode-line-face (cur-face new-faces ranked normals)
+  "Return CUR-FACE or a replacement for displaying in the mode-line, or nil.
+Expect RANKED 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 RANKED 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 reconsider NEW-FACES when CUR-FACE outranks all its
+members.  That is, choose the highest RANKED 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."
+  (cl-check-type erc-track-ignore-normal-contenders-p null)
+  (cl-check-type new-faces cons)
+  (cl-check-type normals hash-table)
+  (when-let ((choice (catch 'face
+                       (dolist (candidate ranked)
+                         (when (or (equal candidate cur-face)
+                                   (gethash candidate (car new-faces)))
+                           (throw 'face candidate))))))
+    (when-let (((equal choice cur-face))
+               ((gethash choice normals))
+               (contender (catch 'face
+                            (progn
+                              (dolist (candidate ranked)
+                                (when (and (not (equal candidate choice))
+                                           (gethash candidate (car new-faces))
+                                           (gethash candidate normals))
+                                  (throw 'face candidate)))
+                              (dolist (f (cdr new-faces))
+                                (when (and (not (equal f choice))
+                                           (gethash f normals))
+                                  (throw 'face f)))))))
+      (setq choice contender))
+    choice))
+
 (defvar erc-track--skipped-msgs '(datestamp)
   "Values of `erc-msg' text prop to ignore.")
 
@@ -819,31 +896,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)))
+             (ranked erc-track-faces-priority-list)
+             (normals erc-track--normal-faces)
+             (erc-track-faces-priority-list
+              `(,@erc-track--attn-faces ,@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 erc-track-faces-priority-list)
+                             (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 ranked 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 ranked normals))))
 		  (setcdr cell (cons (1+ (cadr cell)) new-face)))))
 	    ;; And display it
 	    (erc-modified-channels-display)))
@@ -872,6 +961,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 #3: 0002-5.6-Cache-shortened-channel-names-in-erc-track.patch --]
[-- Type: text/x-patch, Size: 5785 bytes --]

From 67b729dbb9f7bb5b24d66298a354a7c155abf544 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 2/3] [5.6] 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.
---
 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 a341ea42d24..85e7b398573 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -357,6 +357,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'.
@@ -739,10 +770,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 #4: 0003-5.6-Add-erc-track-integration-to-erc-nicks.patch --]
[-- Type: text/x-patch, Size: 4957 bytes --]

From 9466b7ebb1ac4a8316f764e76cc57406d15d0f18 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 3/3] [5.6] Add erc-track integration to erc-nicks

* lisp/erc/erc-button.el (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.
* lisp/erc/erc-nicks.el (erc-nicks-track-faces): New option.
(erc-nicks--highlight-button): Add faces to `erc-track' "normal" table.
(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--setup-track-integration): New function.
(erc-nicks--track-nick-face-as-normal): New function to add newly
created face and known likely combination working store of "normal"
faces maintained by `track'.
---
 lisp/erc/erc-button.el |  4 ++--
 lisp/erc/erc-nicks.el  | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 2 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index e1c10be53f6..e72ceb705de 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -535,9 +535,9 @@ 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 erc-button-nickname-face))
     (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
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index fcd3afdbbc4..3043ad37f78 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -173,6 +173,10 @@ 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)
+
 (defvar erc-nicks--max-skip-search 3 ; make this an option?
   "Max number of faces to visit when testing `erc-nicks-skip-faces'.")
 
@@ -518,6 +522,8 @@ erc-nicks--highlight-button
                                 'font-lock-face))
        (nick (erc-server-user-nickname (erc-button--nick-user nick-object)))
        (out (erc-nicks--highlight nick face)))
+    (when erc-nicks-track-faces
+      (erc-nicks--track-nick-face-as-normal out))
     (setf (erc-button--nick-nickname-face nick-object) out))
   nick-object)
 
@@ -561,6 +567,9 @@ 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))
    (advice-add 'widget-create-child-and-convert :filter-args
                #'erc-nicks--redirect-face-widget-link))
   ((kill-local-variable 'erc-nicks--face-table)
@@ -572,6 +581,8 @@ 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)
    (setf (alist-get "Edit face"
@@ -693,6 +704,28 @@ 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))
+
+(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)))
+
+(defun erc-nicks--track-nick-face-as-normal (face)
+  "Add FACE to local hash table maintained by `track' module."
+  (when (bound-and-true-p erc-track--normal-faces)
+    (puthash `(,@(ensure-list face) erc-default-face) t
+             erc-track--normal-faces)
+    (puthash face t erc-track--normal-faces)))
+
 (provide 'erc-nicks)
 
 ;;; erc-nicks.el ends here
-- 
2.42.0