improve code organization

svn: r8292
This commit is contained in:
Eli Barzilay 2008-01-11 06:57:13 +00:00
parent db3e05e4df
commit eee5f7c0fc

View File

@ -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))))