diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/renderer.scrbl index 9c60d879..3822b290 100644 --- 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 index 0f7a207a..e5809182 100644 --- 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 index efbeb71f..8931cd04 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt @@ -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) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt index 86f47dda..33e65fe0 100644 --- 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 index 23adfe5f..0d802f28 100644 --- 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 index 4323972f..53f9acd5 100644 --- 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 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)))])