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.
This commit is contained in:
Ludovic Courtès 2022-09-01 22:08:12 +02:00
parent ac9a7f6be9
commit 82968362ea
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 19 additions and 1 deletions

View file

@ -386,6 +386,21 @@ (define (escaped-string str)
str) 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) (define (string-width str)
"Return the \"width\" of STR--i.e., the width of the longest line of 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)))) (apply max (map string-length (string-split str #\newline))))
@ -691,7 +706,7 @@ (define new-column
(+ column 1))))) (+ column 1)))))
(_ (_
(let* ((str (cond ((string? obj) (let* ((str (cond ((string? obj)
(escaped-string obj)) (printed-string obj context))
((integer? obj) ((integer? obj)
(integer->string obj context)) (integer->string obj context))
(else (else

View file

@ -186,6 +186,9 @@ (define-syntax-rule (test-pretty-print/sequence str args ...)
(lambda _ (lambda _
xyz))))") xyz))))")
(test-pretty-print "\
(string-append \"a\\tb\" \"\\n\")")
(test-pretty-print "\ (test-pretty-print "\
(description \"abcdefghijkl (description \"abcdefghijkl
mnopqrstuvwxyz.\")" mnopqrstuvwxyz.\")"