From fa4c073b9e26653ab55d4755b7c57da0786070bd Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 26 Dec 2011 13:33:31 -0500 Subject: [PATCH] Adjust `meta/web' for changes in `scribble/html'. 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'. --- collects/meta/web/common/layout.rkt | 24 ++++++++-------- collects/meta/web/common/resources.rkt | 8 +++--- collects/meta/web/common/utils.rkt | 38 ++++++++++++++++++-------- collects/meta/web/minis/drracket.rkt | 2 +- collects/meta/web/stubs/blog.rkt | 3 +- collects/meta/web/stubs/git.rkt | 2 +- collects/meta/web/www/download.rkt | 2 +- collects/meta/web/www/irc.rkt | 2 +- collects/meta/web/www/techreports.rkt | 4 +-- 9 files changed, 48 insertions(+), 37 deletions(-) diff --git a/collects/meta/web/common/layout.rkt b/collects/meta/web/common/layout.rkt index d98ab56b57..af48d11c8d 100644 --- a/collects/meta/web/common/layout.rkt +++ b/collects/meta/web/common/layout.rkt @@ -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)))) diff --git a/collects/meta/web/common/resources.rkt b/collects/meta/web/common/resources.rkt index 4445ff5911..80520e1430 100644 --- a/collects/meta/web/common/resources.rkt +++ b/collects/meta/web/common/resources.rkt @@ -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{ diff --git a/collects/meta/web/common/utils.rkt b/collects/meta/web/common/utils.rkt index e74aa1f938..37d95f1750 100644 --- a/collects/meta/web/common/utils.rkt +++ b/collects/meta/web/common/utils.rkt @@ -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)) diff --git a/collects/meta/web/minis/drracket.rkt b/collects/meta/web/minis/drracket.rkt index bc1c5bb0ca..1574df2b7f 100644 --- a/collects/meta/web/minis/drracket.rkt +++ b/collects/meta/web/minis/drracket.rkt @@ -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|{ diff --git a/collects/meta/web/stubs/blog.rkt b/collects/meta/web/stubs/blog.rkt index c3646caa7b..26249ab4c7 100644 --- a/collects/meta/web/stubs/blog.rkt +++ b/collects/meta/web/stubs/blog.rkt @@ -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). @; diff --git a/collects/meta/web/stubs/git.rkt b/collects/meta/web/stubs/git.rkt index 76130fa74a..e421d7e53e 100644 --- a/collects/meta/web/stubs/git.rkt +++ b/collects/meta/web/stubs/git.rkt @@ -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"]{ diff --git a/collects/meta/web/www/download.rkt b/collects/meta/web/www/download.rkt index b4ed2786e4..1a1ac0aacd 100644 --- a/collects/meta/web/www/download.rkt +++ b/collects/meta/web/www/download.rkt @@ -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;" diff --git a/collects/meta/web/www/irc.rkt b/collects/meta/web/www/irc.rkt index be2510ca49..d9bd70922b 100644 --- a/collects/meta/web/www/irc.rkt +++ b/collects/meta/web/www/irc.rkt @@ -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] diff --git a/collects/meta/web/www/techreports.rkt b/collects/meta/web/www/techreports.rkt index cba36e7311..3b78d699ee 100644 --- a/collects/meta/web/www/techreports.rkt +++ b/collects/meta/web/www/techreports.rkt @@ -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]{