bug#73443: Fwd: bug#73443: 29.4; ERC 5.6.1-git: erc-track mode line face color broken with left timestamps

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

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

Trevor Arjeski <tmarjeski@gmail.com> writes:

> "J.P." <jp@neverwas.me> writes:
>
>> You could start by "bisecting" the non-ERC parts of your config or the
>> non-ERC modes listed in the gathered facts from your initial report
>> (default stuff commented out):
>
> After a bisect, I was able to find the culprit:
>
>       (erc-fill-function 'erc-fill-static)
>
> Toggling this to and from the default - 'erc-fill-variable - allows me
> to reproduce the issue consistently.

Thanks for getting to the bottom of this. I was indeed able to reproduce
it with user options alone.

>
> My guess is that the track parser does not like the extra padding
> between the timestamp and nick, but I haven't yet looked into the code.

Yes, that's essentially what's happening. The new internal function that
extracts all faces in a message acted too aggressively in abandoning its
search after encountering a region without any face properties. So while
this issue is most visible when using `nicks' highlighting, it's
actually always present and therefore somewhat pernicious. The attached
patch should fix the problem.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6.1-Skip-indentation-when-gathering-faces-in-erc-t.patch --]
[-- Type: text/x-patch, Size: 10714 bytes --]

From c9c74f6f3691ffe9a35558bcbd764381d127f36d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Sep 2024 13:48:19 -0700
Subject: [PATCH] [5.6.1] Skip indentation when gathering faces in erc-track

* lisp/erc/erc-nicks.el (erc-nicks-mode, erc-nicks-enable)
(erc-nicks-disable): Use correct name for `track' module hook.
* lisp/erc/erc-track.el (erc-make-mode-line-buffer-name): Don't error
when optional COUNT is nil.
(erc-track-modified-channels): Use new name for face-finding function.
(erc-track--get-faces-in-current-message, erc-track--collect-faces-in):
Rename former to latter to better reflect expanded utility, which can
span gaps, including newlines and indentation that don't have
face-related properties.
* test/lisp/erc/erc-track-tests.el (erc-track--collect-faces-in): New
test.  (Bug#73443)
---
 lisp/erc/erc-nicks.el            |   3 +-
 lisp/erc/erc-track.el            |  42 +++++------
 test/lisp/erc/erc-track-tests.el | 126 ++++++++++++++++++++++++++++++-
 3 files changed, 148 insertions(+), 23 deletions(-)

diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index ccf65f15abd..65a12c927bd 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -580,7 +580,7 @@ nicks
    (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)
+   (add-hook 'erc-track-mode-hook #'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)
@@ -598,6 +598,7 @@ nicks
                     #'erc-nicks--highlight-button)
    (remove-function (local 'erc-track--alt-normals-function)
                     #'erc-nicks--check-normals)
+   (remove-hook 'erc-track-mode-hook #'erc-nicks--setup-track-integration t)
    (setf (alist-get "Edit face"
                     erc-button--nick-popup-alist nil 'remove #'equal)
          nil)
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 39a4775ddca..f40960e4a22 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -768,7 +768,7 @@ erc-make-mode-line-buffer-name
   ;; (really?), 3. the defun needs to switch to BUFFER, so we would
   ;; need to save that value somewhere.
   (let ((map (make-sparse-keymap))
-	(name (if erc-track-showcount
+        (name (if (and count erc-track-showcount)
 		  (concat string
 			  erc-track-showcount-string
 			  (int-to-string count))
@@ -992,7 +992,7 @@ erc-track-modified-channels
         (when-let
             ((faces (if erc-track-ignore-normal-contenders-p
                         (erc-faces-in (buffer-string))
-                      (erc-track--get-faces-in-current-message)))
+                      (erc-track--collect-faces-in)))
              (normals erc-track--normal-faces)
              (erc-track-faces-priority-list
               `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))
@@ -1057,25 +1057,25 @@ erc-faces-in
 (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)))
+(defun erc-track--collect-faces-in ()
+  "Collect all faces in the (presumably narrowed) current buffer.
+Return a cons cell of a hash table and a list ordered from most recently
+seen to least."
+  (let* ((prop (if noninteractive 'font-lock-face 'face))
+         (p (text-property-not-all (point-min) (point-max) prop nil))
+         (seen (and p (make-hash-table :test #'equal)))
+         (faces (make-hash-table :test #'equal))
+         (rfaces ()))
+    (while p
+      (when-let ((cur (get-text-property p prop)))
+        (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 p (next-single-property-change p prop)))
     (cons faces rfaces)))
 
 ;;; Buffer switching
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index 3288c42a42e..8149138a971 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -22,8 +22,12 @@
 
 ;;; Code:
 
-(require 'ert)
 (require 'erc-track)
+(require 'ert-x)
+(eval-and-compile
+  (let ((load-path (cons (ert-resource-directory) load-path)))
+    (require 'erc-tests-common)))
+
 
 (ert-deftest erc-track--shorten-aggressive-nil ()
   "Test non-aggressive erc track buffer name shortening."
@@ -286,4 +290,124 @@ erc-track--select-mode-line-face
      (a b (b a))
      (a b (a b)))))
 
+(ert-deftest erc-track--collect-faces-in ()
+  (with-current-buffer (get-buffer-create "*erc-track--get-faces-in*")
+    (erc-tests-common-prep-for-insertion)
+    (goto-char (point-min))
+    (skip-chars-forward "\n")
+
+    (let ((ts #("[04:37]"
+                0 1 ( erc--msg 0 field erc-timestamp
+                      font-lock-face erc-timestamp-face)
+                1 7 ( field erc-timestamp
+                      font-lock-face erc-timestamp-face)))
+          bounds)
+
+      (with-silent-modifications
+
+        (push (list (point)) bounds)
+        (insert ; JOIN
+         ts "      " ; iniital `fill' indentation lacks properties
+         #("*** You have joined channel #chan" 0 33
+           (font-lock-face erc-notice-face))
+         "\n")
+        (setcdr (car bounds) (point))
+
+        (push (list (point)) bounds)
+        (insert ; 353
+         ts "      "
+         #("*** Users on #chan: bob alice dummy tester"
+           0 30 (font-lock-face erc-notice-face)
+           30 35 (font-lock-face erc-current-nick-face)
+           35 42 (font-lock-face erc-notice-face))
+         "\n" #("                 @fsbot" ; but intervening HAS properties
+                0 23 (font-lock-face erc-notice-face)))
+        (setcdr (car bounds) (point))
+
+        (push (list (point)) bounds)
+        (insert ; PRIVMSG
+         "\n" ts "  "
+         #("<alice> bob: Thou canst not come to me: I come to"
+           0 1 (font-lock-face erc-default-face)
+           ;; erc-dangerous-host-face -> erc-nicks-alice-face (undefined)
+           1 6 (font-lock-face (erc-dangerous-host-face erc-nick-default-face))
+           6 8 (font-lock-face erc-default-face)
+           ;; erc-pal-face -> erc-nicks-bob-face (undefined)
+           8 11 (font-lock-face (erc-pal-face erc-default-face))
+           11 49 (font-lock-face erc-default-face))
+         "\n" #("                 thee."
+                0 22 (font-lock-face erc-default-face))
+         "\n")
+        (setcdr (car bounds) (point)))
+
+      (goto-char (point-max))
+      (should (equal (setq bounds (nreverse bounds))
+                     '((3 . 50) (50 . 129) (129 . 212))))
+
+      ;; For these result assertions, the insertion order of the table
+      ;; elements should mirror that of the consed lists.
+
+      ;; Baseline
+      (narrow-to-region 1 3)
+      (let ((result (erc-track--collect-faces-in)))
+        (should-not (map-pairs (car result)))
+        (should-not (cdr result)))
+
+      ;; JOIN
+      (narrow-to-region (car (nth 0 bounds)) (cdr (nth 0 bounds)))
+      (let ((result (erc-track--collect-faces-in)))
+        (should (seq-set-equal-p
+                 (map-pairs (car result)) '((erc-timestamp-face . t)
+                                            (erc-notice-face . t))))
+        (should (equal (cdr result) '(erc-notice-face erc-timestamp-face))))
+
+      ;; 353
+      (narrow-to-region (car (nth 1 bounds)) (cdr (nth 1 bounds)))
+      (let ((result (erc-track--collect-faces-in)))
+        (should (seq-set-equal-p (map-pairs (car result))
+                                 '((erc-timestamp-face . t)
+                                   (erc-notice-face . t)
+                                   (erc-current-nick-face . t))))
+        (should (equal (cdr result) '(erc-current-nick-face
+                                      erc-notice-face
+                                      erc-timestamp-face))))
+
+      ;; PRIVMSG
+      (narrow-to-region (car (nth 2 bounds)) (cdr (nth 2 bounds)))
+      (let ((result (erc-track--collect-faces-in)))
+        (should (seq-set-equal-p
+                 (map-pairs (car result))
+                 '((erc-timestamp-face . t)
+                   (erc-default-face . t)
+                   ((erc-dangerous-host-face erc-nick-default-face) . t)
+                   ((erc-pal-face erc-default-face) . t))))
+        (should (equal (cdr result)
+                       '((erc-pal-face erc-default-face)
+                         (erc-dangerous-host-face erc-nick-default-face)
+                         erc-default-face
+                         erc-timestamp-face))))
+
+      ;; Entire buffer.
+      (narrow-to-region (car (nth 0 bounds)) erc-insert-marker)
+      (let ((result (erc-track--collect-faces-in)))
+        (should (seq-set-equal-p
+                 (map-pairs (car result))
+                 '((erc-timestamp-face . t)
+                   (erc-notice-face . t)
+                   (erc-current-nick-face . t)
+                   (erc-default-face . t)
+                   ((erc-dangerous-host-face erc-nick-default-face) . t)
+                   ((erc-pal-face erc-default-face) . t))))
+        (should (equal (cdr result)
+                       '((erc-pal-face erc-default-face)
+                         (erc-dangerous-host-face erc-nick-default-face)
+                         erc-default-face
+                         erc-current-nick-face
+                         erc-notice-face
+                         erc-timestamp-face)))))
+
+    (widen)
+    (when noninteractive
+      (kill-buffer))))
+
 ;;; erc-track-tests.el ends here
-- 
2.46.1