summaryrefslogtreecommitdiff
path: root/guix/read-print.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-08-02 15:29:55 +0200
committerLudovic Courtès <ludo@gnu.org>2022-08-08 11:22:32 +0200
commit077324a16fd6c7d2307bfa52a9863ca25cfc6a52 (patch)
tree507f6aeeaa99a99c0e5e68d6e307766897d05230 /guix/read-print.scm
parentf687e27e0385c7f9bab8d967293061158fc3f504 (diff)
read-print: Recognize page breaks.
* guix/read-print.scm (<page-break>, page-break?, page-break) (char-set:whitespace-sans-page-break): New variables. (space?): New procedure. (read-vertical-space): Use it. (read-until-end-of-line): New procedure. (read-with-comments): Add #\page case. (pretty-print-with-comments): Add 'page-break?' case. * tests/read-print.scm ("read-with-comments: top-level page break"): New test. Add round-trip test with page break within an sexp.
Diffstat (limited to 'guix/read-print.scm')
-rw-r--r--guix/read-print.scm46
1 files changed, 43 insertions, 3 deletions
diff --git a/guix/read-print.scm b/guix/read-print.scm
index 2b626ba281..33ed6e3dbe 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -35,6 +35,9 @@
vertical-space-height
canonicalize-vertical-space
+ page-break
+ page-break?
+
comment
comment?
comment->string
@@ -83,6 +86,18 @@
"Return a vertical space corresponding to a single blank line."
unit)))
+(define <page-break>
+ (make-record-type '<page-break> '()
+ #:parent <blank>
+ #:extensible? #f))
+
+(define page-break? (record-predicate <page-break>))
+(define page-break
+ (let ((break ((record-type-constructor <page-break>))))
+ (lambda ()
+ break)))
+
+
(define <comment>
;; Comments.
(make-record-type '<comment> '(str margin?)
@@ -105,12 +120,17 @@ end with newline, otherwise an error is raised."
(&message (message "invalid comment string")))))
(string->comment str margin?))
+(define char-set:whitespace-sans-page-break
+ ;; White space, excluding #\page.
+ (char-set-difference char-set:whitespace (char-set #\page)))
+
+(define (space? chr)
+ "Return true if CHR is white space, except for page breaks."
+ (char-set-contains? char-set:whitespace-sans-page-break chr))
+
(define (read-vertical-space port)
"Read from PORT until a non-vertical-space character is met, and return a
single <vertical-space> record."
- (define (space? chr)
- (char-set-contains? char-set:whitespace chr))
-
(let loop ((height 1))
(match (read-char port)
(#\newline (loop (+ 1 height)))
@@ -118,6 +138,15 @@ single <vertical-space> record."
((? space?) (loop height))
(chr (unread-char chr port) (vertical-space height)))))
+(define (read-until-end-of-line port)
+ "Read white space from PORT until the end of line, included."
+ (let loop ()
+ (match (read-char port)
+ (#\newline #t)
+ ((? eof-object?) #t)
+ ((? space?) (loop))
+ (chr (unread-char chr port)))))
+
(define (read-with-comments port)
"Like 'read', but include <blank> objects when they're encountered."
;; Note: Instead of implementing this functionality in 'read' proper, which
@@ -148,6 +177,11 @@ single <vertical-space> record."
(if blank-line?
(read-vertical-space port)
(loop #t return)))
+ ((eqv? chr #\page)
+ ;; Assume that a page break is on a line of its own and read
+ ;; subsequent white space and newline.
+ (read-until-end-of-line port)
+ (page-break))
((char-set-contains? char-set:whitespace chr)
(loop blank-line? return))
((memv chr '(#\( #\[))
@@ -444,6 +478,12 @@ FORMAT-VERTICAL-SPACE; a useful value of 'canonicalize-vertical-space'."
(loop (- i 1))))
(display (make-string indent #\space) port)
indent)
+ ((? page-break?)
+ (unless delimited? (newline port))
+ (display #\page port)
+ (newline port)
+ (display (make-string indent #\space) port)
+ indent)
(('quote lst)
(unless delimited? (display " " port))
(display "'" port)