diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 4135811f..b62377ee 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -752,7 +752,7 @@ [else (render-plain-element e part ri)])) (define/private (render-plain-element e part ri) - (let* ([raw-style (and (element? e) (element-style e))] + (let* ([raw-style (flatten-style (and (element? e) (element-style e)))] [style (if (with-attributes? raw-style) (with-attributes-style raw-style) raw-style)] @@ -760,7 +760,12 @@ (if (with-attributes? raw-style) (map (lambda (p) (list (car p) (cdr p))) (with-attributes-assoc raw-style)) - null))]) + null))] + [super-render/attribs + (lambda () + (if (with-attributes? raw-style) + `((span ,(attribs) ,@(super render-element e part ri))) + (super render-element e part ri)))]) (cond [(symbol? style) (case style @@ -804,15 +809,18 @@ ,@(super render-element e part ri)))] [(target-url? style) (if (current-no-links) - (super render-element e part ri) + (super-render/attribs) (parameterize ([current-no-links #t]) `((a ([href ,(let ([addr (target-url-addr style)]) (if (path? addr) (from-root addr (get-dest-directory)) addr))] - ,@(if (string? (target-url-style style)) - `([class ,(target-url-style style)]) - null) + ;; The target-url chains to another style. Allow + ;; `with-attributes' inside as well as outside: + ,@(let ([style (target-url-style style)]) + (if (string? style) + `([class ,style]) + null)) . ,(attribs)) ,@(super render-element e part ri)))))] [(url-anchor? style) @@ -842,10 +850,7 @@ p))] . ,(attribs)) ,@sz)))] - [else - (if (with-attributes? raw-style) - `((span ,(attribs) ,@(super render-element e part ri))) - (super render-element e part ri))]))) + [else (super-render/attribs)]))) (define/override (render-table t part ri need-inline?) (define t-style (table-style t)) diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index 88ee0dce..e8b809b3 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -128,7 +128,11 @@ ri) (printf " ``")) (let ([style (and (element? e) - (element-style e))] + (let ([s (flatten-style + (element-style e))]) + (if (with-attributes? s) + (with-attributes-style s) + s)))] [wrap (lambda (e s tt?) (printf "{\\~a{" s) (parameterize ([rendering-tt (or tt? diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss index b6eb2771..ca527787 100644 --- a/collects/scribble/struct.ss +++ b/collects/scribble/struct.ss @@ -490,3 +490,36 @@ [resolve-get/ext? ((or/c part? false/c) resolve-info? info-key? . -> . any)] [resolve-search (any/c (or/c part? false/c) resolve-info? info-key? . -> . any)] [resolve-get-keys ((or/c part? false/c) resolve-info? (info-key? . -> . any/c) . -> . any/c)]) + +;; ---------------------------------------- + +(define (flatten-style s) + (cond + [(with-attributes? s) + (let ([rest (flatten-style (with-attributes-style s))]) + (if (with-attributes? rest) + ;; collapse nested with-attributes + (make-with-attributes + (with-attributes-style rest) + (append (with-attributes-assoc s) + (with-attributes-assoc rest))) + ;; rebuild with flattened inner: + (make-with-attributes + rest + (with-attributes-assoc s))))] + [(target-url? s) + (let ([rest (flatten-style (target-url-style s))]) + (if (with-attributes? rest) + ;; lift nested attributes out: + (make-with-attributes + (make-target-url + (target-url-addr s) + (with-attributes-style rest)) + (with-attributes-assoc rest)) + ;; rebuild with flattened inner: + (make-target-url + (target-url-addr s) + rest)))] + [else s])) + +(provide flatten-style)