[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
09/17: read-print: Recognize page breaks.
From: |
guix-commits |
Subject: |
09/17: read-print: Recognize page breaks. |
Date: |
Mon, 8 Aug 2022 05:55:10 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 077324a16fd6c7d2307bfa52a9863ca25cfc6a52
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Aug 2 15:29:55 2022 +0200
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.
---
guix/read-print.scm | 46 +++++++++++++++++++++++++++++++++++++++++++---
tests/read-print.scm | 22 ++++++++++++++++++++++
2 files changed, 65 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)
diff --git a/tests/read-print.scm b/tests/read-print.scm
index f915b7e2d2..70be7754f8 100644
--- a/tests/read-print.scm
+++ b/tests/read-print.scm
@@ -70,6 +70,21 @@
(read-with-comments port)
(read-with-comments port)))))
+(test-equal "read-with-comments: top-level page break"
+ (list (comment ";; Begin.\n") (vertical-space 1)
+ (page-break)
+ (comment ";; End.\n"))
+ (call-with-input-string "\
+;; Begin.
+
+
+;; End.\n"
+ (lambda (port)
+ (list (read-with-comments port)
+ (read-with-comments port)
+ (read-with-comments port)
+ (read-with-comments port)))))
+
(test-pretty-print "(list 1 2 3 4)")
(test-pretty-print "((a . 1) (b . 2))")
(test-pretty-print "(a b c . boom)")
@@ -229,6 +244,13 @@ mnopqrstuvwxyz.\")"
;; Comment after blank line.
two)")
+(test-pretty-print "\
+(begin
+ break
+
+ ;; page break above
+ end)")
+
(test-equal "pretty-print-with-comments, canonicalize-comment"
"\
(list abc
- branch master updated (bde902cb78 -> 6db3b34d72), guix-commits, 2022/08/08
- 03/17: style: Move reader and printer to (guix read-print)., guix-commits, 2022/08/08
- 04/17: read-print: Add System and Home special forms., guix-commits, 2022/08/08
- 09/17: read-print: Recognize page breaks.,
guix-commits <=
- 11/17: read-print: 'canonicalize-comment' leaves top-level comments unchanged., guix-commits, 2022/08/08
- 01/17: lint: Add '-e'., guix-commits, 2022/08/08
- 05/17: read-print: Expose comment constructor., guix-commits, 2022/08/08
- 02/17: gnu: go-gitlab.com-shackra-goimapnotify: Update to 2.3.7., guix-commits, 2022/08/08
- 07/17: style: Adjust test to not emit blank lines., guix-commits, 2022/08/08
- 08/17: read-print: Read and render vertical space., guix-commits, 2022/08/08
- 10/17: read-print: Add code to read and write sequences of expressions/blanks., guix-commits, 2022/08/08
- 12/17: style: Add '--whole-file' option., guix-commits, 2022/08/08
- 15/17: installer: Render the final configuration with (guix read-print)., guix-commits, 2022/08/08
- 13/17: news: Add entry for 'guix style -f'., guix-commits, 2022/08/08