suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Streamline

Browse Source 
svn: r11357
This commit is contained in:
Jay McCarthy 2008-08-20 16:04:44 +00:00
parent 52c1a313c8
commit 47133090f5
6 changed files with 119 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/web-server/template/examples/basic.scrbl
View File

@ -1,13 +1,12 @@
#lang web-server/template #lang web-server/template
@(title clients client-surname client-firstname client-email)
<html> <html>
<head><title>@|title|</title></head> <head><title>@$title </title></head>
<body> <body>
<table> <table>
@for[([c clients])]{ @in[c $clients]{
<tr> <tr>
<td>@(client-surname c), @(client-firstname c) <td>@($client-surname c), @($client-firstname c)
<td><a href="mailto:@(client-email c)">@(client-email c)</a></td> <td><a href="mailto:@($client-email c)">@($client-email c)</a></td>
</tr> </tr>
} }
</table> </table>
@ -15,10 +14,15 @@
</html> </html>
@; Example: @; Example:
@; (template "Title" @;{
@; `(["First1" "Last1" "email1"] (template #:title "Title"
@; ["First2" "Last2" "email2"] #:clients
@; ["First3" "Last3" "email3"] `(["First1" "Last1" "email1"]
@; ["First4" "Last4" "email4"] ["First2" "Last2" "email2"]
@; ["First5" "Last5" "email5"]) ["First3" "Last3" "email3"]
@; second first third) ["First4" "Last4" "email4"]
["First5" "Last5" "email5"])
#:client-surname second
#:client-firstname first
#:client-email third)
}

27
collects/web-server/template/examples/if.scrbl
View File

@ -1,15 +1,22 @@
#lang web-server/template #lang web-server/template
@(monkeys monkey-limit monkey-minimum) @(if ($monkeys . > . $monkey-limit)
@(if (monkeys . > . monkey-limit)
@t{<p>There are too many monkeys!</p>} @t{<p>There are too many monkeys!</p>}
@t{@(if (monkeys . < . monkey-minimum) @t{@(if ($monkeys . < . $monkey-minimum)
@t{<p>There aren't enough monkeys!</p>} @t{<p>There aren't enough monkeys!</p>}
@t{<p>There are just enough monkeys!</p>})}) @t{<p>There are just enough monkeys!</p>})})
@; (template 5 10 1) @;{
@;"\n<p>There are just enough monkeys!</p>\n" > (template #:monkeys 5
@; (template 11 10 1) #:monkey-limit 10
@;"\n<p>There are too many monkeys!</p>\n" #:monkey-minimum 1)
@; (template 0 10 1) "<p>There are just enough monkeys!</p>\n\n"
@;"\n<p>There aren't enough monkeys!</p>\n" > (template #:monkeys 0
@; #:monkey-limit 10
#:monkey-minimum 1)
"<p>There aren't enough monkeys!</p>\n\n"
> (template #:monkeys 11
#:monkey-limit 10
#:monkey-minimum 1)
"<p>There are too many monkeys!</p>\n\n"
>
}

20
collects/web-server/template/examples/module.scrbl
View File

@ -1,11 +1,10 @@
#lang web-server/template #lang web-server/template
@(require "module-test.ss") @(require "module-test.ss")
@(title clients)
<html> <html>
<head><title>@|title|</title></head> <head><title>@$title </title></head>
<body> <body>
<table> <table>
@for[([client clients])]{ @in[client $clients]{
<tr> <tr>
<td>@(client-surname client), @(client-fname client) <td>@(client-surname client), @(client-fname client)
<td><a href="mailto:@(client-email client)">@(client-email client)</a></td> <td><a href="mailto:@(client-email client)">@(client-email client)</a></td>
@ -16,9 +15,12 @@
</html> </html>
@; Example: @; Example:
@;(template "Title" @;{
@; (list (make-client "First1" "Last1" "email1") (template #:title "Title"
@; (make-client "First2" "Last2" "email2") #:clients
@; (make-client "First3" "Last3" "email3") (list (make-client "First1" "Last1" "email1")
@; (make-client "First4" "Last4" "email4") (make-client "First2" "Last2" "email2")
@; (make-client "First5" "Last5" "email5"))) (make-client "First3" "Last3" "email3")
(make-client "First4" "Last4" "email4")
(make-client "First5" "Last5" "email5")))
}

70
collects/web-server/template/lang.ss
View File

@ -7,34 +7,54 @@
(rename-out [*module-begin #%module-begin]) (rename-out [*module-begin #%module-begin])
(all-from-out web-server/template/lib)) (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) (define-syntax (*module-begin stx)
(syntax-case stx (require) (syntax-case stx (require)
[(_ id (require r ...) nl (fv ...) body ...) [(_ id (require r ...) body ...)
#'(#%module-begin (quasisyntax/loc stx
(#%module-begin
(require r ...) (require r ...)
(define-template id (fv ...) (#%string-append body ...)) (define-template id (#%string-append body ...))
(provide id))] (provide id)))]
[(_ id (fv ...) body ...) [(_ id body ...)
#'(#%module-begin (quasisyntax/loc stx
(define-template id (fv ...) (#%string-append body ...)) (#%module-begin
(provide id))])) (define-template id (#%string-append body ...))
(provide id)))]))
#;(define-syntax (define-template stx)
(syntax-case stx ()
[(_ id body)
(with-syntax ([(pmb body)
(local-expand
(quasisyntax/loc stx body)
'expression
empty)])
(let ([fvars (free-vars #'body)])
(quasisyntax/loc stx
(define (id #,@fvars)
body))))]))
(define-syntax (define-template stx) (define-syntax (define-template stx)
(syntax-case stx () (syntax-case stx ()
[(_ id (fv ...) body) [(_ id body)
(quasisyntax/loc stx (let ([fv-stxs (uniq (ids #'body))])
(define (id fv ...) (with-syntax ([(arg ...)
body))])) (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))))]))

33
collects/web-server/template/lang/reader.ss
View File

@ -4,18 +4,33 @@
(provide (rename-out [*read read]) (provide (rename-out [*read read])
(rename-out [*read-syntax read-syntax])) (rename-out [*read-syntax read-syntax]))
(define (*read [inp (current-input-port)]) ; Adapted from syntax/module-reader and scribble/reader
(wrap inp (scribble:read-inside inp)))
(define (*read-syntax [src #f] [port (current-input-port)]) (define (*read in modpath line col pos)
(wrap port (scribble:read-syntax-inside src port))) (wrap in (scribble:read-inside in) modpath #f line col pos))
(define (wrap port body) (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)] (let* ([p-name (object-name port)]
[name (if (path? p-name) [name (if (path? p-name)
(let-values ([(base name dir?) (split-path p-name)]) (let-values ([(base name dir?) (split-path p-name)])
(string->symbol (path->string (path-replace-suffix name #"")))) (string->symbol
(path->string (path-replace-suffix name #""))))
'page)] 'page)]
[id 'template]) [tag-src (lambda (v)
`(module ,name web-server/template/lang (if (syntax? modpath)
(#%module-begin ,id . ,body)))) (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)))

7
collects/web-server/template/lib.ss
View File

@ -9,8 +9,13 @@
(for/list (for-clause ...) (for/list (for-clause ...)
(#%string-append body ...)))])) (#%string-append body ...)))]))
(provide (rename-out [#%string-append t])) (provide in)
(define-syntax in
(syntax-rules ()
[(_ x xs body ...)
(for ([x xs]) body ...)]))
(provide (rename-out [#%string-append t]))
(provide #%string-append) (provide #%string-append)
(define-syntax (#%string-append stx) (define-syntax (#%string-append stx)
(syntax-case stx () (syntax-case stx ()