From 2e8d5ed9710d820e90f111dbef7f057fc8230210 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 26 Aug 2008 23:27:06 +0000 Subject: [PATCH] Re Eli svn: r11445 --- .../web-server/template/examples/basic.html | 15 ++++ .../web-server/template/examples/basic.scrbl | 28 ------ collects/web-server/template/examples/if.html | 5 ++ .../web-server/template/examples/if.scrbl | 22 ----- .../template/examples/module-test.ss | 4 - .../web-server/template/examples/module.scrbl | 26 ------ collects/web-server/template/examples/run.ss | 89 +++++++++++++++++++ .../web-server/template/examples/static.html | 11 +++ collects/web-server/template/lang.ss | 60 ------------- collects/web-server/template/lang/reader.ss | 36 -------- collects/web-server/template/lib.ss | 36 -------- 11 files changed, 120 insertions(+), 212 deletions(-) create mode 100644 collects/web-server/template/examples/basic.html delete mode 100644 collects/web-server/template/examples/basic.scrbl create mode 100644 collects/web-server/template/examples/if.html delete mode 100644 collects/web-server/template/examples/if.scrbl delete mode 100644 collects/web-server/template/examples/module-test.ss delete mode 100644 collects/web-server/template/examples/module.scrbl create mode 100644 collects/web-server/template/examples/run.ss create mode 100644 collects/web-server/template/examples/static.html delete mode 100644 collects/web-server/template/lang.ss delete mode 100644 collects/web-server/template/lang/reader.ss delete mode 100644 collects/web-server/template/lib.ss diff --git a/collects/web-server/template/examples/basic.html b/collects/web-server/template/examples/basic.html new file mode 100644 index 0000000000..cfec2f8d23 --- /dev/null +++ b/collects/web-server/template/examples/basic.html @@ -0,0 +1,15 @@ + + @title + + + @for/list[([c @clients])]{ + @t{ + + + + + } + } +
@(client-surname c), @(client-firstname c)@(client-email c)
+ + diff --git a/collects/web-server/template/examples/basic.scrbl b/collects/web-server/template/examples/basic.scrbl deleted file mode 100644 index d9264185df..0000000000 --- a/collects/web-server/template/examples/basic.scrbl +++ /dev/null @@ -1,28 +0,0 @@ -#lang web-server/template - - @$title - - - @in[c $clients]{ - - - - } -
@($client-surname c), @($client-firstname c) - @($client-email c)
- - - -@; Example: -@;{ - (template #:title "Title" - #:clients - `(["First1" "Last1" "email1"] - ["First2" "Last2" "email2"] - ["First3" "Last3" "email3"] - ["First4" "Last4" "email4"] - ["First5" "Last5" "email5"]) - #:client-surname second - #:client-firstname first - #:client-email third) - } \ No newline at end of file diff --git a/collects/web-server/template/examples/if.html b/collects/web-server/template/examples/if.html new file mode 100644 index 0000000000..a5a7fa3cb4 --- /dev/null +++ b/collects/web-server/template/examples/if.html @@ -0,0 +1,5 @@ +@(if (@monkeys . > . @monkey-limit) + @t{

There are too many monkeys!

} + @(if (@monkeys . < . @monkey-minimum) + @t{

There aren't enough monkeys!

} + @t{

There are just enough monkeys!

})) diff --git a/collects/web-server/template/examples/if.scrbl b/collects/web-server/template/examples/if.scrbl deleted file mode 100644 index 8906143eee..0000000000 --- a/collects/web-server/template/examples/if.scrbl +++ /dev/null @@ -1,22 +0,0 @@ -#lang web-server/template -@(if ($monkeys . > . $monkey-limit) - @t{

There are too many monkeys!

} - @t{@(if ($monkeys . < . $monkey-minimum) - @t{

There aren't enough monkeys!

} - @t{

There are just enough monkeys!

})}) - -@;{ -> (template #:monkeys 5 - #:monkey-limit 10 - #:monkey-minimum 1) -"

There are just enough monkeys!

\n\n" -> (template #:monkeys 0 - #:monkey-limit 10 - #:monkey-minimum 1) -"

There aren't enough monkeys!

\n\n" -> (template #:monkeys 11 - #:monkey-limit 10 - #:monkey-minimum 1) -"

There are too many monkeys!

\n\n" -> -} \ No newline at end of file diff --git a/collects/web-server/template/examples/module-test.ss b/collects/web-server/template/examples/module-test.ss deleted file mode 100644 index a2f9d53440..0000000000 --- a/collects/web-server/template/examples/module-test.ss +++ /dev/null @@ -1,4 +0,0 @@ -#lang scheme - -(define-struct client (fname surname email)) -(provide (struct-out client)) \ No newline at end of file diff --git a/collects/web-server/template/examples/module.scrbl b/collects/web-server/template/examples/module.scrbl deleted file mode 100644 index 466efa9bd7..0000000000 --- a/collects/web-server/template/examples/module.scrbl +++ /dev/null @@ -1,26 +0,0 @@ -#lang web-server/template -@(require "module-test.ss") - - @$title - - - @in[client $clients]{ - - - - } -
@(client-surname client), @(client-fname client) - @(client-email client)
- - - -@; Example: -@;{ - (template #:title "Title" - #:clients - (list (make-client "First1" "Last1" "email1") - (make-client "First2" "Last2" "email2") - (make-client "First3" "Last3" "email3") - (make-client "First4" "Last4" "email4") - (make-client "First5" "Last5" "email5"))) - } \ No newline at end of file diff --git a/collects/web-server/template/examples/run.ss b/collects/web-server/template/examples/run.ss new file mode 100644 index 0000000000..74cc05644a --- /dev/null +++ b/collects/web-server/template/examples/run.ss @@ -0,0 +1,89 @@ +#lang scheme + +(require scheme/include + (for-syntax scheme) + (prefix-in text: scribble/text) + (for-syntax (prefix-in text: scribble/text)) + (for-syntax (prefix-in at: scribble/reader))) + +; XXX I have to do this because without it there is an infinite loop. +; at:read-syntax-inside returns #'() instead of eof +(define-for-syntax (*read-syntax . args) + (define r (apply at:read-syntax-inside args)) + (if (eof-object? r) r + (if (null? (syntax->datum r)) + eof + r))) + +(define-syntax (include-template stx) + (syntax-case stx () + [(_ a-path) + ; XXX Not desireable, but necessary to get at the body, + ; rather than it being used as a string applied to the rest + (with-syntax ([(begin (#%app body ...)) + (local-expand + (with-syntax ([_stx stx]) + (syntax/loc stx + (include-at/relative-to/reader + _stx _stx + (file a-path) *read-syntax))) + 'module-begin + empty) + ]) + (syntax/loc stx + (with-output-to-string + (begin/show body ...))))])) + +(define-syntax with-output-to-string + (syntax-rules () + [(_ e ...) + (let ([os (open-output-string)]) + (parameterize ([current-output-port os]) + e ...) + (get-output-string os))])) + +(define-syntax begin/show + (syntax-rules () + [(_ e) e] + [(_ e ...) + ; XXX If scribble/text shared "show", then I would use it here + (begin (display e) ...)])) +(define t list) + +; Examples + +(include-template "static.html") + +(define (basic-template title clients client-surname client-firstname client-email) + (include-template "basic.html")) + +(basic-template "Title" + (list (list "First 1" "Second 1" "Third 1") + (list "First 2" "Second 2" "Third 2") + (list "First 3" "Second 3" "Third 3") + (list "First 4" "Second 4" "Third 4")) + first second third) + +(local () + (define-struct client (surname firstname email)) + (basic-template "Title" + (list (make-client "First 1" "Second 1" "Third 1") + (make-client "First 2" "Second 2" "Third 2") + (make-client "First 3" "Second 3" "Third 3") + (make-client "First 4" "Second 4" "Third 4")) + client-surname client-firstname client-email)) + +(define (if-template #:monkeys monkeys + #:monkey-limit monkey-limit + #:monkey-minimum monkey-minimum) + (include-template "if.html")) + +(if-template #:monkeys 5 + #:monkey-limit 10 + #:monkey-minimum 2) +(if-template #:monkeys 11 + #:monkey-limit 10 + #:monkey-minimum 2) +(if-template #:monkeys 1 + #:monkey-limit 10 + #:monkey-minimum 2) diff --git a/collects/web-server/template/examples/static.html b/collects/web-server/template/examples/static.html new file mode 100644 index 0000000000..b211384e7a --- /dev/null +++ b/collects/web-server/template/examples/static.html @@ -0,0 +1,11 @@ + + Title + + + + + + +
Example, Mr.example@"@"foo.com
+ + diff --git a/collects/web-server/template/lang.ss b/collects/web-server/template/lang.ss deleted file mode 100644 index 576b75f761..0000000000 --- a/collects/web-server/template/lang.ss +++ /dev/null @@ -1,60 +0,0 @@ -#lang scheme - -(require (for-syntax scheme) - web-server/template/lib) - -(provide (except-out (all-from-out scheme) #%module-begin) - (rename-out [*module-begin #%module-begin]) - (all-from-out web-server/template/lib)) - -(define-for-syntax (ids stx) - (syntax-case stx () - [(e ...) - (apply append (map ids (syntax->list #'(e ...))))] - [e (and (identifier? #'e) - (equal? #\$ (string-ref (symbol->string (syntax->datum #'e)) 0))) - (list #'e)] - [_ empty])) - -(define-for-syntax (uniq ls) - (hash-map - (foldl (lambda (e a) (hash-set a (syntax->datum e) e)) - (make-immutable-hash empty) ls) - (lambda (k v) v))) - -(define-syntax (*module-begin stx) - (syntax-case stx (require) - [(_ id (require r ...) body ...) - (quasisyntax/loc stx - (#%module-begin - (require r ...) - (define-template id (#%string-append body ...)) - (provide id)))] - [(_ id body ...) - (quasisyntax/loc stx - (#%module-begin - (define-template id (#%string-append body ...)) - (provide id)))])) - -(define-syntax (define-template stx) - (syntax-case stx () - [(_ id body) - (let ([fv-stxs (uniq (ids #'body))]) - (with-syntax ([(arg ...) - (foldl (lambda (i a) - (quasisyntax/loc i - (#,(datum->syntax - i - (string->keyword - (substring - (symbol->string - (syntax->datum i)) - 1)) - i) - #,i - #,@a))) - #'() - fv-stxs)]) - (quasisyntax/loc stx - (define (id arg ...) - body))))])) diff --git a/collects/web-server/template/lang/reader.ss b/collects/web-server/template/lang/reader.ss deleted file mode 100644 index 9e7879c0c3..0000000000 --- a/collects/web-server/template/lang/reader.ss +++ /dev/null @@ -1,36 +0,0 @@ -#lang scheme/base -(require (prefix-in scribble: scribble/reader)) - -(provide (rename-out [*read read]) - (rename-out [*read-syntax read-syntax])) - -; Adapted from syntax/module-reader and scribble/reader - -(define (*read in modpath line col pos) - (wrap in (scribble:read-inside in) modpath #f line col pos)) - -(define (*read-syntax src in modpath line col pos) - (wrap in (scribble:read-syntax-inside src in) modpath src line col pos)) - -(define (wrap port body modpath src line col pos) - (let* ([p-name (object-name port)] - [name (if (path? p-name) - (let-values ([(base name dir?) (split-path p-name)]) - (string->symbol - (path->string (path-replace-suffix name #"")))) - 'page)] - [tag-src (lambda (v) - (if (syntax? modpath) - (datum->syntax #f v - (vector src line col pos - (- (or (syntax-position modpath) - (add1 pos)) - pos))) - v))] - [lib 'web-server/template/lang] - [lib-src (lambda (v) - (if (syntax? modpath) - (datum->syntax #f lib modpath modpath) - v))]) - `(,(tag-src 'module) ,(tag-src name) ,(lib-src lib) - template . ,body))) \ No newline at end of file diff --git a/collects/web-server/template/lib.ss b/collects/web-server/template/lib.ss deleted file mode 100644 index cb3b4f3341..0000000000 --- a/collects/web-server/template/lib.ss +++ /dev/null @@ -1,36 +0,0 @@ -#lang scheme - -(provide for) -(define-syntax for - (syntax-rules () - [(_ (for-clause ...) body ...) - (apply - string-append - (for/list (for-clause ...) - (#%string-append body ...)))])) - -(provide in) -(define-syntax in - (syntax-rules () - [(_ x xs body ...) - (for ([x xs]) body ...)])) - -(provide (rename-out [#%string-append t])) -(provide #%string-append) -(define-syntax (#%string-append stx) - (syntax-case stx () - [(_) - (syntax/loc stx "")] - [(_ e) - (syntax/loc stx e)] - [(_ e1 e2 e ...) - (let ([e1* (syntax->datum #'e1)] - [e2* (syntax->datum #'e2)]) - (cond - [(and (string? e1*) (string? e2*)) - (quasisyntax/loc stx - (#%string-append #,(datum->syntax stx (string-append e1* e2*) stx) - e ...))] - [else - (syntax/loc stx - (string-append e1 (#%string-append e2 e ...)))]))]))