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

repair uses of module paths for Scribble keys that I missed before

Browse Source 
svn: r10173
This commit is contained in:
Matthew Flatt 2008-06-06 15:09:14 +00:00
parent 10a4830f87
commit af1c17353b
4 changed files with 65 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/scribble/basic.ss
View File

@ -79,13 +79,66 @@
;; ----------------------------------------
(provide module-path-prefix->string)
(provide intern-taglet
module-path-index->taglet
module-path-prefix->string)
(define interned (make-weak-hash))
(define (intern-taglet v)
(let ([v (if (list? v)
(map intern-taglet v)
v)])
(if (or (string? v)
(bytes? v)
(list? v))
(let ([b (hash-ref interned v #f)])
(if b
(weak-box-value b)
(begin
(hash-set! interned v (make-weak-box v))
v)))
v)))
(define (module-path-index->taglet mod)
;; Derive the name from the module path:
(let ([p (collapse-module-path-index
mod
(current-directory))])
(if (path? p)
;; If we got a path back anyway, then it's best to use the resolved
;; name; if the current directory has changed since we
;; the path-index was resolved, then p might not be right
(intern-taglet
(path->main-collects-relative
(resolved-module-path-name (module-path-index-resolve mod))))
(let ([p (if (and (pair? p)
(eq? (car p) 'planet))
;; Normalize planet verion number based on current
;; linking:
(let-values ([(path pkg)
(get-planet-module-path/pkg p #f #f)])
(list* 'planet
(cadr p)
(list (car (caddr p))
(cadr (caddr p))
(pkg-maj pkg)
(pkg-min pkg))
(cdddr p)))
;; Otherwise the path is fully normalized:
p)])
(intern-taglet p)))))
(define (module-path-prefix->string p)
(format "~a" (path->main-collects-relative (resolve-module-path p #f))))
(format "~a" (module-path-index->taglet (module-path-index-join p #f))))
;; ----------------------------------------
(require syntax/modcollapse
;; Needed to normalize planet version numbers:
(only-in planet/resolver get-planet-module-path/pkg)
(only-in planet/private/data pkg-maj pkg-min))
(provide itemize item item?)
(define (itemize #:style [style #f] . items)

3
collects/scribble/html-render.ss
View File

@ -15,7 +15,8 @@
scheme/serialize
(prefix-in xml: xml/xml)
(for-syntax scheme/base)
"search.ss")
"search.ss"
"basic.ss")
(provide render-mixin
render-multi-mixin)

57
collects/scribble/search.ss
View File

@ -2,16 +2,9 @@
(require "struct.ss"
"basic.ss"
setup/main-collects
syntax/modcode
syntax/modcollapse
syntax/modcode)
;; Needed to normalize planet version numbers:
(only-in planet/resolver get-planet-module-path/pkg)
(only-in planet/private/data pkg-maj pkg-min))
(provide find-scheme-tag
intern-taglet
module-path-index->taglet)
(provide find-scheme-tag)
(define module-info-cache (make-hasheq))
@ -24,52 +17,6 @@
(module-path-index-join name
(module-path-index-rejoin base rel-to))])))
(define interned (make-weak-hash))
(define (intern-taglet v)
(let ([v (if (list? v)
(map intern-taglet v)
v)])
(if (or (string? v)
(bytes? v)
(list? v))
(let ([b (hash-ref interned v #f)])
(if b
(weak-box-value b)
(begin
(hash-set! interned v (make-weak-box v))
v)))
v)))
(define (module-path-index->taglet mod)
;; Derive the name from the module path:
(let ([p (collapse-module-path-index
mod
(current-directory))])
(if (path? p)
;; If we got a path back anyway, then it's best to use the resolved
;; name; if the current directory has changed since we
;; the path-index was resolved, then p might not be right
(intern-taglet
(path->main-collects-relative
(resolved-module-path-name (module-path-index-resolve mod))))
(let ([p (if (and (pair? p)
(eq? (car p) 'planet))
;; Normalize planet verion number based on current
;; linking:
(let-values ([(path pkg)
(get-planet-module-path/pkg p #f #f)])
(list* 'planet
(cadr p)
(list (car (caddr p))
(cadr (caddr p))
(pkg-maj pkg)
(pkg-min pkg))
(cdddr p)))
;; Otherwise the path is fully normalized:
p)])
(intern-taglet p)))))
(define (find-scheme-tag part ri stx/binding phase-level)
;; The phase-level argument is used only when `stx/binding'
;; is an identifier.

11
collects/setup/scribble.ss
View File

@ -11,6 +11,7 @@
scheme/serialize
scribble/base-render
scribble/struct
scribble/basic
scribble/manual ; really shouldn't be here... see dynamic-require-doc
(prefix-in html: scribble/html-render)
(prefix-in latex: scribble/latex-render))
@ -273,14 +274,14 @@
(and (path? base) (loop base)))))))
only-dirs)))
(define (ensure-doc-prefix v src-file)
(let ([p (format "~a" (path->main-collects-relative src-file))])
(define (ensure-doc-prefix v src-spec)
(let ([p (module-path-prefix->string src-spec)])
(when (and (part-tag-prefix v)
(not (equal? p (part-tag-prefix v))))
(error 'setup
"bad tag prefix: ~e for: ~a expected: ~e"
(part-tag-prefix v)
src-file
src-spec
p))
(let ([tag-prefix p]
[tags (if (member '(part "top") (part-tags v))
@ -406,7 +407,7 @@
(parameterize ([current-directory (doc-src-dir doc)])
(let* ([v (ensure-doc-prefix
(dynamic-require-doc (doc-src-spec doc))
(doc-src-file doc))]
(doc-src-spec doc))]
[dest-dir (pick-dest latex-dest doc)]
[ci (send renderer collect (list v) (list dest-dir))]
[ri (send renderer resolve (list v) (list dest-dir) ci)]
@ -469,7 +470,7 @@
(let* ([v (ensure-doc-prefix (render-time
"load"
(dynamic-require-doc (doc-src-spec doc)))
(doc-src-file doc))]
(doc-src-spec doc))]
[dest-dir (pick-dest latex-dest doc)]
[ci (render-time "collect"
(send renderer collect (list v) (list dest-dir)))])