suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

change the way Scribble generates keys based on modules

Browse Source 
svn: r10170

original commit: 21fd7b93b3f332b1c4272b87b6f286846c26a790
This commit is contained in:
Matthew Flatt 2008-06-06 13:24:58 +00:00
parent b9c84b4cc7
commit 38ad7672e4
5 changed files with 66 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/scribble/manual.ss
View File

@ -394,12 +394,8 @@
(and (checker id) lib)))
(or source-libs null))
(and (pair? libs) (car libs)))])
(and lib (let ([p (resolved-module-path-name
(module-path-index-resolve
(module-path-index-join lib #f)))])
(if (path? p)
(intern-taglet (path->main-collects-relative p))
p)))))
(and lib (module-path-index->taglet
(module-path-index-join lib #f)))))
(define (id-to-target-maker id dep?)
(*id-to-target-maker 'def id dep?))
@ -452,10 +448,8 @@
(lambda () (car content))))))
(define (make-binding-redirect-elements mod-path redirects)
(let ([taglet (path->main-collects-relative
(resolved-module-path-name
(module-path-index-resolve
(module-path-index-join mod-path #f))))])
(let ([taglet (module-path-index->taglet
(module-path-index-join mod-path #f))])
(make-element
#f
(map
@ -1980,11 +1974,7 @@
(define (id-info id)
(let ([b (identifier-label-binding id)])
(if b
(list (let ([p (resolved-module-path-name (module-path-index-resolve
(caddr b)))])
(if (path? p)
(intern-taglet (path->main-collects-relative p))
p))
(list (caddr b)
(list-ref b 3)
(list-ref b 4)
(list-ref b 5)

2
collects/scribble/scheme.ss
View File

@ -77,7 +77,7 @@
(let* ([key (and id-element-cache
(let ([b (identifier-label-binding c)])
(vector (syntax-e c)
(module-path-index-resolve (caddr b))
(module-path-index->taglet (caddr b))
(cadddr b)
(list-ref b 5))))])
(or (and key

74
collects/scribble/search.ss
View File

@ -2,10 +2,16 @@
(require "struct.ss"
"basic.ss"
setup/main-collects
syntax/modcode)
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))
(provide find-scheme-tag
intern-taglet)
intern-taglet
module-path-index->taglet)
(define module-info-cache (make-hasheq))
@ -34,7 +40,35 @@
(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'
@ -59,22 +93,19 @@
stx/binding]
[else
(and (not (symbol? (car stx/binding)))
(let ([p (module-path-index-join
(main-collects-relative->path (car stx/binding))
#f)])
(list #f
(cadr stx/binding)
p
(cadr stx/binding)
(if (= 2 (length stx/binding))
0
(caddr stx/binding))
(if (= 2 (length stx/binding))
0
(cadddr stx/binding))
(if (= 2 (length stx/binding))
0
(cadddr (cdr stx/binding))))))])])
(list #f
(cadr stx/binding)
(car stx/binding)
(cadr stx/binding)
(if (= 2 (length stx/binding))
0
(caddr stx/binding))
(if (= 2 (length stx/binding))
0
(cadddr stx/binding))
(if (= 2 (length stx/binding))
0
(cadddr (cdr stx/binding)))))])])
(and
(pair? b)
(let ([seen (make-hasheq)]
@ -96,10 +127,7 @@
[queue (cdr queue)])
(let* ([rmp (module-path-index-resolve mod)]
[eb (and (equal? 0 export-phase) ;; look for the phase-0 export; good idea?
(list (let ([p (resolved-module-path-name rmp)])
(if (path? p)
(intern-taglet (path->main-collects-relative p))
p))
(list (module-path-index->taglet mod)
id))])
(when (and eb
(not search-key))

27
collects/scribble/xref.ss
View File

@ -104,25 +104,14 @@
(= 2 (length id/binding)))
(let loop ([src (car id/binding)])
(cond
[(path? src)
(if (complete-path? src)
(search (list src (cadr id/binding)))
(loop (path->complete-path src)))]
[(path-string? src)
(loop (path->complete-path src))]
[(resolved-module-path? src)
(let ([n (resolved-module-path-name src)])
(if (pair? n)
(loop n)
(search n)))]
[(module-path-index? src)
(loop (module-path-index-resolve src))]
[(module-path? src)
(loop (module-path-index-join src #f))]
[else
(raise-type-error 'xref-binding-definition->tag
"list starting with module path, resolved module path, module path index, path, or string"
src)]))]
[(module-path-index? src)
(search src)]
[(module-path? src)
(loop (module-path-index-join src #f))]
[else
(raise-type-error 'xref-binding-definition->tag
"list starting with module path or module path index"
src)]))]
[else (raise-type-error 'xref-binding-definition->tag
"identifier, 2-element list, or 7-element list"
id/binding)]))]))

4
collects/scribblings/scribble/xref.scrbl
View File

@ -46,9 +46,7 @@ get all cross-reference information for installed documentation.}
@defproc[(xref-binding->definition-tag [xref xref?]
[binding (or/c identifier?
(list/c (or/c module-path?
module-path-index?
path?
resolved-module-path?)
module-path-index?)
symbol?)
(listof module-path-index?
symbol?