improve code organization
svn: r8292
This commit is contained in:
parent
db3e05e4df
commit
eee5f7c0fc
|
@ -8,47 +8,40 @@
|
||||||
|
|
||||||
(define cached-xref #f)
|
(define cached-xref #f)
|
||||||
|
|
||||||
|
(define (get-dests dir)
|
||||||
|
(map (lambda (d)
|
||||||
|
(if (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
|
||||||
|
(if (memq 'main-doc flags)
|
||||||
|
(build-path (find-doc-dir) name)
|
||||||
|
(build-path dir "compiled" "doc" name))
|
||||||
|
"out.sxref"))
|
||||||
|
#f))
|
||||||
|
((get-info/full dir) 'scribblings)))
|
||||||
|
|
||||||
(define (load-collections-xref [report-loading void])
|
(define (load-collections-xref [report-loading void])
|
||||||
(or cached-xref
|
(or cached-xref
|
||||||
(begin
|
(begin
|
||||||
(report-loading)
|
(report-loading)
|
||||||
(let* ([dirs (find-relevant-directories '(scribblings))]
|
(let* ([dests (map get-dests (find-relevant-directories '(scribblings)))]
|
||||||
[infos (map get-info/full dirs)]
|
[dests (filter values (apply append dests))])
|
||||||
[dests (filter
|
(set! cached-xref
|
||||||
values
|
(load-xref (map (lambda (dest)
|
||||||
(apply append
|
(lambda ()
|
||||||
(map (lambda (i dir)
|
(with-handlers ([exn:fail?
|
||||||
(let ([s (i 'scribblings)])
|
(lambda (exn)
|
||||||
(map (lambda (d)
|
(fprintf (current-error-port)
|
||||||
(if (pair? d)
|
"WARNING: ~a\n"
|
||||||
(let ([flags (if (pair? (cdr d))
|
(if (exn? exn)
|
||||||
(cadr d)
|
(exn-message exn)
|
||||||
null)])
|
(format "~e" exn)))
|
||||||
(let ([name (if (and (pair? (cdr d))
|
#f)])
|
||||||
(pair? (cddr d))
|
(let ([r (with-input-from-file dest read)])
|
||||||
(caddr d))
|
(cadr r)))))
|
||||||
(cadr d)
|
dests)))
|
||||||
(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))))
|
cached-xref))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user