html-properties: add xexpr-property
For injecting literal HTML (or, using `cdata`, literal anything) into the rendered HTML of a document. If you must.
This commit is contained in:
parent
5f29095f02
commit
9c5a45985b
|
@ -2,6 +2,7 @@
|
||||||
@(require scribble/manual
|
@(require scribble/manual
|
||||||
(except-in "utils.rkt" url)
|
(except-in "utils.rkt" url)
|
||||||
"struct-hierarchy.rkt"
|
"struct-hierarchy.rkt"
|
||||||
|
(only-in scribble/eval as-examples)
|
||||||
(for-label scribble/manual-struct
|
(for-label scribble/manual-struct
|
||||||
racket/serialize
|
racket/serialize
|
||||||
file/convertible
|
file/convertible
|
||||||
|
@ -910,6 +911,9 @@ The following @tech{style properties} are currently recognized:
|
||||||
@item{@racket[script-property] structure --- For HTML, supplies a
|
@item{@racket[script-property] structure --- For HTML, supplies a
|
||||||
script alternative to @racket[content].}
|
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
|
@item{@racket[body-id] structure --- For HTML uses the given
|
||||||
string as an @tt{id} attribute of the @tt{<span>} tag.}
|
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
|
@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?
|
@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.}
|
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?
|
@defstruct[css-addition ([path (or/c path-string?
|
||||||
(cons/c 'collects (listof bytes?))
|
(cons/c 'collects (listof bytes?))
|
||||||
url?
|
url?
|
||||||
|
|
|
@ -23,4 +23,4 @@
|
||||||
|
|
||||||
(define pkg-authors '(mflatt eli))
|
(define pkg-authors '(mflatt eli))
|
||||||
|
|
||||||
(define version "1.26")
|
(define version "1.27")
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
[body-id ([value string?])]
|
[body-id ([value string?])]
|
||||||
[document-source ([module-path module-path?])]
|
[document-source ([module-path module-path?])]
|
||||||
|
|
||||||
|
[xexpr-property ([before xexpr/c] [after xexpr/c])]
|
||||||
[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?))])]
|
||||||
|
|
|
@ -1231,6 +1231,14 @@
|
||||||
(element-style->attribs (style-name s) s extras)
|
(element-style->attribs (style-name s) s extras)
|
||||||
(element-style->attribs s #f 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/override (render-content e part ri)
|
||||||
(define (attribs [extras null]) (content-attribs e extras))
|
(define (attribs [extras null]) (content-attribs e extras))
|
||||||
(cond
|
(cond
|
||||||
|
@ -1320,12 +1328,7 @@
|
||||||
,@(if svg?
|
,@(if svg?
|
||||||
`((param ([name "src"] [value ,srcref])))
|
`((param ([name "src"] [value ,srcref])))
|
||||||
null)))))]
|
null)))))]
|
||||||
[(and (or (element? e) (multiarg-element? e))
|
[(element-style-property-matching e script-property?)
|
||||||
(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))))
|
|
||||||
=>
|
=>
|
||||||
(lambda (v)
|
(lambda (v)
|
||||||
(let* ([t `[type ,(script-property-type v)]]
|
(let* ([t `[type ,(script-property-type v)]]
|
||||||
|
@ -1335,6 +1338,12 @@
|
||||||
`(script (,t ,@(attribs) [src ,s])))])
|
`(script (,t ,@(attribs) [src ,s])))])
|
||||||
(list s
|
(list s
|
||||||
`(noscript ,@(render-plain-content e part ri)))))]
|
`(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)
|
[(target-element? e)
|
||||||
`((a ([name ,(format "~a" (anchor-name (add-current-tag-prefix
|
`((a ([name ,(format "~a" (anchor-name (add-current-tag-prefix
|
||||||
(tag-key (target-element-tag e)
|
(tag-key (target-element-tag e)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user