64 lines
2.6 KiB
Scheme
64 lines
2.6 KiB
Scheme
#lang scheme/base
|
|
|
|
(require scribble/xref
|
|
setup/getinfo
|
|
setup/dirs
|
|
setup/main-collects)
|
|
|
|
(provide load-collections-xref)
|
|
|
|
(define cached-xref #f)
|
|
|
|
(define (get-dests dir)
|
|
(let* ([i (get-info/full dir)]
|
|
[scribblings (i 'scribblings)]
|
|
[categories (i 'doc-categories (lambda ()
|
|
(map (lambda (d) 'library) scribblings)))])
|
|
(map (lambda (d cat)
|
|
(and (not (eq? cat 'omit))
|
|
(not (and (pair? cat) (eq? (car cat) 'omit)))
|
|
(pair? d)
|
|
(let* ([flags (if (pair? (cdr d)) (cadr d) null)]
|
|
[name (if (and (pair? (cdr d)) (pair? (cddr d)) (caddr d))
|
|
(cadr d)
|
|
(let-values ([(base name dir?) (split-path (car d))])
|
|
(path-replace-suffix name #"")))])
|
|
(build-path
|
|
(cond
|
|
[(memq 'main-doc-root flags)
|
|
(find-doc-dir)]
|
|
[(memq 'user-doc-root flags)
|
|
(find-user-doc-dir)]
|
|
[(memq 'user-doc flags)
|
|
(build-path (find-user-doc-dir) name)]
|
|
[(or (memq 'main-doc flags)
|
|
(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])
|
|
(or cached-xref
|
|
(begin
|
|
(report-loading)
|
|
(let* ([dests (map get-dests (find-relevant-directories '(scribblings)))]
|
|
[dests (filter values (apply append dests))])
|
|
(set! cached-xref
|
|
(load-xref (map (lambda (dest)
|
|
(lambda ()
|
|
(with-handlers ([exn:fail?
|
|
(lambda (exn)
|
|
(fprintf (current-error-port)
|
|
"WARNING: ~a\n"
|
|
(if (exn? exn)
|
|
(exn-message exn)
|
|
(format "~e" exn)))
|
|
#f)])
|
|
(let ([r (with-input-from-file dest read)])
|
|
(cadr r)))))
|
|
dests)))
|
|
cached-xref))))
|