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 " " + #(" 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