suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

scribble HTML rendering merges style attributes

Browse Source 
This change fixes using `color-property` and `background-color-property`
at the same time, for example.

original commit: d2e1396b136ecb4917233106ba805823207c6592
This commit is contained in:
Matthew Flatt 2013-11-08 05:48:26 -07:00
parent d612610615
commit 644ea52438
3 changed files with 49 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl
View File

@ -450,6 +450,16 @@ The recognized @tech{style properties} are as follows:
content for the @tt{<head>} tag when the part corresponds to
its own HTML page.}
@item{@racket[color-property] structure --- For HTML, applies a color
to the part title.}
@item{@racket[background-color-property] structure --- For HTML,
Applies a color to the background of the part title.}
@item{@racket[hover-property] structure --- For HTML, adds a text
label to the title to be shown when the mouse hovers over
it.}
]
The @racket[to-collect] field contains @techlink{content} that is
@ -808,8 +818,8 @@ The following @tech{style properties} are currently recognized:
@item{@racket[color-property] structure --- Applies a color to the
text of @racket[content].}
@item{@racket[background-color-property] structure --- Applies a color to the
background of @racket[content].}
@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|).}
@ -1068,7 +1078,11 @@ renderer, but at the recognized set includes at least
@racket["white"], @racket["black"], @racket["red"], @racket["green"],
@racket["blue"], @racket["cyan"], @racket["magenta"], and
@racket["yellow"]. When @racket[color] is a list of bytes, the values
are used as RGB levels.}
are used as RGB levels.
When rendering to HTML, a @racket[color-property] is also recognized
for a @tech{block} or @racket[part] (and used for the title in the
latter case).}
@defstruct[background-color-property ([color (or/c string? (list/c byte? byte? byte?))])]{

4
pkgs/scribble-pkgs/scribble-lib/scribble/HISTORY.txt
View File

@ -1,5 +1,9 @@
Version 1.1
Change `verbatim' to support non-string arguments
Add `--html-tree' option to for rendering to multi-page HTML
with nested directories for nested parts
For HTML rendering, merge generated `style' attributes within
a single tag
Older versions
See the "Racket core" release notes for a history of changes before

43
pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
View File

@ -141,22 +141,35 @@
(if (< v 16) (string-append "0" s) s)))
c))))
(define (merge-styles s l)
;; merge multiple 'style attributes into one
(cond
[(null? l) (if s
(list (list 'style s))
null)]
[(eq? 'style (caar l))
(merge-styles (if s (string-append s "; " (cadar l)) (cadar l))
(cdr l))]
[else (cons (car l) (merge-styles s (cdr l)))]))
(define (style->attribs style [extras null])
(let ([a (apply
append
extras
(map (lambda (v)
(cond
[(attributes? v)
(map (lambda (v) (list (car v) (cdr v))) (attributes-assoc v))]
[(color-property? v)
`((style ,(format "color: ~a" (color->string (color-property-color v)))))]
[(background-color-property? v)
`((style ,(format "background-color: ~a" (color->string (background-color-property-color v)))))]
[(hover-property? v)
`((title ,(hover-property-text v)))]
[else null]))
(style-properties style)))])
(let ([a (merge-styles
#f
(apply
append
extras
(map (lambda (v)
(cond
[(attributes? v)
(map (lambda (v) (list (car v) (cdr v))) (attributes-assoc v))]
[(color-property? v)
`((style ,(format "color: ~a" (color->string (color-property-color v)))))]
[(background-color-property? v)
`((style ,(format "background-color: ~a" (color->string (background-color-property-color v)))))]
[(hover-property? v)
`((title ,(hover-property-text v)))]
[else null]))
(style-properties style))))])
(let ([name (style-name style)])
(if (string? name)
(if (assq 'class a)