fix help search to not fail on optional user docs

svn: r8337
This commit is contained in:
Matthew Flatt 2008-01-15 15:44:04 +00:00
parent 04859fb2dd
commit 37b188229e

View File

@ -10,29 +10,35 @@
(define cached-xref #f) (define cached-xref #f)
(define (get-dests dir) (define (get-dests dir)
(map (lambda (d) (let* ([i (get-info/full dir)]
(if (pair? d) [scribblings (i 'scribblings)]
(let* ([flags (if (pair? (cdr d)) (cadr d) null)] [categories (i 'doc-categories (lambda ()
[name (if (and (pair? (cdr d)) (pair? (cddr d)) (caddr d)) (map (lambda (d) 'library) scribblings)))])
(cadr d) (map (lambda (d cat)
(let-values ([(base name dir?) (split-path (car d))]) (and (not (eq? cat 'omit))
(path-replace-suffix name #"")))]) (not (and (pair? cat) (eq? (car cat) 'omit)))
(build-path (pair? d)
(cond (let* ([flags (if (pair? (cdr d)) (cadr d) null)]
[(memq 'main-doc-root flags) [name (if (and (pair? (cdr d)) (pair? (cddr d)) (caddr d))
(find-doc-dir)] (cadr d)
[(memq 'user-doc-root flags) (let-values ([(base name dir?) (split-path (car d))])
(find-user-doc-dir)] (path-replace-suffix name #"")))])
[(memq 'user-doc flags) (build-path
(build-path (find-user-doc-dir) name)] (cond
[(or (memq 'main-doc flags) [(memq 'main-doc-root flags)
(pair? (path->main-collects-relative dir))) (find-doc-dir)]
(build-path (find-doc-dir) name)] [(memq 'user-doc-root flags)
[else (find-user-doc-dir)]
(build-path dir "compiled" "doc" name)]) [(memq 'user-doc flags)
"out.sxref")) (build-path (find-user-doc-dir) name)]
#f)) [(or (memq 'main-doc flags)
((get-info/full dir) 'scribblings))) (pair? (path->main-collects-relative dir)))
(build-path (find-doc-dir) name)]
[else
(build-path dir "compiled" "doc" name)])
"out.sxref"))))
scribblings
categories)))
(define (load-collections-xref [report-loading void]) (define (load-collections-xref [report-loading void])
(or cached-xref (or cached-xref