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

improve handling of resources for sharing

Browse Source 
Separate the "generated resources" part of a site from the "rendered
element" part, so that a site that doesn't use full-page formatting
can take share the resources of one that does.

Also, hide the "resources" function in a site to narrow the interface
exported by `plt-web`.
This commit is contained in:
Matthew Flatt 2014-02-10 19:11:43 -07:00
parent 547957fb4d
commit cec98c7cea
12 changed files with 179 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
new-racket-web/new-plt-services/meta/new-web/stubs/blog.rkt
View File

@ -3,7 +3,8 @@
(require (only-in "../www/resources.rkt" www-site)
racket/port)
(define blog-site (site "stubs/blog" #:resources (site-resources www-site)))
(define blog-site (site "stubs/blog"
#:share-from www-site))
(define racket-css
@text{
@ -22,19 +23,24 @@
opacity: 1.0; filter: alpha(opacity=100);
}
/* --- navbar styles --- */
@navbar-style
@"@"import url("@(site-css-path www-site)");
})
(define font-family
@list{
font-family: Optima, Arial, Verdana, Helvetica, sans-serif;
})
(define (get-resource-text what #:args [args #f])
(define r ((site-resources www-site) what))
(define r (what www-site))
(define xml (if args (apply r args) r))
(define str (xml->string xml))
;; due to some obscure xml issue the `nbsp' entity is not recognized
;; in blogger pages
(regexp-replace* #rx" " str "\\ "))
(define (racket-navbar) (get-resource-text 'make-navbar #:args '(community)))
(define (racket-favicon) (get-resource-text 'icon-headers))
(define (racket-navbar) (get-resource-text site-navbar))
(define (racket-favicon) (get-resource-text site-favicon-path))
(provide blog)
(define blog
@ -231,7 +237,9 @@ a img {
// ELI:
margin-top: 0;
margin-bottom: 0;
@page-sizes
margin-left: auto;
margin-right: auto;
width: 45em;
padding: 10px;
text-align: left;
font: $bodyfont;

3
new-racket-web/new-plt-services/meta/new-web/stubs/dirlist.rkt
View File

@ -4,7 +4,8 @@
(require (only-in "../download/resources.rkt" download-site))
(define dirlist-site (site "stubs/dirlist" #:resources (site-resources download-site)))
(define dirlist-site (site "stubs/dirlist"
#:share-from download-site))
(define header+footer
(lazy (regexp-split #rx"{{{BODY}}}"

21
new-racket-web/new-plt-services/meta/new-web/stubs/docs.rkt
View File

@ -2,7 +2,10 @@
(require (only-in "../www/resources.rkt" www-site))
(define docs-site (site "stubs/docs" #:resources (site-resources www-site)))
(define docs-site (site "stubs/docs"
#:page-style? #f
#:meta? #t
#:share-from www-site))
(provide documentation)
(define documentation
@ -10,3 +13,19 @@
(page #:site docs-site
#:file "" #:link-title "Documentation" #:window-title "{{{TITLE}}}"
"\n{{{BODY}}}\n"))
(void
(plain #:site docs-site
#:file "doc-site.js"
@list{
@(site-navbar-dynamic-js docs-site)
AddOnLoad(AddNavbarToBody);
}))
(void
(plain #:site docs-site
#:file "doc-site.css"
@list{
@"@"import url("@(site-css-path docs-site)")
.navsettop, .tocset { top: 60px; }
.versionbox { top: 64px; }
}))

5
new-racket-web/new-plt-services/meta/new-web/stubs/git.rkt
View File

@ -6,7 +6,6 @@
(site "stubs/git"
#:robots (add-newlines (for/list ([d '(plt libs testing play)])
@list{Disallow: /@|d|/}))))
(define (the-resources) (site-resources git-site))
(provide git)
(define git
@ -44,9 +43,9 @@
our $site_header = "header.html";
our $site_footer = "footer.html";
our $home_text = "@(regexp-replace #rx"^.*/" (home-file) "")";
push @"@"stylesheets, "@((the-resources) 'style-path)";
push @"@"stylesheets, "@(site-css-path git-site)";
@||
our $favicon = "@((the-resources) 'icon-path)";
our $favicon = "@(site-favicon-path git-site)";
our $logo = "@gitweb-logo";
our $logo_url = "http://racket-lang.org/";
our $logo_label = "Racket Homepage";

5
new-racket-web/new-plt-services/meta/new-web/stubs/pkgs.rkt
View File

@ -1,7 +1,10 @@
#lang plt-web
(require (only-in "../www/resources.rkt" www-site))
(define pkgs-site (site "stubs/pkgs"
#:page-style? #f))
#:page-style? #f
#:share-from www-site))
(provide pkgs)
(define pkgs

2
new-racket-web/new-plt-services/meta/new-web/stubs/wiki.rkt
View File

@ -2,7 +2,7 @@
(require (only-in "../www/resources.rkt" www-site))
(define wiki-site (site "stubs/wiki" #:resources (site-resources www-site)))
(define wiki-site (site "stubs/wiki" #:share-from www-site))
(define template
(page #:site wiki-site

8
new-racket-web/new-plt-services/meta/new-web/www/index.rkt
View File

@ -345,7 +345,7 @@ computing and from databases to charts.
@columns[3 style: "text-color: black"]{
@h2[style: "font-size: 180%; margin-bottom: 10pt"]{News}
@p{Racket version 6.0 has been released.}
@p{@a[href: "http://con.racket-lang.org/"]{RacketCon 2014} will be in September in St Louis.}}}
@p{@-rcon[2014]{RacketCon 2014} will be in September in St Louis.}}}
@columns[12 #:row? #t #:center? #t style: "text-align:justify;font-size: 120%; margin-top: 20pt; "]{
@ -423,11 +423,9 @@ explains how to install
@row{
@columns[4]{
@panetitle{News & Events}
@p{@a[href: "http://con.racket-lang.org/"]{RacketCon} — The annual
@p{@-rcon[#f]{RacketCon} — The annual
Racket meeting, coming up in September. Previously
in @a[href: "http://con.racket-lang.org/2013/"]{2013},
@a[href: "http://con.racket-lang.org/2012/"]{2012},
and @a[href: "http://con.racket-lang.org/2011/"]{2011}.}
@-rcon[2013], @-rcon[2012], and @-rcon[2011].}
@p{@a[href: "http://blog.racket-lang.org/"]{Blog}
— Announcements, helpful hints, and thoughtful rants.}

87
new-racket-web/plt-web-pkgs/plt-web-doc/plt-web.scrbl
View File

@ -35,10 +35,9 @@ relative directory is mapped to a destination URL via
@defproc[(site [dir path-string?]
[#:url url (or/c string? #f) #f]
[#:resources resources (or/c #f
((or/c symbol? path-string?) . -> . any/c))
#f]
[#:share-from share-from (or/c site? #f) #f]
[#:page-style? page-style? any/c #t]
[#:meta? meta? any/c page-style?]
[#:robots robots (or/c #f #t outputable/c) #t]
[#:htaccess htaccess (or/c #f #t outputable/c) #t]
[#:navigation navigation (listof outputable/c) null])
@ -48,54 +47,17 @@ Creates a value that represents a site. If @racket[url] is not
@racket[#f], then it will be registered to @racket[url-roots] for a
build in web mode (as opposed to local mode).
The @racket[resources] procedure determines a mapping from an abstract
(symbol) or concrete (path) resource to the content or references to
the resource. Normally, and when @racket[#f] is provided as
@racket[resources], the resource mapping is computed automatically
based on the default page style and arguments such as @racket[robots],
@racket[htaccess], and @racket[navigation]. A resource-mapping
function must support at least the following arguments:
If @racket[share-from] is a site, then resources generated for the
site (such as icons or CSS files) are used when as possible for the
new site.
@itemlist[
@item{@racket['preamble] : @racket[outputable/c] --- content to precede
the @tag{html} tag, such as @racket[(doctype 'html)].}
@item{@racket['postamble] : @racket[outputable/c] --- content to
follow the rest of the page content (after the @tag{body}
tag).}
@item{@racket['headers] : @racket[outputable/c] --- content to
included in the @tag{head} tag.}
@item{@racket['make-navbar] : @racket[(any/c . -> . outputable)] ---
given the destination page, produces content to precede the
rest of the page content (within the @tag{body}
tag).}
@item{@racket['icon-headers] : @racket[outputable/c] --- content to
specify a ``favicon'' for the page, included already
in @racket['headers] content.}
@item{@racket['style-path] : @racket[outputable/c] --- reference to a
resource for the page's CSS, included already in
@racket['headers] content.}
@item{@racket['logo-path] : @racket[outputable/c] --- reference to a
resource for a logo, included already in @racket['headers]
content.}
@item{@racket['icon-path] : @racket[outputable/c] --- reference to a
resource for a ``favicon'', included already in
@racket['icon-headers] content.}
]
If @racket[page-style?] is true, then the default resource-mapping
function for the site includes content to set the style of the overall
page. Otherwise, only sufficient resources and content are included to
specify the style of the PLT web-page header (i.e., a bar with the
Racket logo).
If @racket[page-style?] is true, HTML pages generated for the site
include content to set the style of the overall page. Otherwise, only
sufficient resources and content are included to specify the style of
the PLT web-page header (i.e., a bar with the Racket logo).
If @racket[meta?] is true, then @filepath{.htaccess},
@filepath{robots.txt}, and similar files are generated for the site.
The @racket[robots] and @racket[htaccess] arguments determine robot
and access information included by the default resource-mapping
function. A @racket[#t] value enables normal access, a @racket[#f]
@ -117,10 +79,28 @@ Returns @racket[#t] if @racket[v] represents a site, @racket[#f] otherwise.}
Extracts the destination directory of @racket[s].}
@defproc[(site-resources [s site?]) ((or/c symbol? path-string?) . -> . any/c)]{
@defproc[(site-css-path [s site?]) outputable/c]{
Extracts the resource-mapping function from @racket[s].}
Extracts a reference to a CSS resource for HTML pages at site
@racket[s].}
@defproc[(site-favicon-path [s site?]) outputable/c]{
Extracts a reference to a @filepath{favicon.ico} file for the
site @racket[s]. The result is @racket[#f] if meta-file resources are not
generated for the site.}
@defproc[(site-navbar [s site?]) outputable/c]{
Generates HTML for the banner on HTML pages at the site @racket[s].}
@defproc[(site-navbar-dynamic-js [s site?]) outputable/c]{
Generates a JavaScript definition of a @tt{AddNavbarToBody} function,
which adds a banner dynamically to the current page for a page at site
@racket[s].}
@; ----------------------------------------
@ -259,3 +239,8 @@ that is introduced by @racketmodname[plt-web]:
Extracts a file name from a path.}
@defproc[(web-path [str string?] ...) string?]{
Joins @racket[str]s with a @racket["/"] separator to form a relative
URL path.}

110
new-racket-web/plt-web-pkgs/plt-web-lib/layout.rkt
View File

@ -9,8 +9,11 @@
symlink
(rename-out [mk-site site])
site?
site-resources
site-dir)
site-dir
site-css-path
site-favicon-path
site-navbar
site-navbar-dynamic-js)
(define-for-syntax (process-contents who layouter stx xs)
(let loop ([xs xs] [kws '()] [id? #f])
@ -136,13 +139,10 @@
(list-ref l n)
d))
(define ((navbar-maker logo columns page-style?) this)
(define ((navbar-content logo columns page-style?))
(define (icon name) @i[class: name]{})
(define (row . content) (apply div class: "row" content))
(define (row . content) (apply div class: "row" content))
(define main-promise (resource "www/" #f))
@div[class: "navbar gumby-content" gumby-fixed: "top" id: "nav1"]{
@row{
@(if page-style?
@a[class: "toggle" gumby-trigger: "#nav1 > .row > ul" href: "#"]{
@ -154,7 +154,11 @@
@li{@(list-ref* columns 0 "")}
@li{@(list-ref* columns 1 "")}
@li{@(list-ref* columns 2 "")}
@li{@(list-ref* columns 3 "")}}}})
@li{@(list-ref* columns 3 "")}}})
(define ((navbar-maker logo columns page-style?) this)
@div[class: "navbar gumby-content" gumby-fixed: "top" id: "nav1"]{
@((navbar-content logo columns page-style?))})
(define gumby-preamble
@list{
@ -190,7 +194,6 @@
@link[rel: "shortcut icon" href: icon type: "image/x-icon"]})
(define (html-headers resources favicon page-style?)
(define style (resources 'style-path))
@list{
@meta[name: "generator" content: "Racket"]
@meta[http-equiv: "Content-Type" content: "text/html; charset=utf-8"]
@ -207,14 +210,7 @@
@; @link[rel: "stylesheet" href="css/minified.css"]
@; CSS imports non-minified for staging, minify before moving to
@; production
@(if page-style?
@link[rel: "stylesheet" href: (resources "gumby.css")]
@link[rel: "stylesheet" href: (resources "gumby-slice.css")])
@;@link[rel: "stylesheet" href: (resources "style.css")]
@; TODO: Modify `racket-style' definition (and what it depends on)
@; in "resources.rkt", possibly do something similar with the new files
@(and style
@link[rel: "stylesheet" type: "text/css" href: style title: "default"])
@link[rel: "stylesheet" href: (resources 'style-path)]
@; TODO: Edit the `more.css' definition in www/index.rkt
@; More ideas for your <head> here: h5bp.com/d/head-Tips
@; All JavaScript at the bottom, except for Modernizr / Respond.
@ -227,27 +223,39 @@
null)
})
(define (make-resources files navigation page-style?)
(define (make-resources files navigation page-style? sharing-site)
(define (recur/share what)
(if sharing-site
((site-resources sharing-site) what)
(resources what)))
(define (resources what)
(case what
;; composite resources
[(page-style?) page-style?]
[(preamble) preamble]
[(postamble) postamble]
[(headers) headers]
[(make-navbar) make-navbar] ; page -> navbar
[(make-navbar-content) make-navbar-content] ; -> outputable
[(icon-headers) icon-headers]
;; aliases for specific resource files
[(style-path) (and page-style? (resources "plt.css"))]
[(logo-path) (resources "logo-and-text.png")]
[(icon-path) (and page-style? (resources "plticon.ico"))]
[(style-path) (recur/share
(if page-style?
"gumby.css"
"gumby-slice.css"))]
[(logo-path) (recur/share "logo-and-text.png")]
[(icon-path) (and page-style?
(recur/share "plticon.ico"))]
;; get a resource file path
[else (cond [(assoc what files)
;; delay the `url-of' until we're in the rendering context
=> (λ(f) (λ() (url-of (cadr f))))]
[sharing-site (recur/share what)]
[else (error 'resource "unknown resource: ~e" what)])]))
(define icon-headers (html-icon-headers (resources 'icon-path)))
(define headers (html-headers resources icon-headers page-style?))
(define make-navbar (navbar-maker (resources 'logo-path) navigation page-style?))
(define make-navbar-content (navbar-content (resources 'logo-path) navigation page-style?))
(define preamble (cons @doctype['html]
(if page-style? gumby-preamble null)))
(define postamble (if page-style? (make-gumby-postamble resources) null))
@ -272,24 +280,58 @@
#:htaccess [htaccess #t]
#:navigation [navigation null]
#:page-style? [page-style? #t]
#:resources [resources #f])
#:meta? [meta? page-style?]
#:share-from [given-sharing-site #f])
(when url
(extra-roots (cons (list dir url)
(extra-roots))))
(define sharing-site
;; Can use given site only if it has enough relative to
;; this one:
(and given-sharing-site
(or ((site-resources given-sharing-site) 'page-style?)
(not page-style?))
given-sharing-site))
(define the-site
(make-site dir (delay
(or resources
(make-resources
(make-resource-files
(λ (id . content)
(page* #:id id
#:site the-site
content))
dir robots htaccess
(or page-style?
(pair? navigation)))
navigation
page-style?)))))
(make-resources
(make-resource-files
(λ (id . content)
(page* #:id id
#:site the-site
content))
dir robots htaccess
(or page-style?
(pair? navigation))
meta?
(and sharing-site
#t))
navigation
page-style?
sharing-site))))
the-site)])
site))
(define (site-css-path s)
((site-resources s) 'style-path))
(define (site-favicon-path s)
((site-resources s) 'icon-path))
(define (site-navbar s)
(((site-resources s) 'make-navbar) #f))
(define (site-navbar-dynamic-js s)
(define xml (((site-resources s) 'make-navbar-content)))
@list{
function AddNavbarToBody() {
var body = document.getElementsByTagName("body")[0];
var h = document.createElement('div');
h.setAttribute("class", "navbar gumby-content");
h.innerHTML = @(let ([p (open-output-string)])
(output xml p)
(format "~s" (regexp-replace* #rx"\n +" (get-output-string p) "")));
body.insertBefore(h, body.firstChild);
}
})

2
new-racket-web/plt-web-pkgs/plt-web-lib/links.rkt
View File

@ -51,7 +51,7 @@
(define* -bootstrap @make-link["http://www.bootstrapworld.org/"]{Bootstrap})
(define* (-rcon [year #f] . text)
(define years '(2013 2012 2011))
(define years '(2014 2013 2012 2011))
(a href: (list "http://con.racket-lang.org/"
(and year (not (eq? year (car years))) (list year "/")))
(cond [(pair? text) text]

4
new-racket-web/plt-web-pkgs/plt-web-lib/main.rkt
View File

@ -1,9 +1,9 @@
#lang racket/base
(require (except-in scribble/html/lang #%module-begin)
"layout.rkt" "resources.rkt" "extras.rkt" "links.rkt" "utils.rkt")
"layout.rkt" "extras.rkt" "links.rkt" "utils.rkt")
(provide (all-from-out scribble/html/lang
"layout.rkt" "resources.rkt" "extras.rkt" "links.rkt")
"layout.rkt" "extras.rkt" "links.rkt")
basename web-path url-of ; from "utils.rkt"
(rename-out [module-begin #%module-begin]))

84
new-racket-web/plt-web-pkgs/plt-web-lib/resources.rkt
View File

@ -11,8 +11,7 @@
(require "utils.rkt")
(provide make-resource-files
navbar-style page-sizes font-family) ; needed for the blog template
(provide make-resource-files)
(define-runtime-path resources-dir "resources")
@ -20,7 +19,7 @@
;; they can be #t (the default) for the standard ones, or some text that gets
;; added to the standard contents -- which is the user-agent line and the
;; ErrorDocument respectively.
(define (make-resource-files page dir robots htaccess page-style?)
(define (make-resource-files page dir robots htaccess page-style? meta? sharing?)
;; the default target argument duplicate the behavior in "utils.rkt"
(define (copyfile file [target (basename file)])
(list target (copyfile-resource (build-path resources-dir file) (web-path dir target))))
@ -31,12 +30,11 @@
(list file
(apply page (string->symbol (regexp-replace #rx"[.]html$" file ""))
contents)))
`(,@(if page-style?
(list
(writefile "plt.css" racket-style))
`(,@(if (not sharing?)
(list (copyfile "logo-and-text.png" "logo-and-text.png"))
null)
,(copyfile "logo-and-text.png" "logo-and-text.png")
,@(if page-style?
,@(if (and page-style?
(not sharing?))
(list
(copyfile "css/gumby.css" "gumby.css")
(copyfile "js/libs/jquery-1.9.1.min.js" "jquery-1.9.1.min.js")
@ -47,12 +45,20 @@
(copyfile "fonts/icons/entypo.ttf" "entypo.ttf")
(copyfile "fonts/icons/entypo.woff" "entypo.woff")
(copyfile "fonts/icons/entypo.eot" "entypo.eot"))
(list
(copyfile "css/gumby-slice.css" "gumby-slice.css")))
,@(if page-style?
null)
,@(if (not sharing?)
;; Not used in `page-style?` mode, but available for sharing
;; for non-`page-style?` sites:
(list (copyfile "css/gumby-slice.css" "gumby-slice.css"))
null)
,@(if (and page-style?
(not sharing?))
(list
(copyfile "plticon.ico" "plticon.ico")
(copyfile "logo.png" "logo.png") ; a kind of backward compatibility, just in case
(copyfile "logo.png" "logo.png")) ; a kind of backward compatibility, just in case
null)
,@(if meta?
(list
;; the following resources are not used directly, so their names are
;; irrelevant
@writefile["google5b2dc47c0b1b15cb.html"]{
@ -80,57 +86,3 @@
[t (if (boolean? htaccess) t (list htaccess "\n" t))])
(if t (writefile ".htaccess" t) '(#f #f))))
null)))
(define page-sizes
@list{
margin-left: auto;
margin-right: auto;
width: 45em;
})
(define navbar-style
@list{})
(define font-family
@list{
font-family: Optima, Arial, Verdana, Helvetica, sans-serif;
})
(define racket-style
@list{
@; ---- generic styles ----
html {
overflow-y: scroll;
}
body {
color: black;
background-color: white;
margin: 0px;
padding: 0px;
}
a {
text-decoration: none;
}
a:hover {
text-decoration: underline;
}
@; ---- content styles ----
.bodycontent {
@page-sizes
}
@; ---- styles for extras ----
.parlisttitle {
margin-bottom: 0.5em;
}
.parlistitem {
margin-bottom: 0.5em;
margin-left: 2em;
}
tt {
font-family: Inconsolata;
}
i { font-style: italic; }
})