commit 9c5a45985b3dbd956d56c26a44eaad5d344e2aba
parent 5f29095f021c2d2fcfdd098a83691a2f4b162634
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 28 Dec 2017 15:59:54 -0600
html-properties: add `xexpr-property`
For injecting literal HTML (or, using `cdata`, literal anything) into
the rendered HTML of a document. If you must.
Diffstat:
4 files changed, 48 insertions(+), 9 deletions(-)
diff --git a/scribble-doc/scribblings/scribble/core.scrbl b/scribble-doc/scribblings/scribble/core.scrbl
@@ -2,6 +2,7 @@
@(require scribble/manual
(except-in "utils.rkt" url)
"struct-hierarchy.rkt"
+ (only-in scribble/eval as-examples)
(for-label scribble/manual-struct
racket/serialize
file/convertible
@@ -910,6 +911,9 @@ The following @tech{style properties} are currently recognized:
@item{@racket[script-property] structure --- For HTML, supplies a
script alternative to @racket[content].}
+ @item{@racket[xexpr-property] structure --- For HTML, supplies literal
+ HTML to render before and after @racket[content].}
+
@item{@racket[body-id] structure --- For HTML uses the given
string as an @tt{id} attribute of the @tt{<span>} tag.}
@@ -931,7 +935,8 @@ The following @tech{style properties} are currently recognized:
]
@history[#:changed "1.6" @elem{Changed @racket['exact-chars] handling to
- take effect when the style name is @racket[#f].}]}
+ take effect when the style name is @racket[#f].}
+ #:changed "1.27" @elem{Changed to support @racket[xexpr-property].}]}
@defstruct[(image-element element) ([path (or/c path-string?
@@ -1746,6 +1751,30 @@ Used as a @tech{style property} with @racket[element] to supply a
script alternative to the element content.}
+@defstruct[xexpr-property ([before xexpr/c]
+ [after xexpr/c])]{
+
+Used as a @tech{style property} with @racket[element] to supply literal
+HTML that is rendered before and after element content.
+
+@as-examples["Example:"
+@codeblock[#:keep-lang-line? #t]|{
+ #lang scribble/base
+ @(require scribble/core
+ scribble/html-properties
+ (only-in xml cdata))
+
+ @(define comments (xexpr-property
+ (cdata #f #f "<!-- before -->")
+ (cdata #f #f "<!-- after -->")))
+
+ Here is some
+ @elem[#:style (style #f (list comments))]{content with comments around}.
+}|]
+
+@history[#:added "1.27"]}
+
+
@defstruct[css-addition ([path (or/c path-string?
(cons/c 'collects (listof bytes?))
url?
diff --git a/scribble-lib/info.rkt b/scribble-lib/info.rkt
@@ -23,4 +23,4 @@
(define pkg-authors '(mflatt eli))
-(define version "1.26")
+(define version "1.27")
diff --git a/scribble-lib/scribble/html-properties.rkt b/scribble-lib/scribble/html-properties.rkt
@@ -8,6 +8,7 @@
[body-id ([value string?])]
[document-source ([module-path module-path?])]
+ [xexpr-property ([before xexpr/c] [after xexpr/c])]
[hover-property ([text string?])]
[script-property ([type string?]
[script (or/c path-string? (listof string?))])]
diff --git a/scribble-lib/scribble/html-render.rkt b/scribble-lib/scribble/html-render.rkt
@@ -1231,6 +1231,14 @@
(element-style->attribs (style-name s) s extras)
(element-style->attribs s #f extras))))
+ (define (element-style-property-matching e pred)
+ (and (or (element? e) (multiarg-element? e))
+ (ormap (lambda (v) (and (pred v) v))
+ (let ([s (if (element? e)
+ (element-style e)
+ (multiarg-element-style e))])
+ (if (style? s) (style-properties s) null)))))
+
(define/override (render-content e part ri)
(define (attribs [extras null]) (content-attribs e extras))
(cond
@@ -1320,13 +1328,8 @@
,@(if svg?
`((param ([name "src"] [value ,srcref])))
null)))))]
- [(and (or (element? e) (multiarg-element? e))
- (ormap (lambda (v) (and (script-property? v) v))
- (let ([s (if (element? e)
- (element-style e)
- (multiarg-element-style e))])
- (if (style? s) (style-properties s) null))))
- =>
+ [(element-style-property-matching e script-property?)
+ =>
(lambda (v)
(let* ([t `[type ,(script-property-type v)]]
[s (script-property-script v)]
@@ -1335,6 +1338,12 @@
`(script (,t ,@(attribs) [src ,s])))])
(list s
`(noscript ,@(render-plain-content e part ri)))))]
+ [(element-style-property-matching e xexpr-property?)
+ =>
+ (lambda (v)
+ (cons (xexpr-property-before v)
+ (append (render-plain-content e part ri)
+ (list (xexpr-property-after v)))))]
[(target-element? e)
`((a ([name ,(format "~a" (anchor-name (add-current-tag-prefix
(tag-key (target-element-tag e)
