From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#67767: 30.0.50; ERC 5.6: Add track integration to the nicks module Date: Fri, 04 Oct 2024 01:30:56 -0700 Message-ID: <87ldz4b77j.fsf__44716.7917782039$1728030743$gmane$org@neverwas.me> References: <87edfs3gj4.fsf@neverwas.me> <87ed52q8rd.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="5645"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Trevor Arjeski , emacs-erc@gnu.org To: 67767@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Oct 04 10:32:15 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1swdjS-0001LC-Dj for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 04 Oct 2024 10:32:14 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1swdjF-0008Dx-Hl; Fri, 04 Oct 2024 04:32:01 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1swdjE-0008Cy-7U for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2024 04:32:00 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1swdjD-0004w4-U5 for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2024 04:31:59 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:References:In-Reply-To:From:To:Subject; bh=DTN3jxlM9QK0yusnBOjIEvd9dp+al3GUXoEDaxprUiI=; b=VwnqC9zDuC7kxk8EOZZ70pya8SyGendg7sn4yxEny26VEvlifxtfEKcQGWM1+nPrzSFFU0lJbGMmNZewsJWlBVoVvlMTgbWF1ekQBfluu3RBfz93GMy4jchOFEFRgaHUY/Ey9FNp2PeU5lytxHMiL+0dPpiUyr/cOiIKjxijGRnCVNd852+MeQ3lKtpRDzDii9Ljd+KXAxOXZa9c7uv4mAYbTW6bSGY32l0AXcL8/L6TsGlcuXghrW4zABjuSeTcZ35tmctLbEdsjL5Xc7HArRj1eJAMfKZc8/ec18p5tdo5/JDFEbu/Usfo4RDMZ+wM9OT2hmSBVrg8k3A3z1nVHA==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1swdjG-0006eq-FY for bug-gnu-emacs@gnu.org; Fri, 04 Oct 2024 04:32:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 04 Oct 2024 08:32:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 67767 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 67767-submit@debbugs.gnu.org id=B67767.172803067425525 (code B ref 67767); Fri, 04 Oct 2024 08:32:02 +0000 Original-Received: (at 67767) by debbugs.gnu.org; 4 Oct 2024 08:31:14 +0000 Original-Received: from localhost ([127.0.0.1]:34368 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1swdiQ-0006dZ-Q0 for submit@debbugs.gnu.org; Fri, 04 Oct 2024 04:31:14 -0400 Original-Received: from mail-108-mta78.mxroute.com ([136.175.108.78]:41639) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1swdiL-0006dO-M2 for 67767@debbugs.gnu.org; Fri, 04 Oct 2024 04:31:09 -0400 Original-Received: from filter006.mxroute.com ([136.175.111.3] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta78.mxroute.com (ZoneMTA) with ESMTPSA id 19256a757640003e01.001 for <67767@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Fri, 04 Oct 2024 08:31:00 +0000 X-Zone-Loop: a7357b1c4e5f53cc0f9992c4f03b8803a66babb80420 X-Originating-IP: [136.175.111.3] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=DTN3jxlM9QK0yusnBOjIEvd9dp+al3GUXoEDaxprUiI=; b=RphFBUMNVWKt/oaQMDOvm7tka/ ShSCSMvQviOigq/WQ4ARcdCm9RJGKBE1/tR9hU3f9XmV0tz597EU6wivJO9BoqixxkgpVyaw7sM6Q UQBF+r9WJV8SRS66kd6XmyPnBR5JuNGV8xU3XAyVXVjKe3pyoekvJVSnGMccGIAhjqcj32Ybis6wA KZZ8FhqJC5AnXTfhWRWZdq1nX+Dgu50ITYkGbSH2P6fe/CNBicExbuVG+9StDtZFdaCJxas2vYMER k4COKAP/CPAxDeX0qb6yoMDxwUak7npRe5CfT3kv0FEcOctzFSz5FuSRd/HbpB9PdtnkPOUvZTjal PITRFxWQ==; In-Reply-To: <87ed52q8rd.fsf@neverwas.me> (J. P.'s message of "Sun, 29 Sep 2024 17:34:46 -0700") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:292952 Archived-At: --=-=-= Content-Type: text/plain "J.P." writes: > It's been pointed out that the most recent attempt at improving the > situation, especially with regard to the option `erc-nicks-track-faces', > ended up perpetuating rather unintuitive aspects of the original > behavior in certain common situations. [...] > > Another problem with the current "normals" behavior is that it fails to > adequately exhibit the "flickering" effect when `nicks' _isn't_ enabled. > You can see this by connecting using the default configuration. Notice > that the mode-line segment stays on `erc-default-face while users are > conversing so long as they don't mention one another. However, the > "normals" feature was always meant to provide more responsive feedback > to clearly indicate active conversations (including monologuing). The > patch tries to address this by adding the default buttonized speaker > face to the related options `erc-track-faces-priority-list' and > `erc-track-faces-normal-list'. If there's a smarter way, hopefully > someone will speak up. Attached is a v2 introducing a `t' choice for `erc-nicks-track-faces'. It suppresses the "alternating" effect associated with the option `erc-track-faces-normal-list'. See [1] for additional context. This strays into new feature territory, which should be verboten for patch releases. However, since closely related code exhibits bug-like inconsistencies addressed by this patch, and such an addition might help improve users' mental model in terms of predictability vis-a-vis the current slate of related options, it seems a somewhat justifiable inclusion (IMO). OTOH, we could just as well wait until 5.7. [1] https://lists.gnu.org/archive/html/emacs-erc/2024-10/msg00006.html --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From 417de6ebaf70fe4dfcf3cc03171f01e4c42a6d52 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 4 Oct 2024 00:01:38 -0700 Subject: [PATCH 0/1] *** NOT A PATCH *** v2. Add new `t' variant for `erc-nicks-track-faces', which suppresses the "alternating" behavior associated with `erc-track-faces-normal-list'. Refactor related aspects of erc-nicks.el to facilitate this. Add supporting test. F. Jason Park (1): [5.6.1] Clarify behavior of erc-nicks-track-faces variants etc/ERC-NEWS | 13 + lisp/erc/erc-nicks.el | 89 +++++-- lisp/erc/erc-track.el | 219 ++++++++++------ test/lisp/erc/erc-nicks-tests.el | 269 +++++++++++++++++++- test/lisp/erc/erc-track-tests.el | 262 ++++++++++++++++++- test/lisp/erc/resources/erc-tests-common.el | 43 ++++ 6 files changed, 787 insertions(+), 108 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index d5df54256af..ea65a170b38 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -42,6 +42,12 @@ 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. +** An arguably less distracting 'erc-nicks-track-faces' variant. +Setting this option to t tells the 'track' module to have the mode-line +indicator stick with the most recent speaker's face, even when they're +monologuing, instead of alternating between it and the highest ranked +'erc-track-faces-normal-list' member in a given message. + * Changes in ERC 5.6 diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index a17900d9330..3aed985ea21 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -175,17 +175,20 @@ erc-nicks-key-suffix-format (defcustom erc-nicks-track-faces 'prioritize "Show nick faces in the `track' module's portion of the mode line. -A value of nil means don't show nick faces at all. A value of -`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. -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))) +A value of nil means don't show `nicks'-managed faces at all. A value +of t means treat them as non-\"normal\" faces ranked at or below +`erc-default-face'. This has the effect of always showing them while +suppressing the \"alternating\" behavior normally associated with +`erc-track-faces-normal-list' (including between the speaker and nicks +mentioned in the message body.) A value of `defer' means treat nicks as +unranked normals to favor alternating between them and ranked normals. +A value of `prioritize' exhibits the same alternating effect as `defer' +when speakers stay the same but allows a new speaker's face to +impersonate a ranked normal so that adjacent speakers alternate among +themselves before deferring to non-face normals. 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 boolean (const defer) (const prioritize))) (defvar erc-nicks--max-skip-search 3 ; make this an option? "Max number of faces to visit when testing `erc-nicks-skip-faces'.") @@ -597,7 +600,9 @@ nicks (remove-function (local 'erc-button--modify-nick-function) #'erc-nicks--highlight-button) (remove-function (local 'erc-track--alt-normals-function) - #'erc-nicks--check-normals) + #'erc-nicks--track-prioritize) + (remove-function (local 'erc-track--alt-normals-function) + #'erc-nicks--track-always) (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) @@ -726,7 +731,8 @@ erc-nicks--reject-uninterned-faces (setq candidate (cdr candidate))) (erc--solo candidate)) -(define-inline erc-nicks--oursp (face) +(define-inline erc-nicks--ours-p (face) + "Return uninterned `nicks'-created face if FACE is a known list of faces." (inline-quote (and-let* ((sym (car-safe ,face)) ((symbolp sym)) @@ -738,29 +744,43 @@ erc-nicks-track-normal-max-rank 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))) - (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))))) +(defun erc-nicks--assess-track-faces (current contender ranks normals) + "Return symbol face for CURRENT or t, to mean CURRENT is replaceable. +But only do so if CURRENT and CONTENDER are either nil or \"normal\" +faces ranking at or below `erc-nicks-track-normal-max-rank'. See +`erc-track--select-mode-line-face' for the expected types of RANKS and +NORMALS. Expect a non-nil CONTENDER to always be ranked." + (and-let* + (((or (null contender) (gethash contender normals))) + ((or (null current) (gethash current normals))) + (threshold (gethash erc-nicks-track-normal-max-rank (car ranks))) + ((or (null contender) (<= threshold (gethash contender (car ranks))))) + ((or (erc-nicks--ours-p current) + (null current) + (<= threshold (or (gethash current (car ranks)) 0))))))) + +(defun erc-nicks--track-prioritize (current contender contenders ranks normals) + "Return a viable non-CURRENT `nicks' face among CONTENDERS. +See `erc-track--select-mode-line-face' for parameter types." + (when-let + ((spkr (erc-nicks--assess-track-faces current contender ranks normals))) (catch 'contender (dolist (candidate (cdr contenders)) (when-let (((not (equal candidate current))) - ((gethash candidate normals)) - (s (erc-nicks--oursp candidate)) + (s (erc-nicks--ours-p candidate)) ((not (eq s spkr)))) + (cl-assert (gethash candidate normals)) + (throw 'contender candidate)))))) + +(defun erc-nicks--track-always (current contender contenders ranks normals) + "Return a viable `nicks' face, possibly CURRENT, among CONTENDERS. +See `erc-track--select-mode-line-face' for parameter types." + (when-let + ((spkr (erc-nicks--assess-track-faces current contender ranks normals))) + (catch 'contender + (dolist (candidate (cdr (reverse contenders))) + (when (erc-nicks--ours-p candidate) + (cl-assert (gethash candidate normals)) (throw 'contender candidate)))))) (defun erc-nicks--setup-track-integration () @@ -770,7 +790,10 @@ erc-nicks--setup-track-integration ;; Variant `defer' is handled elsewhere. ('prioritize (add-function :override (local 'erc-track--alt-normals-function) - #'erc-nicks--check-normals)) + #'erc-nicks--track-prioritize)) + ((or 't 'always) + (add-function :override (local 'erc-track--alt-normals-function) + #'erc-nicks--track-always)) ('nil (add-function :override (local 'erc-track--face-reject-function) #'erc-nicks--reject-uninterned-faces))))) diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el index 75cb98b8407..c865a902a0e 100644 --- a/test/lisp/erc/erc-nicks-tests.el +++ b/test/lisp/erc/erc-nicks-tests.el @@ -788,4 +788,51 @@ erc-nicks-track-faces/nil (erc-track-modified-channels) (funcall assert-result '(5 . erc-notice-face)))))) +(ert-deftest erc-nicks-track-faces/t () + (should (eq erc-nicks-track-faces 'prioritize)) + (let ((erc-nicks-track-faces t)) + (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 indicator changes to that + ;; someone's `nicks'-owned face. + (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 though one other "normal" exists + ;; in the message, `erc-default-face', no update occurs. + (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)) + + ;; Another server user speaks, mentioning the previous speaker, + ;; and the indicator is updated to reflect the new speaker. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-default-face) ; bob: + (,alice-face erc-nick-default-face) ; + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(4 ,alice-face erc-nick-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 -- 2.46.2 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6.1-Clarify-behavior-of-erc-nicks-track-faces-vari.patch >From 417de6ebaf70fe4dfcf3cc03171f01e4c42a6d52 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 26 Sep 2024 21:34:25 -0700 Subject: [PATCH 1/1] [5.6.1] Clarify behavior of erc-nicks-track-faces variants * etc/ERC-NEWS: Mention changes to `erc-track-faces-normal-list' and `erc-track-faces-priority-list'. Also mention new choice variant for option `erc-nicks-track-faces'. * lisp/erc/erc-nicks.el (erc-nicks-track-faces): Update doc, and introduce new `t' value choice. (erc-nicks-mode, erc-nicks-disable): Update removals from `erc-track--alt-normals-function' to reflect recent refactoring. (erc-nicks--reject-uninterned-faces): Use helper. (erc-nicks--oursp, erc-nicks--ours-p): Rename former to latter to respect project style guidelines regarding predicates. (erc-nicks-track-normal-max-rank): New variable. (erc-nicks--check-normals, erc-nicks--assess-track-faces): Rename former to latter and change purpose to checking for "normals" membership, ranks position, and incumbent face ownership. Remove unused CONTENDERS parameter. Also change behavior to consider replacing the current mode-line face when it's not `nicks' owned if it's explicitly ranked lower than `erc-default-face'. (erc-nicks--track-prioritize, erc-nicks--track-always): New complementary functions implementing the t and `prioritize' variants of `erc-nicks-track-faces'. Both make use of the factored-out `erc-nicks--check-normals' logic. (erc-nicks--setup-track-integration): Add `erc-nicks--track-always' to `erc-track--alt-normals-function' when `erc-track-normal-faces' is t. * 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, erc-nicks-track-faces/t): 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 | 13 + lisp/erc/erc-nicks.el | 89 +++++-- lisp/erc/erc-track.el | 219 ++++++++++------ test/lisp/erc/erc-nicks-tests.el | 269 +++++++++++++++++++- test/lisp/erc/erc-track-tests.el | 262 ++++++++++++++++++- test/lisp/erc/resources/erc-tests-common.el | 43 ++++ 6 files changed, 787 insertions(+), 108 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index b267db5502e..ea65a170b38 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -35,6 +35,19 @@ 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. + +** An arguably less distracting 'erc-nicks-track-faces' variant. +Setting this option to t tells the 'track' module to have the mode-line +indicator stick with the most recent speaker's face, even when they're +monologuing, instead of alternating between it and the highest ranked +'erc-track-faces-normal-list' member in a given message. + * Changes in ERC 5.6 diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index a0d6d17d732..3aed985ea21 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -175,17 +175,20 @@ erc-nicks-key-suffix-format (defcustom erc-nicks-track-faces 'prioritize "Show nick faces in the `track' module's portion of the mode line. -A value of nil means don't show nick faces at all. A value of -`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." - :type '(choice (const nil) (const defer) (const prioritize))) +A value of nil means don't show `nicks'-managed faces at all. A value +of t means treat them as non-\"normal\" faces ranked at or below +`erc-default-face'. This has the effect of always showing them while +suppressing the \"alternating\" behavior normally associated with +`erc-track-faces-normal-list' (including between the speaker and nicks +mentioned in the message body.) A value of `defer' means treat nicks as +unranked normals to favor alternating between them and ranked normals. +A value of `prioritize' exhibits the same alternating effect as `defer' +when speakers stay the same but allows a new speaker's face to +impersonate a ranked normal so that adjacent speakers alternate among +themselves before deferring to non-face normals. 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 boolean (const defer) (const prioritize))) (defvar erc-nicks--max-skip-search 3 ; make this an option? "Max number of faces to visit when testing `erc-nicks-skip-faces'.") @@ -597,7 +600,9 @@ nicks (remove-function (local 'erc-button--modify-nick-function) #'erc-nicks--highlight-button) (remove-function (local 'erc-track--alt-normals-function) - #'erc-nicks--check-normals) + #'erc-nicks--track-prioritize) + (remove-function (local 'erc-track--alt-normals-function) + #'erc-nicks--track-always) (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) @@ -724,29 +729,58 @@ 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) +(define-inline erc-nicks--ours-p (face) + "Return uninterned `nicks'-created face if FACE is a known list of faces." (inline-quote (and-let* ((sym (car-safe ,face)) ((symbolp sym)) ((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)) - ((or (null current) (gethash current normals))) - (spkr (or (null current) (erc-nicks--oursp current)))) +(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--assess-track-faces (current contender ranks normals) + "Return symbol face for CURRENT or t, to mean CURRENT is replaceable. +But only do so if CURRENT and CONTENDER are either nil or \"normal\" +faces ranking at or below `erc-nicks-track-normal-max-rank'. See +`erc-track--select-mode-line-face' for the expected types of RANKS and +NORMALS. Expect a non-nil CONTENDER to always be ranked." + (and-let* + (((or (null contender) (gethash contender normals))) + ((or (null current) (gethash current normals))) + (threshold (gethash erc-nicks-track-normal-max-rank (car ranks))) + ((or (null contender) (<= threshold (gethash contender (car ranks))))) + ((or (erc-nicks--ours-p current) + (null current) + (<= threshold (or (gethash current (car ranks)) 0))))))) + +(defun erc-nicks--track-prioritize (current contender contenders ranks normals) + "Return a viable non-CURRENT `nicks' face among CONTENDERS. +See `erc-track--select-mode-line-face' for parameter types." + (when-let + ((spkr (erc-nicks--assess-track-faces current contender ranks normals))) (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)) + (s (erc-nicks--ours-p candidate)) ((not (eq s spkr)))) + (cl-assert (gethash candidate normals)) + (throw 'contender candidate)))))) + +(defun erc-nicks--track-always (current contender contenders ranks normals) + "Return a viable `nicks' face, possibly CURRENT, among CONTENDERS. +See `erc-track--select-mode-line-face' for parameter types." + (when-let + ((spkr (erc-nicks--assess-track-faces current contender ranks normals))) + (catch 'contender + (dolist (candidate (cdr (reverse contenders))) + (when (erc-nicks--ours-p candidate) + (cl-assert (gethash candidate normals)) (throw 'contender candidate)))))) (defun erc-nicks--setup-track-integration () @@ -756,7 +790,10 @@ erc-nicks--setup-track-integration ;; Variant `defer' is handled elsewhere. ('prioritize (add-function :override (local 'erc-track--alt-normals-function) - #'erc-nicks--check-normals)) + #'erc-nicks--track-prioritize)) + ((or 't 'always) + (add-function :override (local 'erc-track--alt-normals-function) + #'erc-nicks--track-always)) ('nil (add-function :override (local 'erc-track--face-reject-function) #'erc-nicks--reject-uninterned-faces))))) 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..c865a902a0e 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,268 @@ 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)))))) + +(ert-deftest erc-nicks-track-faces/t () + (should (eq erc-nicks-track-faces 'prioritize)) + (let ((erc-nicks-track-faces t)) + (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 indicator changes to that + ;; someone's `nicks'-owned face. + (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 though one other "normal" exists + ;; in the message, `erc-default-face', no update occurs. + (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)) + + ;; Another server user speaks, mentioning the previous speaker, + ;; and the indicator is updated to reflect the new speaker. + (funcall set-faces `(erc-timestamp-face + (,bob-face erc-default-face) ; bob: + (,alice-face erc-nick-default-face) ; + erc-default-face)) + (erc-track-modified-channels) + (funcall assert-result `(4 ,alice-face erc-nick-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.2 --=-=-=--