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)