master df593b5a619 8/9: Skip indentation when gathering faces in erc-track

[F. Jason Park]

branch: master
commit df593b5a619d63b620f8fd569ecf032dab2602d9
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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.
    (erc-nicks--check-normals): Remove falsity from doc string.
    * 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 preferred 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 now
    includes spanning gaps, including newlines and indentation that may be
    lacking in face-related properties.
    * test/lisp/erc/erc-track-tests.el (erc-track--collect-faces-in): New
    test.  (Bug#73443)
---
 lisp/erc/erc-nicks.el            |   5 +-
 lisp/erc/erc-track.el            |  42 ++++++-------
 test/lisp/erc/erc-track-tests.el | 126 ++++++++++++++++++++++++++++++++++++++-
 3 files changed, 149 insertions(+), 24 deletions(-)

diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index ccf65f15abd..a0d6d17d732 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -580,7 +580,7 @@ Abandon search after examining LIMIT faces."
    (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 @@ Abandon search after examining LIMIT faces."
                     #'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)
@@ -736,7 +737,7 @@ Expect PREFIX to be something like \"ansi-color-\" or 
\"font-lock-\"."
   "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."
+`erc-default-face'."
   (and-let* (((eq contender 'erc-default-face))
              ((or (null current) (gethash current normals)))
              (spkr (or (null current) (erc-nicks--oursp current))))
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 @@ is displayed according to `erc-track-mouse-face'."
   ;; (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 @@ the current buffer is in `erc-mode'."
         (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 @@ the current buffer is in `erc-mode'."
 (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 @@
      (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