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

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

@ -1,15 +1,22 @@
#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{@(if (monkeys . < . monkey-minimum)
@t{@(if ($monkeys . < . $monkey-minimum)
@t{<p>There aren't 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 11 10 1)
@;"\n<p>There are too many monkeys!</p>\n"
@; (template 0 10 1)
@;"\n<p>There aren't enough monkeys!</p>\n"
@;
@;{
> (template #:monkeys 5
#:monkey-limit 10
#:monkey-minimum 1)
"<p>There are just enough monkeys!</p>\n\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
@(require "module-test.ss")
@(title clients)
<html>
<head><title>@|title|</title></head>
<head><title>@$title </title></head>
<body>
<table>
@for[([client clients])]{
@in[client $clients]{
<tr>
<td>@(client-surname client), @(client-fname client)
<td><a href="mailto:@(client-email client)">@(client-email client)</a></td>
@ -16,9 +15,12 @@
</html>
@; Example:
@;(template "Title"
@; (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")))
@;{
(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")))
}

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

@ -7,34 +7,54 @@
(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 ...) nl (fv ...) body ...)
#'(#%module-begin
(require r ...)
(define-template id (fv ...) (#%string-append body ...))
(provide id))]
[(_ id (fv ...) body ...)
#'(#%module-begin
(define-template id (fv ...) (#%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)])
[(_ id (require r ...) body ...)
(quasisyntax/loc stx
(define (id #,@fvars)
body))))]))
(#%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 (fv ...) body)
[(_ 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 fv ...)
body))]))
(define (id arg ...)
body))))]))

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

@ -4,18 +4,33 @@
(provide (rename-out [*read read])
(rename-out [*read-syntax read-syntax]))
(define (*read [inp (current-input-port)])
(wrap inp (scribble:read-inside inp)))
; Adapted from syntax/module-reader and scribble/reader
(define (*read-syntax [src #f] [port (current-input-port)])
(wrap port (scribble:read-syntax-inside src port)))
(define (*read in modpath line col pos)
(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)]
[name (if (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)]
[id 'template])
`(module ,name web-server/template/lang
(#%module-begin ,id . ,body))))
[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)))

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

@ -9,8 +9,13 @@
(for/list (for-clause ...)
(#%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)
(define-syntax (#%string-append stx)
(syntax-case stx ()