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

Factor our the common path computation.

Browse Source
This commit is contained in:
Eli Barzilay 2010-06-16 01:43:34 -04:00
parent 00bca21339
commit 1cce6c1f88
1 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/meta/web/common/layout.rkt
View File

@ -19,12 +19,16 @@
[body #`(lambda () (text #,@xs))])
#'(layouter id ... x ... body))])))
(define (id->file who id sfx)
(let ([f (and id (symbol->string (force id)))])
(cond [(and f (regexp-match #rx"[.]" f)) f]
[(and f sfx) (string-append f (regexp-replace #rx"^[.]?" sfx "."))]
[else (error who "missing `#:file', or `#:id'~a"
(if sfx "" " and `#:suffix'"))])))
(define (get-path who id file sfx dir)
(define file*
(or file
(let ([f (and id (symbol->string (force id)))])
(cond [(and f (regexp-match #rx"[.]" f)) f]
[(and f sfx)
(string-append f (regexp-replace #rx"^[.]?" sfx "."))]
[else (error who "missing `#:file', or `#:id'~a"
(if sfx "" " and `#:suffix'"))]))))
(if dir (web-path dir file*) file*))
;; The following are not intended for direct use, see
;; `define+provide-context' below (it could be used with #f for the
@ -34,23 +38,21 @@
;; for plain text files
(define-syntax (plain stx)
(syntax-case stx () [(_ . xs) (process-contents 'plain #'plain* stx #'xs)]))
(define (plain* #:id [id #f] #:suffix [suffix #f] #:dir [dir #f]
#:file [file (id->file 'plain id suffix)]
(define (plain* #:id [id #f] #:suffix [suffix #f]
#:dir [dir #f] #:file [file #f]
#:referrer
[referrer (lambda (url)
(error 'plain "no referrer for ~e" file))]
#:newline [newline? #t]
content)
(resource (if dir (web-path dir file) file)
(resource (get-path 'plain id file suffix dir)
(file-writer output (list content (and newline? "\n")))
referrer))
;; page layout function
(define-syntax (page stx)
(syntax-case stx () [(_ . xs) (process-contents 'page #'page* stx #'xs)]))
(define (page* #:id [id #f]
#:dir [dir #f]
#:file [file (id->file 'page id "html")]
(define (page* #:id [id #f] #:dir [dir #f] #:file [file #f]
#:title [label (if id
(let* ([id (->string (force id))]
[id (regexp-replace #rx"^.*/" id "")]
@ -79,7 +81,7 @@
@(if body-attrs
(apply body `(,@body-attrs ,content))
(body content))}))
(define this (resource (if dir (web-path dir file) file)
(define this (resource (get-path 'plain id file "html" dir)
(file-writer output-xml page)
referrer))
this)