bug#69860: 29.2; ERC 5.6-git: erc: Incorrect face formatting applied for fg=99 bg=x (irccontrols module with erc-interpret-mirc-color=t)

["J.P." <jp@neverwas.me>]

[-- Attachment #1: Type: text/plain, Size: 1647 bytes --]

Alcor <alcor@tilde.club> writes:

> "J.P." <jp@neverwas.me> writes:
>
>> Oof. Looks like `erc-get-fg-color-face' sets `erc-control-default-bg' in
>> its catch-all `cond' case. As you say, this produces:
>>
>>   #("THIS TEXT IS FORMATTED"
>>     0 22 (font-lock-face (erc-control-default-bg bg:erc-color-face4)))
>>
>> And `erc-get-bg-color-face' sets `erc-control-default-fg'. Clearly,
>> whoever's responsible for this outrage should be banished. (Thanks.)
>
> Yes, that's part of the issue. However, `erc-controls-propertize' should
> also avoid adding the default fg/bg to the font lock face if n=99 to
> avoid overriding an existing fg,bg setting if fg=99,bg=x or bg=99,fg=x.

Here's my current understanding of what you're saying. When there's an
existing fg/bg combo in effect for a given span, and the parsing logic
encounters a ^Cx,99 (or a ^C99,x), the 99 shouldn't induce a clobbering
of the corresponding "incumbent" fg (or bg) face with a dedicated (and
superfluous) default face but instead trigger the _removal_ of said
incumbent face. This has the effect of falling through to honor the
relevant attributes of the underlying `erc-default-face', which ships as
a no-op. For example, given

  ^C03,08 hello ^C99,07 world

the "hello " portion should be green on yellow and " world" should be
${default-foreground} (likely black or white) on orange. Likewise, if
"^C99,07" were instead "^C04", then " world" should be red on yellow.
This behavior aligns with that exhibited by Weechat and (I'm hoping)
other popular clients. The revised patch set (attached) attempts to
mimic this in ERC. Corrections or alternatives welcome. Thanks.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Remove-unused-faces-from-various-erc-goodies-tes.patch --]
[-- Type: text/x-patch, Size: 8709 bytes --]

From dd9302210706cc21ed1548a3a5ea769366c2e7be Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 19 Mar 2024 23:51:46 -0700
Subject: [PATCH 1/2] [5.6] Remove unused faces from various erc-goodies tests

; A note to anyone running ERC's test suite while bisecting and
; unlucky enough to land on this commit.  Apologies for the
; inconvenience.  It fails because it includes adjustments for fixes
; only introduced by the subsequent commit.  This is obviously
; objectionable but was done knowingly in order to duck the
; copyright-exemption threshold for new contributors.

* test/lisp/erc/erc-goodies-tests.el
(erc-controls-highlight--spoilers)
(erc-controls-highlight--inverse): Remove all mention of faces
`erc-control-default-fg' and `erc-control-default-bg'.
(erc-controls-highlight/default-foreground)
(erc-controls-highlight/default-background): New tests.
(Bug#69860)
---
 test/lisp/erc/erc-goodies-tests.el | 127 ++++++++++++++++++++++++++---
 1 file changed, 116 insertions(+), 11 deletions(-)

diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el
index c8fb0544a72..7cbaa39d3f7 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -167,15 +167,13 @@ erc-controls-highlight--spoilers
        '(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))
+       20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) nil)
       ;; Explicit "default" code ignoerd.
       (erc-goodies-tests--assert-face
-       34 "Default" '(erc-control-default-fg erc-control-default-bg)
+       34 "Default" '(erc-default-face)
        '(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))))
+       43 "END" 'erc-default-face nil)))
   (when noninteractive
     (erc-tests-common-kill-buffers)))
 
@@ -214,17 +212,124 @@ erc-controls-highlight--inverse
        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)
+       32 "ReversedDefault" '(erc-inverse-face erc-default-face)
        '(fg:erc-color-face3 bg:erc-color-face13))
       (erc-goodies-tests--assert-face
-       49 "NormalDefault" '(erc-control-default-fg
-                            erc-control-default-bg)
+       49 "NormalDefault" '(erc-default-face)
        '(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))))
+       '(fg:erc-color-face0 bg:erc-color-face0))))
+  (when noninteractive
+    (erc-tests-common-kill-buffers)))
+
+;; This is meant to assert two behavioral properties:
+;;
+;; 1) The background is preserved when only a new foreground is
+;;    defined, in accordance with this bit from the spec: "If only the
+;;    foreground color is set, the background color stays the same."
+;;    https://modern.ircdocs.horse/formatting#color
+;;
+;; 2) The same holds true for a new, lone foreground of 99.  Rather
+;;    than prepend `erc-default-face', this causes the removal of an
+;;    existing foreground face and likewise doesn't clobber the
+;;    existing background.
+(ert-deftest erc-controls-highlight/default-foreground ()
+  (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))
+      (erc-display-message nil nil (current-buffer)
+                           (erc-format-privmessage
+                            "bob" (concat "BEGIN "
+                                          "\C-c03,08 GreenOnYellow "
+                                          "\C-c99 BlackOnYellow "
+                                          "\C-o END")
+                            nil t)))
+    (forward-line -1)
+    (should (search-forward "<bob> " nil t))
+    (should (erc-tests-common-equal-with-props
+             (erc--remove-text-properties
+              (buffer-substring (point) (line-end-position)))
+             #("BEGIN  GreenOnYellow  BlackOnYellow  END"
+               0 6 (font-lock-face erc-default-face)
+               6 21 (font-lock-face (fg:erc-color-face3
+                                     bg:erc-color-face8
+                                     erc-default-face))
+               21 36 (font-lock-face (bg:erc-color-face8
+                                      erc-default-face))
+               36 40 (font-lock-face (erc-default-face)))))
+    (should (search-forward "BlackOnYellow"))
+    (let ((faces (get-text-property (point) 'font-lock-face)))
+      (should (equal (face-background (car faces) nil (cdr faces))
+                     "yellow")))
+
+    ;; Redefine background color alongside default foreground.
+    (let ((erc-fill-column 90))
+      (erc-display-message nil nil (current-buffer)
+                           (erc-format-privmessage
+                            "bob" (concat "BEGIN "
+                                          "\C-c03,08 GreenOnYellow "
+                                          "\C-c99,07 BlackOnOrange "
+                                          "\C-o END")
+                            nil t)))
+    (should (search-forward "<bob> " nil t))
+    (should (erc-tests-common-equal-with-props
+             (erc--remove-text-properties
+              (buffer-substring (point) (line-end-position)))
+             #("BEGIN  GreenOnYellow  BlackOnOrange  END"
+               0 6 (font-lock-face erc-default-face)
+               6 21 (font-lock-face (fg:erc-color-face3
+                                     bg:erc-color-face8
+                                     erc-default-face))
+               21 36 (font-lock-face (bg:erc-color-face7
+                                      erc-default-face))
+               36 40 (font-lock-face (erc-default-face)))))
+    (should (search-forward "BlackOnOrange"))
+    (let ((faces (get-text-property (point) 'font-lock-face)))
+      (should (equal (face-background (car faces) nil (cdr faces))
+                     "orange")))) ; as opposed to white or black
+  (when noninteractive
+    (erc-tests-common-kill-buffers)))
+
+;; This merely asserts our current interpretation of "default faces":
+;; that they reflect the foreground and background exhibited by normal
+;; chat messages before any control-code formatting is applied (rather
+;; than, e.g., some sort of negation or no-op).
+(ert-deftest erc-controls-highlight/default-background ()
+  (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))
+      (erc-display-message nil nil (current-buffer)
+                           (erc-format-privmessage
+                            "bob" (concat "BEGIN "
+                                          "\C-c03,08 GreenOnYellow "
+                                          "\C-c05,99 BrownOnWhite "
+                                          "\C-o END")
+                            nil t)))
+    (forward-line -1)
+    (should (search-forward "<bob> " nil t))
+    (should (erc-tests-common-equal-with-props
+             (erc--remove-text-properties
+              (buffer-substring (point) (line-end-position)))
+             #("BEGIN  GreenOnYellow  BrownOnWhite  END"
+               0 6 (font-lock-face erc-default-face)
+               6 21 (font-lock-face (fg:erc-color-face3
+                                     bg:erc-color-face8
+                                     erc-default-face))
+               21 35 (font-lock-face (fg:erc-color-face5
+                                      erc-default-face))
+               35 39 (font-lock-face (erc-default-face)))))
+    ;; Ensure the background is white or black, rather than yellow.
+    (should (search-forward "BrownOnWhite"))
+    (let ((faces (get-text-property (point) 'font-lock-face)))
+      (should (equal (face-background (car faces) nil `(,@(cdr faces) default))
+                     (face-background 'default)))))
   (when noninteractive
     (erc-tests-common-kill-buffers)))
 
-- 
2.44.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Remove-mishandled-erc-control-default-fg-bg-face.patch --]
[-- Type: text/x-patch, Size: 3544 bytes --]

From 22083686d58c4e43ab7ea05e0c54ff8ade2540f0 Mon Sep 17 00:00:00 2001
From: "F. Moukayed" <smfadi+emacs@gmail.com>
Date: Sun, 17 Mar 2024 16:43:36 +0000
Subject: [PATCH 2/2] [5.6] Remove mishandled erc-control-default-{fg,bg} faces

Partially revert the portions of 7b4ca9e609e "Leverage inverse-video
for erc-inverse-face" that introduced explicit faces for the "default"
99 color code.

* lisp/erc/erc-goodies.el (erc-control-default-fg)
(erc-control-default-bg): Remove unused faces originally meant to be
new in ERC 5.6.
(erc-get-fg-color-face, erc-get-bg-color-face): Return nil for n=99.
(erc-controls-interpret, erc-controls-highlight): Preserve an
interval's existing background so that "if only the foreground color
is set, the background color stays the same".  See
https://modern.ircdocs.horse/formatting#color.
(Bug#69860)

Copyright-paperwork-exempt: yes
---
 lisp/erc/erc-goodies.el | 16 ++++------------
 1 file changed, 4 insertions(+), 12 deletions(-)

diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index da14f5bd728..883f64d3109 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -673,14 +673,6 @@ 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"))
@@ -812,7 +804,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)) 'erc-control-default-fg))))
+     (t (erc-log (format "   Wrong color: %s" n)) nil))))
 
 (defun erc-get-fg-color-face (n)
   "Fetches the right face for foreground color N (0-15)."
@@ -828,7 +820,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)) 'erc-control-default-bg))))
+     (t (erc-log (format "   Wrong color: %s" n)) nil))))
 
 ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t)
 (define-erc-module irccontrols nil
@@ -883,7 +875,7 @@ erc-controls-interpret
                     (setq s (replace-match "" nil nil s 1))
                     (cond ((and erc-interpret-mirc-color (or fg-color bg-color))
                            (setq fg fg-color)
-                           (setq bg bg-color))
+                           (when bg-color (setq bg bg-color)))
                           ((string= control "\C-b")
                            (setq boldp (not boldp)))
                           ((string= control "\C-]")
@@ -944,7 +936,7 @@ erc-controls-highlight
                (replace-match "" nil nil nil 1)
                (cond ((and erc-interpret-mirc-color (or fg-color bg-color))
                       (setq fg fg-color)
-                      (setq bg bg-color))
+                      (when bg-color (setq bg bg-color)))
                      ((string= control "\C-b")
                       (setq boldp (not boldp)))
                      ((string= control "\C-]")
-- 
2.44.0