(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)
#'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)
"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))))
;; (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))
(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))
(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
;;; 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."
(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
projects / emacs.git / commitdiff