commit d612610615fa4dd3fe8cea71306dbbb409cfbae8
parent 1a192ed8d43bfae8f0e819afa4f9740903d2f9f4
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 7 Nov 2013 18:30:14 -0700
scribble: add `--html-tree <n>` mode for rendering to depth <n>
Depth 0 is the same as `--html`, depth 1 is the same as `--htmls`,
and higher depths cause sections and subsections to be rendered
into separate directories when they have their own pages.
original commit: a0c306e2ed0fe9c367cc939de946576552157dac
Diffstat:
6 files changed, 131 insertions(+), 50 deletions(-)
diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl
@@ -15,11 +15,12 @@
(intro)))
@(begin
- (define-syntax-rule (def-html-render-mixin id)
+ (define-syntax-rule (def-html-render-mixin id mid)
(begin
(require (for-label scribble/html-render))
- (define id @racket[render-mixin])))
- (def-html-render-mixin html:render-mixin))
+ (define id @racket[render-mixin])
+ (define mid @racket[render-multi-mixin])))
+ (def-html-render-mixin html:render-mixin html:render-multi-mixin))
@(begin
(define-syntax-rule (def-latex-render-mixin id)
(begin
@@ -53,6 +54,7 @@ function to render a document.
[#:info-out-file info-out-file (or/c #f path-string?) #f]
[#:redirect redirect (or/c #f string?) #f]
[#:redirect-main redirect-main (or/c #f string?) #f]
+ [#:directory-depth directory-depth exact-nonnegative-integer? 0]
[#:quiet? quiet? any/c #t]
[#:warn-undefined? warn-undefined? any/c (not quiet?)])
void?]{
@@ -87,6 +89,9 @@ to the @racket[set-external-tag-path] and
@racketmodname[scribble/html-render], so they should be
non-@racket[#f] only for HTML rendering.
+The @racket[directory-depth] arguments correspond to the
+@racket[set-directory-depth] method of @|html:render-multi-mixin|.
+
If @racket[quiet?] is a false value, output-file information is
written to the current output port.
@@ -333,7 +338,15 @@ directory.}
Further specializes a rendering class produced by
@racket[render-mixin] for generating multiple HTML
-files.}
+files.
+
+@defmethod[(set-directory-depth [depth exact-nonnegative-integer?]) void?]{
+
+Sets the depth of directory structure used when rendering parts that
+are own their own pages. A value of @racket[0] is treated the same as
+@racket[1].}
+
+}
}
diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/running.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/running.scrbl
@@ -23,6 +23,11 @@ its file suffix:
a @filepath{@|fn|} directory, starting with
@filepath{@|fn|/index.html}}
+ @item{@DFlag{html-tree} @nonterm{n} --- HTML pages in a directory
+ tree up to @nonterm{n} layers deep; a tree of depth @exec{0} is
+ equivalent to using @DFlag{html}, and a tree of depth @exec{1}
+ is equivalent to using @DFlag{htmls}}
+
@item{@DFlag{latex} --- LaTeX source @filepath{@|fn|.tex}, plus
any needed additional files (such as non-standard class files)
needed to run @exec{latex} or @exec{pdflatex}}
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt
@@ -117,6 +117,14 @@
(loop (modulo n 10) I V X L C D M))])))
;; ----------------------------------------
+ ;; Methods that really only work on some renderers:
+
+ (define/public (set-external-tag-path p) (void))
+ (define/public (set-external-root-url p) (void))
+ (define/public (add-extra-script-file s) (void))
+ (define/public (set-directory-depth n) (void))
+
+ ;; ----------------------------------------
(define/public (extract-part-style-files d ri stop-at-part? pred extract)
(let ([ht (make-hash)])
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
@@ -58,18 +58,29 @@
;; note: file-size can be bigger than the string, but
;; that's fine.
(read-string (file-size file)))))]
+ [adjust-rel
+ (lambda (depth p)
+ (if (and (relative-path? p)
+ (positive? depth))
+ (let loop ([d depth] [p p])
+ (if (zero? d)
+ p
+ (loop (sub1 d) (string-append "../" p))))
+ p))]
[file-getter
(lambda (default-file make-inline make-ref)
(let ([c #f])
- (lambda (file path)
+ (lambda (file path depth)
(cond [(bytes? file)
(make-inline (bytes->string/utf-8 file))]
[(url? file)
(make-ref (url->string* file))]
[(not (eq? 'inline path))
- (make-ref (or path (let-values ([(base name dir?)
- (split-path file)])
- (path->string name))))]
+ (make-ref (adjust-rel
+ depth
+ (or path (let-values ([(base name dir?)
+ (split-path file)])
+ (path->string name)))))]
[(or (not file) (equal? file default-file))
(unless c
(set! c (make-inline (read-file default-file))))
@@ -209,6 +220,9 @@
(list `(part "???"))
l))
+(define (part-parent d ri)
+ (collected-info-parent (part-collected-info d ri)))
+
;; ----------------------------------------
;; main mixin
@@ -361,15 +375,15 @@
;; ----------------------------------------
(define external-tag-path #f)
- (define/public (set-external-tag-path p)
+ (define/override (set-external-tag-path p)
(set! external-tag-path p))
(define external-root-url #f)
- (define/public (set-external-root-url p)
+ (define/override (set-external-root-url p)
(set! external-root-url p))
(define extra-script-files null)
- (define/public (add-extra-script-file s)
+ (define/override (add-extra-script-file s)
(set! extra-script-files (cons s extra-script-files)))
(define (try-relative-to-external-root dest)
@@ -706,7 +720,10 @@
(style-properties (part-style d)))
(let ([p (part-parent d ri)])
(and p (extract-part-body-id p ri)))))
-
+
+ (define/public (part-nesting-depth d ri)
+ 0)
+
(define/public (render-one-part d ri fn number)
(parameterize ([current-output-file fn])
(let* ([defaults (ormap (lambda (v) (and (html-defaults? v) v))
@@ -730,7 +747,8 @@
=> (lambda (c)
`(title ,@(format-number number '(nbsp))
,(content->string (strip-aux c) this d ri)))]
- [else `(title)])])
+ [else `(title)])]
+ [dir-depth (part-nesting-depth d ri)])
(unless (bytes? style-file)
(unless (lookup-path style-file alt-paths)
(install-file style-file)))
@@ -751,13 +769,15 @@
(meta ([http-equiv "content-type"]
[content "text/html; charset=utf-8"]))
,title
- ,(scribble-css-contents scribble-css (lookup-path scribble-css alt-paths))
+ ,(scribble-css-contents scribble-css
+ (lookup-path scribble-css alt-paths)
+ dir-depth)
,@(map (lambda (style-file)
(if (or (bytes? style-file) (url? style-file))
- (scribble-css-contents style-file #f)
+ (scribble-css-contents style-file #f dir-depth)
(let ([p (lookup-path style-file alt-paths)])
(unless p (install-file style-file))
- (scribble-css-contents style-file p))))
+ (scribble-css-contents style-file p dir-depth))))
(append (extract-part-style-files
d
ri
@@ -766,13 +786,15 @@
css-addition-path)
(list style-file)
style-extra-files))
- ,(scribble-js-contents script-file (lookup-path script-file alt-paths))
+ ,(scribble-js-contents script-file
+ (lookup-path script-file alt-paths)
+ dir-depth)
,@(map (lambda (script-file)
(if (or (bytes? script-file) (url? script-file))
- (scribble-js-contents script-file #f)
+ (scribble-js-contents script-file #f dir-depth)
(let ([p (lookup-path script-file alt-paths)])
(unless p (install-file script-file))
- (scribble-js-contents script-file p))))
+ (scribble-js-contents script-file p dir-depth))))
(append
(extract-part-style-files
d
@@ -797,9 +819,6 @@
,@(navigation d ri #f)))
(div ([id "contextindicator"]) nbsp))))))))
- (define/private (part-parent d ri)
- (collected-info-parent (part-collected-info d ri)))
-
(define (toc-part? d ri)
(and (part-style? d 'toc)
;; topmost part doesn't count as toc, since it
@@ -826,7 +845,7 @@
(define next-content '("next " rarr))
(define sep-element '(nbsp nbsp))
- (define/public (derive-filename d ci ri) "bad.html")
+ (define/public (derive-filename d ci ri depth) "bad.html")
(define/public (include-navigation?) search-box?)
@@ -1594,6 +1613,10 @@
report-output?
all-toc-hidden?)
+ (define directory-depth 1)
+ (define/override (set-directory-depth n)
+ (set! directory-depth (max 1 n)))
+
(define/override (get-suffix) #"")
(define/override (get-dest-directory [create? #f])
@@ -1621,23 +1644,34 @@
(for/list ([p (in-list parents)])
(or (part-tag-prefix p) "")))))
- (define/override (derive-filename d ci ri)
- (let ([fn (format "~a.html"
- (regexp-replace*
- "[^-a-zA-Z0-9_=]"
- (string-append
- (append-part-prefixes d ci ri)
- (let ([s (cadr (car (part-tags/nonempty d)))])
- (cond [(string? s) s]
- [(part-title-content d)
- (content->string (part-title-content d))]
- [else
- ;; last-ditch effort to make up a unique name:
- (format "???~a" (eq-hash-code d))])))
- "_"))])
- (when ((string-length fn) . >= . 48)
- (error "file name too long (need a tag):" fn))
- fn))
+ (define/override (part-nesting-depth d ri)
+ (min (part-depth d ri) (sub1 directory-depth)))
+
+ (define/private (part-depth d ri)
+ (define p (collected-info-parent (part-collected-info d ri)))
+ (if (not p)
+ 0
+ (add1 (part-depth p ri))))
+
+ (define/override (derive-filename d ci ri depth)
+ (let ([base (regexp-replace*
+ "[^-a-zA-Z0-9_=]"
+ (string-append
+ (append-part-prefixes d ci ri)
+ (let ([s (cadr (car (part-tags/nonempty d)))])
+ (cond [(string? s) s]
+ [(part-title-content d)
+ (content->string (part-title-content d))]
+ [else
+ ;; last-ditch effort to make up a unique name:
+ (format "???~a" (eq-hash-code d))])))
+ "_")])
+ (let ([fn (if (depth . < . directory-depth)
+ (path->string (build-path base "index.html"))
+ (format "~a.html" base))])
+ (when ((string-length fn) . >= . 48)
+ (error "file name too long (need a tag):" fn))
+ fn)))
(define/override (include-navigation?) #t)
@@ -1677,12 +1711,13 @@
[collecting-whole-page (prev-sub . <= . 1)])
(if (and (current-part-whole-page? d)
(not (eq? d (current-top-part))))
- (let* ([filename (derive-filename d ci #f)]
- [full-filename (build-path (path-only (current-output-file))
- filename)])
- (check-duplicate-filename full-filename)
- (parameterize ([current-output-file full-filename])
- (super collect-part d parent ci number sub-init-number)))
+ (let* ([filename (derive-filename d ci #f (length number))]
+ [full-filename (build-path (path-only (current-output-file))
+ filename)])
+ (make-directory* (path-only full-filename))
+ (check-duplicate-filename full-filename)
+ (parameterize ([current-output-file full-filename])
+ (super collect-part d parent ci number sub-init-number)))
(super collect-part d parent ci number sub-init-number)))))
(define/override (render ds fns ri)
@@ -1720,12 +1755,15 @@
(if (and (on-separate-page-ok)
(part-whole-page? d ri)
(not (eq? d (current-top-part))))
- ;; Render as just a link, and put the actual content in a
- ;; new file:
- (let* ([filename (derive-filename d #f ri)]
+ ;; Put the actual content in a new file:
+ (let* ([filename (derive-filename d #f ri (part-depth d ri))]
[full-path (build-path (path-only (current-output-file))
filename)])
- (parameterize ([on-separate-page-ok #f])
+ (parameterize ([on-separate-page-ok #f]
+ [current-subdirectory (let ([p (path-only filename)])
+ (if p
+ (build-path (current-subdirectory) p)
+ (current-subdirectory)))])
;; We use 'replace instead of the usual 'truncate/replace
;; to avoid problems where a filename changes only in case,
;; in which case some platforms will see the old file
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/render.rkt
@@ -21,6 +21,7 @@
#:extra-files (listof path-string?)
#:redirect (or/c #f string?)
#:redirect-main (or/c #f string?)
+ #:directory-depth exact-nonnegative-integer?
#:xrefs (listof xref?)
#:info-in-files (listof path-string?)
#:info-out-file (or/c #f path-string?)
@@ -38,6 +39,7 @@
#:extra-files [extra-files null]
#:redirect [redirect #f]
#:redirect-main [redirect-main #f]
+ #:directory-depth [directory-depth 0]
#:xrefs [xrefs null]
#:info-in-files [info-input-files null]
#:info-out-file [info-output-file #f]
@@ -55,6 +57,8 @@
(send renderer set-external-tag-path redirect))
(when redirect-main
(send renderer set-external-root-url redirect-main))
+ (unless (zero? directory-depth)
+ (send renderer set-directory-depth directory-depth))
(unless quiet?
(send renderer report-output!))
(let* ([fns (map (lambda (fn)
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/run.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/run.rkt
@@ -26,6 +26,7 @@
(define current-extra-files (make-parameter null))
(define current-redirect (make-parameter #f))
(define current-redirect-main (make-parameter #f))
+(define current-directory-depth (make-parameter 0))
(define current-quiet (make-parameter #f))
(define helper-file-prefix (make-parameter #f))
@@ -45,6 +46,17 @@
[("--htmls") "generate HTML-format output directory"
(current-html #t)
(current-render-mixin multi-html:render-mixin)]
+ [("--html-tree") n "generate HTML-format output directories <n> deep"
+ (let ([nv (string->number n)])
+ (unless (exact-nonnegative-integer? nv)
+ (raise-user-error 'scribble
+ "invalid depth: ~a"
+ n))
+ (current-directory-depth nv)
+ (current-html #t)
+ (current-render-mixin (if (zero? nv)
+ html:render-mixin
+ multi-html:render-mixin)))]
[("--latex") "generate LaTeX-format output"
(current-html #f)
(current-render-mixin latex:render-mixin)]
@@ -137,6 +149,7 @@
#:helper-file-prefix (helper-file-prefix)
#:redirect (and (current-html) (current-redirect))
#:redirect-main (and (current-html) (current-redirect-main))
+ #:directory-depth (current-directory-depth)
#:quiet? (current-quiet)
#:info-in-files (reverse (current-info-input-files))
#:xrefs (for/list ([mod+id (in-list (reverse (current-xref-input-modules)))])
