From 644ea52438f62415701d07bb3e74718f442c1073 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 8 Nov 2013 05:48:26 -0700 Subject: [PATCH] scribble HTML rendering merges `style` attributes This change fixes using `color-property` and `background-color-property` at the same time, for example. original commit: d2e1396b136ecb4917233106ba805823207c6592 --- .../scribblings/scribble/core.scrbl | 20 +++++++-- .../scribble-lib/scribble/HISTORY.txt | 4 ++ .../scribble-lib/scribble/html-render.rkt | 43 ++++++++++++------- 3 files changed, 49 insertions(+), 18 deletions(-) diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl index b8dfe219..912e9162 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl +++ b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl @@ -450,6 +450,16 @@ The recognized @tech{style properties} are as follows: content for the @tt{} 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{}, @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?))])]{ diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/HISTORY.txt b/pkgs/scribble-pkgs/scribble-lib/scribble/HISTORY.txt index e23935e6..f432c4a4 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/HISTORY.txt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/HISTORY.txt @@ -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 diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt index 33e65fe0..148142b3 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt @@ -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)