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).
(provide define+provide-context define-context)
(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]
[page-id (datum->syntax stx 'page)]
[plain-id (datum->syntax stx 'plain)]
[copyfile-id (datum->syntax stx 'copyfile)]
[symlink-id (datum->syntax stx 'symlink)]
[resources-id (datum->syntax stx 'the-resources)])
(with-syntax
([icon (or icon #'(make-icon dir))]
[logo (or logo #`(make-logo dir))]
[style (or style #`(make-style dir))]
[provides (if provide?
#'(provide page-id plain-id copyfile-id symlink-id)
#'(begin))])
(with-syntax ([resources (or resources
#'(make-resources (make-icon dir)
(make-logo dir)
(make-style dir)))]
[provides (if provide?
#'(provide page-id plain-id copyfile-id
symlink-id)
#'(begin))])
#'(begin
(define resources-id (make-resources icon logo style))
(define resources-id resources)
(define-syntax-rule (page-id . xs)
(page #:resources resources-id #:dir dir . xs))
(define-syntax-rule (plain-id . xs)
@ -198,10 +199,8 @@
(symlink-resource source target referrer #:dir dir))
provides))))
(syntax-case stx ()
[(_ dir)
(make-it #'dir)]
[(_ dir #:resources icon logo style)
(make-it #'dir #'icon #'logo #'style)]))
[(_ dir) (make-it #'dir)]
[(_ dir #:resources resources) (make-it #'dir #'resources)]))
(define-syntax (define+provide-context stx)
(make-define+provide-context stx #t))
(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"
(define-context "stubs/blog" #:resources "icon" "logo" "style")
(require "../common/resources.rkt"
(prefix-in www: (only-in "../www/shared.rkt" the-resources))
racket/port)
(define-context "stubs/blog" #:resources www:the-resources)
(define racket-css
@text{
@;{