From c9c74f6f3691ffe9a35558bcbd764381d127f36d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 " " + #(" 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