suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix doc TOC after latest round of key changes

Browse Source 
svn: r10174
This commit is contained in:
Matthew Flatt 2008-06-06 15:18:16 +00:00
parent af1c17353b
commit 31bb298e67
1 changed files with 18 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/scribblings/main/private/manuals.ss
View File

@ -30,10 +30,11 @@
(if sep? (cons (mk-sep lbl) l) l))]))))
(define (make-start-page all?)
(let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)]
(let* ([recs (find-relevant-directory-records '(scribblings))]
[infos (map get-info/full (map directory-record-path recs))]
[docs (append-map
(lambda (i dir)
(lambda (i rec)
(define dir (directory-record-path rec))
(define s (and (or all? (in-main-collects? dir))
(i 'scribblings)))
(if (not s)
@ -66,16 +67,25 @@
;; Priority label (not used):
""
;; Path
(build-path dir (if (pair? d) (car d) "???"))))))
(build-path dir (if (pair? d) (car d) "???"))
;; Spec
(let ([spec (directory-record-spec rec)])
(list* (car spec)
(if (pair? d) (car d) "UNKNOWN")
(if (eq? 'planet (car spec))
(list (append (cdr spec)
(list (directory-record-maj rec)
(list '= (directory-record-min rec)))))
(cdr spec))))))))
s)))
infos
dirs)]
recs)]
[plain-line
(lambda content
(list (make-flow (list (make-paragraph content)))))]
[line
(lambda (doc)
(plain-line (hspace 2) (other-manual doc #:underline? #f)))])
(lambda (spec)
(plain-line (hspace 2) (other-manual spec #:underline? #f)))])
(define (contents renderer part resolve-info)
(make-table
#f
@ -94,7 +104,7 @@
(make-element (if (string=? str "") "sepspace" "septitle")
(list 'nbsp str))))
(sort (map (lambda (doc)
(list (cadr doc) (line (cadddr doc)) (caddr doc)))
(list (cadr doc) (line (cadddr (cdr doc))) (caddr doc)))
docs)
(lambda (ad bd)
(if (= (car ad) (car bd))