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

Scribble support for redirecting external links and re-rooting corss-reference paths

Browse Source 
svn: r9448

original commit: 931d93ba2fbe45bf5c91fe8dd90983e2ea2322bb
This commit is contained in:
Matthew Flatt 2008-04-24 02:37:47 +00:00
parent 9d1e9de847
commit be7ba71139
9 changed files with 188 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/scribble/base-render.ss
View File

@ -1,4 +1,3 @@
#lang scheme/base
(require "struct.ss"
@ -6,7 +5,9 @@
mzlib/serialize
scheme/file
scheme/path
setup/main-collects)
setup/main-collects
setup/path-relativize
"render-struct.ss")
(provide render%)
@ -14,7 +15,8 @@
(class object%
(init-field dest-dir
[refer-to-existing-files #f])
[refer-to-existing-files #f]
[root-path #f])
(define/public (get-dest-directory) dest-dir)
@ -40,21 +42,50 @@
(define/public (report-output!)
(set! report-output? #t))
;; ----------------------------------------
(define root (make-mobile-root root-path))
(define-values (:path->root-relative
:root-relative->path)
(if root-path
(make-relativize (lambda () root-path)
root
'path->root-relative
'root-relative->path)
(values #f #f)))
(define/public (path->root-relative p)
(if root-path
(:path->root-relative p)
p))
(define/public (root-relative->path p)
(if (and (pair? p)
(mobile-root? (car p)))
(apply build-path (mobile-root-path (car p))
(map bytes->path-element (cdr p)))
p))
;; ----------------------------------------
;; marshal info
(define/public (get-serialize-version)
1)
2)
(define/public (serialize-info ri)
(parameterize ([current-serialize-resolve-info ri])
(serialize (collect-info-ht (resolve-info-ci ri)))))
(serialize (cons root
(collect-info-ht (resolve-info-ci ri))))))
(define/public (deserialize-info v ci)
(let ([ht (deserialize v)]
(define/public (deserialize-info v ci #:root [root-path #f])
(let ([root+ht (deserialize v)]
[in-ht (collect-info-ext-ht ci)])
(for ([(k v) ht])
(when root-path
(set-mobile-root-path! (car root+ht) root-path))
(for ([(k v) (cdr root+ht)])
(hash-set! in-ht k v))))
(define/public (get-defined ci)
(hash-map (collect-info-ht ci) (lambda (k v) k)))

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

@ -9,6 +9,7 @@
setup/main-collects
mzlib/list
net/url
net/base64
scheme/serialize
(prefix-in xml: xml/xml)
(for-syntax scheme/base))
@ -29,18 +30,6 @@
(define extra-breaking? (make-parameter #f))
(define current-version (make-parameter (version)))
(define (path->relative p)
(let ([p (path->main-doc-relative p)])
(if (path? p)
(path->main-collects-relative p)
p)))
(define (relative->path p)
(let ([p (main-doc-relative->path p)])
(if (path? p)
p
(main-collects-relative->path p))))
(define (toc-part? d)
(part-style? d 'toc))
@ -205,6 +194,29 @@
;; ----------------------------------------
(inherit path->root-relative
root-relative->path)
(define (path->relative p)
(let ([p (path->main-doc-relative p)])
(if (path? p)
(let ([p (path->main-collects-relative p)])
(if (path? p)
(path->root-relative p)
p))
p)))
(define (relative->path p)
(let ([p (main-doc-relative->path p)])
(if (path? p)
p
(let ([p (main-collects-relative->path p)])
(if (path? p)
p
(root-relative->path p))))))
;; ----------------------------------------
(define/override (start-collect ds fns ci)
(map (lambda (d fn)
(parameterize ([current-output-file fn]
@ -266,14 +278,23 @@
;; ----------------------------------------
(define external-tag-path #f)
(define/public (set-external-tag-path p)
(set! external-tag-path p))
(define/public (tag->path+anchor ri tag)
(let ([dest (resolve-get #f ri tag)])
;; Called externally; not used internally
(let-values ([(dest ext?) (resolve-get/ext? #f ri tag)])
(if dest
(values
(relative->path (dest-path dest))
(if (dest-page? dest)
#f
(anchor-name (dest-anchor dest))))
(if (and ext? external-tag-path)
(values
external-tag-path
(format "~a" (serialize tag)))
(values
(relative->path (dest-path dest))
(if (dest-page? dest)
#f
(anchor-name (dest-anchor dest)))))
(values #f #f))))
;; ----------------------------------------
@ -686,17 +707,25 @@
[(and (link-element? e)
(not (current-no-links)))
(parameterize ([current-no-links #t])
(let ([dest (resolve-get part ri (link-element-tag e))])
(let-values ([(dest ext?) (resolve-get/ext? part ri (link-element-tag e))])
(if dest
`((a ((href ,(format "~a~a~a"
(from-root (relative->path (dest-path dest))
`((a ((href ,(if (and ext? external-tag-path)
;; Redirected to search:
(format "~a;tag=~a"
external-tag-path
(base64-encode
(string->bytes/utf-8
(format "~a" (serialize (link-element-tag e))))))
;; Normal link:
(format "~a~a~a"
(from-root (relative->path (dest-path dest))
(get-dest-directory))
(if (dest-page? dest)
""
"#")
(if (dest-page? dest)
""
(anchor-name (dest-anchor dest)))))
(anchor-name (dest-anchor dest))))))
,@(if (string? (element-style e))
`((class ,(element-style e)))
null))
@ -792,7 +821,7 @@
null))))])
`((img ((src ,(let ([p (install-file src)])
(if (path? p)
(url->string (path->url p))
(url->string (path->url (path->complete-path p)))
p))))
,@sz)))]
[else (super render-element e part ri)])))
@ -1036,7 +1065,7 @@
(define (from-root p d)
(if (not d)
(url->string (path->url p))
(url->string (path->url (path->complete-path p)))
(let ([e-d (explode (path->complete-path d (current-directory)))]
[e-p (explode (path->complete-path p (current-directory)))])
(let loop ([e-d e-d]

6
collects/scribble/render-struct.ss Normal file
View File

@ -0,0 +1,6 @@
#lang scheme/base
(require scheme/serialize)
(provide (struct-out mobile-root))
(define-serializable-struct mobile-root (path) #:mutable)

6
collects/scribble/run.ss
View File

@ -31,6 +31,8 @@
(make-parameter null))
(define current-style-file
(make-parameter #f))
(define current-redirect
(make-parameter #f))
(define (get-command-line-files argv)
(command-line
@ -52,6 +54,8 @@
(current-dest-name name)]
[("--style") file "use given .css/.tex file"
(current-style-file file)]
[("--redirect") url "redirect external tag links to <url>"
(current-redirect url)]
[("--info-out") file "write format-specific link information to <file>"
(current-info-output-file file)]]
[multi
@ -74,6 +78,8 @@
(let ([renderer (new ((current-render-mixin) render%)
[dest-dir dir]
[style-file (current-style-file)])])
(when (current-redirect)
(send renderer set-external-tag-path (current-redirect)))
(send renderer report-output!)
(let* ([fns (map (lambda (fn)
(let-values ([(base name dir?) (split-path fn)])

15
collects/scribble/struct.ss
View File

@ -41,12 +41,20 @@
#f)])
(values v #t))]))))
(define (resolve-get part ri key)
(define (resolve-get/ext? part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
(when ext?
(hash-set! (resolve-info-undef ri)
(tag-key key ri)
#t))
(values v ext?)))
(define (resolve-get part ri key)
(let-values ([(v ext?) (resolve-get/ext? part ri key)])
v))
(define (resolve-get/tentative part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
v))
(define (resolve-search search-key part ri key)
@ -61,10 +69,6 @@
(hash-set! s-ht key #t))
(resolve-get part ri key))
(define (resolve-get/tentative part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
v))
(define (resolve-get-keys part ri key-pred)
(let ([l null])
(hash-for-each
@ -499,6 +503,7 @@
[collect-put! (collect-info? info-key? any/c . -> . any)]
[resolve-get ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get/tentative ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get/ext? ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-search (any/c (or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get-keys ((or/c part? false/c) resolve-info? (info-key? . -> . any/c) . -> . any/c)])

10
collects/scribble/xref.ss
View File

@ -18,6 +18,7 @@
xref-binding->definition-tag
xref-tag->path+anchor
xref-tag->index-entry
xref-transfer-info
(struct-out entry))
(define-struct entry (words ; list of strings: main term, sub-term, etc.
@ -35,7 +36,9 @@
(define-namespace-anchor here)
(define (load-xref sources #:render% [render% (html:render-mixin render%)])
(define (load-xref sources
#: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)])
@ -43,7 +46,7 @@
(parameterize ([current-namespace (namespace-anchor->empty-namespace here)])
(let ([v (src)])
(when v
(send renderer deserialize-info v ci)))))
(send renderer deserialize-info v ci #:root root-path)))))
sources)
(make-xrefs renderer (send renderer resolve null null ci))))
@ -78,6 +81,9 @@
(void)
(car xs))))
(define (xref-transfer-info renderer ci xrefs)
(send renderer transfer-info ci (resolve-info-ci (xrefs-ri xrefs))))
;; Returns (values <tag-or-#f> <form?>)
(define xref-binding-tag
(case-lambda

66
collects/scribblings/scribble/renderer.scrbl
View File

@ -45,53 +45,57 @@ object's methods directly.
Represents a renderer.
@defconstructor[([dest-dir path-string?])]{
@defconstructor[([dest-dir path-string?]
[refer-to-existing-files any/c #f]
[root-path (or/c path-string? false/c) #f])]{
Creates a renderer whose output goes to @scheme[dest-dir].
}
If @scheme[root-path] is not @scheme[#f], it is normally the same as
@scheme[dest-dir] or a parent of @scheme[dest-dir]. It causes
cross-reference information to record destination files relative to
@scheme[root-path]; when cross-reference information is serialized, it
can be deserialized via @method[render% deserialize-info] with a
different root path (indicating that the destination files have
moved).}
@defmethod[(collect [srcs (listof part?)]
[dests (listof path-string?)])
collect-info?]{
Performs the @techlink{collect pass}.
}
Performs the @techlink{collect pass}.}
@defmethod[(resolve [srcs (listof part?)]
[dests (listof path-string?)]
[ci collect-info?])
resolve-info?]{
Performs the @techlink{resolve pass}.
}
Performs the @techlink{resolve pass}.}
@defmethod[(render [srcs (listof part?)]
[dests (listof path-string?)]
[ri resolve-info?])
void?]{
Produces the final output.
}
Produces the final output.}
@defmethod[(serialize-info [ri resolve-info?])
any/c]{
Serializes the collected info in @scheme[ri].
}
Serializes the collected info in @scheme[ri].}
@defmethod[(deserialize-info [v any/c]
[ci collect-info?])
[ci collect-info?]
[#:root root-path (or/c path-string? false/c) #f])
void?]{
Adds the deserialized form of @scheme[v] to @scheme[ci].
}
If @scheme[root-path] is not @scheme[#f], then file paths that are
recorded in @scheme[ci] as relative to an instantiation-supplied
@scheme[root-path] are deserialized as relative instead to the given
@scheme[root-path].}
}
@ -101,9 +105,9 @@ Adds the deserialized form of @scheme[v] to @scheme[ci].
@defmodule/local[scribble/text-render]{
@defthing[render-mixin ((subclass?/c render%) . -> . (subclass?/c render%))]{
@defmixin[render-mixin (render%) ()]{
Specializes @scheme[render%] for generating plain text.}}
Specializes a @scheme[render%] class for generating plain text.}}
@; ----------------------------------------
@ -111,14 +115,26 @@ Specializes @scheme[render%] for generating plain text.}}
@defmodule/local[scribble/html-render]{
@defthing[render-mixin ((subclass?/c render%) . -> . (subclass?/c render%))]{
@defmixin[render-mixin (render%) ()]{
Specializes @scheme[render%] for generating a single HTML file.}
Specializes a @scheme[render%] class for generating HTML output.
@defthing[render-multi-mixin ((subclass?/c render%) . -> . (subclass?/c render%))]{
@defmethod[(set-external-tag-path [url string?]) void?]{
Further specializes @scheme[render%] for generating multiple HTML
files. The input class must be first extended with @scheme[render-mixin].}}
Configures the renderer to redirect links to external via
@scheme[url], adding a @scheme[tag] query element to the end of the
URL that contains the Base64-encoded, @scheme[print]ed, serialized
original tag (in the sense of @scheme[link-element]) for the link.}
}
@defmixin[render-multi-mixin (render%) ()]{
Further specializes a rendering class produced by
@scheme[render-mixin] for generating multiple HTML
files.}
}
@; ----------------------------------------
@ -126,6 +142,6 @@ files. The input class must be first extended with @scheme[render-mixin].}}
@defmodule/local[scribble/latex-render]{
@defthing[render-mixin ((subclass?/c render%) . -> . (subclass?/c render%))]{
@defmixin[render-mixin (render%) ()]{
Specializes @scheme[render%] for generating Latex input.}}
Specializes a @scheme[render%] class for generating Latex input.}}

9
collects/scribblings/scribble/struct.scrbl
View File

@ -640,6 +640,15 @@ documentation.
}
@defproc[(resolve-get/ext? [p (or/c part? false/c)] [ri resolve-info?] [key info-key?])
(values any/c boolean?)]{
Like @scheme[render-get], but returns a second value to indicate
whether the resulting information originated from an external source
(i.e., a different document).}
@defproc[(resolve-search [dep-key any/c][p (or/c part? false/c)] [ri resolve-info?] [key info-key?])
void?]{

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

@ -22,7 +22,8 @@ by @scheme[load-xref], @scheme[#f] otherwise.}
@defproc[(load-xref [sources (listof (-> any/c))]
[#:render% using-render% (subclass?/c render%)
(render-mixin render%)])
(render-mixin render%)]
[#:root root-path (or/c path-string? false/c) #f])
xref?]{
Creates a cross-reference record given a list of functions that each
@ -34,6 +35,10 @@ Since the format of serialized information is specific to a rendering
class, the optional @scheme[using-render%] argument accepts the
relevant class. It default to HTML rendering.
If @scheme[root-path] is not @scheme[#f], then file paths that are
serialized as relative to an instantiation-supplied @scheme[root-path]
are deserialized as relative instead to the given @scheme[root-path].
Use @scheme[load-collections-xref] from @schememodname[setup/xref] to
get all cross-reference information for installed documentation.}
@ -157,6 +162,16 @@ rendering (such as image files) are referenced from their existing
locations, instead of copying to the directory of @scheme[dest].}
@defproc[(xref-transfer-info [renderer (is-a?/c render%)]
[ci collect-info?]
[xref xref?])
void?]{
Transfers cross-reference information to @scheme[ci], which is the
initially collected information from @scheme[renderer].}
@defproc[(xref-index [xref xref?]) (listof entry?)]{
Converts indexing information @scheme[xref] into a list of