scribble: fix 'aux stripping for hyperlinks and HTML titles

original commit: ce960756cbea2fa1bafdc0497bb558af851596f6
This commit is contained in:
Matthew Flatt 2013-02-19 13:59:10 -07:00
parent 871a61581c
commit 77d079a3ed
2 changed files with 13 additions and 3 deletions

View File

@ -619,14 +619,24 @@
(define (aux-element? e) (define (aux-element? e)
(and (element? e) (and (element? e)
(let ([s (element-style e)]) (let ([s (element-style e)])
(and (style? e) (and (style? s)
(memq 'aux (style-properties s)))))) (memq 'aux (style-properties s))))))
(define (strip-aux content) (define (strip-aux content)
(cond (cond
[(null? content) null] [(null? content) null]
[(aux-element? content) null] [(aux-element? content) null]
[(list? content) (map strip-aux content)] [(element? content)
(define c (element-content content))
(define p (strip-aux c))
(if (equal? c p)
content
(struct-copy element content [content p]))]
[(list? content)
(define p (map strip-aux content))
(if (equal? p content)
content
p)]
[else content])) [else content]))
;; ---------------------------------------- ;; ----------------------------------------

View File

@ -667,7 +667,7 @@
[title (cond [(part-title-content d) [title (cond [(part-title-content d)
=> (lambda (c) => (lambda (c)
`(title ,@(format-number number '(nbsp)) `(title ,@(format-number number '(nbsp))
,(content->string c this d ri)))] ,(content->string (strip-aux c) this d ri)))]
[else `(title)])]) [else `(title)])])
(unless (bytes? style-file) (unless (bytes? style-file)
(unless (lookup-path style-file alt-paths) (unless (lookup-path style-file alt-paths)