commit 87f668de09e5a7ef582c4bcfb3466de770d092f2
parent a38f6d50f58296622ce16b8f0a10c5ff7867760d
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 4 Apr 2011 14:32:55 -0600
Scribble: add `alt-tag' HTML property to set HTML tag in output
original commit: c38118f0e5286affb480fcc9c4d30a09a75c4ec7
Diffstat:
3 files changed, 45 insertions(+), 11 deletions(-)
diff --git a/collects/scribble/html-properties.rkt b/collects/scribble/html-properties.rkt
@@ -13,4 +13,5 @@
[extra-files (listof (or/c path-string? (cons/c 'collects (listof bytes?))))])]
[url-anchor ([name string?])]
+ [alt-tag ([name (and/c string? #rx"^[a-zA-Z0-9]+$")])]
[attributes ([assoc (listof (cons/c symbol? string?))])])
diff --git a/collects/scribble/html-render.rkt b/collects/scribble/html-render.rkt
@@ -146,7 +146,12 @@
(if (string? name)
(cons `[class ,name]
a)
- a))))
+ a))))
+
+(define (style->tag style)
+ (for/or ([s (in-list (style-properties style))])
+ (and (alt-tag? s)
+ (string->symbol (alt-tag-name s)))))
(define (make-search-box top-path) ; appears on every page
(let ([sa string-append]
@@ -917,7 +922,10 @@
(not (style-name style))
(null? attrs))
contents
- `((,(if (memq 'div (style-properties style)) 'div 'p)
+ `((,(or (style->tag style)
+ (if (memq 'div (style-properties style))
+ 'div
+ 'p))
[,@attrs
,@(case (style-name style)
[(author) '([class "author"])]
@@ -1115,6 +1123,10 @@
(if (style? s)
(style-name s)
s))]
+ [alt-tag
+ (let ([s (content-style e)])
+ (and (style? s)
+ (style->tag s)))]
[link? (and (ormap target-url? properties)
(not (current-no-links)))]
[anchor? (ormap url-anchor? properties)]
@@ -1148,7 +1160,8 @@
(if (and (null? attribs)
(not link?)
(not anchor?)
- (not newline?))
+ (not newline?)
+ (not alt-tag))
content
`(,@(if anchor?
(append-map (lambda (v)
@@ -1158,6 +1171,7 @@
properties)
null)
(,(cond
+ [alt-tag alt-tag]
[link? 'a]
[newline? 'br]
[else 'span])
@@ -1267,8 +1281,10 @@
(nested-flow-blocks t)))))
(define/override (render-compound-paragraph t part ri starting-item?)
- `((p ,(style->attribs (compound-paragraph-style t))
- ,@(super render-compound-paragraph t part ri starting-item?))))
+ (let ([style (compound-paragraph-style t)])
+ `((,(or (style->tag style) 'p)
+ ,(style->attribs style)
+ ,@(super render-compound-paragraph t part ri starting-item?)))))
(define/override (render-itemization t part ri)
(let ([style-str (or (and (string? (style-name (itemization-style t)))
diff --git a/collects/scribblings/scribble/core.scrbl b/collects/scribblings/scribble/core.scrbl
@@ -420,13 +420,17 @@ The currently recognized @tech{style properties} are as follows:
content.}
@item{@racket['div] --- Generates @tt{<div>} HTML output instead of
- @tt{<p>}.}
+ @tt{<p>} (unless a @racket[alt-tag] property is provided).}
+
+ @item{@racket[alt-tag] structure --- Generates the indicated HTML tag
+ instead of @tt{<p>} or @tt{<div>}.}
@item{@racket[attributes] structure --- Provides additional HTML
- attributes for the @tt{<p>} or @tt{<div>} tag.}
+ attributes for the @tt{<p>}, @tt{<div>}, or alternate tag.}
@item{@racket[body-id] structure --- For HTML, uses the given string
- as an @tt{id} attribute of the @tt{<p>} or @tt{<div>} tag.}
+ as an @tt{id} attribute of the @tt{<p>}, @tt{<div>}, or
+ alternate tag.}
@item{@racket['never-indents] --- For Latex and @tech{compound
paragraphs}; see @racket[compound-paragraph].}
@@ -597,11 +601,14 @@ for Latex output (see @secref["extra-style"]). The following
name} is used as a command name instead of an environment
name.}
+ @item{@racket[alt-tag] structure --- Generates the given HTML tag
+ instead of @tt{<p>}.}
+
@item{@racket[attributes] structure --- Provides additional HTML
- attributes for the @tt{<p>} tag.}
+ attributes for the @tt{<p>} or alternate tag.}
@item{@racket[body-id] structure --- For HTML, uses the given string
- as an @tt{id} attribute of the @tt{<p>} tag.}
+ as an @tt{id} attribute of the @tt{<p>} or alternate tag.}
@item{@racket['never-indents] --- For Latex within another
@tech{compound paragraph}; see above.}
@@ -696,8 +703,11 @@ The following @tech{style properties} are currently recognized:
@item{@racket[background-color-property] structure --- Applies a color to the
background of @racket[content].}
+ @item{@racket[alt-tag] structure --- Generates the given HTML tag
+ instead of the default one (@tt{<span>}, @tt{b}, @|etc|).}
+
@item{@racket[attributes] structure --- Provides additional HTML
- attributes for a @tt{<span>} tag.}
+ attributes for a tag.}
@item{@racket[hover-property] structure --- For HTML, adds a text
label to the content to be shown when the mouse hovers over
@@ -1213,6 +1223,13 @@ Defined as
Used as a @tech{style property} to add arbitrary attributes to an HTML
tag.}
+@defstruct[alt-tag ([name (and/c string? #rx"^[a-zA-Z0-9]+$")])]{
+
+Use as a @tech{style property} for an @racket[element],
+@racket[paragraph], or @racket[compound-paragraph] to substitute an
+alternate HTML tag (instead of @tt{<span>}, @tt{<p>}, @tt{div},
+@|etc|).}
+
@defstruct[url-anchor ([name string?])]{
