diff options
Diffstat (limited to 'guix/read-print.scm')
-rw-r--r-- | guix/read-print.scm | 59 |
1 files changed, 44 insertions, 15 deletions
diff --git a/guix/read-print.scm b/guix/read-print.scm index 00dde870f4..a5a1b708bf 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)))) @@ -427,26 +442,40 @@ each line except the first one (they're assumed to be already there)." (display (make-string indent #\space) port) (loop tail))))) -(define %symbols-followed-by-octal-integers - ;; Symbols for which the following integer must be printed as octal. - '(chmod umask mkdir mkstemp)) - -(define %symbols-followed-by-hexadecimal-integers - ;; Likewise, for hexadecimal integers. - '(logand logior logxor lognot)) +(define %integer-forms + ;; Forms that take an integer as their argument, where said integer should + ;; be printed in base other than decimal base. + (letrec-syntax ((vhashq (syntax-rules () + ((_) vlist-null) + ((_ (key value) rest ...) + (vhash-consq key value (vhashq rest ...)))))) + (vhashq + ('chmod 8) + ('umask 8) + ('mkdir 8) + ('mkstemp 8) + ('logand 16) + ('logior 16) + ('logxor 16) + ('lognot 16)))) (define (integer->string integer context) "Render INTEGER as a string using a base suitable based on CONTEXT." + (define (form-base form) + (match (vhash-assq form %integer-forms) + (#f 10) + ((_ . base) base))) + + (define (octal? form) + (= 8 (form-base form))) + (define base (match context ((head . tail) - (cond ((memq head %symbols-followed-by-octal-integers) 8) - ((memq head %symbols-followed-by-hexadecimal-integers) - (if (any (cut memq <> %symbols-followed-by-octal-integers) - tail) - 8 - 16)) - (else 10))) + (match (form-base head) + (8 8) + (16 (if (any octal? tail) 8 16)) + (10 10))) (_ 10))) (string-append (match base @@ -691,7 +720,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 |