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

Adjust meta/web' for changes in scribble/html'.

Browse Source 
Add a `resource/referrer' abstraction for referrers, on top of plain
resources.  (When the referrer is `values', it just returns the plain
resource.)  Also add `url-of' to replace `get-resource-path'.
This commit is contained in:
Eli Barzilay 2011-12-26 13:33:31 -05:00
parent 787f3151de
commit fa4c073b9e
9 changed files with 48 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -41,14 +41,12 @@
(syntax-case stx () [(_ . xs) (process-contents 'plain #'plain* stx #'xs)]))
(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))]
#:referrer [referrer values]
#:newline [newline? #t]
content)
(resource (get-path 'plain id file suffix dir)
(file-writer output (list content (and newline? "\n")))
referrer))
(resource/referrer (get-path 'plain id file suffix dir)
(file-writer output (list content (and newline? "\n")))
referrer))
;; page layout function
(define-syntax (page stx)
@ -96,9 +94,9 @@
(body content))
@||}))
(define this (and (not html-only?)
(resource (get-path 'plain id file "html" dir)
(file-writer output-xml page)
referrer)))
(resource/referrer (get-path 'plain id file "html" dir)
(file-writer output-xml page)
referrer)))
(when this (pages->part-of this (or part-of this)))
(or this page))
@ -140,7 +138,7 @@
(middle-text 80 ")")
(middle-text 100 ")")))
(define (header-cell logo)
(td (a href: (get-resource-path (force top-promise))
(td (a href: (url-of (force top-promise))
OPEN
(img src: logo alt: "[logo]"
style: '("vertical-align: middle; "
@ -193,9 +191,9 @@
[(head) make-head]
[(navbar) make-navbar]
[(favicon-headers) favicon]
[(icon-path) (lambda () (get-resource-path icon))]
[(logo-path) (lambda () (get-resource-path logo))]
[(style-path) (lambda () (get-resource-path style))]
[(icon-path) (lambda () (url-of icon))]
[(logo-path) (lambda () (url-of logo))]
[(style-path) (lambda () (url-of style))]
[else (error 'resources "internal error")])
more))))

8
collects/meta/web/common/resources.rkt
View File

@ -20,10 +20,10 @@
(define make-icon (make-file-copier "plticon.ico"))
(define (make-style dir)
(resource (web-path dir "plt.css")
(file-writer output (list racket-style "\n"))
(lambda (url) (link rel: "stylesheet" type: "text/css"
href: url title: "default"))))
(resource/referrer (web-path dir "plt.css")
(file-writer output (list racket-style "\n"))
(lambda (url) (link rel: "stylesheet" type: "text/css"
href: url title: "default"))))
(define page-sizes
@list{

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

@ -12,18 +12,6 @@
'in-here "missing source information" stx)))])
#`(build-path '#,src path paths ...))]))
(define ((make-path-resourcer file-op) source [target #f] #:dir [dir #f])
(let ([target (or target (let-values ([(base file dir?) (split-path source)])
(path->string file)))])
(resource (if (eq? void file-op)
(void) (if dir (web-path dir target) target))
(lambda (file) (file-op source file))
values)))
(provide copyfile-resource symlink-resource)
(define copyfile-resource (make-path-resourcer copy-file))
(define symlink-resource (make-path-resourcer make-file-or-directory-link))
(provide web-path)
(define (web-path . xs)
(string-join xs "/"))
@ -36,3 +24,29 @@
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[else (error '->string "don't know what to do with ~e" x)]))
;; resources with a specific referrer; if the referrer is `values',
;; return a plain resource (which behaves the same)
(provide resource/referrer url-of)
(struct referable (referrer resource) #:property prop:procedure 0)
(define (resource/referrer path renderer referrer)
(define url (resource path renderer))
(if (eq? referrer values)
url
(referable (lambda args (apply referrer (url) args)) url)))
(define (url-of referable [absolute? #f])
(cond [(referable? referable) ((referable-resource referable) absolute?)]
[(resource? referable) (referable absolute?)]
[else (raise-type-error 'url-of "referable" referable)]))
;; simple file resources
(define ((make-path-resourcer file-op) source [target #f] #:dir [dir #f])
(let ([target (or target (let-values ([(base file dir?) (split-path source)])
(path->string file)))])
(resource (if (eq? void file-op)
(void) (if dir (web-path dir target) target))
(lambda (file) (file-op source file)))))
(provide copyfile-resource symlink-resource)
(define copyfile-resource (make-path-resourcer copy-file))
(define symlink-resource (make-path-resourcer make-file-or-directory-link))

2
collects/meta/web/minis/drracket.rkt
View File

@ -48,7 +48,7 @@
}})
colors)))
(meta http-equiv: "refresh"
content: (list "2;URL=" (get-resource-path main)))))
content: (list "2;URL=" (url-of main)))))
(define char-matrix
@list|{

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

@ -36,8 +36,7 @@
(provide blog)
(define blog
@plain[#:file ""
#:referrer (lambda (u) @a[href: u]{Blog})]{
@plain[#:file "" #:referrer (lambda (u) @a[href: u]{Blog})]{
@; This is the blogger style template file, with one hole for the CSS and one
@; for the navbar, and a few more tweaks (first by soegaard and then by eli).
@;

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

@ -25,7 +25,7 @@
(lazy @text{
@p{This is the Racket git server.}
@p{See the "brief", PLT-oriented @intro{introduction to git}.}}))
(define home-file @plain[#:file "home-text.html" #:referrer values home-text])
(define home-file @plain[#:file "home-text.html" home-text])
(define gitweb-config
@plain[#:file "gitweb_config.perl"]{

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

@ -35,7 +35,7 @@
}
setTimeout(init_rollovers, 400);
}
@a[href: (get-resource-path download)
@a[href: (url-of download)
onmouseover: "set_download_image(1);"
onmouseout: "set_download_image(0);"]{
@img[id: "download_button" src: (car images) style: "border-width: 0;"

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

@ -11,7 +11,7 @@
(define irc-logs
(let ()
@plain[#:file "irc-logs/.htaccess" #:referrer values]{
@plain[#:file "irc-logs/.htaccess"]{
RewriteEngine on
RewriteRule ^(.*)$ http://pre.racket-lang.org@;
/irc-logs/@||racket/@|"$1"| [P]

4
collects/meta/web/www/techreports.rkt
View File

@ -65,7 +65,7 @@
number = {|@tr-name},
institution = {PLT Inc.},
year = {2010},
note = {\url{|@(get-resource-path cite-page #t)}}
note = {\url{|@(url-of cite-page #t)}}
}}|
@@refblock{Scribble}|{
(define plt-tr|@num
@ -74,7 +74,7 @@
#:date "2010"
#:location (techrpt-location #:institution "PLT Inc."
#:number "|@tr-name")
#:url "|@(get-resource-path cite-page #t)"))}|
#:url "|@(url-of cite-page #t)"))}|
@h2{Specific Versions}
@blockquote{
@table[frame: 'box rules: 'rows cellpadding: 10]{