53 lines
2.2 KiB
Scheme
53 lines
2.2 KiB
Scheme
#lang scheme/base
|
|
|
|
(require scribble/xref
|
|
setup/getinfo
|
|
scheme/fasl
|
|
"private/doc-path.ss")
|
|
|
|
(provide load-collections-xref)
|
|
|
|
(define cached-xref #f)
|
|
|
|
(define (get-dests dir)
|
|
(let* ([i (get-info/full dir)]
|
|
[scribblings (i 'scribblings)])
|
|
(map (lambda (d)
|
|
(and (not (and (list? d)
|
|
((length d) . > . 2)
|
|
(pair? (list-ref d 2))
|
|
(eq? (car (list-ref d 2)) 'omit)))
|
|
(pair? d)
|
|
(let* ([flags (if (pair? (cdr d)) (cadr d) null)]
|
|
[name (if (and (pair? (cdr d)) (pair? (cddr d))
|
|
(pair? (cdddr d)))
|
|
(cadddr d)
|
|
(let-values ([(base name dir?) (split-path (car d))])
|
|
(path-replace-suffix name #"")))])
|
|
(build-path
|
|
(doc-path dir name flags)
|
|
"out.sxref"))))
|
|
scribblings)))
|
|
|
|
(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 (call-with-input-file* dest fasl->s-exp)])
|
|
(cadr r)))))
|
|
dests)))
|
|
cached-xref))))
|