From 73232afd9934f5b7918d29414d835f33f21aa57c Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 8 May 2013 10:52:04 -0600 Subject: [PATCH] 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 | 7 ++- collects/scribble/text/syntax-utils.rkt | 46 +++++++++++-------- .../scribble/reader-internals.scrbl | 4 +- .../web-server/template/examples/run.rkt | 6 ++- .../web-server/scribblings/templates.scrbl | 8 ++-- collects/web-server/templates.rkt | 23 ++++++---- 6 files changed, 61 insertions(+), 33 deletions(-) diff --git a/collects/scribble/reader.rkt b/collects/scribble/reader.rkt index 30a517a997..c81b36eb1c 100644 --- a/collects/scribble/reader.rkt +++ b/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)]) - ((make-default-at-reader/inside) src inp)) +(define (read-syntax-inside [src default-src] [inp (current-input-port)] + #:command-char [command-char ch:command]) + (((readtable-cached + (lambda (rt) (make-at-reader #:inside? #t #:command-char command-char #:readtable rt)))) + src inp)) diff --git a/collects/scribble/text/syntax-utils.rkt b/collects/scribble/text/syntax-utils.rkt index ebcd501c51..e39e7f4b83 100644 --- a/collects/scribble/text/syntax-utils.rkt +++ b/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) - (begin/text - (include-at/relative-to/reader path-spec path-spec path-spec - (let ([xs #f]) - (λ (src inp) - (unless xs - (set! xs (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)))))))) +(define-syntax (include/text stx) + (syntax-case stx () + [(_ path-spec) + (syntax/loc stx + (include/text #:command-char #f path-spec))] + [(_ #:command-char command-char path-spec) + (syntax/loc stx + (begin/text + (include-at/relative-to/reader + path-spec path-spec path-spec + (let ([xs #f] + [command-char-v command-char]) + (λ (src inp) + (unless xs + (set! xs (if command-char-v + (scribble:read-syntax-inside #:command-char command-char-v src inp) + (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))))))))])) diff --git a/collects/scribblings/scribble/reader-internals.scrbl b/collects/scribblings/scribble/reader-internals.scrbl index 5a94f19902..c7aa6d0b41 100644 --- a/collects/scribblings/scribble/reader-internals.scrbl +++ b/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). } diff --git a/collects/tests/web-server/template/examples/run.rkt b/collects/tests/web-server/template/examples/run.rkt index 12de38c4b0..801fdf5cb0 100644 --- a/collects/tests/web-server/template/examples/run.rkt +++ b/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)") diff --git a/collects/web-server/scribblings/templates.scrbl b/collects/web-server/scribblings/templates.scrbl index b1a942ef1a..e4120f8cd7 100644 --- a/collects/web-server/scribblings/templates.scrbl +++ b/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)]{ - 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]. +@defform*[((include-template path-spec) + (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") ] } diff --git a/collects/web-server/templates.rkt b/collects/web-server/templates.rkt index 33307c3132..d953e3f8f5 100644 --- a/collects/web-server/templates.rkt +++ b/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 - (syntax-rules () - [(_ p) - (with-output-to-string - (lambda () - (output (include/text p))))])) +(define-syntax (include-template stx) + (syntax-parse stx + [(_ (~optional (~seq #:command-char command-char:expr)) p:expr) + (quasisyntax/loc stx + (with-output-to-string + (lambda () + (output (include/text #,@(if (attribute command-char) + (list #'#:command-char #'command-char) + empty) + p)))))])) (define-syntax include-template/xexpr (syntax-rules () - [(_ p) - (string->xexpr (include-template p))])) + [(_ . p) + (string->xexpr (include-template . p))])) (define-syntax in (syntax-rules ()