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

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

Browse Source 
svn: r10173

original commit: af1c17353bcce74385984205d39c00507b8a4443
This commit is contained in:
Matthew Flatt 2008-06-06 15:09:14 +00:00
parent 38ad7672e4
commit 5c1f7ccbbc
3 changed files with 59 additions and 58 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
;; Needed to normalize planet version numbers:
(only-in planet/resolver get-planet-module-path/pkg)
(only-in planet/private/data pkg-maj pkg-min))
syntax/modcode)
(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.