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

Add a `plain', and fix the identifiers.

Browse Source
This commit is contained in:
Eli Barzilay 2010-06-05 13:47:22 -04:00
parent caaa69c689
commit 3b3bfb0719
4 changed files with 24 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -19,10 +19,14 @@
[body #`(lambda () (text #,@xs))]) [body #`(lambda () (text #,@xs))])
#'(layouter id ... x ... body))]))) #'(layouter id ... x ... body))])))
;; The following are not intended for direct use, see
;; `define+provide-context' below (it could be used with #f for the
;; directory if this ever gets used for a flat single directory web
;; page.)
;; for plain text files ;; for plain text files
(define-syntax (plain stx) (define-syntax (plain stx)
(syntax-case stx () [(_ . xs) (process-contents 'plain #'plain* stx #'xs)])) (syntax-case stx () [(_ . xs) (process-contents 'plain #'plain* stx #'xs)]))
(provide plain)
(define (plain* #:id [id #f] #:suffix [suffix #f] #:dir [dir #f] (define (plain* #:id [id #f] #:suffix [suffix #f] #:dir [dir #f]
#:file #:file
[file (if (and id suffix) [file (if (and id suffix)
@ -40,7 +44,6 @@
referrer)) referrer))
;; page layout function ;; page layout function
;; (not providing `page', see `define+provide-context' below)
(define-syntax (page stx) (define-syntax (page stx)
(syntax-case stx () [(_ . xs) (process-contents 'page #'page* stx #'xs)])) (syntax-case stx () [(_ . xs) (process-contents 'page #'page* stx #'xs)]))
(define (page* #:id [id #f] (define (page* #:id [id #f]
@ -154,11 +157,19 @@
;; `define+provide-context' 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). ;; site) to have its own resources (and possibly other customizations).
(provide define+provide-context) (provide define+provide-context)
(define-syntax-rule (define+provide-context page-id copyfile-id dir) (define-syntax (define+provide-context stx)
(begin (define resources (syntax-case stx ()
(make-resources (make-icon dir) (make-logo dir) (make-style dir))) [(_ dir)
(define-syntax-rule (page-id . xs) (with-syntax ([page-id (datum->syntax stx 'page)]
(page #:resources resources #:dir dir . xs)) [plain-id (datum->syntax stx 'plain)]
(define (copyfile-id source [target #f] [referrer values]) [copyfile-id (datum->syntax stx 'copyfile)])
(copyfile-resource source target referrer #:dir dir)) #'(begin
(provide page-id copyfile-id))) (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))
(define-syntax-rule (plain-id . xs)
(plain #:dir dir . xs))
(define (copyfile-id source [target #f] [referrer values])
(copyfile-resource source target referrer #:dir dir))
(provide page-id plain-id copyfile-id)))]))

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

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

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

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

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

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