01/03: read-print: Define forms for which \n, \t, etc. are not escaped.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 82968362ead0ed59c64ee8a21fec346c9265a149
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Sep 1 22:08:12 2022 +0200

    read-print: Define forms for which \n, \t, etc. are not escaped.
    
    Previously, the pretty-printer would unconditionally leave everything
    but double-quotes and backslashes unescaped when rendering a string.
    With this change, the previous behavior only applies to forms listed in
    %NATURAL-WHITESPACE-STRING-FORMS.
    
    * guix/read-print.scm (%natural-whitespace-string-forms): New variable.
    (printed-string): New procedure.
    (pretty-print-with-comments): Use it instead of 'escaped-string'.
    * tests/read-print.scm: Add test.
---
 guix/read-print.scm  | 17 ++++++++++++++++-
 tests/read-print.scm |  3 +++
 2 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/guix/read-print.scm b/guix/read-print.scm
index 00dde870f4..6e1188e87e 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -386,6 +386,21 @@ particular newlines, is left as is."
                           str)
      #\")))
 
+(define %natural-whitespace-string-forms
+  ;; When a string has one of these forms as its parent, only double quotes
+  ;; and backslashes are escaped; newlines, tabs, etc. are left as-is.
+  '(synopsis description G_ N_))
+
+(define (printed-string str context)
+  "Return the read syntax for STR depending on CONTEXT."
+  (match context
+    (()
+     (object->string str))
+    ((head . _)
+     (if (memq head %natural-whitespace-string-forms)
+         (escaped-string str)
+         (object->string str)))))
+
 (define (string-width str)
   "Return the \"width\" of STR--i.e., the width of the longest line of STR."
   (apply max (map string-length (string-split str #\newline))))
@@ -691,7 +706,7 @@ FORMAT-VERTICAL-SPACE; a useful value of 
'canonicalize-vertical-space'."
              (+ column 1)))))
       (_
        (let* ((str (cond ((string? obj)
-                          (escaped-string obj))
+                          (printed-string obj context))
                          ((integer? obj)
                           (integer->string obj context))
                          (else
diff --git a/tests/read-print.scm b/tests/read-print.scm
index 1b0d865972..ca3f3193f7 100644
--- a/tests/read-print.scm
+++ b/tests/read-print.scm
@@ -186,6 +186,9 @@ expressions."
               (lambda _
                 xyz))))")
 
+(test-pretty-print "\
+(string-append \"a\\tb\" \"\\n\")")
+
 (test-pretty-print "\
 (description \"abcdefghijkl
 mnopqrstuvwxyz.\")"