Adding customization of command-char to web-server/template

This entails adding it to include/text and read-syntax-inside as well.

collects/scribble/reader.rkt

@@ -645,5 +645,8 @@
 (provide read-inside read-syntax-inside)
 (define (read-inside [inp (current-input-port)])
   (syntax->datum ((make-default-at-reader/inside) default-src inp)))
-(define (read-syntax-inside [src default-src] [inp (current-input-port)])
+(define (read-syntax-inside [src default-src] [inp (current-input-port)] 
-  ((make-default-at-reader/inside) src inp))
+                            #:command-char [command-char ch:command])
+  (((readtable-cached
+     (lambda (rt) (make-at-reader #:inside? #t #:command-char command-char #:readtable rt))))
+   src inp))

collects/scribble/text/syntax-utils.rkt

@@ -172,22 +172,32 @@
      #'(process-begin/text begin/collect begin expr ...)]))
 
 ;; include for templates
-(require (for-syntax scheme/base (prefix-in scribble: "../reader.rkt"))
+(require (for-syntax scheme/base (prefix-in scribble: "../reader.rkt") syntax/parse)
          scheme/include)
-(define-syntax-rule (include/text path-spec)
+(define-syntax (include/text stx)
-  (begin/text
+  (syntax-case stx ()
-   (include-at/relative-to/reader path-spec path-spec path-spec
+    [(_ path-spec)
-     (let ([xs #f])
+     (syntax/loc stx
-       (λ (src inp)
+       (include/text #:command-char #f path-spec))]
-         (unless xs
+    [(_ #:command-char command-char path-spec)
-           (set! xs (scribble:read-syntax-inside src inp))
+     (syntax/loc stx
-           (when (syntax? xs) (set! xs (or (syntax->list xs) (list xs)))))
+       (begin/text
-         (if (null? xs)
+        (include-at/relative-to/reader 
-           eof
+         path-spec path-spec path-spec
-           (let ([x (car xs)])
+         (let ([xs #f]
-             (set! xs (cdr xs))
+               [command-char-v command-char])
-             (if (and (null? xs)
+           (λ (src inp)
-                      (let ([p (syntax-property x 'scribble)])
+             (unless xs
-                        (and (pair? p) (eq? (car p) 'newline))))
+               (set! xs (if command-char-v
-               eof ; throw away the last newline from the included file
+                          (scribble:read-syntax-inside #:command-char command-char-v src inp)
-               x))))))))
+                          (scribble:read-syntax-inside src inp)))
+               (when (syntax? xs) (set! xs (or (syntax->list xs) (list xs)))))
+             (if (null? xs)
+               eof
+               (let ([x (car xs)])
+                 (set! xs (cdr xs))
+                 (if (and (null? xs)
+                          (let ([p (syntax-property x 'scribble)])
+                            (and (pair? p) (eq? (car p) 'newline))))
+                   eof ; throw away the last newline from the included file
+                   x))))))))]))

collects/scribblings/scribble/reader-internals.scrbl

@@ -188,10 +188,12 @@ for reading.
 
 @defproc[(read-inside [in input-port? (current-input-port)]) any]{}
 @defproc[(read-syntax-inside [source-name any/c (object-name in)]
-                             [in input-port? (current-input-port)])
+                             [in input-port? (current-input-port)]
+                             [#:command-char command-char char? #\@])
          (or/c syntax? eof-object?)]{
 These @racketid[-inside] variants parse as if starting inside a
 @litchar["@{"]...@litchar["}"], and they return a (syntactic) list.
+The @racket[command-char] is used to customize the readtable.
 Useful for implementing languages that are textual by default (see
 @filepath{docreader.rkt} for example).
 }

collects/tests/web-server/template/examples/run.rkt

@@ -1,5 +1,6 @@
 #lang racket
-(require web-server/templates)
+(require web-server/templates
+         rackunit)
 
 (include-template "static.html")
 
@@ -36,3 +37,6 @@
 (if-template #:monkeys 1
              #:monkey-limit 10
              #:monkey-minimum 2)
+
+(check-equal? (include-template #:command-char #\$ "diff.html")
+              "This is the number: 42\nThis is not the number: @(+ 2 40)")

collects/web-server/scribblings/templates.scrbl

@@ -359,12 +359,14 @@ the template to be unescaped, then create a @racket[cdata] structure:
 
 @section{API Details}
 
-@defform[(include-template path-spec)]{
+@defform*[((include-template path-spec)
- Compiles the template at @racket[path-spec] using the @at-reader-ref syntax within the enclosing lexical context. The @racket[path-spec] is the same format used by @racket[include].
+           (include-template #:command-char command-char path-spec))]{
+ Compiles the template at @racket[path-spec] using the @at-reader-ref syntax within the enclosing lexical context. The @racket[path-spec] is the same format used by @racket[include]. Use the @racket[command-char] keyword to customize the escape character.
 
- Example:
+ Examples:
  @racketblock[
   (include-template "static.html")
+  (include-template #:command-char #\$ "dollar-static.html")
  ]
 }
 

collects/web-server/templates.rkt

@@ -1,19 +1,26 @@
 #lang racket/base
 (require xml
          scribble/text
+         (for-syntax racket/base
+                     racket/list
+                     syntax/parse)
          racket/port)
 
-(define-syntax include-template
+(define-syntax (include-template stx)
-  (syntax-rules ()
+  (syntax-parse stx
-    [(_ p)
+    [(_ (~optional (~seq #:command-char command-char:expr)) p:expr)
-     (with-output-to-string
+     (quasisyntax/loc stx
-      (lambda ()
+       (with-output-to-string
-        (output (include/text p))))]))
+         (lambda ()
+           (output (include/text #,@(if (attribute command-char)
+                                      (list #'#:command-char #'command-char)
+                                      empty)
+                                 p)))))]))
 
 (define-syntax include-template/xexpr
   (syntax-rules ()
-    [(_ p)
+    [(_ . p)
-     (string->xexpr (include-template p))]))
+     (string->xexpr (include-template . p))]))
 
 (define-syntax in
   (syntax-rules ()