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

fix scribble/xref

Browse Source
This commit is contained in:
Matthew Flatt 2010-05-22 08:46:05 -06:00
parent b319039468
commit f5a0b9e613
3 changed files with 37 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/scribble/html-render.rkt
View File

@ -313,10 +313,35 @@
(define/public (set-external-root-url p)
(set! external-root-url p))
(define (try-relative-to-external-root dest)
(cond
[(let ([rel (find-relative-path
(find-doc-dir)
(relative->path (dest-path dest)))])
(and (relative-path? rel)
rel))
=> (lambda (rel)
(cons
(url->string
(struct-copy
url
(combine-url/relative
(string->url external-root-url)
(string-join (map path-element->string
(explode-path rel))
"/"))))
(and (not (dest-page? dest))
(anchor-name (dest-anchor dest)))))]
[else #f]))
(define/public (tag->path+anchor ri tag)
;; Called externally; not used internally
(let-values ([(dest ext?) (resolve-get/ext? #f ri tag)])
(cond [(not dest) (values #f #f)]
[(and ext? external-root-url
(try-relative-to-external-root dest))
=> (lambda (p)
(values (car p) (cdr p)))]
[(and ext? external-tag-path)
(values (string->url external-tag-path) (format "~a" (serialize tag)))]
[else (values (relative->path (dest-path dest))

11
collects/scribble/xref.rkt
View File

@ -41,7 +41,8 @@
#:render% [render% (html:render-mixin render%)]
#:root [root-path #f])
(let* ([renderer (new render% [dest-dir (find-system-path 'temp-dir)])]
[ci (send renderer collect null null)])
[fp (send renderer traverse null null)]
[ci (send renderer collect null null fp)])
(for ([src sources])
(parameterize ([current-namespace
(namespace-anchor->empty-namespace here)])
@ -121,8 +122,12 @@
tag))
(define (xref-tag->path+anchor xrefs tag
#:render% [render% (html:render-mixin render%)])
(send (new render% [dest-dir (find-system-path 'temp-dir)])
#:render% [render% (html:render-mixin render%)]
#:external-root-url [redirect-main #f])
(send (let ([r (new render% [dest-dir (find-system-path 'temp-dir)])])
(when redirect-main
(send r set-external-root-url redirect-main))
r)
tag->path+anchor (xrefs-ri xrefs) tag))
(define (xref-tag->index-entry xrefs tag)

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

@ -99,6 +99,7 @@ is found in @racket[xref], the result is @racket[#f].}
@defproc[(xref-tag->path+anchor [xref xref?]
[tag tag?]
[#:external-root-url root-url (or/c string? #f) #f]
[#:render% using-render% (subclass?/c render%)
(render-mixin render%)])
(values (or/c false/c path?)
@ -111,6 +112,9 @@ result is @racket[#f] if the first result is @racket[#f], and it can
also be @racket[#f] if the tag refers to a page rather than a specific
point in a page.
If @racket[root-url] is provided, then references to documentation in
the main installation are redirected to the given URL.
The optional @racket[using-render%] argument is as for
@racket[load-xref].}