scribble/html-properties: allow URLs in css-addition' and js-addition'

original commit: 3fb42cf3f1b49e1cdf024c32a8f969011c2be9b3
This commit is contained in:
Matthew Flatt 2012-09-11 18:52:59 -06:00
parent 4a512f6a66
commit e15bf50937
4 changed files with 19 additions and 9 deletions

View File

@ -9,6 +9,7 @@
setup/main-collects setup/main-collects
setup/path-relativize setup/path-relativize
file/convertible file/convertible
net/url-structs
"render-struct.rkt") "render-struct.rkt")
(provide render% (provide render%
@ -103,7 +104,9 @@
(unless (stop-at-part? p) (unless (stop-at-part? p)
(loop p #f #f))) (loop p #f #f)))
(part-parts p))))) (part-parts p)))))
(for/list ([k (in-hash-keys ht)]) (if (bytes? k) k (main-collects-relative->path k))))) (for/list ([k (in-hash-keys ht)]) (if (or (bytes? k) (url? k))
k
(main-collects-relative->path k)))))
(define/private (extract-style-style-files s ht pred extract) (define/private (extract-style-style-files s ht pred extract)
(for ([v (in-list (style-properties s))]) (for ([v (in-list (style-properties s))])

View File

@ -1,15 +1,16 @@
#lang scheme/base #lang scheme/base
(require "private/provide-structs.rkt" (require "private/provide-structs.rkt"
racket/contract/base racket/contract/base
xml/xexpr) xml/xexpr
net/url-structs)
(provide-structs (provide-structs
[body-id ([value string?])] [body-id ([value string?])]
[hover-property ([text string?])] [hover-property ([text string?])]
[script-property ([type string?] [script-property ([type string?]
[script (or/c path-string? (listof string?))])] [script (or/c path-string? (listof string?))])]
[css-addition ([path (or/c path-string? (cons/c 'collects (listof bytes?)) bytes?)])] [css-addition ([path (or/c path-string? (cons/c 'collects (listof bytes?)) url? bytes?)])]
[js-addition ([path (or/c path-string? (cons/c 'collects (listof bytes?)) bytes?)])] [js-addition ([path (or/c path-string? (cons/c 'collects (listof bytes?)) url? bytes?)])]
[html-defaults ([prefix-path (or/c bytes? path-string? (cons/c 'collects (listof bytes?)))] [html-defaults ([prefix-path (or/c bytes? path-string? (cons/c 'collects (listof bytes?)))]
[style-path (or/c bytes? path-string? (cons/c 'collects (listof bytes?)))] [style-path (or/c bytes? path-string? (cons/c 'collects (listof bytes?)))]
[extra-files (listof (or/c path-string? (cons/c 'collects (listof bytes?))))])] [extra-files (listof (or/c path-string? (cons/c 'collects (listof bytes?))))])]

View File

@ -63,6 +63,8 @@
(lambda (file path) (lambda (file path)
(cond [(bytes? file) (cond [(bytes? file)
(make-inline (bytes->string/utf-8 file))] (make-inline (bytes->string/utf-8 file))]
[(url? file)
(make-ref (url->string file))]
[(not (eq? 'inline path)) [(not (eq? 'inline path))
(make-ref (or path (let-values ([(base name dir?) (make-ref (or path (let-values ([(base name dir?)
(split-path file)]) (split-path file)])
@ -671,7 +673,7 @@
,title ,title
,(scribble-css-contents scribble-css (lookup-path scribble-css alt-paths)) ,(scribble-css-contents scribble-css (lookup-path scribble-css alt-paths))
,@(map (lambda (style-file) ,@(map (lambda (style-file)
(if (bytes? style-file) (if (or (bytes? style-file) (url? style-file))
(scribble-css-contents style-file #f) (scribble-css-contents style-file #f)
(let ([p (lookup-path style-file alt-paths)]) (let ([p (lookup-path style-file alt-paths)])
(unless p (install-file style-file)) (unless p (install-file style-file))
@ -687,7 +689,7 @@
style-extra-files)) style-extra-files))
,(scribble-js-contents script-file (lookup-path script-file alt-paths)) ,(scribble-js-contents script-file (lookup-path script-file alt-paths))
,@(map (lambda (script-file) ,@(map (lambda (script-file)
(if (bytes? script-file) (if (or (bytes? script-file) (url? script-file))
(scribble-js-contents script-file #f) (scribble-js-contents script-file #f)
(let ([p (lookup-path script-file alt-paths)]) (let ([p (lookup-path script-file alt-paths)])
(unless p (install-file script-file)) (unless p (install-file script-file))

View File

@ -1,11 +1,13 @@
#lang scribble/doc #lang scribble/doc
@(require scribble/manual "utils.rkt" @(require scribble/manual
(except-in "utils.rkt" url)
"struct-hierarchy.rkt" "struct-hierarchy.rkt"
(for-label scribble/manual-struct (for-label scribble/manual-struct
file/convertible file/convertible
setup/main-collects setup/main-collects
scriblib/render-cond scriblib/render-cond
xml/xexpr)) xml/xexpr
net/url-structs))
@title[#:tag "core"]{Structures And Processing} @title[#:tag "core"]{Structures And Processing}
@ -1393,10 +1395,11 @@ script alternative to the element content.}
@defstruct[css-addition ([path (or/c path-string? @defstruct[css-addition ([path (or/c path-string?
(cons/c 'collects (listof bytes?)) (cons/c 'collects (listof bytes?))
url?
bytes?)])]{ bytes?)])]{
Used as a @tech{style property} to supply a CSS file (if @racket[path] Used as a @tech{style property} to supply a CSS file (if @racket[path]
is a path, string, or list) or content (if @racket[path] is a byte is a path, string, or list), URL (if @racket[path] is a @racket[url]) or content (if @racket[path] is a byte
string) to be referenced or included in the generated HTML. This string) to be referenced or included in the generated HTML. This
property can be attached to any style, and all additions are collected property can be attached to any style, and all additions are collected
to the top of the generated HTML page. to the top of the generated HTML page.
@ -1407,6 +1410,7 @@ The @racket[path] field can be a result of
@defstruct[js-addition ([path (or/c path-string? @defstruct[js-addition ([path (or/c path-string?
(cons/c 'collects (listof bytes?)) (cons/c 'collects (listof bytes?))
url?
bytes?)])]{ bytes?)])]{
Like @racket[css-addition], but for a Javascript file instead of a CSS file.} Like @racket[css-addition], but for a Javascript file instead of a CSS file.}