commit 21ef05890a9eecbe7925f48b4fc834521b37c27b
parent ec179d4cbfd15929fc203a30e52befba56d110bd
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 11 Apr 2008 19:09:26 +0000
more scribble rendering and doc details
svn: r9261
original commit: b9d7824c8e97ee2b46300d7d4f5dd72102b0c008
Diffstat:
5 files changed, 66 insertions(+), 44 deletions(-)
diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss
@@ -13,7 +13,8 @@
(define render%
(class object%
- (init-field dest-dir)
+ (init-field dest-dir
+ [refer-to-existing-files #f])
(define/public (get-dest-directory) dest-dir)
@@ -370,29 +371,33 @@
;; ----------------------------------------
(define/public (install-file fn)
- (let ([src-dir (path-only fn)]
- [dest-dir (get-dest-directory)]
- [fn (file-name-from-path fn)])
- (let ([src-file (build-path (or src-dir (current-directory)) fn)]
- [dest-file (build-path (or dest-dir (current-directory)) fn)])
- (unless (and (file-exists? dest-file)
- (call-with-input-file*
- src-file
- (lambda (src)
- (call-with-input-file*
- dest-file
- (lambda (dest)
- (or (equal? (port-file-identity src)
- (port-file-identity dest))
- (let loop ()
- (let ([s (read-bytes 4096 src)]
- [d (read-bytes 4096 dest)])
- (and (equal? s d)
- (or (eof-object? s) (loop)))))))))))
- (when (file-exists? dest-file) (delete-file dest-file))
- (make-directory* (path-only dest-file))
- (copy-file src-file dest-file))
- (path->string fn))))
+ (if refer-to-existing-files
+ (if (string? fn)
+ (string->path fn)
+ fn)
+ (let ([src-dir (path-only fn)]
+ [dest-dir (get-dest-directory)]
+ [fn (file-name-from-path fn)])
+ (let ([src-file (build-path (or src-dir (current-directory)) fn)]
+ [dest-file (build-path (or dest-dir (current-directory)) fn)])
+ (unless (and (file-exists? dest-file)
+ (call-with-input-file*
+ src-file
+ (lambda (src)
+ (call-with-input-file*
+ dest-file
+ (lambda (dest)
+ (or (equal? (port-file-identity src)
+ (port-file-identity dest))
+ (let loop ()
+ (let ([s (read-bytes 4096 src)]
+ [d (read-bytes 4096 dest)])
+ (and (equal? s d)
+ (or (eof-object? s) (loop)))))))))))
+ (when (file-exists? dest-file) (delete-file dest-file))
+ (make-directory* (path-only dest-file))
+ (copy-file src-file dest-file))
+ (path->string fn)))))
;; ----------------------------------------
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
@@ -777,7 +777,11 @@
`((width ,(to-num w))
(height ,(to-num h))))
null))))])
- `((img ((src ,(install-file src))) ,@sz)))]
+ `((img ((src ,(let ([p (install-file src)])
+ (if (path? p)
+ (url->string (path->url p))
+ p))))
+ ,@sz)))]
[else (super render-element e part ri)])))
(define/override (render-table t part ri need-inline?)
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -1850,7 +1850,11 @@
(provide commandline)
(define (commandline . s)
- (make-paragraph (list (hspace 2) (apply tt s))))
+ (make-paragraph (cons (hspace 2) (map (lambda (s)
+ (if (string? s)
+ (make-element 'tt (list s))
+ s))
+ s))))
(define (elemtag t . body)
(make-target-element #f (decode-content body) `(elem ,t)))
diff --git a/collects/scribble/xref.ss b/collects/scribble/xref.ss
@@ -63,20 +63,20 @@
;; dest-file can be #f, which will make it return a string holding the
;; resulting html
(define (xref-render xrefs doc dest-file
- #:render% [render% (html:render-mixin render%)])
- ;; In case rendering writes a file (like an image file), which to the
- ;; temp directory:
- (parameterize ([current-directory (find-system-path 'temp-dir)])
- (let* ([dest-file (if (string? dest-file) (string->path dest-file) dest-file)]
- [renderer (new render% [dest-dir (and dest-file (path-only dest-file))]
- [css-path 'inline])]
- [ci (send renderer collect (list doc) (list dest-file))]
- [_ (send renderer transfer-info ci (resolve-info-ci (xrefs-ri xrefs)))]
- [ri (send renderer resolve (list doc) (list dest-file) ci)]
- [xs (send renderer render (list doc) (list dest-file) ri)])
- (if dest-file
- (void)
- (car xs)))))
+ #:render% [render% (html:render-mixin render%)]
+ #:refer-to-existing-files? [use-existing? (not dest-file)])
+ (let* ([dest-file (if (string? dest-file) (string->path dest-file) dest-file)]
+ [renderer (new render%
+ [dest-dir (and dest-file (path-only dest-file))]
+ [refer-to-existing-files use-existing?]
+ [css-path 'inline])]
+ [ci (send renderer collect (list doc) (list dest-file))]
+ [_ (send renderer transfer-info ci (resolve-info-ci (xrefs-ri xrefs)))]
+ [ri (send renderer resolve (list doc) (list dest-file) ci)]
+ [xs (send renderer render (list doc) (list dest-file) ri)])
+ (if dest-file
+ (void)
+ (car xs))))
;; Returns (values <tag-or-#f> <form?>)
(define xref-binding-tag
diff --git a/collects/scribblings/scribble/xref.scrbl b/collects/scribblings/scribble/xref.scrbl
@@ -133,19 +133,28 @@ the binding and its original name.}
@defproc[(xref-render [xref xref?]
[doc part?]
- [dest path-string?]
+ [dest (or/c path-string? false/c)]
[#:render% using-render% (subclass?/c render%)
- (render-mixin render%)])
- void?]{
+ (render-mixin render%)]
+ [#:refer-to-existing-files? use-existing? any/c (not dest)])
+ (or/c void? any/c)]{
Renders @scheme[doc] using the cross-reference info in @scheme[xref]
to the destination @scheme[dest]. For example, @scheme[doc] might be a
generated document of search results using link tags described in
@scheme[xref].
+If @scheme[dest] is @scheme[#f], no file is written, and the result is
+an X-expression for the rendered page. Otherwise, the file
+@scheme[dest] is written and the result is @|void-const|.
+
The optional @scheme[using-render%] argument is as for
@scheme[load-xref]. It determines the kind of output that is
-generated.}
+generated.
+
+If @scheme[use-existing?] is true, then files referenced during
+rendering (such as image files) are referenced from their existing
+locations, instead of copying to the directory of @scheme[dest].}
@defproc[(xref-index [xref xref?]) (listof entry?)]{
