suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

avoid warnings for missing user docs

Browse Source 
svn: r10149
This commit is contained in:
Eli Barzilay 2008-06-05 16:34:53 +00:00
parent a3c2d438de
commit ae09de2fa2
3 changed files with 52 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/scribble/xref.ss
View File

@ -21,10 +21,11 @@
xref-transfer-info xref-transfer-info
(struct-out entry)) (struct-out entry))
(define-struct entry (words ; list of strings: main term, sub-term, etc. (define-struct entry
content ; Scribble content to the index label (words ; list of strings: main term, sub-term, etc.
tag ; for generating a Scribble link content ; Scribble content to the index label
desc)) ; further info that depends on the kind of index entry tag ; for generating a Scribble link
desc)) ; further info that depends on the kind of index entry
;; Private: ;; Private:
(define-struct xrefs (renderer ri)) (define-struct xrefs (renderer ri))
@ -39,15 +40,13 @@
(define (load-xref sources (define (load-xref sources
#:render% [render% (html:render-mixin render%)] #:render% [render% (html:render-mixin render%)]
#:root [root-path #f]) #:root [root-path #f])
(let* ([renderer (new render% (let* ([renderer (new render% [dest-dir (find-system-path 'temp-dir)])]
[dest-dir (find-system-path 'temp-dir)])]
[ci (send renderer collect null null)]) [ci (send renderer collect null null)])
(for-each (lambda (src) (for ([src sources])
(parameterize ([current-namespace (namespace-anchor->empty-namespace here)]) (parameterize ([current-namespace
(let ([v (src)]) (namespace-anchor->empty-namespace here)])
(when v (let ([v (src)])
(send renderer deserialize-info v ci #:root root-path))))) (when v (send renderer deserialize-info v ci #:root root-path)))))
sources)
(make-xrefs renderer (send renderer resolve null null ci)))) (make-xrefs renderer (send renderer resolve null null ci))))
;; ---------------------------------------- ;; ----------------------------------------
@ -147,4 +146,3 @@
;; Try again with 'def: ;; Try again with 'def:
(xref-tag->index-entry xrefs (cons 'def (cdr tag)))] (xref-tag->index-entry xrefs (cons 'def (cdr tag)))]
[else #f]))) [else #f])))

11
collects/setup/private/path-utils.ss
View File

@ -8,10 +8,15 @@
(provide doc-path path->name) (provide doc-path path->name)
(define (doc-path dir name flags) (define (doc-path dir name flags [false-if-missing-user-doc? #f])
(define (user-doc [sub #f])
(let ([d (find-user-doc-dir)])
(and (or (not false-if-missing-user-doc?)
(directory-exists? d))
(if sub (build-path d sub) d))))
(cond [(memq 'main-doc-root flags) (find-doc-dir)] (cond [(memq 'main-doc-root flags) (find-doc-dir)]
[(memq 'user-doc-root flags) (find-user-doc-dir)] [(memq 'user-doc-root flags) (user-doc)]
[(memq 'user-doc flags) (build-path (find-user-doc-dir) name)] [(memq 'user-doc flags) (user-doc name)]
[(or (memq 'main-doc flags) [(or (memq 'main-doc flags)
(pair? (path->main-collects-relative dir))) (pair? (path->main-collects-relative dir)))
(build-path (find-doc-dir) name)] (build-path (find-doc-dir) name)]

71
collects/setup/xref.ss
View File

@ -1,52 +1,45 @@
#lang scheme/base #lang scheme/base
(require scribble/xref (require scribble/xref
setup/getinfo
scheme/fasl scheme/fasl
scheme/path
"getinfo.ss"
"private/path-utils.ss") "private/path-utils.ss")
(provide load-collections-xref) (provide load-collections-xref)
(define cached-xref #f) (define cached-xref #f)
(define (get-dests dir) (define (get-dests)
(let* ([i (get-info/full dir)] (for*/list ([dir (find-relevant-directories '(scribblings))]
[scribblings (i 'scribblings)]) [d ((get-info/full dir) 'scribblings)])
(map (lambda (d) (unless (and (list? d) (pair? d))
(and (not (and (list? d) (error 'xref "bad scribblings entry: ~e" d))
((length d) . > . 2) (let* ([len (length d)]
(pair? (list-ref d 2)) [flags (if (len . >= . 2) (cadr d) '())]
(eq? (car (list-ref d 2)) 'omit))) [name (if (len . >= . 4)
(pair? d) (cadddr d)
(let* ([flags (if (pair? (cdr d)) (cadr d) null)] (path->string (path-replace-suffix
[name (if (and (pair? (cdr d)) (pair? (cddr d)) (file-name-from-path (car d)) #"")))])
(pair? (cdddr d))) (and (not (and (len . >= . 3) (memq 'omit (caddr d))))
(cadddr d) (let ([d (doc-path dir name flags #t)])
(let-values ([(base name dir?) (split-path (car d))]) (and d (build-path d "out.sxref")))))))
(path-replace-suffix name #"")))])
(build-path (define (get-reader-thunks)
(doc-path dir name flags) (map (lambda (dest)
"out.sxref")))) (lambda ()
scribblings))) (with-handlers ([exn:fail? (lambda (exn)
(fprintf (current-error-port)
"WARNING: ~a\n"
(if (exn? exn)
(exn-message exn)
(format "~e" exn)))
#f)])
(cadr (call-with-input-file* dest fasl->s-exp)))))
(filter values (get-dests))))
(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) (set! cached-xref (load-xref (get-reader-thunks)))
(let* ([dests (map get-dests (find-relevant-directories '(scribblings)))] cached-xref)))
[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))))