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

add support for user-specific documentation list

Browse Source 
svn: r8306
This commit is contained in:
Matthew Flatt 2008-01-11 23:13:11 +00:00
parent e42bc2aa97
commit 1c16d5829e
9 changed files with 199 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/help/search.ss
View File

@ -18,8 +18,11 @@
[send-main-page (-> void?)])
(define (send-main-page)
(let ([dest-path (build-path (find-doc-dir) "index.html")])
(send-url (format "file://~a" (path->string dest-path)))))
(let ([user-dest-path (build-path (find-user-doc-dir) "index.html")]
[dest-path (build-path (find-doc-dir) "index.html")])
(send-url (format "file://~a" (path->string (if (file-exists? user-dest-path)
user-dest-path
dest-path))))))
;; if there is exactly one exact match for this search key, go directly
;; to that place. Otherwise, go to a page that lists all of the matches.

4
collects/scribble/scribble.css
View File

@ -374,10 +374,6 @@ i {
vertical-align: top;
}
.centered {
horiz-align: center; /* not right */
}
.ghost {
color: white;
}

1
collects/scribblings/reference/define-struct.scrbl
View File

@ -4,6 +4,7 @@
(for-label scheme/serialize))
@(define posn-eval (make-base-eval))
@interaction-eval[#:eval posn-eval (require (for-syntax scheme/base))]
@title[#:tag "define-struct"]{Defining Structure Types: @scheme[define-struct]}

115
collects/scribblings/start/manuals.ss Normal file
View File

@ -0,0 +1,115 @@
#lang scheme/base
(require scribble/manual
scribble/struct
setup/getinfo
setup/main-collects)
(provide build-contents)
(define (resolve s)
(resolved-module-path-name
(module-path-index-resolve
(module-path-index-join `(lib ,(string-append s ".scrbl")
"scribblings"
,s)
#f))))
(define-struct sec (cat label))
(define sections
(list (make-sec 'getting-started
"Getting Started")
(make-sec 'language
"Languages")
(make-sec 'tool
"Tools")
(make-sec 'library
"Libraries")
(make-sec 'foreign
"Low-Level APIs")
(make-sec 'other
"Other")))
(define (main-collects? dir)
(pair? (path->main-collects-relative dir)))
(define (build-contents all?)
(let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)]
[docs (apply append
(map (lambda (i dir)
(if (or all?
(main-collects? dir))
(let ([s (i 'scribblings)])
(map (lambda (d cat)
(let ([new-cat (if (or (symbol? cat)
(and (list? cat)
(= 2 (length cat))
(symbol? (car cat))
(real? (cadr cat))))
cat
'unknown)])
(list
;; Category
(let ([the-cat (if (list? new-cat)
(car new-cat)
new-cat)])
(case the-cat
[(getting-started language tool library foreign other omit)
the-cat]
[else
(fprintf (current-error-port)
"WARNING: base category: ~e from: ~e"
cat
dir)]))
;; Priority
(if (list? new-cat)
(cadr new-cat)
0)
;; Path
(if (pair? d)
(build-path dir (car d))
(build-path dir "???")))))
s
(i 'doc-categories (lambda ()
(map (lambda (i) 'library) s)))))
null))
infos
dirs))]
[plain-line
(lambda content
(list (make-flow (list (make-paragraph content)))))]
[line
(lambda (doc)
(plain-line (hspace 2)
(other-manual doc #:underline? #f)))])
(make-delayed-flow-element
(lambda (renderer part resolve-info)
(make-table
#f
(cdr
(apply append
(map (lambda (sec)
(let ([docs (filter (lambda (doc)
(eq? (car doc) (sec-cat sec)))
docs)])
(list*
(plain-line (hspace 1))
(plain-line (sec-label sec))
(map
cdr
(sort
(map (lambda (doc) (cons (cadr doc)
(line (caddr doc))))
docs)
(lambda (ad bd)
(let ([a (cadr (paragraph-content (car (flow-paragraphs (cadr ad)))))]
[b (cadr (paragraph-content (car (flow-paragraphs (cadr bd)))))])
(if (= (car ad) (car bd))
(begin
(string-ci<? (element->string a renderer part resolve-info)
(element->string b renderer part resolve-info)))
(> (car ad) (car bd))))))))))
sections))))))))

105
collects/scribblings/start/start.scrbl
View File

@ -1,107 +1,8 @@
#lang scribble/doc
@require[scribble/manual
scribble/struct
setup/getinfo]
@(require scribble/manual
"manuals.ss")
@title{PLT Scheme Documentation}
@begin[
(define (resolve s)
(resolved-module-path-name
(module-path-index-resolve
(module-path-index-join `(lib ,(string-append s ".scrbl")
"scribblings"
,s)
#f))))
@(build-contents #f)
(define-struct sec (cat label))
(define sections
(list (make-sec 'getting-started
"Getting Started")
(make-sec 'language
"Languages")
(make-sec 'tool
"Tools")
(make-sec 'library
"Libraries")
(make-sec 'foreign
"Low-Level APIs")
(make-sec 'other
"Other")))
(let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)]
[docs (apply append
(map (lambda (i dir)
(let ([s (i 'scribblings)])
(map (lambda (d cat)
(let ([new-cat (if (or (symbol? cat)
(and (list? cat)
(= 2 (length cat))
(symbol? (car cat))
(real? (cadr cat))))
cat
'unknown)])
(list
;; Category
(let ([the-cat (if (list? new-cat)
(car new-cat)
new-cat)])
(case the-cat
[(getting-started language tool library foreign other omit)
the-cat]
[else
(fprintf (current-error-port)
"WARNING: base category: ~e from: ~e"
cat
dir)]))
;; Priority
(if (list? new-cat)
(cadr new-cat)
0)
;; Path
(if (pair? d)
(build-path dir (car d))
(build-path dir "???")))))
s
(i 'doc-categories (lambda ()
(map (lambda (i) 'library) s))))))
infos
dirs))]
[plain-line
(lambda content
(list (make-flow (list (make-paragraph content)))))]
[line
(lambda (doc)
(plain-line (hspace 2)
(other-manual doc #:underline? #f)))])
(make-delayed-flow-element
(lambda (renderer part resolve-info)
(make-table
#f
(cdr
(apply append
(map (lambda (sec)
(let ([docs (filter (lambda (doc)
(eq? (car doc) (sec-cat sec)))
docs)])
(list*
(plain-line (hspace 1))
(plain-line (sec-label sec))
(map
cdr
(sort
(map (lambda (doc) (cons (cadr doc)
(line (caddr doc))))
docs)
(lambda (ad bd)
(let ([a (cadr (paragraph-content (car (flow-paragraphs (cadr ad)))))]
[b (cadr (paragraph-content (car (flow-paragraphs (cadr bd)))))])
(if (= (car ad) (car bd))
(begin
(string-ci<? (element->string a renderer part resolve-info)
(element->string b renderer part resolve-info)))
(> (car ad) (car bd))))))))))
sections)))))))
]

4
collects/scribblings/user-start/info.ss Normal file
View File

@ -0,0 +1,4 @@
(module info setup/infotab
(define name "Scribblings: User Start")
(define scribblings '(("user-start.scrbl" (user-doc-root always-run))))
(define doc-categories '(omit)))

12
collects/scribblings/user-start/user-start.scrbl Normal file
View File

@ -0,0 +1,12 @@
#lang scribble/doc
@(require scribble/manual
"../start/manuals.ss")
@title{PLT Scheme Documentation (user)}
@margin-note{This is a user-specific listing, which may include
@|PLaneT| packages and other collections that are not in
the main installation. The main installation's listing is
@other-manual['(lib "scribblings/start/start.scrbl")].}
@(build-contents #t)

66
collects/setup/scribble.ss
View File

@ -23,7 +23,44 @@
vers rendered?)
#:mutable)
(define (setup-scribblings only-dirs latex-dest)
(define (user-start-doc? doc)
(memq 'user-doc-root (doc-flags doc)))
(define (filter-user-start docs)
;; If we've built it before...
(if (file-exists? (build-path (find-user-doc-dir) "index.html"))
;; Keep building:
docs
;; Otherwise, see if we need it:
(let ([cnt-not-main (apply +
(map (lambda (doc)
(if (doc-under-main? doc)
0
1))
docs))]
[start? (ormap (lambda (doc)
(memq 'main-doc-root (doc-flags doc)))
docs)]
[user-start? (ormap user-start-doc? docs)])
(let ([any-not-main? (positive?
(- cnt-not-main
(if start? 1 0)
(if user-start? 1 0)))])
(cond
[any-not-main?
;; Need it:
docs]
[user-start?
;; Don't need it, so drop it:
(filter (lambda (doc) (not (user-start-doc? doc)))
docs)]
[else
;; Wasn't planning to build it, anyway:
docs])))))
(define (setup-scribblings only-dirs ; limits doc builds
latex-dest ; if not #f, generate Latex output
auto-start-doc?) ; if #t, expands `only-dir' with [user-]start to catch new docs
(let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)]
[docs (map (lambda (i dir)
@ -39,6 +76,7 @@
(andmap (lambda (i)
(member i '(main-doc
main-doc-root
user-doc-root
multi-page
always-run)))
(cadr v))
@ -49,6 +87,7 @@
(map (lambda (d)
(let* ([flags (if (pair? (cdr d)) (cadr d) null)]
[under-main? (and (not (memq 'main-doc-root flags))
(not (memq 'user-doc-root flags))
(or (memq 'main-doc flags)
(pair? (path->main-collects-relative dir))))])
(make-doc dir
@ -59,11 +98,15 @@
(cadr d)
(let-values ([(base name dir?) (split-path (car d))])
(path-replace-suffix name #"")))])
(if (memq 'main-doc-root flags)
(find-doc-dir)
(if under-main?
(build-path (find-doc-dir) name)
(build-path dir "doc" name))))
(cond
[(memq 'main-doc-root flags)
(find-doc-dir)]
[(memq 'user-doc-root flags)
(find-user-doc-dir)]
[else
(if under-main?
(build-path (find-doc-dir) name)
(build-path dir "doc" name))]))
flags
under-main?)))
s)
@ -74,9 +117,9 @@
dir)
null))))
infos dirs)]
[docs (apply append docs)])
[docs (filter-user-start (apply append docs))])
(when (ormap (can-build? only-dirs) docs)
(let ([infos (filter values (map (get-doc-info only-dirs latex-dest) docs))])
(let ([infos (filter values (map (get-doc-info only-dirs latex-dest auto-start-doc?) docs))])
(let loop ([first? #t] [iter 0])
(let ([ht (make-hash-table 'equal)])
;; Collect definitions
@ -226,7 +269,7 @@
(part-parts v)
(and (versioned-part? v) (versioned-part-version v))))))
(define ((get-doc-info only-dirs latex-dest) doc)
(define ((get-doc-info only-dirs latex-dest auto-start-doc?) doc)
(let* ([info-out-file (build-path (or latex-dest (doc-dest-dir doc)) "out.sxref")]
[info-in-file (build-path (or latex-dest (doc-dest-dir doc)) "in.sxref")]
[out-file (build-path (doc-dest-dir doc) "index.html")]
@ -267,7 +310,7 @@
(fprintf (current-error-port) "~a\n" (exn-message exn))
(delete-file info-out-file)
(delete-file info-in-file)
((get-doc-info only-dirs latex-dest) doc))])
((get-doc-info only-dirs latex-dest auto-start-doc?) doc))])
(let* ([v-in (with-input-from-file info-in-file read)]
[v-out (with-input-from-file info-out-file read)])
(unless (and (equal? (car v-in) (list vers (doc-flags doc)))
@ -281,7 +324,8 @@
(map rel->path (list-ref v-in 2)) ; deps, in case we don't need to build...
can-run?
my-time info-out-time
(and can-run? (memq 'always-run (doc-flags doc)))
(and (or can-run? auto-start-doc?)
(memq 'always-run (doc-flags doc)))
#f #f
vers
#f)))

6
collects/setup/setup-unit.ss
View File

@ -756,7 +756,8 @@
exn)))])
((doc:setup-scribblings)
(if no-specific-collections? #f (map cc-path ccs-to-compile))
#f)))
#f
(not (null? (archives))))))
(define (render-pdf file)
(define cmd
@ -799,7 +800,8 @@
((doc:verbose) (verbose))
((doc:setup-scribblings)
(if no-specific-collections? #f (map cc-path ccs-to-compile))
tmp-dir)
tmp-dir
#f)
(parameterize ([current-directory tmp-dir])
(for ([f (directory-list)]
#:when (regexp-match? #rx#"[.]tex$" (path-element->bytes f)))