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#69597: 29.2; ERC 5.6-git: Add a new customizable variable controlling how Erc displays spoilers Date: Sat, 09 Mar 2024 08:06:15 -0800 Message-ID: <87bk7n8k5k.fsf__41896.1391713069$1710000486$gmane$org@neverwas.me> References: <87v85xn5uv.fsf@neverwas.me> <87y1askbmr.fsf@neverwas.me> <87edckc8x2.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="40004"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org, 69597@debbugs.gnu.org To: Fadi Moukayed Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Mar 09 17:07:59 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 1rizEs-000AEB-GR for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 09 Mar 2024 17:07:59 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rizET-0007Rp-EI; Sat, 09 Mar 2024 11:07:33 -0500 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 1rizEQ-0007Rc-QH for bug-gnu-emacs@gnu.org; Sat, 09 Mar 2024 11:07:31 -0500 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 1rizEP-0005f0-O9 for bug-gnu-emacs@gnu.org; Sat, 09 Mar 2024 11:07:30 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rizEw-0002WV-62 for bug-gnu-emacs@gnu.org; Sat, 09 Mar 2024 11:08:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 09 Mar 2024 16:08:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69597 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 69597-submit@debbugs.gnu.org id=B69597.17100004249600 (code B ref 69597); Sat, 09 Mar 2024 16:08:02 +0000 Original-Received: (at 69597) by debbugs.gnu.org; 9 Mar 2024 16:07:04 +0000 Original-Received: from localhost ([127.0.0.1]:34669 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rizDx-0002UT-Mp for submit@debbugs.gnu.org; Sat, 09 Mar 2024 11:07:03 -0500 Original-Received: from mail-108-mta223.mxroute.com ([136.175.108.223]:41863) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rizDs-0002UH-AA for 69597@debbugs.gnu.org; Sat, 09 Mar 2024 11:07:00 -0500 Original-Received: from filter006.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta223.mxroute.com (ZoneMTA) with ESMTPSA id 18e23f717630003bea.001 for <69597@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Sat, 09 Mar 2024 16:06:19 +0000 X-Zone-Loop: 095b18ee4a0cf75a2a14b0ecd2d1de2c6fc08cd20041 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=wGbgkxF1Bt2I1Uq+WTmiTb91AZTvzbTP+wOpXCtupy4=; b=NcU5bTZpnst37HWlL9AfuDMW6d quB+rGyDc9YeAcLBijkZkPdzlcsrtd5OSDhDvYbWHXcMRhHtEukw+n1xMkYs3cUCWgduam1N+xEYy P+xeNNyQdTOkERJDv2/mYxKlPbv6TnP/lnHNlbrdWOtMwTZUZ8EFSNZq68ZNHXjPTRiHO6avU4lTR L8UF43V0B4fxePvn+PE2aVcRkmOR8nrPeC6rY0N7iQMSzgFblcXDzJjVyeBDTQ91C/oyMKBvXc4hd rkkqN3wf2nBr4fuumjxZ8cW1CTWwMPuz+kwQj43hg99sqnSKmEvyEnyIMNWVHuGdgCVbMtoWl3dxy LSRYp4fA==; In-Reply-To: (Fadi Moukayed's message of "Sat, 9 Mar 2024 11:34:58 +0100") 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:281344 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Fadi Moukayed writes: > That said, I'd like to +1 the changeset and confirm that the proposed > changes apply cleanly, and yield the desired result. I tested inputs > of the form ^CX,X^C on a temporary private channel =E2=80=93 spoile= rs > are formatted and revealed as intended, and no regressions were > observed. Very nice. Would be a neat addition/fix for the next Erc > release. Really appreciate the thorough testing -- and your patience even more so because as much as I'd like to put a bow on this, it turns out (sigh) there's one lingering matter yet unresolved. Alas, looking more closely at how `erc-controls-propertize' treats `erc-inverse-face' (crucially, as a modifying toggle [1]), I've quickly come to rue the day I ever thought to suggest otherwise, especially in drawing misguided associations with `erc-spoiler-face'. (Indeed, my quasi-conflating the two was what led us astray to begin with.) So, if not already clear, I now believe we should just treat `erc-spoiler-face' as its own concern entirely and not have it inherit from `erc-inverse-face'. All this to say: yet another revision attached. Thanks, and apologies for the head fake. [1] https://modern.ircdocs.horse/formatting#reverse-color --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v2-v3.diff >From d2ad575e8935981c23846bd54a3eac29b9290f45 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 9 Mar 2024 07:12:16 -0800 Subject: [PATCH 0/3] *** NOT A PATCH *** F. Jason Park (2): [5.6] Leverage inverse-video for erc-inverse-face . Add new foreground and background face for color code 99 . Don't apply hover props for ^C99,99 because, by definition, the fg and bg map to different, contrasting colors. . Use `:inverse-video' face attribute for `erc-inverse-face' to mimic effect prescribed by https://modern.ircdocs.horse/formatting#reverse-color. [5.6] Make important text props more resilient in ERC F. Moukayed (1): [5.6] Redefine erc-spoiler-face to indicate revealed text . Have `erc-spoiler-face' inherit from `default' instead of `erc-inverse-face'. lisp/erc/erc-button.el | 3 +- lisp/erc/erc-goodies.el | 39 +++++--- lisp/erc/erc.el | 34 +++++++ test/lisp/erc/erc-goodies-tests.el | 153 ++++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 52 ++++++++++ 5 files changed, 223 insertions(+), 58 deletions(-) Interdiff: diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 212cdbfa9ef..6e9e48e1b81 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -661,11 +661,13 @@ erc-italic-face :group 'erc-faces) (defface erc-inverse-face - '((t :foreground "White" :background "Black")) + '((((supports :inverse-video t)) + :inverse-video t) + (t :foreground "White" :background "Black")) "ERC inverse face." :group 'erc-faces) -(defface erc-spoiler-face '((t :inherit erc-inverse-face)) +(defface erc-spoiler-face '((t :inherit default)) "ERC spoiler face." :group 'erc-faces) @@ -673,6 +675,16 @@ erc-underline-face "ERC underline face." :group 'erc-faces) +(defface erc-control-default-fg '((t :inherit default)) + "ERC foreground face for the \"default\" color code." + :group 'erc-faces) + +(defface erc-control-default-bg '((t :inherit default)) + "ERC background face for the \"default\" color code." + :group 'erc-faces) + +;; FIXME rename these to something like `erc-control-color-N-fg', +;; and deprecate the old names via `define-obsolete-face-alias'. (defface fg:erc-color-face0 '((t :foreground "White")) "ERC face." :group 'erc-faces) @@ -802,7 +814,7 @@ erc-get-bg-color-face (intern (concat "bg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :background (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) '(default))))) + (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg)))) (defun erc-get-fg-color-face (n) "Fetches the right face for foreground color N (0-15)." @@ -818,7 +830,7 @@ erc-get-fg-color-face (intern (concat "fg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :foreground (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) '(default))))) + (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg)))) ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil @@ -966,7 +978,7 @@ erc-controls-propertize "Prepend properties from IRC control characters between FROM and TO. If optional argument STR is provided, apply to STR, otherwise prepend properties to a region in the current buffer." - (when (and fg bg (equal fg bg)) + (when (and fg bg (equal fg bg) (not (equal fg "99"))) (add-text-properties from to '( mouse-face erc-spoiler-face cursor-face erc-spoiler-face) str) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 0ab40808a4a..c8fb0544a72 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -29,19 +29,23 @@ (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) (let ((end (+ beg (1- (length end-str))))) - (while (and beg (< beg end)) - (let* ((val (get-text-property beg 'font-lock-face)) - (ft (flatten-tree (ensure-list val)))) - (dolist (p (ensure-list present)) - (if (consp p) - (should (member p val)) - (should (memq p ft)))) - (dolist (a (ensure-list absent)) - (if (consp a) - (should-not (member a val)) - (should-not (memq a ft)))) - (setq beg (text-property-not-all beg (point-max) - 'font-lock-face val)))))) + (ert-info ((format "beg: %S, end-str: %S" beg end-str)) + (while (and beg (< beg end)) + (let* ((val (get-text-property beg 'font-lock-face)) + (ft (flatten-tree (ensure-list val)))) + (ert-info ((format "looking-at: %S, val: %S" + (buffer-substring-no-properties beg end) + val)) + (dolist (p (ensure-list present)) + (if (consp p) + (should (member p val)) + (should (memq p ft)))) + (dolist (a (ensure-list absent)) + (if (consp a) + (should-not (member a val)) + (should-not (memq a ft))))) + (setq beg (text-property-not-all beg (point-max) + 'font-lock-face val))))))) ;; These are from the "Examples" section of ;; https://modern.ircdocs.horse/formatting.html @@ -134,30 +138,93 @@ erc-controls-highlight--spoilers (erc-tests-common-make-server-buf) (with-current-buffer (erc--open-target "#chan") (setq-local erc-interpret-mirc-color t) - (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!") - (msg (erc-format-privmessage "bob" m nil t))) + (let* ((raw (concat "BEGIN " + "\C-c0,0 WhiteOnWhite " + "\C-c1,1 BlackOnBlack " + "\C-c99,99 Default " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) (erc-display-message nil nil (current-buffer) msg)) (forward-line -1) (should (search-forward " " nil t)) (save-restriction ;; Narrow to EOL or start of right-side stamp. (narrow-to-region (point) (line-end-position)) - (should (eq (get-text-property (+ 9 (point)) 'mouse-face) - 'erc-spoiler-face)) - (should (eq (get-text-property (1- (pos-eol)) 'mouse-face) - 'erc-spoiler-face)) - ;; "Spoiler" appears in ERC default face. + (save-excursion + (search-forward "WhiteOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face)) + (search-forward "BlackOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face))) + ;; Start wtih ERC default face. (erc-goodies-tests--assert-face - 0 "Spoiler: " 'erc-default-face + 0 "BEGIN " 'erc-default-face '(fg:erc-color-face0 bg:erc-color-face0)) - ;; "Hello" is masked in all white. + ;; Masked in all white. (erc-goodies-tests--assert-face - 9 "Hello" '(fg:erc-color-face0 bg:erc-color-face0) + 6 "WhiteOnWhite" '(fg:erc-color-face0 bg:erc-color-face0) '(fg:erc-color-face1 bg:erc-color-face1)) - ;; "World" is masked in all black. + ;; Masked in all black. (erc-goodies-tests--assert-face - 18 " World" '(fg:erc-color-face1 bg:erc-color-face1 ) - '(fg:erc-color-face0 bg:erc-color-face0)))) + 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) + '(erc-control-default-fg erc-control-default-bg)) + ;; Explicit "default" code ignoerd. + (erc-goodies-tests--assert-face + 34 "Default" '(erc-control-default-fg erc-control-default-bg) + '(fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 43 "END" 'erc-default-face + '(erc-control-default-bg erc-control-default-fg)))) + (when noninteractive + (erc-tests-common-kill-buffers))) + +(ert-deftest erc-controls-highlight--inverse () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let* ((erc-fill-column 90) + (raw (concat "BEGIN " + "\C-c3,13 GreenOnPink " + "\C-v PinkOnGreen " + "\C-c99,99 ReversedDefault " + "\C-v NormalDefault " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + ;; Baseline. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Normal fg/bg combo. + (erc-goodies-tests--assert-face + 6 "GreenOnPink" '(fg:erc-color-face3 bg:erc-color-face13) + '(erc-inverse-face)) + ;; Reverse of previous, so former-bg on former-fg. + (erc-goodies-tests--assert-face + 19 "PinkOnGreen" + '(erc-inverse-face fg:erc-color-face3 bg:erc-color-face13) + nil) + ;; The inverse of `default' because reverse still in effect. + (erc-goodies-tests--assert-face + 32 "ReversedDefault" '(erc-inverse-face erc-control-default-fg + erc-control-default-bg) + '(fg:erc-color-face3 bg:erc-color-face13)) + (erc-goodies-tests--assert-face + 49 "NormalDefault" '(erc-control-default-fg + erc-control-default-bg) + '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 64 "END" 'erc-default-face + '( erc-control-default-fg erc-control-default-bg + fg:erc-color-face0 bg:erc-color-face0)))) (when noninteractive (erc-tests-common-kill-buffers))) -- 2.44.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Leverage-inverse-video-for-erc-inverse-face.patch >From 2c0b39529cfc9edd6178f4243145688b915d37c6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 7 Mar 2024 21:53:11 -0800 Subject: [PATCH 1/3] [5.6] Leverage inverse-video for erc-inverse-face * lisp/erc/erc-goodies.el (erc-inverse-face): Prefer the "reversing" effect of swapping foreground and background colors over affected intervals. See https://modern.ircdocs.horse/formatting#reverse-color. (erc-control-default-fg erc-control-default-bg): New faces to allow for customizing the look of IRC color-code number 99. Ignore the ERC convention of prefixing control-code-derived faces with "fg:" and "bg:" because it doesn't comport with modern sensibilities, which demand identifiers normally be namespaced. (erc-get-bg-color-face, erc-get-fg-color-face): Don't wrap face in a list, and use new, dedicated faces. * test/lisp/erc/erc-goodies-tests.el (erc-controls-highlight--inverse): Redo, asserting behavior described in https://modern.ircdocs.horse/formatting#reverse-color. (erc-controls-highlight--spoilers): New test based on the body of the old `erc-controls-highlight--inverse', except without shadowing `erc-insert-modify-hook' with an unrealistic, idealized value. Adjust expected buffer state to reflect the new role of `erc-spoiler-face'. (Bug#69597) --- lisp/erc/erc-goodies.el | 18 +++- test/lisp/erc/erc-goodies-tests.el | 153 ++++++++++++++++++++--------- 2 files changed, 124 insertions(+), 47 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 7e30b1060fd..dbf869dafe6 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -661,7 +661,9 @@ erc-italic-face :group 'erc-faces) (defface erc-inverse-face - '((t :foreground "White" :background "Black")) + '((((supports :inverse-video t)) + :inverse-video t) + (t :foreground "White" :background "Black")) "ERC inverse face." :group 'erc-faces) @@ -675,6 +677,16 @@ erc-underline-face "ERC underline face." :group 'erc-faces) +(defface erc-control-default-fg '((t :inherit default)) + "ERC foreground face for the \"default\" color code." + :group 'erc-faces) + +(defface erc-control-default-bg '((t :inherit default)) + "ERC background face for the \"default\" color code." + :group 'erc-faces) + +;; FIXME rename these to something like `erc-control-color-N-fg', +;; and deprecate the old names via `define-obsolete-face-alias'. (defface fg:erc-color-face0 '((t :foreground "White")) "ERC face." :group 'erc-faces) @@ -804,7 +816,7 @@ erc-get-bg-color-face (intern (concat "bg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :background (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) '(default))))) + (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg)))) (defun erc-get-fg-color-face (n) "Fetches the right face for foreground color N (0-15)." @@ -820,7 +832,7 @@ erc-get-fg-color-face (intern (concat "fg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :foreground (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) '(default))))) + (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg)))) ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 7013ce0c8fc..c8fb0544a72 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -29,19 +29,23 @@ (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) (let ((end (+ beg (1- (length end-str))))) - (while (and beg (< beg end)) - (let* ((val (get-text-property beg 'font-lock-face)) - (ft (flatten-tree (ensure-list val)))) - (dolist (p (ensure-list present)) - (if (consp p) - (should (member p val)) - (should (memq p ft)))) - (dolist (a (ensure-list absent)) - (if (consp a) - (should-not (member a val)) - (should-not (memq a ft)))) - (setq beg (text-property-not-all beg (point-max) - 'font-lock-face val)))))) + (ert-info ((format "beg: %S, end-str: %S" beg end-str)) + (while (and beg (< beg end)) + (let* ((val (get-text-property beg 'font-lock-face)) + (ft (flatten-tree (ensure-list val)))) + (ert-info ((format "looking-at: %S, val: %S" + (buffer-substring-no-properties beg end) + val)) + (dolist (p (ensure-list present)) + (if (consp p) + (should (member p val)) + (should (memq p ft)))) + (dolist (a (ensure-list absent)) + (if (consp a) + (should-not (member a val)) + (should-not (memq a ft))))) + (setq beg (text-property-not-all beg (point-max) + 'font-lock-face val))))))) ;; These are from the "Examples" section of ;; https://modern.ircdocs.horse/formatting.html @@ -129,39 +133,100 @@ erc-controls-highlight--examples ;; Hovering over the redacted area should reveal its underlying text ;; in a high-contrast face. -(ert-deftest erc-controls-highlight--inverse () +(ert-deftest erc-controls-highlight--spoilers () (should (eq t erc-interpret-controls-p)) - (let ((erc-insert-modify-hook '(erc-controls-highlight)) - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (with-current-buffer (get-buffer-create "#chan") - (erc-mode) - (setq-local erc-interpret-mirc-color t) - (erc--initialize-markers (point) nil) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (let* ((raw (concat "BEGIN " + "\C-c0,0 WhiteOnWhite " + "\C-c1,1 BlackOnBlack " + "\C-c99,99 Default " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + (save-excursion + (search-forward "WhiteOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face)) + (search-forward "BlackOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face))) + ;; Start wtih ERC default face. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Masked in all white. + (erc-goodies-tests--assert-face + 6 "WhiteOnWhite" '(fg:erc-color-face0 bg:erc-color-face0) + '(fg:erc-color-face1 bg:erc-color-face1)) + ;; Masked in all black. + (erc-goodies-tests--assert-face + 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) + '(erc-control-default-fg erc-control-default-bg)) + ;; Explicit "default" code ignoerd. + (erc-goodies-tests--assert-face + 34 "Default" '(erc-control-default-fg erc-control-default-bg) + '(fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 43 "END" 'erc-default-face + '(erc-control-default-bg erc-control-default-fg)))) + (when noninteractive + (erc-tests-common-kill-buffers))) - (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!") - (msg (erc-format-privmessage "bob" m nil t))) - (erc-display-message nil nil (current-buffer) msg)) - (forward-line -1) - (should (search-forward " " nil t)) - (save-restriction - (narrow-to-region (point) (pos-eol)) - (should (eq (get-text-property (+ 9 (point)) 'mouse-face) - 'erc-inverse-face)) - (should (eq (get-text-property (1- (pos-eol)) 'mouse-face) - 'erc-inverse-face)) - (erc-goodies-tests--assert-face - 0 "Spoiler: " 'erc-default-face - '(fg:erc-color-face0 bg:erc-color-face0)) - (erc-goodies-tests--assert-face - 9 "Hello" '(erc-spoiler-face) - '( fg:erc-color-face0 bg:erc-color-face0 - fg:erc-color-face1 bg:erc-color-face1)) - (erc-goodies-tests--assert-face - 18 " World" '(erc-spoiler-face) - '( fg:erc-color-face0 bg:erc-color-face0 - fg:erc-color-face1 bg:erc-color-face1 ))) - (when noninteractive - (kill-buffer))))) +(ert-deftest erc-controls-highlight--inverse () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let* ((erc-fill-column 90) + (raw (concat "BEGIN " + "\C-c3,13 GreenOnPink " + "\C-v PinkOnGreen " + "\C-c99,99 ReversedDefault " + "\C-v NormalDefault " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + ;; Baseline. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Normal fg/bg combo. + (erc-goodies-tests--assert-face + 6 "GreenOnPink" '(fg:erc-color-face3 bg:erc-color-face13) + '(erc-inverse-face)) + ;; Reverse of previous, so former-bg on former-fg. + (erc-goodies-tests--assert-face + 19 "PinkOnGreen" + '(erc-inverse-face fg:erc-color-face3 bg:erc-color-face13) + nil) + ;; The inverse of `default' because reverse still in effect. + (erc-goodies-tests--assert-face + 32 "ReversedDefault" '(erc-inverse-face erc-control-default-fg + erc-control-default-bg) + '(fg:erc-color-face3 bg:erc-color-face13)) + (erc-goodies-tests--assert-face + 49 "NormalDefault" '(erc-control-default-fg + erc-control-default-bg) + '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 64 "END" 'erc-default-face + '( erc-control-default-fg erc-control-default-bg + fg:erc-color-face0 bg:erc-color-face0)))) + (when noninteractive + (erc-tests-common-kill-buffers))) (defvar erc-goodies-tests--motd ;; This is from ergo's MOTD -- 2.44.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Make-important-text-props-more-resilient-in-ERC.patch >From 7b97bb8fad96fcc2fb48858018bf0e5509a6d741 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 7 Mar 2024 21:53:23 -0800 Subject: [PATCH 2/3] [5.6] Make important text props more resilient in ERC * lisp/erc/erc-button.el (erc-button-remove-old-buttons): Restore original `mouse-face' values in areas marked as important after clobbering. * lisp/erc/erc.el (erc--reserve-important-text-props): New function. (erc--restore-important-text-props): New function. * test/lisp/erc/erc-tests.el (erc--restore-important-text-props): New test. (Bug#69597) --- lisp/erc/erc-button.el | 3 ++- lisp/erc/erc.el | 34 +++++++++++++++++++++++++ test/lisp/erc/erc-tests.el | 52 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 88 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 6b78e451b54..4b4930e5bff 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -528,7 +528,8 @@ erc-button-remove-old-buttons '(erc-callback nil erc-data nil mouse-face nil - keymap nil))) + keymap nil)) + (erc--restore-important-text-props '(mouse-face))) (defun erc-button-add-button (from to fun nick-p &optional data regexp) "Create a button between FROM and TO with callback FUN and data DATA. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index cce3b2508fb..08bc9939b9a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3532,6 +3532,40 @@ erc--remove-from-prop-value-list old (get-text-property pos prop object) end (next-single-property-change pos prop object to))))) +(defun erc--reserve-important-text-props (beg end plist &optional object) + "Record text-property pairs in PLIST as important between BEG and END. +Also mark the message being inserted as containing these important props +so modules performing destructive modifications can later restore them. +Expect to run in a narrowed buffer at message-insertion time." + (when erc--msg-props + (let ((existing (erc--check-msg-prop 'erc--important-prop-names))) + (puthash 'erc--important-prop-names (seq-union existing (map-keys plist)) + erc--msg-props))) + (erc--merge-prop beg end 'erc--important-props plist object)) + +(defun erc--restore-important-text-props (props &optional beg end) + "Restore PROPS where recorded in the accessible portion of the buffer. +Expect to run in a narrowed buffer at message-insertion time. Limit the +effect to the region between buffer positions BEG and END, when non-nil. + +Callers should be aware that this function fails if the property +`erc--important-props' has an empty value almost anywhere along the +affected region. Use the function `erc--remove-from-prop-value-list' to +ensure that props with empty values are excised completely." + (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names)) + (present (seq-intersection props registered)) + (b (or beg (point-min))) + (e (or end (point-max)))) + (while-let + (((setq b (text-property-not-all b e 'erc--important-props nil))) + (val (get-text-property b 'erc--important-props)) + (q (next-single-property-change b 'erc--important-props nil e))) + (while-let ((k (pop val)) + (v (pop val))) + (when (memq k present) + (put-text-property b q k v))) + (setq b q)))) + (defvar erc-legacy-invisible-bounds-p nil "Whether to hide trailing rather than preceding newlines. Beginning in ERC 5.6, invisibility extends from a message's diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 085b063bdb2..6809d9db41d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2232,6 +2232,58 @@ erc--remove-from-prop-value-list/many (when noninteractive (kill-buffer)))) +(ert-deftest erc--restore-important-text-props () + (erc-mode) + (let ((erc--msg-props (map-into '((erc--important-prop-names a)) + 'hash-table))) + (insert (propertize "foo" 'a 'A 'b 'B 'erc--important-props '(a A)) + " " + (propertize "bar" 'c 'C 'a 'A 'b 'B + 'erc--important-props '(a A c C))) + + ;; Attempt to restore a and c when only a is registered. + (remove-list-of-text-properties (point-min) (point-max) '(a c)) + (erc--restore-important-text-props '(a c)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" + 0 3 (a A b B erc--important-props (a A)) + 4 7 (a A b B erc--important-props (a A c C))))) + + ;; Add d between 3 and 6. + (erc--reserve-important-text-props 3 6 '(d D)) + (put-text-property 3 6 'd 'D) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" ; #1 + 0 2 (a A b B erc--important-props (a A)) + 2 3 (d D a A b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D a A b B erc--important-props (d D a A c C)) + 5 7 (a A b B erc--important-props (a A c C))))) + ;; Remove a and d, and attempt to restore d. + (remove-list-of-text-properties (point-min) (point-max) '(a d)) + (erc--restore-important-text-props '(d)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" + 0 2 (b B erc--important-props (a A)) + 2 3 (d D b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D b B erc--important-props (d D a A c C)) + 5 7 (b B erc--important-props (a A c C))))) + + ;; Restore a only. + (erc--restore-important-text-props '(a)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" ; same as #1 above + 0 2 (a A b B erc--important-props (a A)) + 2 3 (d D a A b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D a A b B erc--important-props (d D a A c C)) + 5 7 (a A b B erc--important-props (a A c C))))))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space -- 2.44.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Redefine-erc-spoiler-face-to-indicate-revealed-t.patch >From d2ad575e8935981c23846bd54a3eac29b9290f45 Mon Sep 17 00:00:00 2001 From: "F. Moukayed" Date: Fri, 8 Mar 2024 08:39:03 +0000 Subject: [PATCH 3/3] [5.6] Redefine erc-spoiler-face to indicate revealed text * lisp/erc/erc-goodies.el (erc-spoiler-face): Redefine role and redo definition to inherit from `erc-control-default-face'. (erc-controls-propertize): Include `cursor-face' in the applied hover properties for spoiler text, and ensure they aren't clobbered by other built-in modules, like `button'. (Bug#69597) Copyright-paperwork-exempt: yes --- lisp/erc/erc-goodies.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index dbf869dafe6..6e9e48e1b81 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -667,9 +667,7 @@ erc-inverse-face "ERC inverse face." :group 'erc-faces) -(defface erc-spoiler-face - '((((background light)) :foreground "DimGray" :background "DimGray") - (((background dark)) :foreground "LightGray" :background "LightGray")) +(defface erc-spoiler-face '((t :inherit default)) "ERC spoiler face." :group 'erc-faces) @@ -980,13 +978,16 @@ erc-controls-propertize "Prepend properties from IRC control characters between FROM and TO. If optional argument STR is provided, apply to STR, otherwise prepend properties to a region in the current buffer." - (if (and fg bg (equal fg bg)) - (progn - (setq fg 'erc-spoiler-face - bg nil) - (put-text-property from to 'mouse-face 'erc-inverse-face str)) - (when fg (setq fg (erc-get-fg-color-face fg))) - (when bg (setq bg (erc-get-bg-color-face bg)))) + (when (and fg bg (equal fg bg) (not (equal fg "99"))) + (add-text-properties from to '( mouse-face erc-spoiler-face + cursor-face erc-spoiler-face) + str) + (erc--reserve-important-text-props from to + '( mouse-face erc-spoiler-face + cursor-face erc-spoiler-face) + str)) + (when fg (setq fg (erc-get-fg-color-face fg))) + (when bg (setq bg (erc-get-bg-color-face bg))) (font-lock-prepend-text-property from to -- 2.44.0 --=-=-=--