racket/collects/setup/xref.ss
2007-12-19 15:36:35 +00:00

55 lines
3.1 KiB
Scheme

#lang scheme/base
(require scribble/xref
setup/getinfo
setup/dirs)
(provide load-collections-xref)
(define cached-xref #f)
(define (load-collections-xref [report-loading void])
(or cached-xref
(begin
(report-loading)
(let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)]
[dests (filter
values
(apply append
(map (lambda (i dir)
(let ([s (i 'scribblings)])
(map (lambda (d)
(if (pair? d)
(let ([flags (if (pair? (cdr d))
(cadr d)
null)])
(let ([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
(if (memq 'main-doc flags)
(build-path (find-doc-dir) name)
(build-path dir "compiled" "doc" name))
"out.sxref")))
#f))
s)))
infos
dirs)))])
(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))))