diff --git a/collects/scribble/html-properties.rkt b/collects/scribble/html-properties.rkt index dc26d85178..8621d313d3 100644 --- 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 index 24c488a061..c7651bb5b6 100644 --- 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 index 2a39f127f3..a0723123e9 100644 --- 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{
} HTML output instead of - @tt{

}.} + @tt{

} (unless a @racket[alt-tag] property is provided).} + + @item{@racket[alt-tag] structure --- Generates the indicated HTML tag + instead of @tt{

} or @tt{

}.} @item{@racket[attributes] structure --- Provides additional HTML - attributes for the @tt{

} or @tt{

} tag.} + attributes for the @tt{

}, @tt{

}, or alternate tag.} @item{@racket[body-id] structure --- For HTML, uses the given string - as an @tt{id} attribute of the @tt{

} or @tt{

} tag.} + as an @tt{id} attribute of the @tt{

}, @tt{

}, 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{

}.} + @item{@racket[attributes] structure --- Provides additional HTML - attributes for the @tt{

} tag.} + attributes for the @tt{

} or alternate tag.} @item{@racket[body-id] structure --- For HTML, uses the given string - as an @tt{id} attribute of the @tt{

} tag.} + as an @tt{id} attribute of the @tt{

} 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{}, @tt{b}, @|etc|).} + @item{@racket[attributes] structure --- Provides additional HTML - attributes for a @tt{} 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{}, @tt{

}, @tt{div}, +@|etc|).} + @defstruct[url-anchor ([name string?])]{