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#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with Date: Sat, 08 Jul 2023 07:19:26 -0700 Message-ID: <87sf9y32q9.fsf__33690.2443015546$1688826033$gmane$org@neverwas.me> References: <87bkh21gfa.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="5379"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 64301@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Jul 08 16:20:25 2023 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 1qI8nQ-0001DI-Fh for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 08 Jul 2023 16:20:24 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qI8n6-0008To-Gn; Sat, 08 Jul 2023 10:20:04 -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 1qI8n4-0008TO-K9 for bug-gnu-emacs@gnu.org; Sat, 08 Jul 2023 10:20:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qI8n4-0007Yk-BG for bug-gnu-emacs@gnu.org; Sat, 08 Jul 2023 10:20:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qI8n4-00055g-19 for bug-gnu-emacs@gnu.org; Sat, 08 Jul 2023 10:20: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: Sat, 08 Jul 2023 14:20:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 64301 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 64301-submit@debbugs.gnu.org id=B64301.168882598119523 (code B ref 64301); Sat, 08 Jul 2023 14:20:01 +0000 Original-Received: (at 64301) by debbugs.gnu.org; 8 Jul 2023 14:19:41 +0000 Original-Received: from localhost ([127.0.0.1]:45032 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qI8mf-00054m-Mq for submit@debbugs.gnu.org; Sat, 08 Jul 2023 10:19:40 -0400 Original-Received: from mail-108-mta17.mxroute.com ([136.175.108.17]:32777) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qI8mb-00054Z-BW for 64301@debbugs.gnu.org; Sat, 08 Jul 2023 10:19:36 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta17.mxroute.com (ZoneMTA) with ESMTPSA id 18935df3c730007ced.001 for <64301@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Sat, 08 Jul 2023 14:19:29 +0000 X-Zone-Loop: ae40c419092b05028c88da4d02e6dc9fc5e9aa054461 X-Originating-IP: [136.175.111.2] 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=X7fnbEzwnArxMe8N91FILeNmRXEghj/ebuN+09NQUrI=; b=XhtwulivSshAMvs+onJ/v+sF0e ruqWv7+lK9wpO6ODt9A6MnUBr/ZFyyLy2seP440TYfzHPcfYdTwyc3ufp8sDCmzUz1SwXLbicStgF 6NW45SAsjDqHADPmypw2nc3BzV/W9eUPXkOTB0C2osiSNpg8B7JPrF5UpcE6y62Vb4fF6/zUHhddw oFn7YS5ggIeazdd2sD5hLgxV5VbIHjH3k/P83SofZLH61SmCpCulhfx3qGfC/vsC1TUb4ZFnvPfBp rFINi2Q49axLWTL3aS0RN2SlIjEy3HLMFzQbBGRd3MCPqSfbyJyUhbMuJrGOPwaXBB88HQLiPshCo d4maRWLw==; In-Reply-To: <87bkh21gfa.fsf@neverwas.me> (J. P.'s message of "Mon, 26 Jun 2023 06:50:17 -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:264773 Archived-At: --=-=-= Content-Type: text/plain v3. Fix problem calculating column width. Add command to toggle fool invisibility. Add test for hidden date stamps. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v2-v3.diff >From aae534bcbe0eb75e436c428b248a87748ec185b6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 8 Jul 2023 07:06:09 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): [5.6] Respect existing invisibility props in erc-stamp [5.6] Simplify erc-button-add-nickname-buttons [5.6] Add text props for CTCPs and speakers in ERC [5.6] Handle composite faces better in erc-display-message etc/ERC-NEWS | 29 ++- lisp/erc/erc-backend.el | 39 ++-- lisp/erc/erc-button.el | 78 ++++---- lisp/erc/erc-dcc.el | 16 +- lisp/erc/erc-fill.el | 25 ++- lisp/erc/erc-match.el | 29 +-- lisp/erc/erc-sasl.el | 8 +- lisp/erc/erc-stamp.el | 21 ++- lisp/erc/erc-track.el | 12 +- lisp/erc/erc.el | 99 +++++++--- test/lisp/erc/erc-button-tests.el | 2 +- test/lisp/erc/erc-fill-tests.el | 5 +- test/lisp/erc/erc-scenarios-match.el | 259 ++++++++++++++++++++++++--- 13 files changed, 467 insertions(+), 155 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 40bcd934772..795553f1666 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -144,11 +144,12 @@ the same effect by issuing a "/CLEAR" at the prompt. Some minor quality-of-life niceties have finally made their way to ERC. For example, the function 'erc-echo-timestamp' is now interactive and can be invoked on any message to view its timestamp in -the echo area. The command 'erc-button-previous' now moves to the -beginning instead of the end of buttons. A new command, 'erc-news', -can now be invoked to visit this very file. And the 'irccontrols' -module now supports additional colors and special handling for -"spoilers" (hidden text). +the echo area. Fool visibility has become togglable with the new +command 'erc-match-toggle-hidden-fools'. The 'button' module's +'erc-button-previous' now moves to the beginning instead of the end of +buttons. A new command, 'erc-news', can be invoked to visit this very +file. And the 'irccontrols' module now supports additional colors and +special handling for "spoilers" (hidden text). ** Changes in the library API. @@ -197,6 +198,9 @@ traversing messages. To compensate, a new property, 'erc-timestamp', now spans message bodies but not the newlines delimiting them. Somewhat relatedly, the function 'erc-insert-aligned' has been deprecated and removed from the primary client code path. +Additionally, the 'stamp' module now merges its 'invisible' property +with existing ones, when present, and it includes all white space +around stamps when doing so. *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and provided library diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 549de4feeb8..a5b0af41b2a 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -660,6 +660,10 @@ erc-match--hide-fools-offset-bounds (defun erc-hide-fools (match-type _nickuserhost _message) "Hide comments from designated fools." (when (eq match-type 'fool) + (erc-match--hide-message))) + +(defun erc-match--hide-message () + (progn ; FIXME raise sexp (if erc-match--hide-fools-offset-bounds (let ((beg (point-min)) (end (point-max))) @@ -677,12 +681,21 @@ erc-beep-on-match (beep))) (defun erc-match--modify-invisibility-spec () - "Add an ellipsis property to the local spec." + "Add an `erc-match' property to the local spec." (if erc-match-mode (add-to-invisibility-spec 'erc-match) (erc-with-all-buffers-of-server nil nil (remove-from-invisibility-spec 'erc-match)))) +(defun erc-match-toggle-hidden-fools () + "Toggle fool visibility. +Expect `erc-hide-fools' or a function that does something similar +to be in `erc-text-matched-hook'." + (interactive) + (if (memq 'erc-match (ensure-list buffer-invisibility-spec)) + (remove-from-invisibility-spec 'erc-match) + (add-to-invisibility-spec 'erc-match))) + (provide 'erc-match) ;;; erc-match.el ends here diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 2f52d78d42b..83ee4a200ed 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -437,6 +437,7 @@ erc-insert-timestamp-right (goto-char (point-max)) (forward-char -1) ; before the last newline (let* ((str-width (string-width string)) + (buffer-invisibility-spec nil) ; `current-column' > 0 window ; used in computation of `pos' only (pos (cond (erc-timestamp-right-column erc-timestamp-right-column) diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index edc1749cdd2..715fe9c25d7 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -24,8 +24,11 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(require 'erc-stamp) -(require 'erc-match) +(eval-when-compile + (require 'erc-join) + (require 'erc-stamp) + (require 'erc-match)) + (require 'erc-fill) ;; This defends against a regression in which all matching by the @@ -62,6 +65,9 @@ erc-scenarios-match--stamp-left-current-nick ;; interactively, and check for wierdness before and after doing ;; M-: (remove-from-invisibility-spec 'erc-match) RET. (defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) + (unless noninteractive + (kill-new "(remove-from-invisibility-spec 'erc-match)")) + (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") (dumb-server (erc-d-run "localhost" t 'foonet)) @@ -236,6 +242,93 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) -(eval-when-compile (require 'erc-join)) +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () + :tags '(:expensive-test) + (should (eq erc-insert-timestamp-function + #'erc-insert-timestamp-left-and-right)) + + ;; Rewind the clock to known date artificially. + (let ((erc-stamp--current-time 704591940) + (erc-stamp--tz t) + (erc-fill-function #'erc-fill-static) + (bob-utterance-counter 0)) + + (erc-scenarios-match--invisible-stamp + + (lambda () + (ert-info ("Baseline check") + ;; False date printed initially before anyone speaks. + (when (zerop bob-utterance-counter) + (save-excursion + (goto-char (point-min)) + (search-forward "[Wed Apr 29 1992]") + (search-forward "[23:59]")))) + + (ert-info ("Line endings in Bob's messages are invisible") + ;; The message proper has the `invisible' property `erc-match'. + (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) + (mend (next-single-property-change mbeg 'erc-command))) + + (if (/= 1 bob-utterance-counter) + (should-not (field-at-pos mend)) + ;; For Bob's stamped message, check newline after stamp. + (should (eq (field-at-pos mend) 'erc-timestamp)) + (setq mend (field-end mend))) + + ;; The `erc-timestamp' property spans entire messages, + ;; including stamps and filled text, which makes for + ;; convenient traversal when `erc-stamp-mode' is enabled. + (should (get-text-property (pos-bol) 'erc-timestamp)) + (should (= (next-single-property-change (pos-bol) 'erc-timestamp) + mend)) + + ;; Line ending has the `invisible' property `erc-match'. + (should (= (char-after mend) ?\n)) + (should (eq (get-text-property mend'invisible) 'erc-match)))) + + ;; Only the message right after Alice speaks contains stamps. + (when (= 1 bob-utterance-counter) + + (ert-info ("Date stamp occupying previous line is invisible") + (save-excursion + (forward-line -1) + (goto-char (pos-bol)) + (should (looking-at (rx "[Mon May 4 1992]"))) + ;; Date stamp has a combined `invisible' property value + ;; that extends until the start of the message proper. + (should (equal (get-text-property (point) 'invisible) + '(timestamp erc-match))) + (should (= (next-single-property-change (point) 'invisible) + (1+ (pos-eol)))))) + + (ert-info ("Folding preserved despite invisibility") + ;; Message has a trailing time stamp, but it's been folded + ;; over to the next line. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (save-excursion + (forward-line) + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))) + + ;; Stamp invisibility starts where message's ends. + (let ((msgend (next-single-property-change (pos-bol) 'invisible))) + ;; Stamp has a combined `invisible' property value. + (should (equal (get-text-property msgend 'invisible) + '(timestamp erc-match))) + + ;; Combined `invisible' property spans entire timestamp. + (should (= (next-single-property-change msgend 'invisible) + (save-excursion (forward-line) (pos-eol))))))) + + (cl-incf bob-utterance-counter)) + + ;; Alice. + (lambda () + ;; Set clock ahead a week or so. + (setq erc-stamp--current-time 704962800) + + ;; This message has no time stamp and is completely visible. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (should-not (next-single-property-change (pos-bol) 'invisible)))))) ;;; erc-scenarios-match.el ends here -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Respect-existing-invisibility-props-in-erc-stamp.patch >From 4ac5a1835bdaa31d69449e1bcc3aa3d33c770585 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 2 Jul 2023 20:58:37 -0700 Subject: [PATCH 1/4] [5.6] Respect existing invisibility props in erc-stamp * lisp/erc/erc-match.el (erc-hide-fools): change `invisible' property to `erc-match' for all messages, not just those with offset bounds. (erc-match--modify-invisibility-spec): Fix error in doc string. (erc-match-toggle-hidden-fools): New command. * lisp/erc/erc-stamp.el (erc-stamp--invisible-property): Add new internal variable to hold existing `invisible' property merged with the one registered by this module. (erc-stamp--skip-when-invisible): Add new internal variable to act as escape hatch for pre ERC-5.6 behavior in which timestamps were not applied at all to invisible messages. This led to strange-looking, uneven logs, and it prevented other modules from offering toggle functionality for invisibility spec members registered to them. (erc-add-timestamp): Merge with existing `invisible' property, when present, instead of clobbering, but only when escape hatch `erc-stamp--skip-when-invisible' is nil. (erc-insert-timestamp-left, erc-format-timestamp): Use possibly merged `invisible' prop value. Don't bother with `isearch-open-invisible', which only affects overlays. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--invisible-stamp): Move setup and core assertions for stamp-related tests into fixture. (erc-scenarios-match--stamp-left-fools-invisible): Fix temporarily disabled test and use fixture. (erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-right-invisible-fill-wrap): New test. (Bug#64301) --- etc/ERC-NEWS | 14 +- lisp/erc/erc-match.el | 18 +- lisp/erc/erc-stamp.el | 21 ++- test/lisp/erc/erc-scenarios-match.el | 259 ++++++++++++++++++++++++--- 4 files changed, 273 insertions(+), 39 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5665b760ea9..37435a1d915 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -144,11 +144,12 @@ the same effect by issuing a "/CLEAR" at the prompt. Some minor quality-of-life niceties have finally made their way to ERC. For example, the function 'erc-echo-timestamp' is now interactive and can be invoked on any message to view its timestamp in -the echo area. The command 'erc-button-previous' now moves to the -beginning instead of the end of buttons. A new command, 'erc-news', -can now be invoked to visit this very file. And the 'irccontrols' -module now supports additional colors and special handling for -"spoilers" (hidden text). +the echo area. Fool visibility has become togglable with the new +command 'erc-match-toggle-hidden-fools'. The 'button' module's +'erc-button-previous' now moves to the beginning instead of the end of +buttons. A new command, 'erc-news', can be invoked to visit this very +file. And the 'irccontrols' module now supports additional colors and +special handling for "spoilers" (hidden text). ** Changes in the library API. @@ -197,6 +198,9 @@ traversing messages. To compensate, a new property, 'erc-timestamp', now spans message bodies but not the newlines delimiting them. Somewhat relatedly, the function 'erc-insert-aligned' has been deprecated and removed from the primary client code path. +Additionally, the 'stamp' module now merges its 'invisible' property +with existing ones, when present, and it includes all white space +around stamps when doing so. *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and provided library diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 2b7fff87ff0..cd2c55b0091 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -669,10 +669,9 @@ erc-hide-fools (save-restriction (widen) (put-text-property (1- beg) (1- end) 'invisible 'erc-match))) - ;; The docs say `intangible' is deprecated, but this has been - ;; like this for ages. Should verify unneeded and remove if so. - (erc-put-text-properties (point-min) (point-max) - '(invisible intangible))))) + ;; Before ERC 5.6, this also used to add an `intangible' + ;; property, but the docs say it's now obsolete. + (put-text-property (point-min) (point-max) 'invisible 'erc-match)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. @@ -681,12 +680,21 @@ erc-beep-on-match (beep))) (defun erc-match--modify-invisibility-spec () - "Add an ellipsis property to the local spec." + "Add an `erc-match' property to the local spec." (if erc-match-mode (add-to-invisibility-spec 'erc-match) (erc-with-all-buffers-of-server nil nil (remove-from-invisibility-spec 'erc-match)))) +(defun erc-match-toggle-hidden-fools () + "Toggle fool visibility. +Expect `erc-hide-fools' or a function that does something similar +to be in `erc-text-matched-hook'." + (interactive) + (if (memq 'erc-match (ensure-list buffer-invisibility-spec)) + (remove-from-invisibility-spec 'erc-match) + (add-to-invisibility-spec 'erc-match))) + (provide 'erc-match) ;;; erc-match.el ends here diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 5035e60a87d..83ee4a200ed 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -179,6 +179,12 @@ stamp (kill-local-variable 'erc-timestamp-last-inserted-left) (kill-local-variable 'erc-timestamp-last-inserted-right)))) +(defvar erc-stamp--invisible-property nil + "Existing `invisible' property value and/or symbol `timestamp'.") + +(defvar erc-stamp--skip-when-invisible nil + "Escape hatch for omitting stamps when first char is invisible.") + (defun erc-stamp--recover-on-reconnect () (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted @@ -209,8 +215,11 @@ erc-add-timestamp (progn ; remove this `progn' on next major refactor (let* ((ct (erc-stamp--current-time)) (invisible (get-text-property (point-min) 'invisible)) + (erc-stamp--invisible-property + ;; FIXME on major version bump, make this `erc-' prefixed. + (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp)) (erc-stamp--current-time ct)) - (unless invisible + (unless (setq invisible (and erc-stamp--skip-when-invisible invisible)) (funcall erc-insert-timestamp-function (erc-format-timestamp ct erc-timestamp-format))) ;; FIXME this will error when advice has been applied. @@ -380,7 +389,7 @@ erc-insert-timestamp-left (s (if ignore-p (make-string len ? ) string))) (unless ignore-p (setq erc-timestamp-last-inserted string)) (erc-put-text-property 0 len 'field 'erc-timestamp s) - (erc-put-text-property 0 len 'invisible 'timestamp s) + (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) (insert s))) (defun erc-insert-aligned (string pos) @@ -428,6 +437,7 @@ erc-insert-timestamp-right (goto-char (point-max)) (forward-char -1) ; before the last newline (let* ((str-width (string-width string)) + (buffer-invisibility-spec nil) ; `current-column' > 0 window ; used in computation of `pos' only (pos (cond (erc-timestamp-right-column erc-timestamp-right-column) @@ -477,6 +487,8 @@ erc-insert-timestamp-right (put-text-property from (point) p v))) (erc-put-text-property from (point) 'field 'erc-timestamp) (erc-put-text-property from (point) 'rear-nonsticky t) + (erc-put-text-property from (point) 'invisible + erc-stamp--invisible-property) (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) @@ -520,9 +532,8 @@ erc-format-timestamp (let ((ts (format-time-string format time erc-stamp--tz))) (erc-put-text-property 0 (length ts) 'font-lock-face 'erc-timestamp-face ts) - (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) - (erc-put-text-property 0 (length ts) - 'isearch-open-invisible 'timestamp ts) + (erc-put-text-property 0 (length ts) 'invisible + erc-stamp--invisible-property ts) ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 782907bfc30..715fe9c25d7 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -24,8 +24,12 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(require 'erc-stamp) -(require 'erc-match) +(eval-when-compile + (require 'erc-join) + (require 'erc-stamp) + (require 'erc-match)) + +(require 'erc-fill) ;; This defends against a regression in which all matching by the ;; `erc-match-message' fails when `erc-add-timestamp' precedes it in @@ -57,28 +61,23 @@ erc-scenarios-match--stamp-left-current-nick (should (eq (get-text-property (1- (point)) 'font-lock-face) 'erc-current-nick-face)))))) -;; This asserts that when stamps appear before a message, -;; some non-nil invisibility property spans the entire message. -(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () - :tags '(:expensive-test) - (ert-skip "WIP: fix included in bug#64301") +;; When hacking on tests that use this fixture, it's best to run it +;; interactively, and check for wierdness before and after doing +;; M-: (remove-from-invisibility-spec 'erc-match) RET. +(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) + (unless noninteractive + (kill-new "(remove-from-invisibility-spec 'erc-match)")) + (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") (dumb-server (erc-d-run "localhost" t 'foonet)) (port (process-contact dumb-server :service)) (erc-server-flood-penalty 0.1) - (erc-insert-timestamp-function 'erc-insert-timestamp-left) (erc-timestamp-only-if-changed-flag nil) (erc-fools '("bob")) (erc-text-matched-hook '(erc-hide-fools)) (erc-autojoin-channels-alist '((FooNet "#chan"))) - (expect (erc-d-t-make-expecter)) - (hiddenp (lambda () - (and (eq (field-at-pos (pos-bol)) 'erc-timestamp) - (get-text-property (pos-bol) 'invisible) - (>= (next-single-property-change (pos-bol) - 'invisible nil) - (pos-eol)))))) + (expect (erc-d-t-make-expecter))) (ert-info ("Connect") (with-current-buffer (erc :server "127.0.0.1" @@ -94,30 +93,242 @@ erc-scenarios-match--stamp-left-fools-invisible (ert-info ("Ensure lines featuring \"bob\" are invisible") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (should (funcall expect 10 " tester, welcome!")) - (should (funcall hiddenp)) + (ert-info (" tester, welcome!") (funcall hiddenp)) ;; Alice's is the only one visible. (should (funcall expect 10 " tester, welcome!")) - (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) - (should (get-text-property (pos-bol) 'invisible)) - (should-not (get-text-property (point) 'invisible)) + (ert-info (" tester, welcome!") (funcall visiblep)) (should (funcall expect 10 " alice: But, as it seems")) - (should (funcall hiddenp)) + (ert-info (" alice: But, as it seems") (funcall hiddenp)) (should (funcall expect 10 " bob: Well, this is the forest")) - (should (funcall hiddenp)) + (ert-info (" bob: Well, this is the forest") (funcall hiddenp)) (should (funcall expect 10 " bob: And will you")) - (should (funcall hiddenp)) + (ert-info (" bob: And will you") (funcall hiddenp)) (should (funcall expect 10 " alice: Live, and be prosperous")) - (should (funcall hiddenp)) + (ert-info (" alice: Live, and be prosperous") (funcall hiddenp)) (should (funcall expect 10 "ERC>")) (should-not (get-text-property (pos-bol) 'invisible)) (should-not (get-text-property (point) 'invisible)))))) -(eval-when-compile (require 'erc-join)) +;; This asserts that when stamps appear before a message, registered +;; invisibility properties owned by modules span the entire message. +(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left)) + (erc-scenarios-match--invisible-stamp + + (lambda () + ;; This is a time-stamped message. + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + + ;; Leading stamp has combined `invisible' property value. + (should (equal (get-text-property (pos-bol) 'invisible) + '(timestamp erc-match))) + + ;; Message proper has the `invisible' property `erc-match'. + (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) + (should (eq (get-text-property msg-beg 'invisible) 'erc-match)) + (should (>= (next-single-property-change msg-beg 'invisible nil) + (pos-eol))))) + + (lambda () + ;; This is a time-stamped message. + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + (should (get-text-property (pos-bol) 'invisible)) + + ;; The entire message proper is visible. + (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) + (should + (= (next-single-property-change msg-beg 'invisible nil (pos-eol)) + (pos-eol)))))))) + +(defun erc-scenarios-match--find-eol () + (save-excursion + (goto-char (next-single-property-change (point) 'erc-command)) + (pos-eol))) + +;; In most cases, `erc-hide-fools' makes line endings invisible. +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) + (erc-scenarios-match--invisible-stamp + + (lambda () + (let ((end (erc-scenarios-match--find-eol))) + ;; The end of the message is a newline. + (should (= ?\n (char-after end))) + + ;; Every message has a trailing time stamp. + (should (eq (field-at-pos (1- end)) 'erc-timestamp)) + + ;; Stamps have a combined `invisible' property value. + (should (equal (get-text-property (1- end) 'invisible) + '(timestamp erc-match))) + + ;; The final newline is hidden by `match', not `stamps' + (should (equal (get-text-property end 'invisible) 'erc-match)) + + ;; The message proper has the `invisible' property `erc-match', + ;; and it starts after the preceding newline. + (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + + ;; It ends just before the timestamp. + (let ((msg-end (next-single-property-change (pos-bol) 'invisible))) + (should (equal (get-text-property msg-end 'invisible) + '(timestamp erc-match))) + + ;; Stamp's `invisible' property extends throughout the stamp + ;; and ends before the trailing newline. + (should (= (next-single-property-change msg-end 'invisible) end))))) + + (lambda () + (let ((end (erc-scenarios-match--find-eol))) + ;; This message has a time stamp like all the others. + (should (eq (field-at-pos (1- end)) 'erc-timestamp)) + + ;; The entire message proper is visible. + (should-not (get-text-property (pos-bol) 'invisible)) + (let ((inv-beg (next-single-property-change (pos-bol) 'invisible))) + (should (eq (get-text-property inv-beg 'invisible) + 'timestamp)))))))) + +;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides +;; the preceding message's line ending. +(ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right) + (erc-fill-function #'erc-fill-wrap)) + (erc-scenarios-match--invisible-stamp + + (lambda () + ;; Every message has a trailing time stamp. + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + + ;; Stamps appear in the right margin. + (should (equal (car (get-text-property (1- (pos-eol)) 'display)) + '(margin right-margin))) + + ;; Stamps have a combined `invisible' property value. + (should (equal (get-text-property (1- (pos-eol)) 'invisible) + '(timestamp erc-match))) + + ;; The message proper has the `invisible' property `erc-match', + ;; which starts at the preceding newline... + (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match)) + + ;; ... and ends just before the timestamp. + (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible))) + (should (equal (get-text-property msgend 'invisible) + '(timestamp erc-match))) + + ;; The newline before `erc-insert-marker' is still visible. + (should-not (get-text-property (pos-eol) 'invisible)) + (should (= (next-single-property-change msgend 'invisible) + (pos-eol))))) + + (lambda () + ;; This message has a time stamp like all the others. + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + + ;; Unlike hidden messages, the preceding newline is visible. + (should-not (get-text-property (1- (pos-bol)) 'invisible)) + + ;; The entire message proper is visible. + (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) + (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) + +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () + :tags '(:expensive-test) + (should (eq erc-insert-timestamp-function + #'erc-insert-timestamp-left-and-right)) + + ;; Rewind the clock to known date artificially. + (let ((erc-stamp--current-time 704591940) + (erc-stamp--tz t) + (erc-fill-function #'erc-fill-static) + (bob-utterance-counter 0)) + + (erc-scenarios-match--invisible-stamp + + (lambda () + (ert-info ("Baseline check") + ;; False date printed initially before anyone speaks. + (when (zerop bob-utterance-counter) + (save-excursion + (goto-char (point-min)) + (search-forward "[Wed Apr 29 1992]") + (search-forward "[23:59]")))) + + (ert-info ("Line endings in Bob's messages are invisible") + ;; The message proper has the `invisible' property `erc-match'. + (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) + (mend (next-single-property-change mbeg 'erc-command))) + + (if (/= 1 bob-utterance-counter) + (should-not (field-at-pos mend)) + ;; For Bob's stamped message, check newline after stamp. + (should (eq (field-at-pos mend) 'erc-timestamp)) + (setq mend (field-end mend))) + + ;; The `erc-timestamp' property spans entire messages, + ;; including stamps and filled text, which makes for + ;; convenient traversal when `erc-stamp-mode' is enabled. + (should (get-text-property (pos-bol) 'erc-timestamp)) + (should (= (next-single-property-change (pos-bol) 'erc-timestamp) + mend)) + + ;; Line ending has the `invisible' property `erc-match'. + (should (= (char-after mend) ?\n)) + (should (eq (get-text-property mend'invisible) 'erc-match)))) + + ;; Only the message right after Alice speaks contains stamps. + (when (= 1 bob-utterance-counter) + + (ert-info ("Date stamp occupying previous line is invisible") + (save-excursion + (forward-line -1) + (goto-char (pos-bol)) + (should (looking-at (rx "[Mon May 4 1992]"))) + ;; Date stamp has a combined `invisible' property value + ;; that extends until the start of the message proper. + (should (equal (get-text-property (point) 'invisible) + '(timestamp erc-match))) + (should (= (next-single-property-change (point) 'invisible) + (1+ (pos-eol)))))) + + (ert-info ("Folding preserved despite invisibility") + ;; Message has a trailing time stamp, but it's been folded + ;; over to the next line. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (save-excursion + (forward-line) + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))) + + ;; Stamp invisibility starts where message's ends. + (let ((msgend (next-single-property-change (pos-bol) 'invisible))) + ;; Stamp has a combined `invisible' property value. + (should (equal (get-text-property msgend 'invisible) + '(timestamp erc-match))) + + ;; Combined `invisible' property spans entire timestamp. + (should (= (next-single-property-change msgend 'invisible) + (save-excursion (forward-line) (pos-eol))))))) + + (cl-incf bob-utterance-counter)) + + ;; Alice. + (lambda () + ;; Set clock ahead a week or so. + (setq erc-stamp--current-time 704962800) + + ;; This message has no time stamp and is completely visible. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (should-not (next-single-property-change (pos-bol) 'invisible)))))) ;;; erc-scenarios-match.el ends here -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Simplify-erc-button-add-nickname-buttons.patch >From a8e8078b95fa3dfa0b37b88a4d3b94432ae75468 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 30 Jun 2023 23:42:01 -0700 Subject: [PATCH 2/4] [5.6] Simplify erc-button-add-nickname-buttons * lisp/erc/erc-button.el (erc-button--nick): Remove `face' slot which was set to `erc-button-face' by default. It's ignored when the button is a nick and thus completely useless. (erc-button-add-nickname-buttons): Rework and reflow for readability. Don't bind or set `erc-button' face because it's ignored when dealing with nicks. Don't return the value of face options when calling a `form' function because they can be nil in practice even though their Custom type specs do not say so. * lisp/erc/erc.el (erc--get-speaker-bounds): New helper function to retrieve bounds of a speaker label when present. (Bug#64301) --- lisp/erc/erc-button.el | 78 ++++++++++++++++++++---------------------- lisp/erc/erc.el | 10 ++++++ 2 files changed, 47 insertions(+), 41 deletions(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 0c616a6026d..c30f7c10ca6 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -355,8 +355,6 @@ erc-button--nick ( cuser nil :type (or null erc-channel-user) ;; The CDR of a value from an `erc-channel-users' table. :documentation "A possibly nil `erc-channel-user'.") - ( face erc-button-face :type symbol - :documentation "Temp `erc-button-face' while buttonizing.") ( nickname-face erc-button-nickname-face :type symbol :documentation "Temp `erc-button-nickname-face' while buttonizing.") ( mouse-face erc-button-mouse-face :type symbol @@ -431,45 +429,43 @@ erc-button--phantom-users-mode (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." - (let ((form (nth 2 entry)) - (fun (nth 3 entry)) - (erc-button-buttonize-nicks (and erc-button-buttonize-nicks - erc-button--modify-nick-function)) - bounds word) - (when (and form (setq form (erc-button--extract-form form))) - (goto-char (point-min)) - (while (erc-forward-word) - (when (setq bounds (erc-bounds-of-word-at-point)) - (setq word (buffer-substring-no-properties - (car bounds) (cdr bounds))) - (let* ((erc-button-face erc-button-face) - (erc-button-mouse-face erc-button-mouse-face) - (erc-button-nickname-face erc-button-nickname-face) - (down (erc-downcase word)) - (cuser (and erc-channel-users - (gethash down erc-channel-users))) - (user (or (and cuser (car cuser)) - (and erc-server-users - (gethash down erc-server-users)) - (funcall erc-button--fallback-user-function - down word bounds))) - (data (list word))) - (when (or (not (functionp form)) - (and-let* ((user) - (obj (funcall form (make-erc-button--nick - :bounds bounds :data data - :downcased down :user user - :cuser (cdr cuser))))) - (setq bounds (erc-button--nick-bounds obj) - data (erc-button--nick-data obj) - erc-button-mouse-face - (erc-button--nick-mouse-face obj) - erc-button-nickname-face - (erc-button--nick-nickname-face obj) - erc-button-face - (erc-button--nick-face obj)))) - (erc-button-add-button (car bounds) (cdr bounds) - fun t data)))))))) + (when-let ((form (nth 2 entry)) + ;; Spoof `form' slot of default legacy `nicknames' entry + ;; so `erc-button--extract-form' sees a function value. + (form (let ((erc-button-buttonize-nicks + (and erc-button-buttonize-nicks + erc-button--modify-nick-function))) + (erc-button--extract-form form))) + (seen 0)) + (goto-char (point-min)) + (while-let + (((erc-forward-word)) + (bounds (or (and (= 1 (cl-incf seen)) (erc--get-speaker-bounds)) + (erc-bounds-of-word-at-point))) + (word (buffer-substring-no-properties (car bounds) (cdr bounds))) + (down (erc-downcase word))) + (let* ((erc-button-mouse-face erc-button-mouse-face) + (erc-button-nickname-face erc-button-nickname-face) + (cuser (and erc-channel-users (gethash down erc-channel-users))) + (user (or (and cuser (car cuser)) + (and erc-server-users (gethash down erc-server-users)) + (funcall erc-button--fallback-user-function + down word bounds))) + (data (list word))) + (when (or (not (functionp form)) + (and-let* ((user) + (obj (funcall form (make-erc-button--nick + :bounds bounds :data data + :downcased down :user user + :cuser (cdr cuser))))) + (setq erc-button-mouse-face ; might be null + (erc-button--nick-mouse-face obj) + erc-button-nickname-face ; might be null + (erc-button--nick-nickname-face obj) + data (erc-button--nick-data obj) + bounds (erc-button--nick-bounds obj)))) + (erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry) + 'nickp data)))))) (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e23185934f7..06b88ade2a0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5025,6 +5025,16 @@ erc-is-message-ctcp-and-not-action-p (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) +(define-inline erc--get-speaker-bounds () + "Return the bounds of `erc-speaker' property when present. +Assume buffer is narrowed to the confines of an inserted message." + (inline-quote + (and-let* + (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE))) + (beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min)) + (next-single-property-change (point-min) 'erc-speaker)))) + (cons beg (next-single-property-change beg 'erc-speaker))))) + (defvar erc--user-from-nick-function #'erc--examine-nick "Function to possibly consider unknown user. Must return either nil or a cons of an `erc-server-user' and a -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Add-text-props-for-CTCPs-and-speakers-in-ERC.patch >From 0f324a9946804fe01476ed62be9c23e99b47aaed Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 24 Jun 2023 18:33:20 -0700 Subject: [PATCH 3/4] [5.6] Add text props for CTCPs and speakers in ERC * lisp/erc/erc-fill.el (erc-fill-spaced-commands, erc-fill--spaced-commands): Rename former to latter and demote from user option to internal variable. (erc-fill--wrap-continued-message-p): Use `erc-ctcp' text prop instead of face to detect ACTION. (erc-fill--wrap-action-dedent-p): New variable to toggle whether `line-prefix' is applied to CTCP ACTION messages. (erc-fill-wrap): Look for `erc-speaker' property before falling back on word at point. Use `erc-ctcp' to detect ACTION messages. * lisp/erc/erc.el (erc-notice-face, erc-action-face): Prefer weight of `semi-bold' when available so that buttonization is at least somewhat visible. (erc-send-action): Ensure nickname passed to `erc-display-message' has `erc-speaker' property and `erc-ctcp' ACTION property. Apply both `erc-input-face' and `erc-action-face' to messages. (erc--own-property-names): Add `erc-speaker'. (erc-format-privmessage): Don't clobber `erc-nick-prefix-face'. That is, retain face applied to a leading stretch of characters in the `nick' parameter. But continue to discard trailing faces. (erc-format-my-nick, erc-ctcp-query-ACTION): Add a new text property, `erc-speaker', to the nick portion of the formatted speaker label. Do this to assist modules, like `button' and `match', that re-parse speakers in inserted messages. (erc-process-ctcp-query): Add `erc-ctcp' property to entire message before insertion hooks. (Bug#64301) * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--compare): Warn about certain unreliable comparisons if generalizing helper for use by other modules. --- lisp/erc/erc-fill.el | 25 ++++++++++++++------- lisp/erc/erc.el | 40 ++++++++++++++++++++++++--------- test/lisp/erc/erc-fill-tests.el | 5 ++++- 3 files changed, 51 insertions(+), 19 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 5115e45210d..a65c95f1d85 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -124,11 +124,9 @@ erc-fill-line-spacing :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) number)) -(defcustom erc-fill-spaced-commands '(PRIVMSG NOTICE) +(defvar erc-fill--spaced-commands '(PRIVMSG NOTICE) "Types of messages to add space between on graphical displays. -Only considered when `erc-fill-line-spacing' is non-nil." - :package-version '(ERC . "5.6") ; FIXME sync on release - :type '(repeat (choice integer symbol))) +Only considered when `erc-fill-line-spacing' is non-nil.") (defvar-local erc-fill--function nil "Internal copy of `erc-fill-function'. @@ -153,12 +151,12 @@ erc-fill (p (point-min))) (widen) (when (or (and-let* ((cmd (get-text-property p 'erc-command))) - (memq cmd erc-fill-spaced-commands)) + (memq cmd erc-fill--spaced-commands)) (and-let* ((cmd (save-excursion (forward-line -1) (get-text-property (point) 'erc-command)))) - (memq cmd erc-fill-spaced-commands))) + (memq cmd erc-fill--spaced-commands))) (put-text-property (1- p) p 'line-spacing erc-fill-line-spacing)))))))) @@ -384,8 +382,7 @@ erc-fill--wrap-continued-message-p (when (eq 'erc-timestamp (field-at-pos m)) (set-marker m (field-end m))) (and (eq 'PRIVMSG (get-text-property m 'erc-command)) - (not (eq (get-text-property m 'font-lock-face) - 'erc-action-face)) + (not (eq (get-text-property m 'erc-ctcp) 'ACTION)) (cons (get-text-property m 'erc-timestamp) (get-text-property (1+ m) 'erc-data))))) (ts (pop props)) @@ -418,6 +415,12 @@ erc-fill--wrap-stamp-insert-prefixed-date `(space :width (- erc-fill--wrap-value ,width)))) args) +;; An escape hatch for third-party code expecting speakers of ACTION +;; messages to be exempt from `line-prefix'. This could be converted +;; into a user option if users feel similarly. +(defvar erc-fill--wrap-action-dedent-p t + "Whether to dedent speakers in CTCP \"ACTION\" lines.") + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." @@ -428,6 +431,12 @@ erc-fill-wrap (let ((len (or (and erc-fill--wrap-length-function (funcall erc-fill--wrap-length-function)) (progn + (when-let ((e (erc--get-speaker-bounds)) + (b (pop e)) + ((or erc-fill--wrap-action-dedent-p + (not (eq (get-text-property b 'erc-ctcp) + 'ACTION))))) + (goto-char e)) (skip-syntax-forward "^-") (forward-char) ;; Using the `invisible' property might make more diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 06b88ade2a0..d43281825fb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1302,12 +1302,15 @@ erc-command-indicator-face (defface erc-notice-face '((default :weight bold) + (((class color) (min-colors 88) (supports :weight semi-bold)) + :weight semi-bold :foreground "SlateBlue") (((class color) (min-colors 88)) :foreground "SlateBlue") (t :foreground "blue")) "ERC face for notices." :group 'erc-faces) -(defface erc-action-face '((t :weight bold)) +(defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold) + (t :weight bold)) "ERC face for actions generated by /ME." :group 'erc-faces) @@ -2723,10 +2726,13 @@ erc-send-action (erc-send-ctcp-message tgt (format "ACTION %s" str) force) (let ((erc-insert-pre-hook (cons (lambda (s) ; Leave newline be. - (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)) - erc-insert-pre-hook))) - (erc-display-message nil 'input (current-buffer) - 'ACTION ?n (erc-current-nick) ?a str ?u "" ?h ""))) + (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s) + (put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s)) + erc-insert-pre-hook)) + (nick (erc-current-nick))) + (setq nick (propertize nick 'erc-speaker nick)) + (erc-display-message nil '(action input) (current-buffer) + 'ACTION ?n nick ?a str ?u "" ?h ""))) ;; Display interface @@ -4532,7 +4538,7 @@ erc-ensure-channel-name (concat "#" channel))) (defvar erc--own-property-names - '( tags erc-parsed display ; core + '( tags erc-speaker erc-parsed display ; core ;; `erc-display-prompt' rear-nonsticky erc-prompt field front-sticky read-only ;; stamp @@ -5051,11 +5057,19 @@ erc-format-privmessage (mark-e (if msgp (if privp "*" ">") "-")) (str (format "%s%s%s %s" mark-s nick mark-e msg)) (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) + (nick-prefix-face (get-text-property 0 'font-lock-face nick)) + (prefix-len (or (and nick-prefix-face (text-property-not-all + 0 (length nick) 'font-lock-face + nick-prefix-face nick)) + 0)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick (erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str) - (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'font-lock-face nick-face str) + (erc-put-text-properties (+ (length mark-s) prefix-len) + (+ (length mark-s) (length nick)) + '(font-lock-face erc-speaker) str + (list nick-face + (substring-no-properties nick prefix-len))) (erc-put-text-property (+ (length mark-s) (length nick)) (length str) 'font-lock-face msg-face str) str)) @@ -5107,7 +5121,7 @@ erc-format-my-nick (concat (propertize open 'font-lock-face 'erc-default-face) (propertize mode 'font-lock-face 'erc-my-nick-prefix-face) - (propertize nick 'font-lock-face 'erc-my-nick-face) + (propertize nick 'font-lock-face 'erc-my-nick-face 'erc-speaker nick) (propertize close 'font-lock-face 'erc-default-face))) (let ((prefix "> ")) (propertize prefix 'font-lock-face 'erc-default-face)))) @@ -5345,7 +5359,12 @@ erc-process-ctcp-query 'ctcp-empty ?n nick) (while queries (let* ((type (upcase (car (split-string (car queries))))) - (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))) + (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))) + (erc-insert-pre-hook + (cons (lambda (s) + (put-text-property 0 (1- (length s)) 'erc-ctcp + (intern type) s)) + erc-insert-pre-hook))) (if (and hook (boundp hook)) (if (string-equal type "ACTION") (run-hook-with-args-until-success @@ -5380,6 +5399,7 @@ erc-ctcp-query-ACTION (buf (or (erc-get-buffer to proc) (erc-get-buffer nick proc) (process-buffer proc)))) + (setq nick (propertize nick 'erc-speaker nick)) (erc-display-message parsed 'action buf 'ACTION ?n nick ?u login ?h host ?a s)))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 15a8087f848..99ec4a9635e 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -153,7 +153,10 @@ erc-fill-tests--compare (with-temp-file expect-file (insert repr)) (if (file-exists-p expect-file) - ;; Compare set-equal over intervals + ;; Compare set-equal over intervals. This comparison is + ;; less useful for messages treated by other modules because + ;; it doesn't compare "nested" props belonging to + ;; string-valued properties, like timestamps. (should (equal-including-properties (read repr) (read (with-temp-buffer -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.6-Handle-composite-faces-better-in-erc-display-mes.patch >From aae534bcbe0eb75e436c428b248a87748ec185b6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 24 Jun 2023 18:33:20 -0700 Subject: [PATCH 4/4] [5.6] Handle composite faces better in erc-display-message * etc/ERC-NEWS: Tell users to update their customized `erc-track-faces-priority-list' values. * lisp/erc/erc-backend.el (erc-server-401, erc-server-402, erc-server-403, erc-server-404, erc-server-405, erc-server-406, erc-server-412, erc-server-421, erc-server-432, erc-server-442, erc-server-461, erc-server-474, erc-server-475, erc-server-482): Change `erc-display-message' `type' arg from list of both `error' and `notice' to just a lone `error' symbol. (erc-server-465, erc-server-431): Inline calls to `erc-display-error-notice, except just pass `error' for `type' arg. Also, remove forward declaration for `erc-display-error-notice' from atop file. * lisp/erc/erc-dcc.el (erc-dcc-do-GET-command, erc-dcc-do-SEND-command, erc-ctcp-query-DCC, erc-dcc-handle-ctcp-chat, erc-dcc-get-filter, erc-dcc-get-sentinel): Change `erc-display-message' `type' arg from list to `error'. * lisp/erc/erc-match.el (erc-hide-fools): Merge `invisible' prop `erc-match' with existing, if present, and move body to helper for hiding matched messages. (erc-match--hide-message): New generalized helper function to hide messages regardless of match type. * lisp/erc/erc-sasl.el (erc-server-902, erc-server-907, erc-server-904, erc-server-908): Change `erc-display-message' `type' arg from list to `error'. * lisp/erc/erc-track.el: Require `erc-button' atop file because options, like `erc-track-faces-priority-list', whose Custom type involves faces, fail validation otherwise. (erc-track--attn-faces): Add new internal variable for faces that should always light up the mode line no matter what. (erc-track-modified-channels, erc-track-face-priority): Prepend `erc-track--attn-faces' to `erc-track-faces-priority-list'. * lisp/erc/erc.el (erc--compose-text-properties): New internal variable to alter behavior of `erc-put-text-property'. (erc--merge-prop): Port over `erc-button-add-face' for general use by all of ERC. (erc-display-message-highlight): Set face to `erc-default-face' the symbol instead of the string. (erc-display-message): Explain how type param works when it's a list. Fix code in type-as-list branch so that it combines faces instead of clobbers them. (erc-nickname-in-use): Inline `erc-display-error-notice' but change `type' arg from list to `error'. (erc-put-text-property): Unalias from `put-text-property' and instead fall back to latter unless caller wants to combine faces, in which case defer to `erc--merge-prop'. * test/lisp/erc/erc-button-tests.el (erc-button--display-error-notice-with-keys): Expect a combined "error notice" face. (Bug#64301) --- etc/ERC-NEWS | 15 ++++++++++ lisp/erc/erc-backend.el | 39 +++++++++++------------- lisp/erc/erc-dcc.el | 16 +++++----- lisp/erc/erc-match.el | 13 ++++---- lisp/erc/erc-sasl.el | 8 ++--- lisp/erc/erc-track.el | 12 ++++++-- lisp/erc/erc.el | 49 ++++++++++++++++++++++--------- test/lisp/erc/erc-button-tests.el | 2 +- 8 files changed, 97 insertions(+), 57 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 37435a1d915..795553f1666 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -228,6 +228,21 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** 'erc-display-message' combines faces when 'type' is a list. +Users may notice that ERC now renders messages passed to the +convenience function 'erc-display-error-notice' in a combination of +'erc-error-face' and 'erc-notice-face'. This is merely a consequence +of that function being a wrapper around 'erc-display-message', which +has gotten smarter about how it treats face properties when its 'type' +parameter is a list. Originally, ERC's authors intended to display +both server-originating and ERC-generated errors in this style, but +due to various complications, that intent was never realized until +this release, and even now only partially so. Indeed, to minimize +churn, the effect has been limited to internal and usage errors. For +third-party code, the key take away is that more 'font-lock-face' +properties encountered in the wild may be combinations of faces rather +than simple ones. + *** Prompt input is split before 'erc-pre-send-functions' has a say. Hook members are now treated to input whose lines have already been adjusted to fall within the allowed length limit. For convenience, diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index f1b51f9234a..bf21ec96225 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -148,7 +148,6 @@ erc-whowas-on-nosuchnick (declare-function erc-current-time "erc" (&optional specified-time)) (declare-function erc-default-target "erc" nil) (declare-function erc-delete-default-channel "erc" (channel &optional buffer)) -(declare-function erc-display-error-notice "erc" (parsed string)) (declare-function erc-display-server-message "erc" (_proc parsed)) (declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time)) (declare-function erc-format-message "erc" (msg &rest args)) @@ -2411,47 +2410,47 @@ erc-server-322-message (when erc-whowas-on-nosuchnick (erc-log (format "cmd: WHOWAS: %s" nick/channel)) (erc-server-send (format "WHOWAS %s 1" nick/channel))) - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's401 ?n nick/channel))) (define-erc-response-handler (402) "No such server." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's402 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (403) "No such channel." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's403 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (404) "Cannot send to channel." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's404 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (405) "Can't join that many channels." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's405 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (406) "No such nick." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's406 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (412) "No text to send." nil - (erc-display-message parsed '(notice error) 'active 's412)) + (erc-display-message parsed 'error 'active 's412)) (define-erc-response-handler (421) "Unknown command." nil - (erc-display-message parsed '(notice error) 'active 's421 + (erc-display-message parsed 'error 'active 's421 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (432) "Bad nick." nil - (erc-display-message parsed '(notice error) 'active 's432 + (erc-display-message parsed 'error 'active 's432 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (433) @@ -2469,12 +2468,12 @@ erc-server-322-message (define-erc-response-handler (442) "Not on channel." nil - (erc-display-message parsed '(notice error) 'active 's442 + (erc-display-message parsed 'error 'active 's442 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (461) "Not enough parameters for command." nil - (erc-display-message parsed '(notice error) 'active 's461 + (erc-display-message parsed 'error 'active 's461 ?c (cadr (erc-response.command-args parsed)) ?m (erc-response.contents parsed))) @@ -2482,20 +2481,19 @@ erc-server-322-message "You are banned from this server." nil (setq erc-server-banned t) ;; show the server's message, as a reason might be provided - (erc-display-error-notice - parsed + (erc-display-message parsed 'error 'active (erc-response.contents parsed))) (define-erc-response-handler (474) "Banned from channel errors." nil - (erc-display-message parsed '(notice error) nil + (erc-display-message parsed 'error nil (intern (format "s%s" (erc-response.command parsed))) ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (475) "Channel key needed." nil - (erc-display-message parsed '(notice error) nil 's475 + (erc-display-message parsed 'error nil 's475 ?c (cadr (erc-response.command-args parsed))) (when erc-prompt-for-channel-key (let ((channel (cadr (erc-response.command-args parsed))) @@ -2516,7 +2514,7 @@ erc-server-322-message "You need to be a channel operator to do that." nil (let ((channel (cadr (erc-response.command-args parsed))) (message (erc-response.contents parsed))) - (erc-display-message parsed '(notice error) 'active 's482 + (erc-display-message parsed 'error 'active 's482 ?c channel ?m message))) (define-erc-response-handler (671) @@ -2551,11 +2549,8 @@ erc-server-322-message ;; 491 - No O-lines for your host ;; 501 - Unknown MODE flag ;; 502 - Cannot change mode for other users - "Generic display of server error messages. - -See `erc-display-error-notice'." nil - (erc-display-error-notice - parsed + "Display error message as given from server." nil + (erc-display-message parsed 'error 'active (intern (format "s%s" (erc-response.command parsed))))) ;; FIXME: These are yet to be implemented, they're just stubs for now diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index cc2dcc9a788..8968295a83c 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -566,7 +566,7 @@ erc-dcc-do-GET-command file)) (erc-dcc-get-file elt file proc) (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-get-cmd-aborted ?n nick ?f filename))) (t @@ -578,7 +578,7 @@ erc-dcc-do-GET-command (setq erc-dcc-list (cons (plist-put elt :turbo t) (delq elt erc-dcc-list))))) (erc-display-message - nil '(notice error) 'active + nil 'error 'active 'dcc-get-notfound ?n nick ?f filename)))) (defvar-local erc-dcc-byte-count nil) @@ -648,7 +648,7 @@ erc-dcc-do-SEND-command nil 'notice 'active 'dcc-send-offer ?n nick ?f file) (erc-dcc-send-file nick file) t) - (erc-display-message nil '(notice error) proc "File not found") t)) + (erc-display-message nil 'error proc "File not found") t)) ;;; Server message handling (i.e. messages from remote users) @@ -675,7 +675,7 @@ erc-ctcp-query-DCC (funcall handler proc query nick login host to) ;; FIXME: Send a ctcp error notice to the remote end? (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-ctcp-unknown ?q query ?n nick ?u login ?h host)))) @@ -771,7 +771,7 @@ erc-dcc-handle-ctcp-chat (;; DCC CHAT requests must be sent to you, and you alone. (not (erc-current-nick-p to)) (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-request-bogus ?r "CHAT" ?n nick ?u login ?h host)) ((string-match erc-dcc-ctcp-query-chat-regexp query) ;; We need to use let* here, since erc-dcc-member might clutter @@ -805,7 +805,7 @@ erc-dcc-handle-ctcp-chat proc)))) (t (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-malformed ?n nick ?u login ?h host ?q query))))) @@ -1053,7 +1053,7 @@ erc-dcc-get-filter ((and (> (plist-get erc-dcc-entry-data :size) 0) (> received-bytes (plist-get erc-dcc-entry-data :size))) (erc-display-message - nil '(notice error) 'active + nil 'error 'active 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) @@ -1085,7 +1085,7 @@ erc-dcc-get-sentinel (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) (let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))) (erc-display-message - nil (if done 'notice '(notice error)) erc-server-process + nil (if done 'notice 'error) erc-server-process (if done 'dcc-get-complete 'dcc-get-failed) ?v (plist-get erc-dcc-entry-data :size) ?f erc-dcc-file-name diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index cd2c55b0091..a5b0af41b2a 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -657,21 +657,22 @@ erc-go-to-log-matches-buffer (defvar-local erc-match--hide-fools-offset-bounds nil) -;; FIXME this should merge with instead of overwrite existing -;; `invisible' values. (defun erc-hide-fools (match-type _nickuserhost _message) - "Hide foolish comments. -This function should be called from `erc-text-matched-hook'." + "Hide comments from designated fools." (when (eq match-type 'fool) + (erc-match--hide-message))) + +(defun erc-match--hide-message () + (progn ; FIXME raise sexp (if erc-match--hide-fools-offset-bounds (let ((beg (point-min)) (end (point-max))) (save-restriction (widen) - (put-text-property (1- beg) (1- end) 'invisible 'erc-match))) + (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match))) ;; Before ERC 5.6, this also used to add an `intangible' ;; property, but the docs say it's now obsolete. - (put-text-property (point-min) (point-max) 'invisible 'erc-match)))) + (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index c6922b1b26b..73d318fd4fd 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -377,7 +377,7 @@ erc-sasl--destroy (define-erc-response-handler (902) "Handle an ERR_NICKLOCKED response." nil - (erc-display-message parsed '(notice error) 'active 's902 + (erc-display-message parsed 'error 'active 's902 ?n (car (erc-response.command-args parsed)) ?s (erc-response.contents parsed)) (erc-sasl--destroy proc)) @@ -391,19 +391,19 @@ erc-sasl--destroy (define-erc-response-handler (907) "Handle a RPL_SASLALREADY response." nil - (erc-display-message parsed '(notice error) 'active 's907 + (erc-display-message parsed 'error 'active 's907 ?s (erc-response.contents parsed))) (define-erc-response-handler (904 905 906) "Handle various SASL-related error responses." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active (intern (format "s%s" (erc-response.command parsed))) ?s (erc-response.contents parsed)) (erc-sasl--destroy proc)) (define-erc-response-handler (908) "Handle a RPL_SASLMECHS response." nil - (erc-display-message parsed '(notice error) 'active 's908 + (erc-display-message parsed 'error 'active 's908 ?m (alist-get 'mechanism erc-sasl--options) ?s (string-join (cdr (erc-response.command-args parsed)) " ")) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index e060b7039bd..bc09c5d87fb 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -37,6 +37,7 @@ (eval-when-compile (require 'cl-lib)) (require 'erc) (require 'erc-match) +(require 'erc-button) ; for validating faces in custom options ;;; Code: @@ -309,6 +310,8 @@ erc-track-switch-direction (const leastactive) (const mostactive))) +(defconst erc-track--attn-faces '((erc-error-face erc-notice-face)) + "Faces whose presence always trigger mode-line inclusion.") (defun erc-track-remove-from-mode-line () "Remove `erc-track-modified-channels' from the mode-line." @@ -736,6 +739,9 @@ erc-track-find-face (declare (obsolete erc-track-select-mode-line-face "28.1")) (erc-track-select-mode-line-face (car faces) (cdr faces))) +;; Note that unless called by `erc-track-modified-channels', +;; `erc-track-faces-priority-list' will not begin with +;; `erc-track--attn-faces'. (defun erc-track-select-mode-line-face (cur-face new-faces) "Return the face to use in the mode line. @@ -802,7 +808,9 @@ erc-track-modified-channels ;; (in the car), change its face attribute (in the cddr) if ;; necessary. See `erc-modified-channels-alist' for the ;; exact data structure used. - (let ((faces (erc-faces-in (buffer-string)))) + (let ((faces (erc-faces-in (buffer-string))) + (erc-track-faces-priority-list + `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))) (unless (and (or (eq erc-track-priority-faces-only 'all) (member this-channel erc-track-priority-faces-only)) @@ -873,7 +881,7 @@ erc-track-face-priority higher number than any other face in that list." (let ((count 0)) (catch 'done - (dolist (item erc-track-faces-priority-list) + (dolist (item `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)) (if (equal item face) (throw 'done t) (setq count (1+ count))))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d43281825fb..98127697815 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2885,6 +2885,25 @@ erc-display-line (process-buffer erc-server-process) (current-buffer)))))) +(defvar erc--compose-text-properties nil + "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.") + +(defun erc--merge-prop (from to prop val &optional object) + "Compose existing PROP values with VAL between FROM and TO in OBJECT. +For spans where PROP is non-nil, cons VAL onto the existing +value, ensuring a proper list. Otherwise, just set PROP to VAL. +See also `erc-button-add-face'." + (let ((old (get-text-property from prop object)) + (pos from) + (end (next-single-property-change from prop object to)) + new) + (while (< pos to) + (setq new (if old (cons val (ensure-list old)) val)) + (put-text-property pos end prop new object) + (setq pos end + old (get-text-property pos prop object) + end (next-single-property-change pos prop object to))))) + (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. @@ -2896,7 +2915,7 @@ erc-display-message-highlight 0 (length string) 'font-lock-face (or (intern-soft (concat "erc-" (symbol-name type) "-face")) - "erc-default-face") + 'erc-default-face) string) string))) @@ -3100,6 +3119,10 @@ erc-display-message ARGS, PARSED, and TYPE are used to format MSG sensibly. +When TYPE is a list of symbols, call handlers from left to right. +For example, expect a TYPE of (notice error) to result in MSG's +`font-lock-face' being (erc-error-face erc-notice-face). + See also `erc-format-message' and `erc-display-line'." (let ((string (if (symbolp msg) (apply #'erc-format-message msg args) @@ -3110,10 +3133,9 @@ erc-display-message ((null type) string) ((listp type) - (mapc (lambda (type) - (setq string - (erc-display-message-highlight type string))) - type) + (let ((erc--compose-text-properties t)) + (dolist (type type) + (setq string (erc-display-message-highlight type string)))) string) ((symbolp type) (erc-display-message-highlight type string)))) @@ -4941,17 +4963,14 @@ erc--nickname-in-use-make-request (erc-cmd-NICK temp)) (defun erc-nickname-in-use (nick reason) - "If NICK is unavailable, tell the user the REASON. - -See also `erc-display-error-notice'." + "Explain REASON NICK is taken and maybe ask for alternate." (if (or (not erc-try-new-nick-p) ;; how many default-nicks are left + one more try... (eq erc-nick-change-attempt-count (if (consp erc-nick) (+ (length erc-nick) 1) 1))) - (erc-display-error-notice - nil + (erc-display-message nil 'error 'active (format "Nickname %s is %s, try another." nick reason)) (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1)) (let ((newnick (nth 1 erc-default-nicks)) @@ -4974,8 +4993,7 @@ erc-nickname-in-use (- 9 (length erc-nick-uniquifier)))) erc-nick-uniquifier))) (erc--nickname-in-use-make-request nick newnick) - (erc-display-error-notice - nil + (erc-display-message nil 'error 'active (format "Nickname %s is %s, trying %s" nick reason newnick))))) @@ -6079,7 +6097,7 @@ erc-highlight-error (erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s) s) -(defalias 'erc-put-text-property 'put-text-property +(defun erc-put-text-property (start end property value &optional object) "Set text-property for an object (usually a string). START and END define the characters covered. PROPERTY is the text-property set, usually the symbol `face'. @@ -6089,7 +6107,10 @@ 'erc-put-text-property OBJECT is modified without being copied first. You can redefine or `defadvice' this function in order to add -EmacsSpeak support.") +EmacsSpeak support." + (if erc--compose-text-properties + (erc--merge-prop start end property value object) + (put-text-property start end property value object))) (defalias 'erc-list 'ensure-list) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index 6a6f6934389..3dacf95a59f 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -265,7 +265,7 @@ erc-button--display-error-notice-with-keys (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k (erc-button-next 1) (should (equal (get-text-property (point) 'font-lock-face) - '(erc-button erc-error-face))) + '(erc-button erc-error-face erc-notice-face))) (should (eq (get-text-property (point) 'mouse-face) 'highlight)) (should (eq erc-button-face 'erc-button))) ; extent evaporates -- 2.41.0 --=-=-=--