From 3fb42cf3f1b49e1cdf024c32a8f969011c2be9b3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 11 Sep 2012 18:52:59 -0600 Subject: [PATCH] scribble/html-properties: allow URLs in `css-addition' and `js-addition' --- collects/net/url-structs.rkt | 2 +- collects/net/url.rkt | 4 ++-- collects/scribble/base-render.rkt | 5 ++++- collects/scribble/html-properties.rkt | 7 ++++--- collects/scribble/html-render.rkt | 6 ++++-- collects/scribblings/scribble/core.scrbl | 10 +++++++--- 6 files changed, 22 insertions(+), 12 deletions(-) diff --git a/collects/net/url-structs.rkt b/collects/net/url-structs.rkt index 094d848b21..ee6177c11f 100644 --- a/collects/net/url-structs.rkt +++ b/collects/net/url-structs.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/contract racket/serialize) +(require racket/contract/base racket/serialize) (define-serializable-struct url (scheme user host port path-absolute? path query fragment) diff --git a/collects/net/url.rkt b/collects/net/url.rkt index aa30803bad..08d642f5cf 100644 --- a/collects/net/url.rkt +++ b/collects/net/url.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/unit racket/port racket/string racket/contract +(require racket/port racket/string racket/contract/base "url-connect.rkt" "url-structs.rkt" "uri-codec.rkt") @@ -24,7 +24,7 @@ ;; structs. since only the url-exception? predicate ;; was exported, we just add this in to the predicate ;; to preserve backwards compatibility - (and (exn:fail:contract:blame? x) + (and (exn:fail:contract? x) (regexp-match? #rx"^string->url:" (exn-message x))))) (define file-url-path-convention-type (make-parameter (system-path-convention-type))) diff --git a/collects/scribble/base-render.rkt b/collects/scribble/base-render.rkt index b112289b10..cbc6da6cb0 100644 --- a/collects/scribble/base-render.rkt +++ b/collects/scribble/base-render.rkt @@ -9,6 +9,7 @@ setup/main-collects setup/path-relativize file/convertible + net/url-structs "render-struct.rkt") (provide render% @@ -103,7 +104,9 @@ (unless (stop-at-part? p) (loop p #f #f))) (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) (for ([v (in-list (style-properties s))]) diff --git a/collects/scribble/html-properties.rkt b/collects/scribble/html-properties.rkt index 4c95fd08b7..b1f7d16e56 100644 --- a/collects/scribble/html-properties.rkt +++ b/collects/scribble/html-properties.rkt @@ -1,15 +1,16 @@ #lang scheme/base (require "private/provide-structs.rkt" racket/contract/base - xml/xexpr) + xml/xexpr + net/url-structs) (provide-structs [body-id ([value string?])] [hover-property ([text string?])] [script-property ([type string?] [script (or/c path-string? (listof string?))])] - [css-addition ([path (or/c path-string? (cons/c 'collects (listof bytes?)) bytes?)])] - [js-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?)) url? 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?)))] [extra-files (listof (or/c path-string? (cons/c 'collects (listof bytes?))))])] diff --git a/collects/scribble/html-render.rkt b/collects/scribble/html-render.rkt index 584640957e..56b176e6ef 100644 --- a/collects/scribble/html-render.rkt +++ b/collects/scribble/html-render.rkt @@ -63,6 +63,8 @@ (lambda (file path) (cond [(bytes? file) (make-inline (bytes->string/utf-8 file))] + [(url? file) + (make-ref (url->string file))] [(not (eq? 'inline path)) (make-ref (or path (let-values ([(base name dir?) (split-path file)]) @@ -671,7 +673,7 @@ ,title ,(scribble-css-contents scribble-css (lookup-path scribble-css alt-paths)) ,@(map (lambda (style-file) - (if (bytes? style-file) + (if (or (bytes? style-file) (url? style-file)) (scribble-css-contents style-file #f) (let ([p (lookup-path style-file alt-paths)]) (unless p (install-file style-file)) @@ -687,7 +689,7 @@ style-extra-files)) ,(scribble-js-contents script-file (lookup-path script-file alt-paths)) ,@(map (lambda (script-file) - (if (bytes? script-file) + (if (or (bytes? script-file) (url? script-file)) (scribble-js-contents script-file #f) (let ([p (lookup-path script-file alt-paths)]) (unless p (install-file script-file)) diff --git a/collects/scribblings/scribble/core.scrbl b/collects/scribblings/scribble/core.scrbl index 4672e9cbdf..2be4e7bbe5 100644 --- a/collects/scribblings/scribble/core.scrbl +++ b/collects/scribblings/scribble/core.scrbl @@ -1,11 +1,13 @@ #lang scribble/doc -@(require scribble/manual "utils.rkt" +@(require scribble/manual + (except-in "utils.rkt" url) "struct-hierarchy.rkt" (for-label scribble/manual-struct file/convertible setup/main-collects scriblib/render-cond - xml/xexpr)) + xml/xexpr + net/url-structs)) @title[#:tag "core"]{Structures And Processing} @@ -1393,10 +1395,11 @@ script alternative to the element content.} @defstruct[css-addition ([path (or/c path-string? (cons/c 'collects (listof bytes?)) + url? bytes?)])]{ 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 property can be attached to any style, and all additions are collected 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? (cons/c 'collects (listof bytes?)) + url? bytes?)])]{ Like @racket[css-addition], but for a Javascript file instead of a CSS file.}