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

scribble: add --html-tree <n> mode for rendering to depth <n>

Browse Source 
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
This commit is contained in:
Matthew Flatt 2013-11-07 18:30:14 -07:00
parent 1a192ed8d4
commit d612610615
6 changed files with 131 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl
View File

@ -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].}
}
}

5
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/running.scrbl
View File

@ -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}}

8
pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt
View File

@ -116,6 +116,14 @@
(string-append (loop (quotient n 10) X L C D M D M)
(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)

130
pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
View File

@ -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

4
pkgs/scribble-pkgs/scribble-lib/scribble/render.rkt
View File

@ -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)

13
pkgs/scribble-pkgs/scribble-lib/scribble/run.rkt
View File

@ -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)))])