From 75f12151384db0e257b6367ce357ef5d8bcfae6b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 26 Sep 2024 21:34:25 -0700 Subject: [PATCH] [5.6.1] Fix prioritize variant of erc-nicks-track-faces * etc/ERC-NEWS: Mention changes to `erc-track-faces-normal-list' and `erc-track-faces-priority-list'. * lisp/erc/erc-nicks.el (erc-nicks-track-faces): Update doc. (erc-nicks--reject-uninterned-faces): Use helper. (erc-nicks-track-normal-max-rank): New variable. (erc-nicks--check-normals): Change behavior to also consider replacing the current mode-line face when it's not `nicks' owned if it's explicitly ranked lower than `erc-default-face'. * lisp/erc/erc-track.el (erc-track--massage-nick-button-faces): Change type of symbol property `erc-track--obsolete-faces' for options `erc-track-faces-priority-list' and friends from a boolean to an alist. (erc-track-faces-priority-list): Add new face for buttonized speakers. (erc-track-faces-normal-list): Add new face for buttonized speakers. Also add `erc-notice-face'. (erc-track--priority-faces): New local variable to cache ranked faces. (erc-track--setup): Initialize new `erc-track--priority-faces' variable and refactor. (erc-track--alt-normals-function): Doc. (erc-track--select-mode-line-face): Update expected type of `ranks' parameter. (erc-track-modified-channels): Fix wrong-type bug occurring when `erc-track-ignore-normal-contenders-p' and `erc-track-priority-faces-only' are both non-nil. Also fix subtle compatibility oversight regarding an empty face list returned by `erc-track--collect-faces-in'. * test/lisp/erc/erc-nicks-tests.el: Load helpers and fixtures library. (erc-nicks-tests--track-faces): New function. (erc-nicks-track-faces/prioritize, erc-nicks-track-faces/defer) (erc-nicks-track-faces/nil): New tests. * test/lisp/erc/erc-track-tests.el (erc-track-tests--select-mode-line-face): Update expected type of mocked parameter. (erc-track-tests--modified-channels/baseline): New function. (erc-track-modified-channels/baseline) (erc-track-modified-channels/baseline/mention) (erc-track-modified-channels/baseline/ignore) (erc-track-modified-channels/baseline/mention/ignore) (erc-track-modified-channels/priority-only-all/baseline) (erc-track-modified-channels/priority-only-all/sans-notice): New tests. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-track-modified-channels) (erc-tests-common-track-modified-channels-sans-setup): New functions. (Bug67767) --- etc/ERC-NEWS | 7 + lisp/erc/erc-nicks.el | 44 ++-- lisp/erc/erc-track.el | 219 ++++++++++------ test/lisp/erc/erc-nicks-tests.el | 222 ++++++++++++++++- test/lisp/erc/erc-track-tests.el | 262 +++++++++++++++++++- test/lisp/erc/resources/erc-tests-common.el | 43 ++++ 6 files changed, 700 insertions(+), 97 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index b267db5502e..d5df54256af 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -35,6 +35,13 @@ has been removed. Option 'erc-keep-place-indicator-truncation' manages the tension between truncation and place keeping, prioritizing one or the other. +** Updated defaults for the 'track' module's face-list options. +The default values of options 'erc-track-faces-priority-list' and +'erc-track-faces-normal-list' have both gained a face for buttonized +speaker names, with the latter option also gaining 'erc-notice-face'. +This was done to provide a more frequent and practical indication of +channel activity in keeping with the module's original design. + * Changes in ERC 5.6 diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index a0d6d17d732..a17900d9330 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -179,12 +179,12 @@ erc-nicks-track-faces `defer' means have `track' consider nick faces only after those ranked faces in `erc-track-faces-normal-list'. This has the effect of \"alternating\" between a ranked \"normal\" and a nick. -The value `prioritize' means have `track' consider nick faces to -be \"normal\" unless the current speaker is the same as the -previous one, in which case pretend the value is `defer'. Like -most options in this module, updating the value mid-session is -not officially supported, although cycling \\[erc-nicks-mode] may -be worth a shot." +A value of `prioritize' works like `defer' when speakers stay the +same but allows a new speaker's face to impersonate a ranked +normal so nick faces can alternate back-to-back. Like most +options in this module, updating the value mid-session is not +officially supported, although cycling \\[erc-nicks-mode] may be +worth a shot." :type '(choice (const nil) (const defer) (const prioritize))) (defvar erc-nicks--max-skip-search 3 ; make this an option? @@ -724,7 +724,7 @@ erc-nicks--reject-uninterned-faces ((facep next)) ((not (intern-soft next)))) (setq candidate (cdr candidate))) - (if (and (consp candidate) (not (cdr candidate))) (car candidate) candidate)) + (erc--solo candidate)) (define-inline erc-nicks--oursp (face) (inline-quote @@ -733,16 +733,30 @@ erc-nicks--oursp ((get sym 'erc-nicks--key))) sym))) -(defun erc-nicks--check-normals (current contender contenders normals) - "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'." - (and-let* (((eq contender 'erc-default-face)) +(defvar erc-nicks-track-normal-max-rank 'erc-default-face + "Highest priority normal face still eligible to alternate with `nicks' faces. +Must appear in both `erc-track-faces-priority-list' and +`erc-track-faces-normal-list'.") + +(defun erc-nicks--check-normals (current contender contenders ranks normals) + "Return a viable non-CURRENT `nicks' face in CONTENDERS. +But only do so if CURRENT and CONTENDER are \"normal\" faces either +unranked or at or below `erc-nicks-track-normal-max-rank'. See +`erc-track--select-mode-line-face' for the expected types of CONTENDERS, +RANKS, and NORMALS." + (and-let* (((or (null contender) (gethash contender normals))) ((or (null current) (gethash current normals))) - (spkr (or (null current) (erc-nicks--oursp current)))) + (threshold (gethash erc-nicks-track-normal-max-rank (car ranks))) + ((<= threshold (or (gethash contender (car ranks)) + ;; Unranked `contender' always replaceable. + most-positive-fixnum))) + (spkr (or (erc-nicks--oursp current) + ;; Use t to mean `current' is not a nick face but + ;; replaceable nonetheless. + (null current) + (<= threshold (or (gethash current (car ranks)) 0))))) (catch 'contender - (dolist (candidate (cdr contenders) contender) + (dolist (candidate (cdr contenders)) (when-let (((not (equal candidate current))) ((gethash candidate normals)) (s (erc-nicks--oursp candidate)) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index f40960e4a22..82e5f402910 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -161,25 +161,33 @@ erc-track-use-faces \(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)" :type 'boolean) +;; In an emergency, users can opt out of this migration with: +;; +;; (put 'erc-track-faces-priority-list 'erc-track--obsolete-faces t) +;; (put 'erc-track-faces-normal-list 'erc-track--obsolete-faces t) +;; (defun erc-track--massage-nick-button-faces (sym val &optional set-fn) - "Transform VAL of face-list option SYM to have new defaults. -Use `set'-compatible SET-FN when given. If an update was -performed, set the symbol property `erc-track--obsolete-faces' of -SYM to t." - (let* ((changedp nil) - (new (mapcar - (lambda (f) - (if (and (eq (car-safe f) 'erc-nick-default-face) - (equal f '(erc-nick-default-face erc-default-face))) - (progn - (setq changedp t) - (put sym 'erc-track--obsolete-faces t) - (cons 'erc-button-nick-default-face (cdr f))) - f)) - val))) - (if set-fn - (funcall set-fn sym (if changedp new val)) - (set-default sym (if changedp new val))))) + "Transform VAL of face-list option SYM to remove/replace obsolete items. +Use `set'-compatible SET-FN when given. Record any migrations as cons +cells of (OLD . NEW) in the symbol property `erc-track--obsolete-faces' +of SYM." + (let* ((oldface '(erc-nick-default-face erc-default-face)) + (newface '(erc-button-nick-default-face erc-default-face)) + (migrations (get sym 'erc-track--obsolete-faces)) + (new (if migrations + val + (delq nil + (mapcar + (lambda (f) + (if (equal f oldface) + (setf (alist-get oldface migrations + nil nil #'equal) + (and (not (member newface val)) newface)) + f)) + val))))) + (when migrations + (put sym 'erc-track--obsolete-faces migrations)) + (if set-fn (funcall set-fn sym new) (set-default sym new)))) (defcustom erc-track-faces-priority-list '(erc-error-face @@ -191,6 +199,7 @@ erc-track-faces-priority-list (erc-button erc-default-face) erc-dangerous-host-face erc-nick-default-face + (erc-button-nick-default-face erc-nick-default-face) (erc-button-nick-default-face erc-default-face) erc-default-face erc-action-face @@ -204,7 +213,7 @@ erc-track-faces-priority-list Note that ERC prioritizes certain faces reserved for critical messages regardless of this option's value." - :package-version '(ERC . "5.6") + :package-version '(ERC . "5.6.1") :set #'erc-track--massage-nick-button-faces :type (erc--with-dependent-type-match (repeat (choice face (repeat :tag "Combination" face))) @@ -229,8 +238,10 @@ erc-track-faces-normal-list '((erc-button erc-default-face) erc-dangerous-host-face erc-nick-default-face + (erc-button-nick-default-face erc-nick-default-face) (erc-button-nick-default-face erc-default-face) erc-default-face + erc-notice-face erc-action-face) "A list of faces considered to be part of normal conversations. This list is used to highlight active buffer names in the mode line. @@ -246,7 +257,7 @@ erc-track-faces-normal-list \\[erc-track-mode]. The effect may be disabled by setting this variable to nil." - :package-version '(ERC . "5.6") + :package-version '(ERC . "5.6.1") :set #'erc-track--massage-nick-button-faces :type (erc--with-dependent-type-match (repeat (choice face (repeat :tag "Combination" face))) @@ -636,49 +647,79 @@ erc-track-when-inactive (erc-track-enable)) (set sym val)))) +(defvar-local erc-track--priority-faces nil + "Local copy of `erc-track-faces-priority-list' as a hash table. +Keys are faces and values are rank integers (smaller is more important).") + (defvar-local erc-track--normal-faces nil - "Local copy of `erc-track-faces-normal-list' as a hash table.") + "Local copy of `erc-track-faces-normal-list' as a hash table. +Keys and values are faces. The table is weak valued so it can double as +a buttonizing cache. See `erc-button-add-button' and `erc--merge-prop'.") (defun erc-track--setup () "Initialize a buffer for use with the `track' module. -If this is a server buffer or `erc-track-faces-normal-list' is -locally bound, create a new `erc-track--normal-faces' for the -current buffer. Otherwise, set the local value to the server -buffer's." +If this is a server buffer or either `erc-track-faces-normal-list' or +`erc-track-faces-priority-list' is locally bound, create a new cache +table with corresponding local variable `erc-track--normal-faces' or +`erc-track--priority-faces'. Otherwise, in target buffers with no local +binding, set the cache variable's local value to that of server's." (if erc-track-mode - (let ((existing (erc-with-server-buffer erc-track--normal-faces)) - (localp (and erc--target - (local-variable-p 'erc-track-faces-normal-list))) - (opts '(erc-track-faces-normal-list erc-track-faces-priority-list)) - warnp table) + (let (warnp) ;; Don't bother warning users who've disabled `button'. - (unless (or erc--target (not (or (bound-and-true-p erc-button-mode) - (memq 'button erc-modules)))) - (when (or localp (local-variable-p 'erc-track-faces-priority-list)) - (dolist (opt opts) + (unless (or erc--target + (not (or (bound-and-true-p erc-button-mode) + (memq 'button erc-modules)))) + (dolist (opt '(erc-track-faces-normal-list + erc-track-faces-priority-list)) + (when (local-variable-p opt) (erc-track--massage-nick-button-faces opt (symbol-value opt) - #'set))) - (dolist (opt opts) - (when (get opt 'erc-track--obsolete-faces) - (push opt warnp) + #'set)) + (when-let ((migrations (get opt 'erc-track--obsolete-faces)) + ((consp migrations))) + (push (cons opt + (mapcar (pcase-lambda (`(,old . ,new)) + (format (if new "changed %s to %s" + "removed %s") + old new)) + migrations)) + warnp) (put opt 'erc-track--obsolete-faces nil))) (when warnp - (erc--warn-once-before-connect 'erc-track-mode - (if (cdr warnp) "Options " "Option ") - (mapconcat (lambda (o) (format "`%S'" o)) warnp " and ") - (if (cdr warnp) " contain" " contains") - " an obsolete item, %S, intended to match buttonized nicknames." - " ERC has changed it to %S for the current session." - " Please save the current value to silence this message." - '(erc-nick-default-face erc-default-face) - '(erc-button-nick-default-face erc-default-face)))) - (when (or (null existing) localp) - (setq table (map-into (mapcar (lambda (f) (cons f f)) - erc-track-faces-normal-list) - '(hash-table :test equal :weakness value)))) - (setq erc-track--normal-faces (or table existing)) - (unless (or localp existing) - (erc-with-server-buffer (setq erc-track--normal-faces table)))) + (pcase-dolist (`(,opt . ,migrations) warnp) + (erc--warn-once-before-connect 'erc-track-mode + "Option `%S' contains " + (if (cdr migrations) "obsolete items." "an obsolete item.") + " ERC has done the following for the current session: %s." + " Please review these changes and, if convinced," + " silence this message by saving the current value." + opt (string-join migrations ", "))))) + ;; Set `erc-track--priority-faces' cache to new or shared value. + (let* ((localp (and erc--target + (local-variable-p 'erc-track-faces-priority-list))) + (existing (erc-with-server-buffer erc-track--priority-faces)) + (table (or (and (not localp) existing) + (let ((p 0)) + (map-into + (mapcar (lambda (f) (cons f (cl-incf p))) + (append erc-track--attn-faces + erc-track-faces-priority-list)) + `(hash-table :test equal)))))) + (setq erc-track--priority-faces table) + (unless (or localp existing) + (erc-with-server-buffer (setq erc-track--priority-faces table)))) + ;; Likewise for `erc-track--normal-faces' cache. + (let* ((localp (and erc--target + (local-variable-p 'erc-track-faces-normal-list))) + (existing (erc-with-server-buffer erc-track--normal-faces)) + (table (or (and (not localp) existing) + (map-into (mapcar (lambda (f) (cons f f)) + erc-track-faces-normal-list) + `(hash-table :test equal + :weakness value))))) + (setq erc-track--normal-faces table) + (unless (or localp existing) + (erc-with-server-buffer (setq erc-track--normal-faces table))))) + (kill-local-variable 'erc-track--priority-faces) (kill-local-variable 'erc-track--normal-faces))) ;;; Visibility @@ -915,44 +956,54 @@ erc-track-select-mode-line-face (defvar erc-track--alt-normals-function nil "A function to possibly elect a \"normal\" face. Called with the current incumbent and the worthiest new contender -followed by all new contending faces and so-called \"normal\" -faces. See `erc-track--select-mode-line-face' for their meanings -and expected types. This function should return a face or nil.") +followed by all new contending faces, ranked faces, and so-called +\"normal\" faces. See `erc-track--select-mode-line-face' for their +meanings and expected types. This function should return a face or nil.") (defun erc-track--select-mode-line-face (cur-face new-faces ranks normals) "Return CUR-FACE or a replacement for displaying in the mode-line, or nil. -Expect RANKS to be a list of faces and both NORMALS and the car -of NEW-FACES to be hash tables mapping faces to non-nil values. -Assume the latter's makeup and that of RANKS to resemble -`erc-track-faces-normal-list' and `erc-track-faces-priority-list'. -If NEW-FACES has a cdr, expect it to be its car's contents -ordered from most recently seen (later in the buffer) to -earliest. In general, act like `erc-track-select-mode-line-face' -except appeal to `erc-track--alt-normals-function' if it's -non-nil, falling back on reconsidering NEW-FACES when CUR-FACE -outranks all its members. That is, choose the first among RANKS -in NEW-FACES not equal to CUR-FACE. Failing that, choose the -first face in NEW-FACES that's also in NORMALS, assuming -NEW-FACES has a cdr." +Expect NEW-FACES to be a cons cell whose car is a hash table mapping +faces present in the applicable region to t and whose cdr is its car's +contents ordered from most recently seen (later in the buffer) to +earliest. Expect RANKS to be a cons cell whose car is a hash table +similar to `erc-track--priority-faces' and whose cdr is a list of +prioritized faces resembling `erc-track-faces-priority-list'. Expect +NORMALS to be a hash table mapping faces to themselves. In general, act +identically to `erc-track-select-mode-line-face', except appeal to +`erc-track--alt-normals-function' if it's non-nil, and fall back on +reconsidering only NEW-FACES appearing in NORMALS when CUR-FACE is +itself \"normal\" and outranks all NEW-FACES. That is, choose the first +among RANKS in both NEW-FACES and NORMALS not equal to CUR-FACE. +Failing that, choose the first face in both NEW-FACES and NORMALS." (cl-check-type erc-track-ignore-normal-contenders-p null) (cl-check-type new-faces cons) + ;; Choose the highest ranked face in `erc-track-faces-priority-list' + ;; that's either `cur-face' itself or one appearing in the region + ;; being processed. (when-let ((choice (catch 'face - (dolist (candidate ranks) + (dolist (candidate (cdr ranks)) (when (or (equal candidate cur-face) (gethash candidate (car new-faces))) (throw 'face candidate)))))) (or (and erc-track--alt-normals-function (funcall erc-track--alt-normals-function - cur-face choice new-faces normals)) + cur-face choice new-faces ranks normals)) + ;; If `choice' is still `cur-face' and also a "normal", attempt + ;; to choose another normal in order to produce the flickering + ;; effect mentioned in the doc of `erc-track-faces-normal-list'. (and (equal choice cur-face) (gethash choice normals) (catch 'face + ;; If ranked "normal" faces other than `choice' appear in + ;; the region, return the most important one. (progn - (dolist (candidate ranks) + (dolist (candidate (cdr ranks)) (when (and (not (equal candidate choice)) (gethash candidate (car new-faces)) (gethash choice normals)) (throw 'face candidate))) + ;; Otherwise, go with any "normal" face other than + ;; `choice' in the region. (dolist (candidate (cdr new-faces)) (when (and (not (equal candidate choice)) (gethash candidate normals)) @@ -996,14 +1047,24 @@ erc-track-modified-channels (normals erc-track--normal-faces) (erc-track-faces-priority-list `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)) - (ranks erc-track-faces-priority-list) + (ranks (cons erc-track--priority-faces + erc-track-faces-priority-list)) ((not (and (or (eq erc-track-priority-faces-only 'all) (member this-channel erc-track-priority-faces-only)) - (not (catch 'found - (dolist (f ranks) - (when (gethash f (or (car-safe faces) faces)) - (throw 'found t))))))))) + ;; Iterate over the shorter of `ranks' and `faces'. + (let* ((r>fp (or erc-track-ignore-normal-contenders-p + (> (hash-table-count (car ranks)) + (hash-table-count (car faces))))) + (elems (cond ((not r>fp) (cdr ranks)) ; f>=r + (erc-track-ignore-normal-contenders-p + faces) + ((cdr faces)))) + (table (if r>fp (car ranks) (car faces)))) + (not (catch 'found + (dolist (f elems) + (when (gethash f table) + (throw 'found t)))))))))) (progn ; FIXME remove `progn' on next major edit (if (not (assq (current-buffer) erc-modified-channels-alist)) ;; Add buffer, faces and counts @@ -1017,7 +1078,7 @@ erc-track-modified-channels nil faces ranks normals)))) erc-modified-channels-alist)) ;; Else modify the face for the buffer, if necessary. - (when faces + (when (or erc-track-ignore-normal-contenders-p (cdr faces)) (let* ((cell (assq (current-buffer) erc-modified-channels-alist)) (old-face (cddr cell)) diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el index 08080d249d5..75cb98b8407 100644 --- a/test/lisp/erc/erc-nicks-tests.el +++ b/test/lisp/erc/erc-nicks-tests.el @@ -30,8 +30,11 @@ ;;; Code: -(require 'ert-x) (require 'erc-nicks) +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) ;; This function replicates the behavior of older "invert" strategy ;; implementations from EmacsWiki, etc. The values for the lower and @@ -568,4 +571,221 @@ erc-nicks--create-coerced-pool (should (equal erc-nicks--colors-rejects '(t))))) +(declare-function erc-track-modified-channels "erc-track" ()) + +(defun erc-nicks-tests--track-faces (test) + (require 'erc-track) + (defvar erc-modified-channels-alist) + (defvar erc-track--normal-faces) + + (erc-tests-common-make-server-buf) + (erc-nicks-mode +1) + + (let ((erc-modules (cons 'nicks erc-modules)) + ;; Pretend these faces were added in response-handling during + ;; insertion modification by buttonizing hooks. See + ;; `erc-nicks--highlight-button'. + (add-face (lambda (face) + (erc-nicks--remember-face-for-track ; speaker + (list face 'erc-nick-default-face)) + (erc-nicks--remember-face-for-track ; mention + (list face 'erc-default-face)))) + ;; + bob-face alice-face assert-result) + + (with-current-buffer (erc--open-target "#chan") + (should erc-nicks-mode) + (should (setq bob-face (erc-nicks--get-face "bob" "bob@foonet"))) + (should (setq alice-face (erc-nicks--get-face "alice" "alice@foonet"))) + + (erc-tests-common-track-modified-channels-sans-setup + + (lambda (set-faces) + + (setq assert-result ; fixture binds `erc-modified-channels-alist' + (lambda (result) + (should (equal (alist-get (current-buffer) + erc-modified-channels-alist) + result)))) + + (funcall test set-faces assert-result add-face + bob-face alice-face))))) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-nicks-track-faces/prioritize () + (should (eq erc-nicks-track-faces 'prioritize)) + (erc-nicks-tests--track-faces + (lambda (set-faces assert-result add-face bob-face alice-face) + + (defvar erc-track--alt-normals-function) + (should erc-track--alt-normals-function) + + (funcall add-face bob-face) + (funcall add-face alice-face) + + ;; Simulate a JOIN. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (funcall assert-result '(1 . erc-notice-face)) + + ;; Someone speaks, and the mode-line changes to a `nicks' owned + ;; composite face for the speaker. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(2 ,bob-face erc-nick-default-face)) + + ;; That same someone speaks, and the mode-line indicator changes to + ;; another "normal" face in the message body. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result '(3 . erc-default-face)) + + ;; And yet again, which results in the indicator going back to one. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(4 ,bob-face erc-nick-default-face)) + + ;; Now the same person mentions another server user, resulting in a + ;; change to *that* `nicks' owned face because it appears later in + ;; the message content (timestamp is last). + (funcall set-faces `(erc-timestamp-face + (,alice-face erc-default-face) + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(5 ,alice-face erc-default-face)) + + ;; The mentioned user replies, mentioning the mentioner. But + ;; instead of the normal "normals" processing preferring the ranked + ;; `erc-default-face', the `erc-nicks-track-faces' logic kicks in + ;; via `erc-track--alt-normals-function' and provides a `nicks' + ;; owned replacement. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-default-face) + (,alice-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(6 ,bob-face erc-default-face)) + + ;; Finally, another notice arrives. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (funcall assert-result '(7 . erc-notice-face))))) + +(ert-deftest erc-nicks-track-faces/defer () + (should (eq erc-nicks-track-faces 'prioritize)) + (let ((erc-nicks-track-faces 'defer)) + (erc-nicks-tests--track-faces + (lambda (set-faces assert-result add-face bob-face alice-face) + + (funcall add-face bob-face) + (funcall add-face alice-face) + + ;; Simulate a JOIN. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (funcall assert-result '(1 . erc-notice-face)) + + ;; Someone speaks, and the mode-line indicator changes to the + ;; highest ranked face in the message. (All `nicks' owned faces + ;; are unranked). + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(2 . erc-default-face)) + + ;; That same someone speaks, and the mode-line indicator changes + ;; to a `nicks' owned face. It first reaches for the highest + ;; ranked face in the message but then applies the "normals" + ;; rules, resulting in a promoted alternate. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(3 ,bob-face erc-nick-default-face)) + + ;; And yet again, which results in the indicator going back to one. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result '(4 . erc-default-face)) + + ;; The same person mentions another server user, resulting in a + ;; change to that `nicks' owned face because the logic from + ;; 3. again applies. + (funcall set-faces `(erc-timestamp-face + (,alice-face erc-default-face) + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(5 ,alice-face erc-default-face)) + + ;; The mentioned user replies, mentioning the mentioner. + ;; However, the `nicks' module does not intercede in the decision + ;; making to overrule the ranked nominee. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-default-face) + (,alice-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result '(6 . erc-default-face)) + + ;; Finally, another notice arrives. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (funcall assert-result '(7 . erc-notice-face)))))) + +(ert-deftest erc-nicks-track-faces/nil () + (should (eq erc-nicks-track-faces 'prioritize)) + (let (erc-nicks-track-faces) + (erc-nicks-tests--track-faces + (lambda (set-faces assert-result _ bob-face alice-face) + + (defvar erc-track--face-reject-function) + (should erc-track--face-reject-function) + + ;; Simulate a JOIN. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (funcall assert-result '(1 . erc-notice-face)) + + ;; Someone speaks, and the mode-line indicator changes to the + ;; only ranked face in the message. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(2 . erc-default-face)) + + ;; That same someone speaks, and since no other "normals" exist + ;; in the message, the indicator is not updated. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result '(3 . erc-default-face)) + + ;; Now the same person mentions another server user, but the same + ;; logic applies, and the indicator is not updated. + (funcall set-faces `(erc-timestamp-face + (,alice-face erc-default-face) + (,bob-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(4 . erc-default-face)) + + ;; Finally, another notice arrives. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (funcall assert-result '(5 . erc-notice-face)))))) + ;;; erc-nicks-tests.el ends here diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el index 8149138a971..c830c8b2016 100644 --- a/test/lisp/erc/erc-track-tests.el +++ b/test/lisp/erc/erc-track-tests.el @@ -227,6 +227,13 @@ erc-track-select-mode-line-face (defun erc-track-tests--select-mode-line-face (ranked normals cases) (setq normals (map-into (mapcar (lambda (f) (cons f t)) normals) '(hash-table :test equal))) + + (setq ranked (cons (map-into (mapcar (let ((i 0)) + (lambda (f) (cons f (cl-incf i)))) + ranked) + '(hash-table :test equal)) + ranked)) + (pcase-dolist (`(,want ,cur-face ,new-faces) cases) (ert-info ((format "Observed: {cur: %S, new: %S, want: %S}" @@ -235,8 +242,8 @@ erc-track-tests--select-mode-line-face (mapcar (lambda (f) (cons f t)) new-faces) '(hash-table :test equal)) (reverse new-faces))) - (should (equal want (funcall #'erc-track--select-mode-line-face - cur-face new-faces ranked normals)))))) + (should (equal want (erc-track--select-mode-line-face + cur-face new-faces ranked normals)))))) ;; The main difference between these variants is that with the above, ;; when given alternating lines like @@ -410,4 +417,255 @@ erc-track--collect-faces-in (when noninteractive (kill-buffer)))) +(defun erc-track-tests--modified-channels/baseline (set-faces) + ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(1 . erc-notice-face))) + + ;; Someone speaks, and the mode-line face goes from ERC's generic + ;; "notice" face, `erc-notice-face', to the first face in the + ;; inserted message that outranks it, which happens to be the + ;; `button' module's composite face for buttonized speakers: + ;; (erc-button-nick-default-face erc-nick-default-face). It + ;; outranks both the previous occupant, `erc-notice-face', and its + ;; one cohabitant in the message text, `erc-default-face', in + ;; `erc-track-faces-priority-list'. Note that in the following + ;; list, `erc-default-face' appears first because it's used for the + ;; opening speaker bracket "<". The timestamp appears last because + ;; it's a right-sided stamp appended to the message body. + (funcall set-faces '(erc-timestamp-face + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(2 erc-button-nick-default-face erc-nick-default-face))) + + ;; The speaker speaks again immediately, and the segment changes to + ;; `erc-default-face', which appears later in the message, as + ;; normal body text. This happens because both `erc-default-face' + ;; and (erc-button-nick-default-face erc-nick-default-face) appear + ;; in `erc-track-faces-normal-list', meaning the lower-ranked + ;; former can replace the higher-ranked latter in the mode-line for + ;; the purpose of indicating channel activity. + (funcall set-faces '(erc-timestamp-face + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(3 . erc-default-face))) + + ;; Note: if (erc-button-nick-default-face erc-nick-default-face) + ;; were removed from `erc-track-faces-priority-list' but kept in + ;; `erc-track-faces-normal-list', then replaying the sequence would + ;; result in the previous two results being switched: + ;; `erc-default-face' would replace `erc-notice-face' before being + ;; replaced by the buttonized composite. + + ;; The speaker speaks yet again, and the segment goes back to the + ;; higher ranking face. + (funcall set-faces '(erc-timestamp-face + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(4 erc-button-nick-default-face erc-nick-default-face))) + + ;; Finally, another notice arrives. Although lower ranked, it also + ;; appears in `erc-track-faces-normal-list' and so is eligible to + ;; replace the incumbent. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(5 . erc-notice-face)))) + +(ert-deftest erc-track-modified-channels/baseline () + (erc-tests-common-track-modified-channels + #'erc-track-tests--modified-channels/baseline)) + +(ert-deftest erc-track-modified-channels/baseline/mention () + (erc-tests-common-track-modified-channels + (lambda (set-faces) + ;; Note: these messages don't have timestamps. + + ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(1 . erc-notice-face))) + + ;; Someone speaks, mentioning someone else, and the mode-line + ;; changes to (erc-button-nick-default-face erc-nick-default-face) + ;; rather than (erc-button-nick-default-face erc-default-face) + ;; based on their rankings in `erc-track-faces-priority-list'. + (funcall set-faces '((erc-button-nick-default-face erc-default-face) + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(2 erc-button-nick-default-face erc-nick-default-face))) + + ;; Someone else speaks, again with a mention and additional body text. + (funcall set-faces '((erc-button-nick-default-face erc-default-face) + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(3 erc-button-nick-default-face erc-default-face))) + + ;; And yet again, which results in the indicator going back to one. + (funcall set-faces '((erc-button-nick-default-face erc-default-face) + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(4 erc-button-nick-default-face erc-nick-default-face))) + + ;; Finally, another notice arrives. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(5 . erc-notice-face)))))) + +;; The compat-oriented option `erc-track-ignore-normal-contenders-p' +;; blinds track to `erc-track-faces-normal-list' for certain consecutive +;; messages with an identical face makeup. +(ert-deftest erc-track-modified-channels/baseline/ignore () + (let ((erc-track-ignore-normal-contenders-p t)) + (erc-tests-common-track-modified-channels + (lambda (set-faces) + ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(1 . erc-notice-face))) + + ;; Someone speaks, and the mode-line indicator's face changes to + ;; that of a buttonized speaker. + (funcall set-faces + '(erc-timestamp-face + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(2 erc-button-nick-default-face erc-nick-default-face))) + + ;; The speaker speaks again immediately, and the segment doesn't + ;; change. + (funcall set-faces + '(erc-timestamp-face + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(3 erc-button-nick-default-face erc-nick-default-face))) + + ;; Finally, another notice arrives. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(4 . erc-notice-face))))))) + +;; Compat-oriented option `erc-track-ignore-normal-contenders-p'. +(ert-deftest erc-track-modified-channels/baseline/mention/ignore () + (let ((erc-track-ignore-normal-contenders-p t)) + (erc-tests-common-track-modified-channels + (lambda (set-faces) + + ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(1 . erc-notice-face))) + + ;; Someone speaks, and the mode-line indicator's face changes to + ;; that of a buttonized speaker. + (funcall set-faces + '((erc-button-nick-default-face erc-default-face) + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(2 erc-button-nick-default-face erc-nick-default-face))) + + ;; Someone else speaks, again with a mention and additional body + ;; text, but the indicator stays the same. + (funcall set-faces + '((erc-button-nick-default-face erc-default-face) + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(3 erc-button-nick-default-face erc-nick-default-face))) + + ;; Finally, another notice arrives. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(4 . erc-notice-face))))))) + +;; Option `erc-track-priority-faces-only' does not affect the behavior +;; of the baseline "normals" scenario because all faces appear in +;; `erc-track-faces-priority-list'. +(ert-deftest erc-track-modified-channels/priority-only-all/baseline () + (let ((erc-track-priority-faces-only 'all)) + (erc-tests-common-track-modified-channels + #'erc-track-tests--modified-channels/baseline))) + +;; This test simulates a common configuration that combines an +;; `erc-track-faces-priority-list' removed of `erc-notice-face' with +;; `erc-track-priority-faces-only' being `all'. It also features in the +;; sample configuration in ERC's manual. +(ert-deftest erc-track-modified-channels/priority-only-all/sans-notice () + (let ((erc-track-priority-faces-only 'all) + (erc-track-faces-priority-list + (remq 'erc-notice-face erc-track-faces-priority-list))) + + (erc-tests-common-track-modified-channels + (lambda (set-faces) + ;; Note: these messages don't have timestamps. + + ;; Simulate a message normally displayed in `erc-notice-face', + ;; which has been removed from `erc-track-faces-priority-list'. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should-not (alist-get (current-buffer) erc-modified-channels-alist)) + + ;; Someone speaks, mentioning someone else, and the mode-line + ;; changes to the buttonized speaker face rather than the + ;; buttonized mention face, due to their respective ranks. + (funcall set-faces + '((erc-button-nick-default-face erc-default-face) + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(1 erc-button-nick-default-face erc-nick-default-face))) + + ;; Someone else speaks, again with a mention and additional body text. + (funcall set-faces + '((erc-button-nick-default-face erc-default-face) + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(2 erc-button-nick-default-face erc-default-face))) + + ;; And yet again, which results in the indicator going back to one. + (funcall set-faces + '((erc-button-nick-default-face erc-default-face) + (erc-button-nick-default-face erc-nick-default-face) + erc-default-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(3 erc-button-nick-default-face erc-nick-default-face))) + + ;; Finally, another notice arrives, which is ignored. + (funcall set-faces '(erc-notice-face)) + (erc-track-modified-channels) + (should (equal (alist-get (current-buffer) erc-modified-channels-alist) + '(3 erc-button-nick-default-face + erc-nick-default-face))))))) + ;;; erc-track-tests.el ends here diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 1cd54a1f715..91654467dae 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -330,4 +330,47 @@ erc-tests-common-create-subprocess (set-process-query-on-exit-flag proc t) proc)) +(declare-function erc-track--setup "erc-track" ()) + +(defun erc-tests-common-track-modified-channels (test) + (erc-tests-common-prep-for-insertion) + (setq erc--target (erc--target-from-string "#chan")) + (erc-tests-common-track-modified-channels-sans-setup test)) + +(defun erc-tests-common-track-modified-channels-sans-setup (test) + "Provide a fixture for testing `erc-track-modified-channels'. +Call function TEST with another function that sets the mocked return +value of `erc-track--collect-faces-in' to the given argument, a list of +faces in the reverse order they appear in an inserted message." + (defvar erc-modified-channels-alist) + (defvar erc-modified-channels-object) + (defvar erc-track--attn-faces) + (defvar erc-track--normal-faces) + (defvar erc-track--priority-faces) + (defvar erc-track-faces-normal-list) + (defvar erc-track-faces-priority-list) + (defvar erc-track-mode) + + (cl-letf* ((erc-track-mode t) + (erc-modified-channels-alist nil) + (erc-modified-channels-object erc-modified-channels-object) + (faces ()) + ((symbol-function 'force-mode-line-update) #'ignore) + ((symbol-function 'erc-faces-in) (lambda (_) faces)) + ((symbol-function 'erc-track--collect-faces-in) + (lambda () + (cons (map-into (mapcar (lambda (f) (cons f t)) faces) + '(hash-table :test equal)) + faces)))) + (erc-track--setup) + + ;; Faces from `erc-track--attn-faces' prepended. + (should (= (+ (length erc-track--attn-faces) + (length erc-track-faces-priority-list)) + (hash-table-count erc-track--priority-faces))) + (should (= (length erc-track-faces-normal-list) + (hash-table-count erc-track--normal-faces))) + + (funcall test (lambda (arg) (setq faces arg))))) + (provide 'erc-tests-common) -- 2.46.1