[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/03: Texinfo serialization: add braces when needed
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 02/03: Texinfo serialization: add braces when needed |
|
Date: |
Tue, 11 Oct 2016 21:03:20 +0000 (UTC) |
wingo pushed a commit to branch master
in repository guile.
commit 06e4091c9c05942413cb55b7d9ffef6f83f876f3
Author: Andy Wingo <address@hidden>
Date: Tue Oct 11 22:08:03 2016 +0200
Texinfo serialization: add braces when needed
* module/texinfo/serialize.scm (include, empty-command, inline-text):
(inline-args, inline-text-args, eol-text-args, eol-text, eol-args)
(environ, table-environ, paragraph, item, entry, fragment, serialize)
(stexi->texi): Pass extra rest? parameter around to indicate arguments
that can take any number of subforms without being surrounded by
braces.
(embrace, serialize-text-args): Surround non-rest arguments with
braces.
* test-suite/tests/texinfo.serialize.test: Add tests.
---
module/texinfo/serialize.scm | 79 +++++++++++++++++++------------
test-suite/tests/texinfo.serialize.test | 9 +++-
2 files changed, 58 insertions(+), 30 deletions(-)
diff --git a/module/texinfo/serialize.scm b/module/texinfo/serialize.scm
index f3840c4..05d3fac 100644
--- a/module/texinfo/serialize.scm
+++ b/module/texinfo/serialize.scm
@@ -28,6 +28,7 @@
#:use-module (texinfo)
#:use-module (texinfo string-utils)
#:use-module (sxml transform)
+ #:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:export (stexi->texi))
@@ -61,17 +62,17 @@
;; Why? Well, because syntax-case defines `include', and carps about its
;; wrong usage below...
(eval-when (expand load eval)
- (define (include exp lp command type formals args accum)
+ (define (include exp lp command type formals rest? args accum)
(list* "\n"
(list-intersperse
args
" ")
" " command "@" accum)))
-(define (empty-command exp lp command type formals args accum)
+(define (empty-command exp lp command type formals rest? args accum)
(list* " " command "@" accum))
-(define (inline-text exp lp command type formals args accum)
+(define (inline-text exp lp command type formals rest? args accum)
(if (not (string=? command "*braces*")) ;; fixme :(
(list* "}"
(append-map (lambda (x) (lp x '())) (reverse (cdr exp)))
@@ -80,7 +81,7 @@
(append-map (lambda (x) (lp x '())) (reverse (cdr exp)))
"@{" accum)))
-(define (inline-args exp lp command type formals args accum)
+(define (inline-args exp lp command type formals rest? args accum)
(list* "}"
(if (not args) ""
(list-intersperse
@@ -98,7 +99,7 @@
","))
"{" command "@" accum))
-(define (inline-text-args exp lp command type formals args accum)
+(define (inline-text-args exp lp command type formals rest? args accum)
(list* "}"
(if (not args) ""
(apply
@@ -112,30 +113,49 @@
'(","))))
"{" command "@" accum))
-(define (serialize-text-args lp formals args)
- (apply
- append
- (list-intersperse
- (map (lambda (arg) (append-map (lambda (x) (lp x '())) arg))
- (map
- reverse
- (drop-while
- not (map (lambda (x) (assq-ref args x))
- (reverse formals)))))
- '(" "))))
+(define (embrace x)
+ (define (needs-embrace? x)
+ (define (has-space? x)
+ (and (string? x)
+ (string-index x char-set:whitespace)))
+ (or (null? x) (or-map has-space? x)))
+ (if (needs-embrace? x)
+ (append '("}") x '("{"))
+ x))
-(define (eol-text-args exp lp command type formals args accum)
+(define (serialize-text-args lp formals rest? args)
+ (define (serialize-arg formal rest?)
+ (let ((val (assq-ref args formal)))
+ (if val
+ (let ((out (append-map (lambda (x) (lp x '()))
+ (reverse val))))
+ (if rest?
+ out
+ (embrace out)))
+ #f)))
+ (define (serialize-args rformals rest?)
+ (match rformals
+ (() '())
+ ((formal . rformals)
+ (cons (serialize-arg formal rest?)
+ (serialize-args rformals #f)))))
+ (apply append
+ (list-intersperse
+ (filter identity (serialize-args (reverse formals) rest?))
+ '(" "))))
+
+(define (eol-text-args exp lp command type formals rest? args accum)
(list* "\n"
- (serialize-text-args lp formals args)
+ (serialize-text-args lp formals rest? args)
" " command "@" accum))
-(define (eol-text exp lp command type formals args accum)
+(define (eol-text exp lp command type formals rest? args accum)
(list* "\n"
(append-map (lambda (x) (lp x '()))
(reverse (if args (cddr exp) (cdr exp))))
" " command "@" accum))
-(define (eol-args exp lp command type formals args accum)
+(define (eol-args exp lp command type formals rest? args accum)
(list* "\n"
(list-intersperse
(apply append
@@ -145,7 +165,7 @@
", ")
" " command "@" accum))
-(define (environ exp lp command type formals args accum)
+(define (environ exp lp command type formals rest? args accum)
(case (car exp)
((texinfo)
(list* "@bye\n"
@@ -169,10 +189,10 @@
body
(cons "\n" body)))
"\n"
- (serialize-text-args lp formals args)
+ (serialize-text-args lp formals rest? args)
" " command "@" accum))))
-(define (table-environ exp lp command type formals args accum)
+(define (table-environ exp lp command type formals rest? args accum)
(list* "\n\n" command "@end "
(append-map (lambda (x) (lp x '()))
(reverse (if args (cddr exp) (cdr exp))))
@@ -188,26 +208,26 @@
#:line-width 72
#:break-long-words? #f))
-(define (paragraph exp lp command type formals args accum)
+(define (paragraph exp lp command type formals rest? args accum)
(list* "\n\n"
(wrap
(reverse
(append-map (lambda (x) (lp x '())) (reverse (cdr exp)))))
accum))
-(define (item exp lp command type formals args accum)
+(define (item exp lp command type formals rest? args accum)
(list* (append-map (lambda (x) (lp x '())) (reverse (cdr exp)))
"@item\n"
accum))
-(define (entry exp lp command type formals args accum)
+(define (entry exp lp command type formals rest? args accum)
(list* (append-map (lambda (x) (lp x '())) (reverse (cddr exp)))
"\n"
(append-map (lambda (x) (lp x '())) (reverse (cdar args)))
"@item "
accum))
-(define (fragment exp lp command type formals args accum)
+(define (fragment exp lp command type formals rest? args accum)
(list* "address@hidden %end of fragment\n"
(append-map (lambda (x) (lp x '())) (reverse (cdr exp)))
"address@hidden %start of fragment\n\n"
@@ -230,10 +250,10 @@
(FRAGMENT . ,fragment)
(#f . ,include))) ; support writing include statements
-(define (serialize exp lp command type formals args accum)
+(define (serialize exp lp command type formals rest? args accum)
((or (assq-ref serializers type)
(error "Unknown command type" exp type))
- exp lp command type formals args accum))
+ exp lp command type formals rest? args accum))
(define escaped-chars '(#\} #\{ #\@))
(define (escape str)
@@ -263,6 +283,7 @@
(symbol->string (car in))
(cadr command-spec)
(filter* symbol? (cddr command-spec))
+ (not (list? (cddr command-spec)))
(cond
((and (pair? (cdr in)) (pair? (cadr in))
(eq? (caadr in) '%))
diff --git a/test-suite/tests/texinfo.serialize.test
b/test-suite/tests/texinfo.serialize.test
index 554390c..1c28b5a 100644
--- a/test-suite/tests/texinfo.serialize.test
+++ b/test-suite/tests/texinfo.serialize.test
@@ -28,7 +28,7 @@
(with-test-prefix "test-serialize"
(define (assert-serialize stexi str)
- (pass-if str (equal? str (stexi->texi stexi))))
+ (pass-if-equal stexi str (stexi->texi stexi)))
(assert-serialize '(para)
"
@@ -182,4 +182,11 @@ foo
"@deffnx bar foo (x @code{int})
")
+ (assert-serialize '(deffnx (% (name "foo") (category "bar baz") (arguments
"(" "x" " " (code "int") ")")))
+ "@deffnx {bar baz} foo (x @code{int})
+")
+
+ (assert-serialize '(deffnx (% (name "foo") (category (code "bar") " baz")
(arguments "(" "x" " " (code "int") ")")))
+ "@deffnx address@hidden baz} foo (x @code{int})
+")
)