svn: r9362

original commit: 82c212625b41758f99920900d0477d37b4414504
This commit is contained in:
Matthew Flatt 2008-04-18 18:49:23 +00:00
parent 829f905ac9
commit 6a20d8c2fa
5 changed files with 51 additions and 47 deletions

View File

@ -407,61 +407,65 @@
;; ----------------------------------------
(define/private (do-table-of-contents part ri delta quiet)
(define/private (do-table-of-contents part ri delta quiet depth)
(make-table #f (generate-toc part
ri
(+ delta
(length (collected-info-number
(part-collected-info part ri))))
#t
quiet)))
quiet
depth)))
(define/public (table-of-contents part ri)
(do-table-of-contents part ri -1 not))
(do-table-of-contents part ri -1 not +inf.0))
(define/public (local-table-of-contents part ri)
(table-of-contents part ri))
(define/public (local-table-of-contents part ri style)
(do-table-of-contents part ri -1 not (if (eq? style 'immediate-only)
1
+inf.0)))
(define/public (quiet-table-of-contents part ri)
(do-table-of-contents part ri 1 (lambda (x) #t)))
(do-table-of-contents part ri 1 (lambda (x) #t) +inf.0))
(define/private (generate-toc part ri base-len skip? quiet)
(define/private (generate-toc part ri base-len skip? quiet depth)
(let* ([number (collected-info-number (part-collected-info part ri))]
[subs
(if (quiet (and (part-style? part 'quiet)
(not (= base-len (sub1 (length number))))))
(apply append (map (lambda (p)
(generate-toc p ri base-len #f quiet))
(part-parts part)))
null)])
(if (and (quiet (and (part-style? part 'quiet)
(not (= base-len (sub1 (length number))))))
(positive? depth))
(apply append (map (lambda (p)
(generate-toc p ri base-len #f quiet (sub1 depth)))
(part-parts part)))
null)])
(if skip?
subs
(let ([l (cons
(list (make-flow
(list
(make-paragraph
subs
(let ([l (cons
(list (make-flow
(list
(make-element
'hspace
(list (make-string (* 2 (- (length number)
base-len))
#\space)))
(make-link-element
(if (= 1 (length number)) "toptoclink" "toclink")
(append
(format-number
number
(list (make-element 'hspace '(" "))))
(or (part-title-content part) '("???")))
(car (part-tags part))))))))
subs)])
(if (and (= 1 (length number))
(or (not (car number)) ((car number) . > . 1)))
(cons (list (make-flow
(list (make-paragraph
(list (make-element 'hspace (list "")))))))
l)
l)))))
(make-paragraph
(list
(make-element
'hspace
(list (make-string (* 2 (- (length number)
base-len))
#\space)))
(make-link-element
(if (= 1 (length number)) "toptoclink" "toclink")
(append
(format-number
number
(list (make-element 'hspace '(" "))))
(or (part-title-content part) '("???")))
(car (part-tags part))))))))
subs)])
(if (and (= 1 (length number))
(or (not (car number)) ((car number) . > . 1)))
(cons (list (make-flow
(list (make-paragraph
(list (make-element 'hspace (list "")))))))
l)
l)))))
;; ----------------------------------------

View File

@ -170,13 +170,13 @@
(define (clean-up s)
;; Remove leading spaces, which might appear there due to images or something
;; else that gets dropped in string form.
(regexp-replace* #rx"^ +" s ""))
(regexp-replace #rx"^ +" s ""))
(define (record-index word-seq element-seq tag content)
(make-index-element #f
(list (make-target-element #f content `(idx ,tag)))
`(idx ,tag)
(map clean-up word-seq)
word-seq
element-seq
#f))
@ -191,7 +191,7 @@
(define (as-index . s)
(let ([key (make-generated-tag)]
[content (decode-content s)])
(record-index (list (content->string content))
(record-index (list (clean-up (content->string content)))
(if (= 1 (length content))
content
(list (make-element #f content)))
@ -294,7 +294,7 @@
(lambda (renderer part ri)
(send renderer table-of-contents part ri))))
(define (local-table-of-contents)
(define (local-table-of-contents #:style [style #f])
(make-delayed-block
(lambda (renderer part ri)
(send renderer local-table-of-contents part ri))))
(send renderer local-table-of-contents part ri style))))

View File

@ -89,7 +89,7 @@
(cons (make-index-element
#f null (car tags)
(list (regexp-replace
#px"^(?:A|An|The)\\s" (content->string title) ""))
#px"^\\s+(?:(?:A|An|The)\\s)?" (content->string title) ""))
(list (make-element #f title))
(make-part-index-desc))
l)

View File

@ -889,7 +889,7 @@
(cond
[(string? i)
(let ([m (and (extra-breaking?)
(regexp-match-positions #rx"[-:/+]" i))])
(regexp-match-positions #rx"[-:/+_]|[a-z](?=[A-Z])" i))])
(if m
(list* (substring i 0 (cdar m))
;; Most browsers wrap after a hyphen. The

View File

@ -382,7 +382,7 @@
;; FIXME: isn't local to the section
(make-toc-paragraph null))
(define/override (local-table-of-contents part ri)
(define/override (local-table-of-contents part ri style)
(make-paragraph null))
;; ----------------------------------------