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

2
collects/scribble/scheme.ss
View File

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

74
collects/scribble/search.ss
View File

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

27
collects/scribble/xref.ss
View File

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