better start-doc implementation, including alphabetizing list

svn: r7710
This commit is contained in:
Matthew Flatt 2007-11-13 14:15:28 +00:00
parent be7dc21b69
commit c4d2882557
6 changed files with 59 additions and 32 deletions

View File

@ -34,14 +34,6 @@
(substring s 0 (sub1 (string-length s)))) (substring s 0 (sub1 (string-length s))))
sep))) sep)))
(define/public (strip-aux content)
(cond
[(null? content) null]
[(aux-element? (car content))
(strip-aux (cdr content))]
[else (cons (car content)
(strip-aux (cdr content)))]))
;; ---------------------------------------- ;; ----------------------------------------
;; marshal info ;; marshal info

View File

@ -63,7 +63,6 @@
install-file install-file
get-dest-directory get-dest-directory
format-number format-number
strip-aux
quiet-table-of-contents) quiet-table-of-contents)
(define/override (get-suffix) #".html") (define/override (get-suffix) #".html")

View File

@ -270,7 +270,8 @@
;; ---------------------------------------- ;; ----------------------------------------
(provide content->string (provide content->string
element->string) element->string
strip-aux)
(define content->string (define content->string
(case-lambda (case-lambda
@ -297,12 +298,26 @@
[else (format "~s" c)])])] [else (format "~s" c)])])]
[(c renderer sec ri) [(c renderer sec ri)
(cond (cond
[(and (link-element? c)
(null? (element-content c)))
(let ([dest (resolve-get sec ri (link-element-tag c))])
(if dest
(content->string (strip-aux (cadr dest)) renderer sec ri)
"???"))]
[(element? c) (content->string (element-content c) renderer sec ri)] [(element? c) (content->string (element-content c) renderer sec ri)]
[(delayed-element? c) [(delayed-element? c)
(content->string (delayed-element-content c ri) (content->string (delayed-element-content c ri)
renderer sec ri)] renderer sec ri)]
[else (element->string c)])])) [else (element->string c)])]))
(define (strip-aux content)
(cond
[(null? content) null]
[(aux-element? (car content))
(strip-aux (cdr content))]
[else (cons (car content)
(strip-aux (cdr content)))]))
;; ---------------------------------------- ;; ----------------------------------------
(provide flow-element-width (provide flow-element-width

View File

@ -453,7 +453,7 @@ A placeholder for a tag to be generated during the @scheme{collect
@defproc*[([(content->string (content list?)) string?] @defproc*[([(content->string (content list?)) string?]
[(content->string (content list?) (p part?) (info resolve-info?)) string?])]{ [(content->string (content list?) (renderer any/c) (p part?) (info resolve-info?)) string?])]{
Converts a list of elements to a single string (essentially Converts a list of elements to a single string (essentially
rendering the content as ``plain text''). rendering the content as ``plain text'').
@ -465,7 +465,7 @@ element (if it has not been forced already).}
@defproc*[([(element->string (element any/c)) string?] @defproc*[([(element->string (element any/c)) string?]
[(element->string (element any/c) (p part?) (info resolve-info?)) string?])]{ [(element->string (element any/c) (renderer any/c) (p part?) (info resolve-info?)) string?])]{
Like @scheme[content->string], but for a single element. Like @scheme[content->string], but for a single element.
} }

View File

@ -1,18 +1,27 @@
#lang scribble/doc #lang scribble/doc
@require[scribble/manual @require[scribble/manual
scribble/struct scribble/struct
setup/getinfo setup/getinfo]
setup/main-collects]
@title{PLT Scheme Documentation} @title{PLT Scheme Documentation}
@begin[ @begin[
(define (resolve s)
(resolved-module-path-name
(module-path-index-resolve
(module-path-index-join `(lib ,(string-append s ".scrbl")
"scribblings"
,s)
#f))))
(define initial-ones (define initial-ones
'("(collects . scribblings/quick/quick.scrbl):top" (list (resolve "quick")
blank 'blank
"(collects . scribblings/guide/guide.scrbl):top" (resolve "guide")
"(collects . scribblings/reference/reference.scrbl):top" (resolve "reference")
blank)) 'blank
(resolve "gui")
'blank))
(let* ([dirs (find-relevant-directories '(scribblings))] (let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)] [infos (map get-info/full dirs)]
@ -21,22 +30,31 @@
(let ([s (i 'scribblings)]) (let ([s (i 'scribblings)])
(map (lambda (d) (map (lambda (d)
(if (pair? d) (if (pair? d)
(format "~a:top" (build-path dir (car d))
(path->main-collects-relative (build-path dir "???")))
(build-path dir (car d))))
(format "bad: ~s" d)))
s))) s)))
infos infos
dirs))]) dirs))]
(make-table [line
#f (lambda (doc)
(map (lambda (doc)
(list (make-flow (list (make-paragraph (list (list (make-flow (list (make-paragraph (list
(if (eq? doc 'blank) (if (eq? doc 'blank)
(hspace 1) (hspace 1)
(secref doc)))))))) (secref #:doc doc "top"))))))))])
(append initial-ones
(remove* initial-ones (make-delayed-flow-element
(remove "(collects . scribblings/start/start.scrbl):top" (lambda (renderer part resolve-info)
docs)))))) (make-table
#f
(append (map line initial-ones)
(sort
(map line
(remove* initial-ones
(remove (resolve "start")
docs)))
(lambda (a b)
(let ([a (car (paragraph-content (car (flow-paragraphs (car a)))))]
[b (car (paragraph-content (car (flow-paragraphs (car b)))))])
(string-ci<? (element->string a renderer part resolve-info)
(element->string b renderer part resolve-info))))))))))
] ]

View File

@ -100,6 +100,9 @@ in several significant ways:
"x.ss" is now named "x_ss.zo". The "_loader" protocol for "x.ss" is now named "x_ss.zo". The "_loader" protocol for
native-code extensions is no longer supported. native-code extensions is no longer supported.
- Windows console binary names are converted like Unix binary names:
downcased with " " replaced by "-".
====================================================================== ======================================================================
Immutable and Mutable Pairs Immutable and Mutable Pairs
====================================================================== ======================================================================