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

define-pager' -> define+provide-context' that also creates a

Browse Source 
`copyfile' binding.
This commit is contained in:
Eli Barzilay 2010-06-05 13:20:52 -04:00
parent d8f8dfe9b7
commit caaa69c689
5 changed files with 18 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,7 +27,7 @@
#:file
[file (if (and id suffix)
(let ([f (format "~a.~a" (force id) suffix)])
(if dir (string-append dir "/" f) f))
(if dir (web-path dir f) f))
(error 'plain
"missing `#:file', or `#:id' and `#:suffix'"))]
#:referrer
@ -40,7 +40,7 @@
referrer))
;; page layout function
;; (not providing `page', see `define-pager' below)
;; (not providing `page', see `define+provide-context' below)
(define-syntax (page stx)
(syntax-case stx () [(_ . xs) (process-contents 'page #'page* stx #'xs)]))
(define (page* #:id [id #f]
@ -77,7 +77,7 @@
(apply body `(,@body-attrs ,content))
(body content))}))
(define this
(resource (if dir (string-append dir "/" file) file)
(resource (if dir (web-path dir file) file)
(file-writer output-xml page) referrer))
this)
@ -151,11 +151,14 @@
[else (error 'resources "internal error")])
more))))
;; `define-pager' should be used in each toplevel directory (= each
;; `define+provide-context' should be used in each toplevel directory (= each
;; site) to have its own resources (and possibly other customizations).
(provide define-pager)
(define-syntax-rule (define-pager page-id dir)
(provide define+provide-context)
(define-syntax-rule (define+provide-context page-id copyfile-id dir)
(begin (define resources
(make-resources (make-icon dir) (make-logo dir) (make-style dir)))
(define-syntax-rule (page-id . xs)
(page #:resources resources #:dir dir . xs))))
(page #:resources resources #:dir dir . xs))
(define (copyfile-id source [target #f] [referrer values])
(copyfile-resource source target referrer #:dir dir))
(provide page-id copyfile-id)))

7
collects/meta/web/common/utils.rkt
View File

@ -13,8 +13,11 @@
#`(build-path '#,src path paths ...))]))
(provide copyfile-resource)
(define (copyfile-resource source target [referrer values])
(resource target (lambda (file) (copy-file source file)) referrer))
(define (copyfile-resource source [target #f] [referrer values] #:dir [dir #f])
(let ([target (or target (let-values ([(base file dir?) (split-path source)])
(path->string file)))])
(resource (if dir (web-path dir target) target)
(lambda (file) (copy-file source file)) referrer)))
(provide web-path)
(define (web-path . xs)

2
collects/meta/web/download/shared.rkt
View File

@ -2,4 +2,4 @@
(provide page (all-from-out "../common.rkt"))
(define-pager page "download")
(define+provide-context page copyfile "download")

2
collects/meta/web/stubs/shared.rkt
View File

@ -2,4 +2,4 @@
(provide page (all-from-out "../common.rkt"))
(define-pager page "stubs")
(define+provide-context page copyfile "stubs")

2
collects/meta/web/www/shared.rkt
View File

@ -2,4 +2,4 @@
(provide page (all-from-out "../common.rkt"))
(define-pager page "www")
(define+provide-context page copyfile "www")