From b1cff95e0360f7db8391763bba334aaac595dd41 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Fri, 17 Nov 2023 13:55:07 +0000
Subject: ui: Colorize format specifiers not format arguments.

* ccwl/ui.scm (report-formatted-message): Colorize format specifiers
not format arguments.
* tests/ui.scm ("report-formatted-message must not fail on arguments
that are not strings"): New test.
---
 ccwl/ui.scm  | 15 ++++++++++++---
 tests/ui.scm | 12 +++++++++++-
 2 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/ccwl/ui.scm b/ccwl/ui.scm
index 7f5c76a..3b46a23 100644
--- a/ccwl/ui.scm
+++ b/ccwl/ui.scm
@@ -20,6 +20,7 @@
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-28)
+  #:use-module (ice-9 string-fun)
   #:use-module (term ansi-color)
   #:use-module (ccwl conditions)
   #:export (report-formatted-message
@@ -29,9 +30,17 @@
   "Report @var{exception}, a @code{&formatted-message} condition to the
 user."
   (display (apply format
-                  (formatted-message-format exception)
-                  (map (cut colorize-string <> 'BOLD 'MAGENTA)
-                       (formatted-message-arguments exception)))
+                  ;; We colorize the format specifiers instead of the
+                  ;; arguments because we cannot always be sure that
+                  ;; the arguments are strings.
+                  (string-replace-substring
+                   (string-replace-substring
+                    (formatted-message-format exception)
+                    "~a"
+                    (colorize-string "~a" 'BOLD 'MAGENTA))
+                   "~s"
+                   (colorize-string "~s" 'BOLD 'MAGENTA))
+                  (formatted-message-arguments exception))
            (current-error-port))
   (newline (current-error-port)))
 
diff --git a/tests/ui.scm b/tests/ui.scm
index 4189e6c..a5741c0 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -17,7 +17,9 @@
 ;;; along with ccwl.  If not, see <https://www.gnu.org/licenses/>.
 
 (use-modules (srfi srfi-64)
-             (term ansi-color))
+             (term ansi-color)
+             (ccwl ui)
+             (ccwl conditions))
 
 (define source-in-context
   (@@ (ccwl ui) source-in-context))
@@ -43,4 +45,12 @@
   (call-with-input-string "(foo (bar))"
     (cut source-in-context <> 0 5)))
 
+(test-assert "report-formatted-message must not fail on arguments that are not strings"
+  (call-with-output-string
+    (lambda (port)
+      (with-error-to-port port
+        (lambda ()
+          (report-formatted-message
+           (formatted-message "Foo ~a" 'bar)))))))
+
 (test-end "ui")
-- 
cgit v1.2.3