@@ -163,6 +163,18 @@ (define %special-forms
('with-output-to-file 2)
('with-input-from-file 2)))
+(define %newline-forms
+ ;; List heads that must be followed by a newline. The second argument is
+ ;; the context in which they must appear. This is similar to a special form
+ ;; of 1, except that indent is 1 instead of 2 columns.
+ (vhashq
+ ('arguments '(package))
+ ('sha256 '(origin source package))
+ ('base32 '(sha256 origin))
+ ('search-paths '(package))
+ ('native-search-paths '(package))
+ ('search-path-specification '())))
+
(define (prefix? candidate lst)
"Return true if CANDIDATE is a prefix of LST."
(let loop ((candidate candidate)
@@ -188,6 +200,14 @@ (define (special-form-lead symbol context)
(and (prefix? prefix context) (- level 1))))
alist))))
+(define (newline-form? symbol context)
+ "Return true if parenthesized expressions starting with SYMBOL must be
+followed by a newline."
+ (match (vhash-assq symbol %newline-forms)
+ (#f #f)
+ ((_ . prefix)
+ (prefix? prefix context))))
+
(define (escaped-string str)
"Return STR with backslashes and double quotes escaped. Everything else, in
particular newlines, is left as is."
@@ -377,6 +397,7 @@ (define new-column
(column (if overflow?
(+ indent 1)
(+ column (if delimited? 1 2))))
+ (newline? (newline-form? head context))
(context (cons head context)))
(if overflow?
(begin
@@ -384,17 +405,26 @@ (define new-column
(display (make-string indent #\space) port))
(unless delimited? (display " " port)))
(display "(" port)
+
(let* ((new-column (loop column column #t context head))
(indent (if (or (>= new-column max-width)
(not (symbol? head))
(sequence-would-protrude?
- (+ new-column 1) tail))
+ (+ new-column 1) tail)
+ newline?)
column
(+ new-column 1))))
- (define column
- (print-sequence context indent new-column tail #f))
- (display ")" port)
- (+ column 1))))
+ (when newline?
+ ;; Insert a newline right after HEAD.
+ (newline port)
+ (display (make-string indent #\space) port))
+
+ (let ((column
+ (print-sequence context indent
+ (if newline? indent new-column)
+ tail newline?)))
+ (display ")" port)
+ (+ column 1)))))
(_
(let* ((str (if (string? obj)
(escaped-string obj)
@@ -465,6 +465,19 @@ (define file
;; Regular indentation for 'replace' here.
(replace \"gmp\" gmp))")
+(test-pretty-print "\
+(package
+ ;; Here 'sha256', 'base32', and 'arguments' must be
+ ;; immediately followed by a newline.
+ (source (origin
+ (method url-fetch)
+ (sha256
+ (base32
+ \"not a real base32 string\"))))
+ (arguments
+ '(#:phases %standard-phases
+ #:tests? #f)))")
+
(test-end)
;; Local Variables: