Leverage inverse-video for erc-inverse-face

* lisp/erc/erc-goodies.el (erc-inverse-face): Specify face attribute
`:inverse-video' (née :reverse-video) to swap foreground and
background colors over affected intervals, as per
https://modern.ircdocs.horse/formatting#reverse-color.
(erc-control-default-fg erc-control-default-bg): New faces for 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): Return new, dedicated
faces instead of `default', and don't nest them in a list.
* test/lisp/erc/erc-goodies-tests.el
(erc-controls-highlight--inverse): Redo completely, asserting behavior
described in the spec linked to above.
(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)

(cherry picked from commit 7b4ca9e609e2eadc824313053e70d7272d360b9d)

diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 7e30b1060fd7de2ceae175aadc24f5b250960e6c..f19fb5ed727ec89bd79a329b6acb028a8666df73 100644 (file)
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -661,7 +661,7 @@ The value `erc-interpret-controls-p' must also be t for this to work."
   :group 'erc-faces)
 
 (defface erc-inverse-face
-  '((t :foreground "White" :background "Black"))
+  '((t :inverse-video t))
   "ERC inverse face."
   :group 'erc-faces)
 
@@ -675,6 +675,16 @@ The value `erc-interpret-controls-p' must also be t for this to work."
   "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 +814,7 @@ The value `erc-interpret-controls-p' must also be t for this to work."
       (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 +830,7 @@ The value `erc-interpret-controls-p' must also be t for this to work."
       (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 7013ce0c8fc040c421b5c88d8df8f68f982cfba3..c8fb0544a7295bbc20367ee68a448a1fbfd6ed23 100644 (file)
--- 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 @@
 ;; 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 "<bob> " 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 "<bob> " 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 "<bob> " 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