Scribble: add `alt-tag' HTML property to set HTML tag in output

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?))])])

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)))

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?])]{