From be49d711bc6cc6756bfd1da83514b91e5953311d Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Thu, 23 Jun 2011 12:55:40 +0200
Subject: Translate the code to R6RS.

---
 json-template.rkt | 370 +++++++++++++++++++++++++++++++-----------------------
 1 file changed, 211 insertions(+), 159 deletions(-)

diff --git a/json-template.rkt b/json-template.rkt
index fe596c4..ebbe1bb 100755
--- a/json-template.rkt
+++ b/json-template.rkt
@@ -1,28 +1,86 @@
+#!r6rs
 ;;; -*- mode: scheme; coding: utf-8 -*-
 ;;; Copyright 2011, Matthias Andreas Benkard.
-#lang racket
 
-(provide read-template
-         formatters)
+(library (json-template)
+ (export make-template
+         formatters
+         meta-left
+         meta-right
+         default-formatter
+         format-char)
+ (import (rnrs base) (rnrs programs) (rnrs unicode) (rnrs lists) (rnrs control)
+         (rnrs records syntactic) (rnrs records procedural) (rnrs records inspection)
+         (rnrs exceptions) (rnrs conditions) (rnrs io simple) (rnrs io ports) (rnrs hashtables)
+         (rnrs r5rs) (srfi :39) (srfi :28)
+         ;; Racket-specific:
+         (only (racket)
+               regexp-quote regexp-replace regexp regexp-split regexp-match)
+         (only (racket mpair)
+               list->mlist)
+         
+         )
+ 
+ ;; Racket-specific:
+ (define pregexp-quote regexp-quote)
+ (define pregexp-split (lambda args (list->mlist (apply regexp-split args))))
+ (define pregexp regexp)
+ (define pregexp-replace regexp-replace)
+ (define pregexp-match
+   (lambda args
+     (let ([m (apply regexp-match args)])
+       (and m
+            (list->mlist m)))))
+ 
+(define meta-left (make-parameter "{"))
+(define meta-right (make-parameter "}"))
+(define default-formatter (make-parameter "raw"))
+(define format-char (make-parameter "|"))
+
+(define-syntax λ
+  (syntax-rules ()
+    [(_ forms ...)
+     (lambda forms ...)]))
+
+(define (dict? x)
+  (or (list? x)
+      (hashtable? x)))
+
+(define (dict-ref dict key default)
+  (let* ([default-default (cons #f #f)]
+         [result
+          (cond
+            [(list? dict)
+             (let ([result-cons (assoc key dict)])
+               (if result-cons
+                   (cdr result-cons)
+                   default-default))]
+            [(hashtable? dict)
+             (hashtable-ref dict key default-default)])])
+    (if (eq? result default-default)
+        (if (procedure? default)
+            (default)
+            default)
+        result)))
 
 (define (template-string->chunks input meta-left meta-right)
-  (let* ([meta-left-re   (regexp-quote meta-left)]
-         [meta-right-re  (regexp-quote meta-right)]
+  (let* ([meta-left-re   (pregexp-quote meta-left)]
+         [meta-right-re  (pregexp-quote meta-right)]
          [re (regexp
               (string-append "(" meta-left-re ")|(" meta-right-re ")"))])
-    (regexp-split re input)))
+    (pregexp-split re input)))
 
 (define (flip-flop-map f1 f2 lst)
   "Like map, but alternate between f1 and f2 as the function to apply."
-  (define (flip items)
-    (match items
-      ['()          '()]
-      [(list* x xs) (cons (f1 x) (flop xs))]))
-  (define (flop items)
-    (match items
-      ['()          '()]
-      [(list* x xs) (cons (f2 x) (flip xs))]))
-  (flip lst))
+  (letrec ((flip (λ (items)
+                   (cond
+                     [(null? items)'()]
+                     [else         (cons (f1 (car items)) (flop (cdr items)))])))
+           (flop (λ (items)
+                   (cond
+                     [(null? items)'()]
+                     [else         (cons (f2 (car items)) (flip (cdr items)))]))))
+    (flip lst)))
 
 (define (classify-chunks chunks format-char)
   (flip-flop-map (λ (x) x)
@@ -30,51 +88,51 @@
                  chunks))
 
 (define (parse-directive directive format-char)
-  (match directive
-    [(regexp #rx"^#")
+  (cond
+    [(pregexp-match "^#" directive)
      #f]
-    [(regexp #px"^\\.section\\s+(.*)$" (list _ x))
-     (list 'section x)]
-    [(regexp #px"^\\.repeated\\s+section\\s+(.*)$" (list _ x))
-     (list 'repeated-section x)]
-    [#".end"
+    [(pregexp-match "^\\.section[ \t]+(.*)$" directive)
+     => (λ (x) (list 'section (cadr x)))]
+    [(pregexp-match "^\\.repeated[ \t]+section[ \t]+(.*)$" directive)
+     => (λ (x) (list 'repeated-section (cadr x)))]
+    [(string=? ".end" directive)
      (list 'end)]
-    [#".or"
+    [(string=? ".or" directive)
      (list 'or)]
-    [(regexp #px"^\\.alternates\\s+with$")
+    [(pregexp-match "^\\.alternates\\s+with$" directive)
      (list 'alternates-with)]
-    [_
-     (list* 'substitute (regexp-split (regexp-quote format-char)
-                                      directive))]))
+    [else
+     (cons 'substitute (pregexp-split (pregexp-quote format-char)
+                                            directive))]))
   
 (define (remove-spurious-newlines-from-token-groups groups)
   (let ([last-was-directive? #f])
-    (for/list ([group groups])
-      (if last-was-directive?
-          (begin
-            (set! last-was-directive? (pair? group))
-            (if (or (string? group) (bytes? group))
-                (regexp-replace #rx"^\n" group "")
-                group))
-          (begin
-            (set! last-was-directive? (pair? group))
-            group)))))
+    (map
+      (λ (group)
+        (if last-was-directive?
+            (begin
+              (set! last-was-directive? (pair? group))
+              (if (string? group)
+                  (pregexp-replace "^\n" group "")
+                  group))
+            (begin
+              (set! last-was-directive? (pair? group))
+              group)))
+      groups)))
 
-(struct section
-  (name
-   body
-   alternative)
-  #:transparent)
+(define-record-type section
+  (fields (immutable name)
+          (immutable body)
+          (immutable alternative)))
 
-(struct repeated-section section
-  (alternates-with)
-  #:transparent)
+(define-record-type repeated-section
+  (parent section)
+  (fields (immutable alternates-with)))
 
-(struct substitution
-  (name
-   formatter
-   arguments)
-  #:transparent)
+(define-record-type substitution
+  (fields (immutable name)
+          (immutable formatter)
+          (immutable arguments)))
 
 (define (parse-structure parsed-groups)
   (let loop ([parsed-groups parsed-groups]
@@ -85,23 +143,27 @@
         (values (reverse clauses)
                 (and (pair? parsed-groups) (caar parsed-groups))
                 (if (pair? parsed-groups) (cdr parsed-groups) '()))
-        (match (car parsed-groups)
-          [(list 'section x)
-           (let-values ([(stuff reason rest)
-                         (parse-structure (cdr parsed-groups))])
-             (case reason
-               [(or)
-                (let-values ([(stuff2 _ rest2)
-                              (parse-structure rest)])
-                  (loop rest2 (cons (section x stuff stuff2) clauses)))]
-               [(end)
-                (loop rest (cons (section x stuff #f) clauses))]))]
-          [(list 'repeated-section x)
+        (let ([grp (car parsed-groups)])
+          (cond
+            [(string? grp)
+             (loop (cdr parsed-groups)
+                   (cons grp clauses))]
+            [(eq? (car grp) 'section)
+             (let-values ([(stuff reason rest)
+                           (parse-structure (cdr parsed-groups))])
+               (case reason
+                 [(or)
+                  (let-values ([(stuff2 _ rest2)
+                                (parse-structure rest)])
+                    (loop rest2 (cons (make-section (cadr grp) stuff stuff2) clauses)))]
+                 [(end)
+                  (loop rest (cons (make-section (cadr grp) stuff #f) clauses))]))]
+          [(eq? (car grp) 'repeated-section)
            (let inner-loop ([subsections '()]
                             [rest (cdr parsed-groups)])
              (let-values ([(stuff reason new-rest)
                            (parse-structure rest)])
-               (when (false? reason)
+               (when (not reason)
                  (error "Premature end of file."))
                (if (eq? reason 'end)
                    (let inner-inner-loop
@@ -110,10 +172,10 @@
                         [alternates-with #f])
                      (if (null? (cdr subsections))
                          (loop new-rest
-                               (cons (repeated-section x
-                                                       (cdar subsections)
-                                                       alternative
-                                                       alternates-with)
+                               (cons (make-repeated-section (cadr grp)
+                                                            (cdar subsections)
+                                                            alternative
+                                                            alternates-with)
                                      clauses))
                          (case (caadr subsections)
                            [(alternates-with)
@@ -127,42 +189,31 @@
                            [else
                             (error "Oh no, I don't know what I'm doing here!  Subsections:" subsections)])))
                    (inner-loop (cons (cons reason stuff) subsections) new-rest))))]
-          [(list 'substitute x)
-           (loop (cdr parsed-groups)
-                 (cons (substitution x #f '()) clauses))]
-          [(list 'substitute x y arg ...)
+          [(eq? (car grp) 'substitute)
            (loop (cdr parsed-groups)
-                 (cons (substitution x y arg) clauses))]
-          [x
-           (loop (cdr parsed-groups)
-                 (cons x clauses))]))))
+                 (if (null? (cddr grp))
+                     (cons (make-substitution (cadr grp) #f '()) clauses)
+                     (cons (make-substitution (cadr grp) (caddr grp) (cdddr grp)) clauses)))])))))
 
 (define (parse-structure* x)
   (let-values ([(stuff reason rest) (parse-structure x)])
     stuff))
 
-(struct template (expander)
-  #:property prop:procedure (struct-field-index expander))
-
-(define (read-template #:meta-left         [meta-left "{"]
-                       #:meta-right        [meta-right "}"]
-                       #:default-formatter [default-formatter "raw"]
-                       #:format-char       [format-char "|"])
+(define (make-template template-string)
   (let ([template-data
          (parse-structure*
           (remove-spurious-newlines-from-token-groups
-           (classify-chunks (template-string->chunks (current-input-port)
-                                                     meta-left meta-right)
-                            format-char)))])
-    (template
-     (λ (context)
-       (expand-template template-data (list context) default-formatter)))))
+           (classify-chunks (template-string->chunks template-string
+                                                     (meta-left) (meta-right))
+                            (format-char))))])
+    (let ([default-formatter (default-formatter)])
+      (λ (context)
+        (expand-template template-data (list context) default-formatter)))))
 
-(define (name->path bytename)
-  (let ([name (bytes->string/utf-8 bytename)])
-    (if (string=? name "@")
-        '()
-        (regexp-split #rx"\\." name))))
+(define (name->path name)
+  (if (string=? name "@")
+      '()
+      (pregexp-split "\\." name)))
 
 (define (resolve-path stack path)
   (if (null? stack)
@@ -174,7 +225,7 @@
             (resolve-path (cdr stack) path)))))
 
 (define (resolve-path-in-object context path)
-  (let ([nothing (gensym)])
+  (let ([nothing (cons #f #f)])
     (cond [(null? path)
            (values context #t)]
           [(dict? context)
@@ -191,50 +242,49 @@
            (values #f #f)])))
 
 (define (find-formatter name)
-  (cdr (assoc (if (string? name)
-                  name
-                  (bytes->string/utf-8 name))
-              (formatters))))
+  (cdr (assoc name (formatters))))
 
 (define (expand-template template stack default-formatter)
-  (for ([thing template])
-    (match thing
-      [(repeated-section name body alternative alternates-with)
-       (let ([context (resolve-path stack (name->path name))])
-         (if (or (false? context)
-                 (null? (sequence->list context)))
-             (when alternative
-               (expand-template alternative
+  (for-each
+   (λ (thing)
+    (cond
+      [(repeated-section? thing)
+       (let ([context (resolve-path stack (name->path (section-name thing)))])
+         (if (or (not context)
+                 (null? context))
+             (when (section-alternative thing)
+               (expand-template (section-alternative thing)
                                 (cons context stack)
                                 default-formatter))
              (let ([first-iteration? #t])
-               (for ([value context])
-                 (when alternates-with
+               (for-each
+                (λ (value)
+                 (when (repeated-section-alternates-with thing)
                    (if first-iteration?
                        (set! first-iteration? #f)
-                       (expand-template alternates-with
+                       (expand-template (repeated-section-alternates-with thing)
                                         stack
                                         default-formatter)))
-                 (expand-template body
+                 (expand-template (section-body thing)
                                   (cons value stack)
-                                  default-formatter)))))]
-      [(section name body alternative)
-       (let ([context (resolve-path stack (name->path name))])
+                                  default-formatter))
+                context))))]
+      [(section? thing)
+       (let ([context (resolve-path stack (name->path (section-name thing)))])
          (if context
-             (expand-template body
+             (expand-template (section-body thing)
                               (cons context stack)
                               default-formatter)
-             (when alternative
-               (expand-template alternative
+             (when (section-alternative thing)
+               (expand-template (section-alternative thing)
                                 (cons context stack)
                                 default-formatter))))]
-      [(substitution name formatter args)
-       (display ((find-formatter (or formatter default-formatter))
-                 (resolve-path stack (name->path name))))]
-      [_
-       (display thing)])))
-
-
+      [(substitution? thing)
+       (display ((find-formatter (or (substitution-formatter thing) default-formatter))
+                 (resolve-path stack (name->path (substitution-name thing)))))]
+      [else
+       (display thing)]))
+   template))
 
 (define (make-escaper replacements)
   (let* ([escapees  (map car replacements)]
@@ -242,48 +292,48 @@
          [re        (regexp
                      (string-append "^(.*?)"
                                     "(?:("
-                                    (foldl (λ (x acc)
-                                             (string-append acc
-                                                            ")|("
-                                                            (regexp-quote (string x))))
-                                           (regexp-quote (string (car escapees)))
-                                           (cdr escapees))
+                                    (fold-left (λ (acc x)
+                                                 (string-append acc
+                                                                ")|("
+                                                                (pregexp-quote (string x))))
+                                               (pregexp-quote (string (car escapees)))
+                                               (cdr escapees))
                                     "))"
                                     "|$"))])
     (λ (thing)
-        (with-output-to-string
-         (λ ()
-           (with-input-from-string
-            (if (string? thing)
-                thing
-                (format "~a" thing))
-            (λ ()
-              (let loop ()
-                (unless (eof-object? (peek-byte))
-                  (match-let ([(list* _ raw-text escapee-matches)
-                               (regexp-match re (current-input-port))])
-                    (when raw-text
-                      (display raw-text))
-                    (for ([x escapee-matches]
-                          [y escapings])
-                      (when x
-                        (display y)))
-                    (loop)))))))))))
+        (call-with-string-output-port
+         (λ (out)
+           (let ([in (open-string-input-port (if (string? thing)
+                                                 thing
+                                                 (format "~a" thing)))])
+             (let loop ()
+               (if (eof-object? (peek-char in))
+                   (values)
+                   (let* ([m               (pregexp-match re in)]
+                          [raw-text        (and m (cadr m))]
+                          [escapee-matches (and m (cddr m))])
+                     (when raw-text
+                       (display raw-text out))
+                     (for-each (λ (x y)
+                                 (when x
+                                   (display y out)))
+                               escapee-matches
+                               escapings)
+                     (loop))))))))))
 
 
 (define (escape-for-uri thing)
-  (with-output-to-string
-    (λ ()
-      (for ([char (in-string (if (string? thing)
-                                 thing
-                                 (format "~a" thing)))])
+  (call-with-string-output-port
+    (λ (out)
+      (for-each
+       (λ (char)
         (let ((cnum (char->integer char)))
           (if (or (<= (char->integer #\A) cnum (char->integer #\Z))
                   (<= (char->integer #\a) cnum (char->integer #\z))
                   (<= (char->integer #\0) cnum (char->integer #\9))
                   (member char
                           '(#\$ #\- #\_ #\. #\+ #\! #\* #\( #\) #\')))
-              (display char)
+              (display char out)
               ;; FIXME: This assumes that (< cnum 256).
               ;; Maybe we should interpret the data as a byte string
               ;; rather than as a string.  W3C says we ought to use
@@ -292,8 +342,11 @@
               ;;
               ;;  http://www.w3.org/International/O-URL-code.html
               (if (< cnum 16)
-                  (printf "%0~x" cnum)
-                  (printf "%~x"  cnum))))))))
+                  (display (format "%0~x" cnum) out)
+                  (display (format "%~x"  cnum) out)))))
+        (if (string? thing)
+            thing
+            (format "~a" thing))))))
 
 
 (define formatters
@@ -311,8 +364,7 @@
 
 
 #;
-(let ([template (with-input-from-string
-                 #<<EOF
+(let ([template (make-template "
 <h1>{title|html}</h1>
 {.section people}
 <ul>
@@ -323,10 +375,10 @@
 {.or}
 <p>No one's registered.</p>
 {.end}
-EOF
-                  (λ () (read-template)))])
+")])
   (template '((title . "<Registered People>")
               (people .
                       (((name . "Nathalie") (age . 24))
                        ((name . "Heinrich") (age . 28))
                        ((name . "Hans")     (age . 25)))))))
+)
-- 
cgit v1.2.3


From f7699c7f504602aa49c173a36909a9270dab3122 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Thu, 23 Jun 2011 13:18:04 +0200
Subject: Remove Racket-isms.

---
 json-template.rkt | 42 ++++++++++++++----------------------------
 1 file changed, 14 insertions(+), 28 deletions(-)

diff --git a/json-template.rkt b/json-template.rkt
index ebbe1bb..0cd2b40 100755
--- a/json-template.rkt
+++ b/json-template.rkt
@@ -12,25 +12,10 @@
  (import (rnrs base) (rnrs programs) (rnrs unicode) (rnrs lists) (rnrs control)
          (rnrs records syntactic) (rnrs records procedural) (rnrs records inspection)
          (rnrs exceptions) (rnrs conditions) (rnrs io simple) (rnrs io ports) (rnrs hashtables)
-         (rnrs r5rs) (srfi :39) (srfi :28)
-         ;; Racket-specific:
-         (only (racket)
-               regexp-quote regexp-replace regexp regexp-split regexp-match)
-         (only (racket mpair)
-               list->mlist)
-         
-         )
- 
- ;; Racket-specific:
- (define pregexp-quote regexp-quote)
- (define pregexp-split (lambda args (list->mlist (apply regexp-split args))))
- (define pregexp regexp)
- (define pregexp-replace regexp-replace)
- (define pregexp-match
-   (lambda args
-     (let ([m (apply regexp-match args)])
-       (and m
-            (list->mlist m)))))
+         (rnrs r5rs)
+         (srfi :39) (srfi :28)
+         (pregexp))
+
  
 (define meta-left (make-parameter "{"))
 (define meta-right (make-parameter "}"))
@@ -66,7 +51,7 @@
 (define (template-string->chunks input meta-left meta-right)
   (let* ([meta-left-re   (pregexp-quote meta-left)]
          [meta-right-re  (pregexp-quote meta-right)]
-         [re (regexp
+         [re (pregexp
               (string-append "(" meta-left-re ")|(" meta-right-re ")"))])
     (pregexp-split re input)))
 
@@ -289,7 +274,7 @@
 (define (make-escaper replacements)
   (let* ([escapees  (map car replacements)]
          [escapings (map cdr replacements)]
-         [re        (regexp
+         [re        (pregexp
                      (string-append "^(.*?)"
                                     "(?:("
                                     (fold-left (λ (acc x)
@@ -303,13 +288,14 @@
     (λ (thing)
         (call-with-string-output-port
          (λ (out)
-           (let ([in (open-string-input-port (if (string? thing)
-                                                 thing
-                                                 (format "~a" thing)))])
-             (let loop ()
-               (if (eof-object? (peek-char in))
+           (let ([input (if (string? thing)
+                            thing
+                            (format "~a" thing))])
+             (let loop ([position 0])
+               (if (>= position (string-length input))
                    (values)
-                   (let* ([m               (pregexp-match re in)]
+                   (let* ([m               (pregexp-match re input position)]
+                          [positions       (pregexp-match-positions re input position)]
                           [raw-text        (and m (cadr m))]
                           [escapee-matches (and m (cddr m))])
                      (when raw-text
@@ -319,7 +305,7 @@
                                    (display y out)))
                                escapee-matches
                                escapings)
-                     (loop))))))))))
+                     (loop (cdar positions)))))))))))
 
 
 (define (escape-for-uri thing)
-- 
cgit v1.2.3


From 9b1ab002261f65379cbcbe0c2d9e5f60233f6544 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Thu, 23 Jun 2011 13:23:26 +0200
Subject: Change file extension from .rkt to .s6l.

---
 json-template.s6l | 370 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 370 insertions(+)
 create mode 100755 json-template.s6l

diff --git a/json-template.s6l b/json-template.s6l
new file mode 100755
index 0000000..7d88833
--- /dev/null
+++ b/json-template.s6l
@@ -0,0 +1,370 @@
+#!r6rs
+;;; -*- mode: scheme; coding: utf-8 -*-
+;;; Copyright 2011, Matthias Andreas Benkard.
+
+(library (json-template)
+ (export make-template
+         formatters
+         meta-left
+         meta-right
+         default-formatter
+         format-char)
+ (import (rnrs base) (rnrs programs) (rnrs unicode) (rnrs lists) (rnrs control)
+         (rnrs records syntactic) (rnrs records procedural) (rnrs records inspection)
+         (rnrs exceptions) (rnrs conditions) (rnrs io simple) (rnrs io ports) (rnrs hashtables)
+         (rnrs r5rs)
+         (srfi :39) (srfi :28)
+         (pregexp))
+
+ 
+(define meta-left (make-parameter "{"))
+(define meta-right (make-parameter "}"))
+(define default-formatter (make-parameter "raw"))
+(define format-char (make-parameter "|"))
+
+(define-syntax λ
+  (syntax-rules ()
+    [(_ forms ...)
+     (lambda forms ...)]))
+
+(define (dict? x)
+  (or (list? x)
+      (hashtable? x)))
+
+(define (dict-ref dict key default)
+  (let* ([default-default (cons #f #f)]
+         [result
+          (cond
+            [(list? dict)
+             (let ([result-cons (assoc key dict)])
+               (if result-cons
+                   (cdr result-cons)
+                   default-default))]
+            [(hashtable? dict)
+             (hashtable-ref dict key default-default)])])
+    (if (eq? result default-default)
+        (if (procedure? default)
+            (default)
+            default)
+        result)))
+
+(define (template-string->chunks input meta-left meta-right)
+  (let* ([meta-left-re   (pregexp-quote meta-left)]
+         [meta-right-re  (pregexp-quote meta-right)]
+         [re (pregexp
+              (string-append "(" meta-left-re ")|(" meta-right-re ")"))])
+    (pregexp-split re input)))
+
+(define (flip-flop-map f1 f2 lst)
+  "Like map, but alternate between f1 and f2 as the function to apply."
+  (letrec ((flip (λ (items)
+                   (cond
+                     [(null? items)'()]
+                     [else         (cons (f1 (car items)) (flop (cdr items)))])))
+           (flop (λ (items)
+                   (cond
+                     [(null? items)'()]
+                     [else         (cons (f2 (car items)) (flip (cdr items)))]))))
+    (flip lst)))
+
+(define (classify-chunks chunks format-char)
+  (flip-flop-map (λ (x) x)
+                 (λ (x) (parse-directive x format-char))
+                 chunks))
+
+(define (parse-directive directive format-char)
+  (cond
+    [(pregexp-match "^#" directive)
+     #f]
+    [(pregexp-match "^\\.section[ \t]+(.*)$" directive)
+     => (λ (x) (list 'section (cadr x)))]
+    [(pregexp-match "^\\.repeated[ \t]+section[ \t]+(.*)$" directive)
+     => (λ (x) (list 'repeated-section (cadr x)))]
+    [(string=? ".end" directive)
+     (list 'end)]
+    [(string=? ".or" directive)
+     (list 'or)]
+    [(pregexp-match "^\\.alternates\\s+with$" directive)
+     (list 'alternates-with)]
+    [else
+     (cons 'substitute (pregexp-split (pregexp-quote format-char)
+                                            directive))]))
+  
+(define (remove-spurious-newlines-from-token-groups groups)
+  (let ([last-was-directive? #f])
+    (map
+      (λ (group)
+        (if last-was-directive?
+            (begin
+              (set! last-was-directive? (pair? group))
+              (if (string? group)
+                  (pregexp-replace "^\n" group "")
+                  group))
+            (begin
+              (set! last-was-directive? (pair? group))
+              group)))
+      groups)))
+
+(define-record-type section
+  (fields (immutable name)
+          (immutable body)
+          (immutable alternative)))
+
+(define-record-type repeated-section
+  (parent section)
+  (fields (immutable alternates-with)))
+
+(define-record-type substitution
+  (fields (immutable name)
+          (immutable formatter)
+          (immutable arguments)))
+
+(define (parse-structure parsed-groups)
+  (let loop ([parsed-groups parsed-groups]
+             [clauses '()])
+    (if (or (null? parsed-groups)
+            (and (pair? (car parsed-groups))
+                 (memq (caar parsed-groups) '(end or alternates-with))))
+        (values (reverse clauses)
+                (and (pair? parsed-groups) (caar parsed-groups))
+                (if (pair? parsed-groups) (cdr parsed-groups) '()))
+        (let ([grp (car parsed-groups)])
+          (cond
+            [(string? grp)
+             (loop (cdr parsed-groups)
+                   (cons grp clauses))]
+            [(eq? (car grp) 'section)
+             (let-values ([(stuff reason rest)
+                           (parse-structure (cdr parsed-groups))])
+               (case reason
+                 [(or)
+                  (let-values ([(stuff2 _ rest2)
+                                (parse-structure rest)])
+                    (loop rest2 (cons (make-section (cadr grp) stuff stuff2) clauses)))]
+                 [(end)
+                  (loop rest (cons (make-section (cadr grp) stuff #f) clauses))]))]
+          [(eq? (car grp) 'repeated-section)
+           (let inner-loop ([subsections '()]
+                            [rest (cdr parsed-groups)])
+             (let-values ([(stuff reason new-rest)
+                           (parse-structure rest)])
+               (when (not reason)
+                 (error "Premature end of file."))
+               (if (eq? reason 'end)
+                   (let inner-inner-loop
+                       ([subsections (cons (cons 'end stuff) subsections)]
+                        [alternative #f]
+                        [alternates-with #f])
+                     (if (null? (cdr subsections))
+                         (loop new-rest
+                               (cons (make-repeated-section (cadr grp)
+                                                            (cdar subsections)
+                                                            alternative
+                                                            alternates-with)
+                                     clauses))
+                         (case (caadr subsections)
+                           [(alternates-with)
+                            (inner-inner-loop (cdr subsections)
+                                              alternative
+                                              (cdar subsections))]
+                           [(or)
+                            (inner-inner-loop (cdr subsections)
+                                              (cdar subsections)
+                                              alternates-with)]
+                           [else
+                            (error "Oh no, I don't know what I'm doing here!  Subsections:" subsections)])))
+                   (inner-loop (cons (cons reason stuff) subsections) new-rest))))]
+          [(eq? (car grp) 'substitute)
+           (loop (cdr parsed-groups)
+                 (if (null? (cddr grp))
+                     (cons (make-substitution (cadr grp) #f '()) clauses)
+                     (cons (make-substitution (cadr grp) (caddr grp) (cdddr grp)) clauses)))])))))
+
+(define (parse-structure* x)
+  (let-values ([(stuff reason rest) (parse-structure x)])
+    stuff))
+
+(define (make-template template-string)
+  (let ([template-data
+         (parse-structure*
+          (remove-spurious-newlines-from-token-groups
+           (classify-chunks (template-string->chunks template-string
+                                                     (meta-left) (meta-right))
+                            (format-char))))])
+    (let ([default-formatter (default-formatter)])
+      (λ (context)
+        (expand-template template-data (list context) default-formatter)))))
+
+(define (name->path name)
+  (if (string=? name "@")
+      '()
+      (pregexp-split "\\." name)))
+
+(define (resolve-path stack path)
+  (if (null? stack)
+      #f
+      (let-values ([(value success?)
+                    (resolve-path-in-object (car stack) path)])
+        (if success?
+            value
+            (resolve-path (cdr stack) path)))))
+
+(define (resolve-path-in-object context path)
+  (let ([nothing (cons #f #f)])
+    (cond [(null? path)
+           (values context #t)]
+          [(dict? context)
+           (let ([y (dict-ref context
+                              (car path)
+                              (λ ()
+                                (dict-ref context
+                                          (string->symbol (car path))
+                                          nothing)))])
+             (if (eq? y nothing)
+                 (values #f #f)
+                 (resolve-path-in-object y (cdr path))))]
+          [else
+           (values #f #f)])))
+
+(define (find-formatter name)
+  (cdr (assoc name (formatters))))
+
+(define (expand-template template stack default-formatter)
+  (for-each
+   (λ (thing)
+    (cond
+      [(repeated-section? thing)
+       (let ([context (resolve-path stack (name->path (section-name thing)))])
+         (if (or (not context)
+                 (null? context))
+             (when (section-alternative thing)
+               (expand-template (section-alternative thing)
+                                (cons context stack)
+                                default-formatter))
+             (let ([first-iteration? #t])
+               (for-each
+                (λ (value)
+                 (when (repeated-section-alternates-with thing)
+                   (if first-iteration?
+                       (set! first-iteration? #f)
+                       (expand-template (repeated-section-alternates-with thing)
+                                        stack
+                                        default-formatter)))
+                 (expand-template (section-body thing)
+                                  (cons value stack)
+                                  default-formatter))
+                context))))]
+      [(section? thing)
+       (let ([context (resolve-path stack (name->path (section-name thing)))])
+         (if context
+             (expand-template (section-body thing)
+                              (cons context stack)
+                              default-formatter)
+             (when (section-alternative thing)
+               (expand-template (section-alternative thing)
+                                (cons context stack)
+                                default-formatter))))]
+      [(substitution? thing)
+       (display ((find-formatter (or (substitution-formatter thing) default-formatter))
+                 (resolve-path stack (name->path (substitution-name thing)))))]
+      [else
+       (display thing)]))
+   template))
+
+(define (make-escaper replacements)
+  (let* ([escapees  (map car replacements)]
+         [escapings (map cdr replacements)]
+         [re        (pregexp
+                     (string-append "^(.*?)"
+                                    "(?:("
+                                    (fold-left (λ (acc x)
+                                                 (string-append acc
+                                                                ")|("
+                                                                (pregexp-quote (string x))))
+                                               (pregexp-quote (string (car escapees)))
+                                               (cdr escapees))
+                                    "))"
+                                    "|$"))])
+    (λ (thing)
+        (call-with-string-output-port
+         (λ (out)
+           (let ([input (if (string? thing)
+                            thing
+                            (format "~a" thing))])
+             (let loop ([position 0])
+               (if (>= position (string-length input))
+                   (values)
+                   (let* ([m               (pregexp-match re input position)]
+                          [positions       (pregexp-match-positions re input position)]
+                          [raw-text        (and m (cadr m))]
+                          [escapee-matches (and m (cddr m))])
+                     (when raw-text
+                       (display raw-text out))
+                     (for-each (λ (x y)
+                                 (when x
+                                   (display y out)))
+                               escapee-matches
+                               escapings)
+                     (loop (cdar positions)))))))))))
+
+
+(define (escape-for-uri thing)
+  (call-with-string-output-port
+    (λ (out)
+      (for-each
+       (λ (char)
+        (let ((cnum (char->integer char)))
+          (if (or (<= (char->integer #\A) cnum (char->integer #\Z))
+                  (<= (char->integer #\a) cnum (char->integer #\z))
+                  (<= (char->integer #\0) cnum (char->integer #\9))
+                  (member char
+                          '(#\$ #\- #\_ #\. #\+ #\! #\* #\( #\) #\')))
+              (display char out)
+              ;; FIXME: This assumes that (< cnum 256).
+              ;; Maybe we should interpret the data as a byte string
+              ;; rather than as a string.  W3C says we ought to use
+              ;; UTF-8 encoding, which is consistent with the Racket
+              ;; default encoding:
+              ;;
+              ;;  http://www.w3.org/International/O-URL-code.html
+              (if (< cnum 16)
+                  (display (format "%0~x" cnum) out)
+                  (display (format "%~x"  cnum) out)))))
+        (if (string? thing)
+            thing
+            (format "~a" thing))))))
+
+
+(define formatters
+  (make-parameter
+   `(("html"            . ,(make-escaper '((#\< . "&#60;")
+                                           (#\> . "&#62;")
+                                           (#\& . "&#38;"))))
+     ("html-attr-value" . ,(make-escaper '((#\< . "&#60;")
+                                           (#\> . "&#62;")
+                                           (#\& . "&#38;")
+                                           (#\' . "&#39;")
+                                           (#\" . "&#34;"))))
+     ("url-param-value" . ,escape-for-uri)
+     ("raw"             . ,(λ (x) x)))))
+
+
+#;
+(let ([template (make-template "
+<h1>{title|html}</h1>
+{.section people}
+<ul>
+{.repeated section @}
+  <li>{name} ({age} years)</li>
+{.end}
+</ul>
+{.or}
+<p>No one's registered.</p>
+{.end}
+")])
+  (template '((title . "<Registered People>")
+              (people .
+                      (((name . "Nathalie") (age . 24))
+                       ((name . "Heinrich") (age . 28))
+                       ((name . "Hans")     (age . 25)))))))
+)
-- 
cgit v1.2.3


From dc7023ed6909aef82917930bb4b6da0bc776de89 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Thu, 23 Jun 2011 14:53:34 +0200
Subject: Remove json-template.rkt.

---
 json-template.rkt | 370 ------------------------------------------------------
 1 file changed, 370 deletions(-)
 delete mode 100755 json-template.rkt

diff --git a/json-template.rkt b/json-template.rkt
deleted file mode 100755
index 0cd2b40..0000000
--- a/json-template.rkt
+++ /dev/null
@@ -1,370 +0,0 @@
-#!r6rs
-;;; -*- mode: scheme; coding: utf-8 -*-
-;;; Copyright 2011, Matthias Andreas Benkard.
-
-(library (json-template)
- (export make-template
-         formatters
-         meta-left
-         meta-right
-         default-formatter
-         format-char)
- (import (rnrs base) (rnrs programs) (rnrs unicode) (rnrs lists) (rnrs control)
-         (rnrs records syntactic) (rnrs records procedural) (rnrs records inspection)
-         (rnrs exceptions) (rnrs conditions) (rnrs io simple) (rnrs io ports) (rnrs hashtables)
-         (rnrs r5rs)
-         (srfi :39) (srfi :28)
-         (pregexp))
-
- 
-(define meta-left (make-parameter "{"))
-(define meta-right (make-parameter "}"))
-(define default-formatter (make-parameter "raw"))
-(define format-char (make-parameter "|"))
-
-(define-syntax λ
-  (syntax-rules ()
-    [(_ forms ...)
-     (lambda forms ...)]))
-
-(define (dict? x)
-  (or (list? x)
-      (hashtable? x)))
-
-(define (dict-ref dict key default)
-  (let* ([default-default (cons #f #f)]
-         [result
-          (cond
-            [(list? dict)
-             (let ([result-cons (assoc key dict)])
-               (if result-cons
-                   (cdr result-cons)
-                   default-default))]
-            [(hashtable? dict)
-             (hashtable-ref dict key default-default)])])
-    (if (eq? result default-default)
-        (if (procedure? default)
-            (default)
-            default)
-        result)))
-
-(define (template-string->chunks input meta-left meta-right)
-  (let* ([meta-left-re   (pregexp-quote meta-left)]
-         [meta-right-re  (pregexp-quote meta-right)]
-         [re (pregexp
-              (string-append "(" meta-left-re ")|(" meta-right-re ")"))])
-    (pregexp-split re input)))
-
-(define (flip-flop-map f1 f2 lst)
-  "Like map, but alternate between f1 and f2 as the function to apply."
-  (letrec ((flip (λ (items)
-                   (cond
-                     [(null? items)'()]
-                     [else         (cons (f1 (car items)) (flop (cdr items)))])))
-           (flop (λ (items)
-                   (cond
-                     [(null? items)'()]
-                     [else         (cons (f2 (car items)) (flip (cdr items)))]))))
-    (flip lst)))
-
-(define (classify-chunks chunks format-char)
-  (flip-flop-map (λ (x) x)
-                 (λ (x) (parse-directive x format-char))
-                 chunks))
-
-(define (parse-directive directive format-char)
-  (cond
-    [(pregexp-match "^#" directive)
-     #f]
-    [(pregexp-match "^\\.section[ \t]+(.*)$" directive)
-     => (λ (x) (list 'section (cadr x)))]
-    [(pregexp-match "^\\.repeated[ \t]+section[ \t]+(.*)$" directive)
-     => (λ (x) (list 'repeated-section (cadr x)))]
-    [(string=? ".end" directive)
-     (list 'end)]
-    [(string=? ".or" directive)
-     (list 'or)]
-    [(pregexp-match "^\\.alternates\\s+with$" directive)
-     (list 'alternates-with)]
-    [else
-     (cons 'substitute (pregexp-split (pregexp-quote format-char)
-                                            directive))]))
-  
-(define (remove-spurious-newlines-from-token-groups groups)
-  (let ([last-was-directive? #f])
-    (map
-      (λ (group)
-        (if last-was-directive?
-            (begin
-              (set! last-was-directive? (pair? group))
-              (if (string? group)
-                  (pregexp-replace "^\n" group "")
-                  group))
-            (begin
-              (set! last-was-directive? (pair? group))
-              group)))
-      groups)))
-
-(define-record-type section
-  (fields (immutable name)
-          (immutable body)
-          (immutable alternative)))
-
-(define-record-type repeated-section
-  (parent section)
-  (fields (immutable alternates-with)))
-
-(define-record-type substitution
-  (fields (immutable name)
-          (immutable formatter)
-          (immutable arguments)))
-
-(define (parse-structure parsed-groups)
-  (let loop ([parsed-groups parsed-groups]
-             [clauses '()])
-    (if (or (null? parsed-groups)
-            (and (pair? (car parsed-groups))
-                 (memq (caar parsed-groups) '(end or alternates-with))))
-        (values (reverse clauses)
-                (and (pair? parsed-groups) (caar parsed-groups))
-                (if (pair? parsed-groups) (cdr parsed-groups) '()))
-        (let ([grp (car parsed-groups)])
-          (cond
-            [(string? grp)
-             (loop (cdr parsed-groups)
-                   (cons grp clauses))]
-            [(eq? (car grp) 'section)
-             (let-values ([(stuff reason rest)
-                           (parse-structure (cdr parsed-groups))])
-               (case reason
-                 [(or)
-                  (let-values ([(stuff2 _ rest2)
-                                (parse-structure rest)])
-                    (loop rest2 (cons (make-section (cadr grp) stuff stuff2) clauses)))]
-                 [(end)
-                  (loop rest (cons (make-section (cadr grp) stuff #f) clauses))]))]
-          [(eq? (car grp) 'repeated-section)
-           (let inner-loop ([subsections '()]
-                            [rest (cdr parsed-groups)])
-             (let-values ([(stuff reason new-rest)
-                           (parse-structure rest)])
-               (when (not reason)
-                 (error "Premature end of file."))
-               (if (eq? reason 'end)
-                   (let inner-inner-loop
-                       ([subsections (cons (cons 'end stuff) subsections)]
-                        [alternative #f]
-                        [alternates-with #f])
-                     (if (null? (cdr subsections))
-                         (loop new-rest
-                               (cons (make-repeated-section (cadr grp)
-                                                            (cdar subsections)
-                                                            alternative
-                                                            alternates-with)
-                                     clauses))
-                         (case (caadr subsections)
-                           [(alternates-with)
-                            (inner-inner-loop (cdr subsections)
-                                              alternative
-                                              (cdar subsections))]
-                           [(or)
-                            (inner-inner-loop (cdr subsections)
-                                              (cdar subsections)
-                                              alternates-with)]
-                           [else
-                            (error "Oh no, I don't know what I'm doing here!  Subsections:" subsections)])))
-                   (inner-loop (cons (cons reason stuff) subsections) new-rest))))]
-          [(eq? (car grp) 'substitute)
-           (loop (cdr parsed-groups)
-                 (if (null? (cddr grp))
-                     (cons (make-substitution (cadr grp) #f '()) clauses)
-                     (cons (make-substitution (cadr grp) (caddr grp) (cdddr grp)) clauses)))])))))
-
-(define (parse-structure* x)
-  (let-values ([(stuff reason rest) (parse-structure x)])
-    stuff))
-
-(define (make-template template-string)
-  (let ([template-data
-         (parse-structure*
-          (remove-spurious-newlines-from-token-groups
-           (classify-chunks (template-string->chunks template-string
-                                                     (meta-left) (meta-right))
-                            (format-char))))])
-    (let ([default-formatter (default-formatter)])
-      (λ (context)
-        (expand-template template-data (list context) default-formatter)))))
-
-(define (name->path name)
-  (if (string=? name "@")
-      '()
-      (pregexp-split "\\." name)))
-
-(define (resolve-path stack path)
-  (if (null? stack)
-      #f
-      (let-values ([(value success?)
-                    (resolve-path-in-object (car stack) path)])
-        (if success?
-            value
-            (resolve-path (cdr stack) path)))))
-
-(define (resolve-path-in-object context path)
-  (let ([nothing (cons #f #f)])
-    (cond [(null? path)
-           (values context #t)]
-          [(dict? context)
-           (let ([y (dict-ref context
-                              (car path)
-                              (λ ()
-                                (dict-ref context
-                                          (string->symbol (car path))
-                                          nothing)))])
-             (if (eq? y nothing)
-                 (values #f #f)
-                 (resolve-path-in-object y (cdr path))))]
-          [else
-           (values #f #f)])))
-
-(define (find-formatter name)
-  (cdr (assoc name (formatters))))
-
-(define (expand-template template stack default-formatter)
-  (for-each
-   (λ (thing)
-    (cond
-      [(repeated-section? thing)
-       (let ([context (resolve-path stack (name->path (section-name thing)))])
-         (if (or (not context)
-                 (null? context))
-             (when (section-alternative thing)
-               (expand-template (section-alternative thing)
-                                (cons context stack)
-                                default-formatter))
-             (let ([first-iteration? #t])
-               (for-each
-                (λ (value)
-                 (when (repeated-section-alternates-with thing)
-                   (if first-iteration?
-                       (set! first-iteration? #f)
-                       (expand-template (repeated-section-alternates-with thing)
-                                        stack
-                                        default-formatter)))
-                 (expand-template (section-body thing)
-                                  (cons value stack)
-                                  default-formatter))
-                context))))]
-      [(section? thing)
-       (let ([context (resolve-path stack (name->path (section-name thing)))])
-         (if context
-             (expand-template (section-body thing)
-                              (cons context stack)
-                              default-formatter)
-             (when (section-alternative thing)
-               (expand-template (section-alternative thing)
-                                (cons context stack)
-                                default-formatter))))]
-      [(substitution? thing)
-       (display ((find-formatter (or (substitution-formatter thing) default-formatter))
-                 (resolve-path stack (name->path (substitution-name thing)))))]
-      [else
-       (display thing)]))
-   template))
-
-(define (make-escaper replacements)
-  (let* ([escapees  (map car replacements)]
-         [escapings (map cdr replacements)]
-         [re        (pregexp
-                     (string-append "^(.*?)"
-                                    "(?:("
-                                    (fold-left (λ (acc x)
-                                                 (string-append acc
-                                                                ")|("
-                                                                (pregexp-quote (string x))))
-                                               (pregexp-quote (string (car escapees)))
-                                               (cdr escapees))
-                                    "))"
-                                    "|$"))])
-    (λ (thing)
-        (call-with-string-output-port
-         (λ (out)
-           (let ([input (if (string? thing)
-                            thing
-                            (format "~a" thing))])
-             (let loop ([position 0])
-               (if (>= position (string-length input))
-                   (values)
-                   (let* ([m               (pregexp-match re input position)]
-                          [positions       (pregexp-match-positions re input position)]
-                          [raw-text        (and m (cadr m))]
-                          [escapee-matches (and m (cddr m))])
-                     (when raw-text
-                       (display raw-text out))
-                     (for-each (λ (x y)
-                                 (when x
-                                   (display y out)))
-                               escapee-matches
-                               escapings)
-                     (loop (cdar positions)))))))))))
-
-
-(define (escape-for-uri thing)
-  (call-with-string-output-port
-    (λ (out)
-      (for-each
-       (λ (char)
-        (let ((cnum (char->integer char)))
-          (if (or (<= (char->integer #\A) cnum (char->integer #\Z))
-                  (<= (char->integer #\a) cnum (char->integer #\z))
-                  (<= (char->integer #\0) cnum (char->integer #\9))
-                  (member char
-                          '(#\$ #\- #\_ #\. #\+ #\! #\* #\( #\) #\')))
-              (display char out)
-              ;; FIXME: This assumes that (< cnum 256).
-              ;; Maybe we should interpret the data as a byte string
-              ;; rather than as a string.  W3C says we ought to use
-              ;; UTF-8 encoding, which is consistent with the Racket
-              ;; default encoding:
-              ;;
-              ;;  http://www.w3.org/International/O-URL-code.html
-              (if (< cnum 16)
-                  (display (format "%0~x" cnum) out)
-                  (display (format "%~x"  cnum) out)))))
-        (if (string? thing)
-            thing
-            (format "~a" thing))))))
-
-
-(define formatters
-  (make-parameter
-   `(("html"            . ,(make-escaper '((#\< . "&#60;")
-                                           (#\> . "&#62;")
-                                           (#\& . "&#38;"))))
-     ("html-attr-value" . ,(make-escaper '((#\< . "&#60;")
-                                           (#\> . "&#62;")
-                                           (#\& . "&#38;")
-                                           (#\' . "&#39;")
-                                           (#\" . "&#34;"))))
-     ("url-param-value" . ,escape-for-uri)
-     ("raw"             . ,(λ (x) x)))))
-
-
-#;
-(let ([template (make-template "
-<h1>{title|html}</h1>
-{.section people}
-<ul>
-{.repeated section @}
-  <li>{name} ({age} years)</li>
-{.end}
-</ul>
-{.or}
-<p>No one's registered.</p>
-{.end}
-")])
-  (template '((title . "<Registered People>")
-              (people .
-                      (((name . "Nathalie") (age . 24))
-                       ((name . "Heinrich") (age . 28))
-                       ((name . "Hans")     (age . 25)))))))
-)
-- 
cgit v1.2.3


From 4058f72817bc4e268eab3bff8f43055343f148e6 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Thu, 23 Jun 2011 14:54:09 +0200
Subject: Add some documentation.

---
 info.rkt     |   2 ++
 manual.scrbl | 110 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 112 insertions(+)
 create mode 100644 info.rkt
 create mode 100644 manual.scrbl

diff --git a/info.rkt b/info.rkt
new file mode 100644
index 0000000..017c55c
--- /dev/null
+++ b/info.rkt
@@ -0,0 +1,2 @@
+#lang setup/infotab
+(define scribblings '(("manual.scrbl" ())))
diff --git a/manual.scrbl b/manual.scrbl
new file mode 100644
index 0000000..e372e34
--- /dev/null
+++ b/manual.scrbl
@@ -0,0 +1,110 @@
+#lang scribble/manual
+@(require scribble/eval)
+@(require racket/sandbox)
+@(require (for-label r6rs))
+@;@(require (for-label "json-template.s6l"))
+@(require "json-template.s6l")
+
+@;@defmodule/this-package[json-template]
+
+@(define r6rs-evaluator
+   (call-with-trusted-sandbox-configuration
+    (lambda ()
+      (parameterize ([sandbox-output 'string]
+                     [sandbox-error-output 'string])
+        (make-evaluator
+         'r6rs
+         '(import (rnrs) (json-template)))))))
+@(define racket-evaluator
+   (call-with-trusted-sandbox-configuration
+    (lambda ()
+      (parameterize ([sandbox-output 'string]
+                     [sandbox-error-output 'string])
+        (make-evaluator
+         'racket/base
+         #:requires (list 'json-template))))))
+
+
+@title{JSON Template for R6RS}
+@author{Matthias A. Benkard}
+
+
+@section{Installation}
+
+@subsection{Installing pregexp}
+
+Download the pregexp library from @url{http://evalwhen.com/pregexp/}.  Wrap @filepath{pregexp.scm} in the following form (replacing ``....'' with the file's original content):
+
+@schemeblock[
+(library (pregexp)
+  (export pregexp
+          pregexp-match
+          pregexp-match-positions
+          pregexp-split
+          pregexp-replace
+          pregexp-replace*
+          pregexp-quote)
+  (import (rnrs) (rnrs mutable-pairs))
+  
+  ....
+
+)
+]
+
+You can then install @filepath{pregexp.scm} as an R6RS library.  For details on how to do this, consult the manual of your Scheme implementation.
+
+As an example, @codeblock[@"plt-r6rs --install pregexp.scm"] will work on @hyperlink["http://racket-lang.org/"]{Racket}.
+
+
+@subsection{Installing JSON Template for R6RS}
+
+JSON Template for R6RS is provided as a ready-to-use R6RS library file.  Simply install @filepath{json-template.s6l} as per the manual of the Scheme implementation of your choice.
+
+On Racket, @codeblock[@"plt-r6rs --install json-template.s6l"] ought to work just fine.
+
+
+@section{Usage}
+
+@subsection{API}
+
+@defproc[(make-template [template-data string?]) procedure?]{
+  Create a template from @scheme[template-data], which must be in JSON Template syntax.
+
+  The returned procedure expects a single argument, the @italic{subtitution context}, and returns the expanded template as a string.  Three types of contexts are supported:
+
+  @itemlist[
+    @item{@bold{Primitive contexts.}  These may be of any form whatever (valid primitive contexts are lists, numbers, symbols, strings, etc.) and are not treated specially.  Their only purpose is being printed into the template expansion as plain text.  Note that a primitive context does not make a whole lot of sense when used as an argument to @scheme{make-template} (although it can be used as such and referenced as @scheme["@"]); it is much more commonly encountered as a nested context in a map.}
+    @item{@bold{Sequences.}  At present, these may only be lists.  They can be iterated over by the use of repeated sections.}
+    @item{@bold{Maps.}  These may be either hash tables or association lists.  They can be indexed into by substitutions.}
+  ]
+  
+  @scheme[make-template]'s behavior can be customized by the parameters @scheme[formatters], @scheme[meta-left], @scheme[meta-right], @scheme[default-formatter], and @scheme[format-char].
+
+  For general information about JSON Template, see @url{http://json-template.googlecode.com/svn/trunk/doc/Introducing-JSON-Template.html} and @url{http://code.google.com/p/json-template/wiki/Reference}.
+}
+
+
+@subsection{Examples}
+
+@interaction[#:eval r6rs-evaluator
+(define template (make-template "
+<h1>{title|html}</h1>
+{.section people}
+<ul>
+{.repeated section @}
+  <li>{name} ({age} years)</li>
+{.end}
+</ul>
+{.or}
+<p>No one's registered.</p>
+{.end}
+"))
+(template '((title . "<Registered People>")
+            (people .
+                    (((name . "Nathalie") (age . 24))
+                     ((name . "Heinrich") (age . 28))
+                     ((name . "Hans")     (age . 25))))))
+(template '((title . "<Registered People>")
+            (people)))
+(template '((title . "<Registered People>")))
+]
-- 
cgit v1.2.3


From d58e4b66b9ed2118d47947ea4fb960d7d7ca0620 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Thu, 23 Jun 2011 18:20:09 +0200
Subject: Do not activate a section for null? contexts.

---
 json-template.s6l | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/json-template.s6l b/json-template.s6l
index 7d88833..06a591b 100755
--- a/json-template.s6l
+++ b/json-template.s6l
@@ -256,7 +256,7 @@
                 context))))]
       [(section? thing)
        (let ([context (resolve-path stack (name->path (section-name thing)))])
-         (if context
+         (if (and context (not (null? context)))
              (expand-template (section-body thing)
                               (cons context stack)
                               default-formatter)
-- 
cgit v1.2.3


From f634effc069bceb552f73b571f7ad016e4889b45 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Thu, 23 Jun 2011 18:24:53 +0200
Subject: Minor cleanups.

---
 manual.scrbl | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/manual.scrbl b/manual.scrbl
index e372e34..109ea24 100644
--- a/manual.scrbl
+++ b/manual.scrbl
@@ -3,9 +3,6 @@
 @(require racket/sandbox)
 @(require (for-label r6rs))
 @;@(require (for-label "json-template.s6l"))
-@(require "json-template.s6l")
-
-@;@defmodule/this-package[json-template]
 
 @(define r6rs-evaluator
    (call-with-trusted-sandbox-configuration
-- 
cgit v1.2.3