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

Finish previously incomplete treatment of contexts with #:resource

Browse Source
This commit is contained in:
Eli Barzilay 2010-06-16 02:09:47 -04:00
parent 098b32b0af
commit 4f6502129a
2 changed files with 14 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -172,22 +172,23 @@
;; site) to have its own resources (and possibly other customizations). ;; site) to have its own resources (and possibly other customizations).
(provide define+provide-context define-context) (provide define+provide-context define-context)
(define-for-syntax (make-define+provide-context stx provide?) (define-for-syntax (make-define+provide-context stx provide?)
(define (make-it dir [icon #f] [logo #f] [style #f]) (define (make-it dir [resources #f])
(with-syntax ([dir dir] (with-syntax ([dir dir]
[page-id (datum->syntax stx 'page)] [page-id (datum->syntax stx 'page)]
[plain-id (datum->syntax stx 'plain)] [plain-id (datum->syntax stx 'plain)]
[copyfile-id (datum->syntax stx 'copyfile)] [copyfile-id (datum->syntax stx 'copyfile)]
[symlink-id (datum->syntax stx 'symlink)] [symlink-id (datum->syntax stx 'symlink)]
[resources-id (datum->syntax stx 'the-resources)]) [resources-id (datum->syntax stx 'the-resources)])
(with-syntax (with-syntax ([resources (or resources
([icon (or icon #'(make-icon dir))] #'(make-resources (make-icon dir)
[logo (or logo #`(make-logo dir))] (make-logo dir)
[style (or style #`(make-style dir))] (make-style dir)))]
[provides (if provide? [provides (if provide?
#'(provide page-id plain-id copyfile-id symlink-id) #'(provide page-id plain-id copyfile-id
#'(begin))]) symlink-id)
#'(begin))])
#'(begin #'(begin
(define resources-id (make-resources icon logo style)) (define resources-id resources)
(define-syntax-rule (page-id . xs) (define-syntax-rule (page-id . xs)
(page #:resources resources-id #:dir dir . xs)) (page #:resources resources-id #:dir dir . xs))
(define-syntax-rule (plain-id . xs) (define-syntax-rule (plain-id . xs)
@ -198,10 +199,8 @@
(symlink-resource source target referrer #:dir dir)) (symlink-resource source target referrer #:dir dir))
provides)))) provides))))
(syntax-case stx () (syntax-case stx ()
[(_ dir) [(_ dir) (make-it #'dir)]
(make-it #'dir)] [(_ dir #:resources resources) (make-it #'dir #'resources)]))
[(_ dir #:resources icon logo style)
(make-it #'dir #'icon #'logo #'style)]))
(define-syntax (define+provide-context stx) (define-syntax (define+provide-context stx)
(make-define+provide-context stx #t)) (make-define+provide-context stx #t))
(define-syntax (define-context stx) (define-syntax (define-context stx)

4
collects/meta/web/stubs/blog.rkt
View File

@ -1,11 +1,11 @@
#lang at-exp s-exp "../common.rkt" #lang at-exp s-exp "../common.rkt"
(define-context "stubs/blog" #:resources "icon" "logo" "style")
(require "../common/resources.rkt" (require "../common/resources.rkt"
(prefix-in www: (only-in "../www/shared.rkt" the-resources)) (prefix-in www: (only-in "../www/shared.rkt" the-resources))
racket/port) racket/port)
(define-context "stubs/blog" #:resources www:the-resources)
(define racket-css (define racket-css
@text{ @text{
@;{ @;{