diff --git a/doclang-raw.rkt b/doclang-raw.rkt index b4f203b..0ff1401 100755 --- a/doclang-raw.rkt +++ b/doclang-raw.rkt @@ -10,9 +10,8 @@ (define-syntax (*module-begin stx) (syntax-case stx () - [(_ . body) - (with-syntax ([id #'doc-raw] ; name of the main export from doclang-raw - [post-process #'(λ(x) x)] + [(_ id . body) + (with-syntax ([post-process #'(λ(x) x)] [exprs #'()]) #'(#%module-begin (doc-begin id post-process exprs . body)))])) diff --git a/language-info.rkt b/language-info.rkt index c7e14f6..b02483a 100644 --- a/language-info.rkt +++ b/language-info.rkt @@ -1,7 +1,7 @@ #lang racket/base (provide get-language-info) -(define (get-language-info data) - (lambda (key default) +(define (get-language-info top-here-path) + (λ(key default) (case key - [(configure-runtime) '(#(pollen/runtime-config configure #f))] + [(configure-runtime) `(#(pollen/runtime-config configure ,top-here-path))] [else default]))) \ No newline at end of file diff --git a/main-base.rkt b/main-base.rkt index 05da0dd..ecd5a23 100644 --- a/main-base.rkt +++ b/main-base.rkt @@ -34,14 +34,16 @@ [(VALUE (... ...)) (datum->syntax #'(EXPR (... ...)) meta-values)] [METAS (format-id #'(EXPR (... ...)) "~a" (world:current-meta-export))] [META-MOD (format-symbol "~a" (world:current-meta-export))] - [DOC (format-id #'(EXPR (... ...)) "~a" (world:current-main-export))]) + [DOC (format-id #'(EXPR (... ...)) "~a" (world:current-main-export))] + [DOC-RAW (generate-temporary)]); prevents conflicts with other imported Pollen sources (replace-context #'(EXPR (... ...)) #'(#%module-begin (module META-MOD racket/base (provide (all-defined-out)) (define METAS (apply hash (append (list 'KEY VALUE) (... ...))))) - (module inner pollen/doclang-raw ; exports result as doc-raw + (module inner pollen/doclang-raw + DOC-RAW ; positional arg for doclang-raw that sets name of export. (require pollen/top pollen/world) (provide #%top (all-defined-out) (all-from-out pollen/world)) EXPR-WITHOUT-METAS (... ...)) @@ -58,6 +60,6 @@ [else ; for preprocessor output, just make a string (λ xs (apply string-append (map to-string xs)))])] ;; drop leading newlines, as they're often the result of `defines` and `requires` - [doc-elements (dropf doc-raw (λ(ln) (equal? ln "\n")))]) + [doc-elements (dropf DOC-RAW (λ(ln) (equal? ln "\n")))]) (apply proc doc-elements))) - (provide DOC METAS (except-out (all-from-out 'inner) doc-raw #%top))))))])))) ; hide internal exports \ No newline at end of file + (provide DOC METAS (except-out (all-from-out 'inner) DOC-RAW #%top))))))])))) ; hide internal exports \ No newline at end of file diff --git a/pagetree.rkt b/pagetree.rkt index 9a9d4eb..39efd13 100644 --- a/pagetree.rkt +++ b/pagetree.rkt @@ -37,9 +37,15 @@ (define+provide/contract (decode-pagetree xs) (txexpr-elements? . -> . any/c) ; because pagetree is being explicitly validated + (define pt-root-tag (world:current-pagetree-root-node)) + (define (splice-nested-pagetree xs) + (apply append (for/list ([x (in-list xs)]) + (if (and (txexpr? x) (eq? (get-tag x) pt-root-tag)) + (get-elements x) + (list x))))) (validate-pagetree - (decode (cons (world:current-pagetree-root-node) xs) - #:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs)) + (decode (cons pt-root-tag xs) + #:txexpr-elements-proc (compose1 splice-nested-pagetree (λ(xs) (filter-not whitespace? xs))) #:string-proc string->symbol))) ; because faster than ->pagenode @@ -53,6 +59,7 @@ x)))) + (define+provide (pagetree? x) (with-handlers ([exn:fail? (λ(e) #f)]) (->boolean (validate-pagetree x)))) @@ -61,7 +68,9 @@ (check-true (pagetree? '(foo))) (check-true (pagetree? '(foo (hee)))) (check-true (pagetree? '(foo (hee (uncle foo))))) - (check-false (pagetree? '(foo (hee hee (uncle foo)))))) + (check-false (pagetree? '(foo (hee hee (uncle foo))))) + (check-equal? (decode-pagetree '(one two (pagetree-root three (pagetree-root four five) six) seven eight)) + '(pagetree-root one two three four five six seven eight))) (define+provide/contract (directory->pagetree dir) @@ -76,7 +85,7 @@ (define (sort-names xs) (sort xs #:key ->string stringsyntax source-stx reader-here-path)] - [POLLEN-MOD (format-symbol "~a" 'pollen-lang-module)] + [POLLEN-MOD (format-symbol "~a" (gensym))] ; prevents conflicts with other imported Pollen sources [PARSER-MODE-VALUE (format-symbol "~a" parser-mode)] [DIRECTORY-REQUIRES (datum->syntax source-stx (require+provide-directory-require-files path-string))] [(SOURCE-LINE ...) source-stx] @@ -53,10 +53,10 @@ SOURCE-LINE ...) (require (submod pollen/runtime-config show) 'POLLEN-MOD) (provide (all-from-out 'POLLEN-MOD)) - (show DOC inner:parser-mode))))) + (show DOC inner:parser-mode HERE-PATH))))) ; HERE-PATH acts as "local" runtime config (syntax-property post-parser-syntax 'module-language - '#(pollen/language-info get-language-info #f)))) + `#(pollen/language-info get-language-info ,reader-here-path)))) ; reader-here-path acts as "top" runtime config (define-syntax-rule (define+provide-reader-in-mode mode) diff --git a/runtime-config.rkt b/runtime-config.rkt index c0c8cb7..e225c97 100644 --- a/runtime-config.rkt +++ b/runtime-config.rkt @@ -7,16 +7,19 @@ (define show-enabled (make-parameter #f)) - (define (show doc parser-mode) - (when (show-enabled) - (if (or (equal? parser-mode world:mode-preproc) - (equal? parser-mode world:mode-template)) + (define (show doc parser-mode here-path) + ;; we only want the top doc to print in the runtime environment + ;; otherwise if a Pollen source imports others, they will all print their docs in sequence. + ;; so only print if the current here-path is the top path, which is stored in the `show-enabled` parameter. + (when (and (show-enabled) (equal? here-path (show-enabled))) + (if (or (eq? parser-mode world:mode-preproc) + (eq? parser-mode world:mode-template)) (display doc) (print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| ((dynamic-require 'racket/string 'string-join) (cdr ((dynamic-require 'racket/string 'string-split) (exn-message exn) ": ")) ": "))))]) ((dynamic-require 'txexpr 'validate-txexpr) doc))))))) (require 'show) -(define (configure data) - (show-enabled #t)) +(define (configure top-here-path) + (show-enabled top-here-path)) diff --git a/scribblings/pagetree.scrbl b/scribblings/pagetree.scrbl index 49d92fd..17d4326 100644 --- a/scribblings/pagetree.scrbl +++ b/scribblings/pagetree.scrbl @@ -116,6 +116,87 @@ Experienced programmers may want to know that because a pagetree is just an X-ex Note that you need to take more care when building a pagetree by hand. Pagenodes are symbols, not strings, thus the use of @racket[string->symbol] is mandatory. One benefit of using a pagetree source file is that it takes care of this housekeeping for you. +@section{Nesting pagetrees} + +You can put other pagetrees within a pagetree. Since every pagetree is an X-expression, you can nest pagetrees as you would ordinary X-expressions. Suppose we have this pagetree: + +@fileblock["sub.ptree" @codeblock{ +#lang pollen +three +four +}] + +And we want to add it to an existing pagetree: + +@fileblock["index.ptree" @codeblock{ +#lang pollen +one +two +five +six}] + +You can @racket[require] @filepath{sub.ptree} normally to import its @racket[doc]: + +@fileblock["index.ptree" @codeblock{ +#lang pollen +◊(require "sub.ptree") +one +two +◊doc +five +six}] + +And you'll get this: + +@repl-output{'(pagetree-root one two three four five six)} + +Pollen does one bit of housekeeping for you, which is that it automatically drops the root node of the imported pagetree, and splices the remaining nodes into the parent pagetree at the insertion point. Otherwise you'd get this, which is probably not what you wanted: + +@repl-output{'(pagetree-root one two (pagetree-root three four) five six)} + +But if you do want the imported pagetree under a subnode, just add a containing pagenode as usual: + +@fileblock["index.ptree" @codeblock{ +#lang pollen +◊(require "sub.ptree") +one +two +◊subtree{ + ◊doc +} +five +six}] + +Which will give you: + +@repl-output{'(pagetree-root one two (subtree three four) five six)} + +If you want to combine a number of pagetrees, @racket[require] can get cumbersome because you have to juggle multiple @racket[doc] imports (which can be done with @racket[prefix-in], but it's still juggling). Instead, you can use @racket[dynamic-require] to put each imported pagetree where you want it. + +@fileblock["index.ptree" @codeblock{ +#lang pollen +one +two +◊(dynamic-require "sub.ptree" 'doc) +five +six +◊(dynamic-require "sub-two.ptree" 'doc) +nine +ten +}] + +Nesting pagetrees won't circumvent the usual rule against duplicate pagenodes. So this pagetree, which tries to nest @filepath{sub.ptree} twice, won't work: + +@fileblock["index.ptree" @codeblock{ +#lang pollen +one +two +◊(dynamic-require "sub.ptree" 'doc) +◊(dynamic-require "sub.ptree" 'doc) +five +six +}] + @section{The automatic pagetree} In situations where Pollen needs a pagetree but can't find one, it will automatically synthesize a pagetree from a listing of files in the directory. This arises most frequently when @secref["Using_the_dashboard" #:doc '(lib "pollen/scribblings/pollen.scrbl")] in a directory that doesn't contain an explicit @filepath{index.ptree}. This way, you can get going with a project without having to stop for @racketfont{.ptree} housekeeping. diff --git a/test/test-langs.rkt b/test/test-langs.rkt index d345faa..25c8064 100644 --- a/test/test-langs.rkt +++ b/test/test-langs.rkt @@ -48,8 +48,7 @@ (with-output-to-string (λ() (system cmd-string)))) (check-equal? (run test.ptree) "'(pagetree-root test ====)") (check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")}) - ;; todo: this one's a little weird. Pollen-to-Pollen require prints the result of required file on import. - (check-equal? (run test-import.html.pm) @string-append{'(root "This is sample 01.")'(root "test" "\n" "====" "\n" (root "This is sample 01."))}) + (check-equal? (run test-import.html.pm) @string-append{'(root "test" "\n" "====" "\n" (root "This is sample 01."))}) (check-equal? (run test.html.pmd) "'(root (h1 ((id \"test\")) \"test\"))") (check-equal? (run test.html.pp) "test\n====") (check-equal? (run test.no-ext) "test\n===="))