aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/read-print.scm38
-rw-r--r--tests/read-print.scm8
2 files changed, 43 insertions, 3 deletions
diff --git a/guix/read-print.scm b/guix/read-print.scm
index 63ff9ca5bd..00dde870f4 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -22,6 +22,7 @@
#:use-module (ice-9 rdelim)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (guix i18n)
@@ -426,6 +427,34 @@ 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->string integer context)
+ "Render INTEGER as a string using a base suitable based on CONTEXT."
+ (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)))
+ (_ 10)))
+
+ (string-append (match base
+ (10 "")
+ (16 "#x")
+ (8 "#o"))
+ (number->string integer base)))
+
(define* (pretty-print-with-comments port obj
#:key
(format-comment
@@ -661,9 +690,12 @@ FORMAT-VERTICAL-SPACE; a useful value of 'canonicalize-vertical-space'."
(display ")" port)
(+ column 1)))))
(_
- (let* ((str (if (string? obj)
- (escaped-string obj)
- (object->string obj)))
+ (let* ((str (cond ((string? obj)
+ (escaped-string obj))
+ ((integer? obj)
+ (integer->string obj context))
+ (else
+ (object->string obj))))
(len (string-width str)))
(if (and (> (+ column 1 len) max-width)
(not delimited?))
diff --git a/tests/read-print.scm b/tests/read-print.scm
index 4dabcc1e64..1b0d865972 100644
--- a/tests/read-print.scm
+++ b/tests/read-print.scm
@@ -248,6 +248,14 @@ mnopqrstuvwxyz.\")"
(list x y z))")
(test-pretty-print "\
+(begin
+ (chmod \"foo\" #o750)
+ (chmod port
+ (logand #o644
+ (lognot (umask))))
+ (logand #x7f xyz))")
+
+(test-pretty-print "\
(substitute-keyword-arguments (package-arguments x)
((#:phases phases)
`(modify-phases ,phases