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

new defn-finding support in scribble-index

Browse Source 
svn: r7967

original commit: 6b2be05771029921d8e6d9a91cf7a2bdab716f57
This commit is contained in:
Matthew Flatt 2007-12-12 14:54:46 +00:00
parent 877a2eb2f8
commit 5caf386a47
2 changed files with 64 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -108,6 +108,18 @@
;; ----------------------------------------
(define/public (tag->path+anchor ri tag)
(let ([dest (resolve-get #f ri tag)])
(if dest
(values
(relative->path (car dest))
(if (caddr dest)
#f
(anchor-name (cadddr dest))))
(values #f #f))))
;; ----------------------------------------
(define/private (reveal-subparts? p)
(part-style? p 'reveal))

53
collects/setup/scribble-index.ss
View File

@ -9,11 +9,14 @@
setup/getinfo
setup/dirs
mzlib/serialize
scheme/path)
scheme/path
setup/main-collects)
(provide load-xref
xref-render
xref-index
xref-binding->definition-tag
xref-tag->path+anchor
(struct-out entry))
(define-struct entry (words ; list of strings: main term, sub-term, etc.
@ -97,3 +100,51 @@
(let ([ri (send renderer resolve (list doc) (list dest-file) ci)])
(send renderer render (list doc) (list dest-file) ri)
(void))))
;; Returns (values <tag-or-#f> <form?>)
(define (xref-binding-tag xrefs src id)
(let ([search
(lambda (src)
(let ([base (format ":~a:~a"
(if (path? src)
(path->main-collects-relative src)
src)
id)]
[ht (collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs)))])
(let ([form-tag `(form ,base)]
[val-tag `(def ,base)])
(if (hash-table-get ht form-tag #f)
(values form-tag #t)
(if (hash-table-get ht val-tag #f)
(values val-tag #f)
(values #f #f))))))])
(let loop ([src src])
(cond
[(path? src)
(if (complete-path? src)
(search src)
(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
"module path, resolved module path, module path index, path, or string"
src)]))))
(define (xref-binding->definition-tag xrefs src id)
(let-values ([(tag form?) (xref-binding-tag xrefs src id)])
tag))
(define (xref-tag->path+anchor xrefs tag)
(let ([renderer (new (html:render-mixin render%)
[dest-dir (find-system-path 'temp-dir)])])
(send renderer tag->path+anchor (xrefs-ri xrefs) tag)))