Allow using `doc-path' for main docs only.

svn: r10181
This commit is contained in:
Eli Barzilay 2008-06-06 18:46:04 +00:00
parent d9134861c4
commit 05e530f443
2 changed files with 12 additions and 10 deletions

View File

@ -8,17 +8,18 @@
(provide doc-path path->name)
(define (doc-path dir name flags [false-if-missing-user-doc? #f])
;; user-doc-mode can be `false-if-missing' or `never'
(define (doc-path dir name flags [user-doc-mode #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))))
(and (not (eq? 'never))
(let ([d (find-user-doc-dir)])
(and (or (not (eq? 'false-if-missing user-doc-mode))
(directory-exists? d))
(if sub (build-path d sub) d)))))
(cond [(memq 'main-doc-root flags) (find-doc-dir)]
[(memq 'user-doc-root flags) (user-doc)]
[(memq 'user-doc flags) (user-doc name)]
[(or (memq 'main-doc flags)
(pair? (path->main-collects-relative dir)))
[(or (memq 'main-doc flags) (pair? (path->main-collects-relative dir)))
(build-path (find-doc-dir) name)]
[else (build-path dir "doc" name)]))

View File

@ -19,10 +19,11 @@
[flags (if (len . >= . 2) (cadr d) '())]
[name (if (len . >= . 4)
(cadddr d)
(path->string (path-replace-suffix
(file-name-from-path (car d)) #"")))])
(path->string
(path-replace-suffix (file-name-from-path (car d))
#"")))])
(and (not (and (len . >= . 3) (memq 'omit (caddr d))))
(let ([d (doc-path dir name flags #t)])
(let ([d (doc-path dir name flags 'false-if-missing)])
(and d (build-path d "out.sxref")))))))
(define (get-reader-thunks)