add runtime overrides to pollen/world (closes #60)

pull/84/head
Matthew Butterick 10 years ago
parent 6555af92e8
commit 0f396471e9

@ -7,7 +7,7 @@
(provide reset-cache current-cache make-cache cached-require cache-ref) (provide reset-cache current-cache make-cache cached-require cache-ref)
(define (get-cache-file-path) (define (get-cache-file-path)
(build-path (world:current-project-root) world:cache-filename)) (build-path (world:current-project-root) (world:get-cache-filename)))
(define (make-cache) (define (make-cache)
(define cache-file-path (get-cache-file-path)) (define cache-file-path (get-cache-file-path))
@ -37,16 +37,16 @@
(hash-set! (current-cache) path (make-hash)) (hash-set! (current-cache) path (make-hash))
(define cache-hash (cache-ref path)) (define cache-hash (cache-ref path))
(hash-set! cache-hash 'mod-time (file-or-directory-modify-seconds path)) (hash-set! cache-hash 'mod-time (file-or-directory-modify-seconds path))
(hash-set! cache-hash world:main-pollen-export (dynamic-require path world:main-pollen-export)) (hash-set! cache-hash (world:get-main-export) (dynamic-require path (world:get-main-export)))
(hash-set! cache-hash world:meta-pollen-export (dynamic-require path world:meta-pollen-export)) (hash-set! cache-hash (world:get-meta-export) (dynamic-require path (world:get-meta-export)))
(write-to-file (serialize (current-cache)) (get-cache-file-path) #:exists 'replace) (write-to-file (serialize (current-cache)) (get-cache-file-path) #:exists 'replace)
(void)) (void))
(define (cached-require path-string key) (define (cached-require path-string key)
(when (not (current-cache)) (error "cached-require: No cache set up.")) (when (not (current-cache)) (error 'cached-require "No cache set up."))
(define path (define path
(with-handlers ([exn:fail? (λ(exn) (error (format "cached-require: ~a is not a valid path" path-string)))]) (with-handlers ([exn:fail? (λ(exn) (error 'cached-require (format "~a is not a valid path" path-string)))])
(->complete-path path-string))) (->complete-path path-string)))
(when (not (file-exists? path)) (error (format "cached-require: ~a does not exist" (path->string path)))) (when (not (file-exists? path)) (error (format "cached-require: ~a does not exist" (path->string path))))

@ -18,7 +18,12 @@ render [dir] [dest] render project in dir (default is current dir)
render filename render filename only (can be source or output name) render filename render filename only (can be source or output name)
publish copy project to desktop without source files publish copy project to desktop without source files
publish [dir] [dest] copy project in dir to dest without source files publish [dir] [dest] copy project in dir to dest without source files
(warning: overwrites existing dest dir)" ,(world:current-server-port)))) (warning: overwrites existing dest dir)
version print the version (~a)" ,(world:current-server-port) ,(world:get-pollen-version))))
(define (handle-version)
`(displayln ,(world:get-pollen-version)))
(define (handle-render path-args) (define (handle-render path-args)
@ -64,7 +69,7 @@ publish [dir] [dest] copy project in dir to dest without source files
(define (handle-publish directory rest-args arg-command-name) (define (handle-publish directory rest-args arg-command-name)
(define target-path (or (define target-path (or
(and rest-args (not (null? rest-args)) (path->complete-path (string->path (car rest-args)))) (and rest-args (not (null? rest-args)) (path->complete-path (string->path (car rest-args))))
(build-path (find-system-path 'desk-dir) (string->path (if (equal? arg-command-name "clone") "clone" world:publish-directory-name))))) (build-path (find-system-path 'desk-dir) (string->path (if (equal? arg-command-name "clone") "clone" (world:get-publish-directory-name))))))
`(begin `(begin
(require racket/file pollen/file racket/list) (require racket/file pollen/file racket/list)

@ -12,7 +12,7 @@
(cond (cond
[(and p-breaks (txexpr? x) (equal? (car x) 'p) (apply string-append `("\n" ,@(map ->string (map loop (get-elements x))) "\n")))] [(and p-breaks (txexpr? x) (equal? (car x) 'p) (apply string-append `("\n" ,@(map ->string (map loop (get-elements x))) "\n")))]
[(txexpr? x) (apply string-append [(txexpr? x) (apply string-append
(map ->string `(,world:command-marker ,(get-tag x) (map ->string `(,(world:get-command-char) ,(get-tag x)
,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null) ,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null)
,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))] ,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))]
[(symbol? x) (loop (entity->integer x))] [(symbol? x) (loop (entity->integer x))]

@ -280,7 +280,7 @@
;; turn the right items into <br> tags ;; turn the right items into <br> tags
(define+provide/contract (detect-linebreaks xc (define+provide/contract (detect-linebreaks xc
#:separator [newline world:linebreak-separator] #:separator [newline (world:get-linebreak-separator)]
#:insert [linebreak '(br)]) #:insert [linebreak '(br)])
((txexpr-elements?) (#:separator string? #:insert xexpr?) . ->* . txexpr-elements?) ((txexpr-elements?) (#:separator string? #:insert xexpr?) . ->* . txexpr-elements?)
;; todo: should this test be not block + not whitespace? ;; todo: should this test be not block + not whitespace?
@ -334,7 +334,7 @@
;; is x a paragraph break? ;; is x a paragraph break?
(define+provide/contract (paragraph-break? x #:separator [sep world:paragraph-separator]) (define+provide/contract (paragraph-break? x #:separator [sep (world:get-paragraph-separator)])
((any/c) (#:separator pregexp?) . ->* . coerce/boolean?) ((any/c) (#:separator pregexp?) . ->* . coerce/boolean?)
(define paragraph-pattern (pregexp (format "^~a+$" sep))) (define paragraph-pattern (pregexp (format "^~a+$" sep)))
(and (string? x) (regexp-match paragraph-pattern x))) (and (string? x) (regexp-match paragraph-pattern x)))
@ -342,7 +342,7 @@
(define (newline? x) (define (newline? x)
(and (string? x) (equal? world:newline x))) (and (string? x) (equal? (world:get-newline) x)))
(define (not-newline? x) (define (not-newline? x)
(not (newline? x))) (not (newline? x)))
@ -379,7 +379,7 @@
;; detect paragraphs ;; detect paragraphs
;; todo: unit tests ;; todo: unit tests
(define+provide/contract (detect-paragraphs elements #:tag [tag 'p] (define+provide/contract (detect-paragraphs elements #:tag [tag 'p]
#:separator [sep world:paragraph-separator] #:separator [sep (world:get-paragraph-separator)]
#:linebreak-proc [linebreak-proc detect-linebreaks] #:linebreak-proc [linebreak-proc detect-linebreaks]
#:force? [force-paragraph #f]) #:force? [force-paragraph #f])
((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?) #:force? boolean?) ((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?) #:force? boolean?)

@ -50,7 +50,7 @@
(syntax-case stx () (syntax-case stx ()
[(_ stem) [(_ stem)
(let ([stem-datum (syntax->datum #'stem)]) (let ([stem-datum (syntax->datum #'stem)])
(with-syntax ([file-ext (format-id stx "world:~a-source-ext" #'stem)] (with-syntax ([world:get-stem-source-ext (format-id stx "world:get-~a-source-ext" #'stem)]
[stem-source? (format-id stx "~a-source?" #'stem)] [stem-source? (format-id stx "~a-source?" #'stem)]
[get-stem-source (format-id stx "get-~a-source" #'stem)] [get-stem-source (format-id stx "get-~a-source" #'stem)]
[has-stem-source? (format-id stx "has-~a-source?" #'stem)] [has-stem-source? (format-id stx "has-~a-source?" #'stem)]
@ -60,7 +60,7 @@
#`(begin #`(begin
;; does file have particular extension ;; does file have particular extension
(define+provide (stem-source? x) (define+provide (stem-source? x)
(->boolean (and (pathish? x) (has-ext? (->path x) file-ext)))) (->boolean (and (pathish? x) (has-ext? (->path x) (world:get-stem-source-ext)))))
(define+provide (get-stem-source x) (define+provide (get-stem-source x)
(and (pathish? x) (and (pathish? x)
@ -82,9 +82,9 @@
x x
#,(if (equal? stem-datum 'scribble) #,(if (equal? stem-datum 'scribble)
#'(if (x . has-ext? . 'html) ; different logic for scribble sources #'(if (x . has-ext? . 'html) ; different logic for scribble sources
(add-ext (remove-ext* x) file-ext) (add-ext (remove-ext* x) (world:get-stem-source-ext))
#f) #f)
#'(add-ext x file-ext)))) #'(add-ext x (world:get-stem-source-ext)))))
(and result (->path result))) (and result (->path result)))
;; coerce either a source or output file to both ;; coerce either a source or output file to both
@ -111,8 +111,8 @@
(make-source-utility-functions pagetree) (make-source-utility-functions pagetree)
(module-test-external (module-test-external
(require pollen/world) (require pollen/world)
(check-true (pagetree-source? (format "foo.~a" world:pagetree-source-ext))) (check-true (pagetree-source? (format "foo.~a" (world:get-pagetree-source-ext))))
(check-false (pagetree-source? (format "~a.foo" world:pagetree-source-ext))) (check-false (pagetree-source? (format "~a.foo" (world:get-pagetree-source-ext))))
(check-false (pagetree-source? #f))) (check-false (pagetree-source? #f)))
(make-source-utility-functions markup) (make-source-utility-functions markup)
@ -177,7 +177,7 @@
(or (ends-with? (path->string path) "compiled")))) (or (ends-with? (path->string path) "compiled"))))
(define+provide (cache-file? path) (define+provide (cache-file? path)
(or (ends-with? (path->string path) world:cache-filename))) (or (ends-with? (path->string path) (world:get-cache-filename))))
(define+provide (pollen-related-file? file) (define+provide (pollen-related-file? file)

@ -7,4 +7,4 @@
(define scribblings '(("scribblings/pollen.scrbl" (multi-page)))) (define scribblings '(("scribblings/pollen.scrbl" (multi-page))))
(define raco-commands '(("pollen" (submod pollen/raco main) "issue Pollen command" #f))) (define raco-commands '(("pollen" (submod pollen/raco main) "issue Pollen command" #f)))
(define compile-omit-paths '("tests" "raco.rkt")) (define compile-omit-paths '("tests" "raco.rkt"))
(define test-omit-paths '("test-support")) (define test-omit-paths '("tests/data"))

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax) pollen/world) (require (for-syntax racket/base racket/syntax pollen/world) pollen/world)
(provide (all-defined-out) (all-from-out pollen/world)) (provide (all-defined-out) (all-from-out pollen/world))
@ -13,6 +13,9 @@
(define-syntax (new-module-begin stx-arg) (define-syntax (new-module-begin stx-arg)
(syntax-case stx-arg () (syntax-case stx-arg ()
[(_ body-exprs (... ...)) [(_ body-exprs (... ...))
(with-syntax ([local-meta-tag-name (format-id stx-arg (symbol->string (world:get-meta-tag-name)))]
[local-doc-export-name (format-id stx-arg (symbol->string (world:get-main-export)))]
[local-metas-export-name (format-id stx-arg (symbol->string (world:get-meta-export)))])
(syntax-protect (syntax-protect
#'(#%module-begin #'(#%module-begin
(module inner pollen/doclang-raw (module inner pollen/doclang-raw
@ -44,7 +47,7 @@
(define doc-with-metas (define doc-with-metas
`(placeholder-root `(placeholder-root
,@(cons (meta 'here-path: here-path) ,@(cons `(local-meta-tag-name (here-path ,here-path))
(if (list? doc-raw) (if (list? doc-raw)
(dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file (dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file
doc-raw)))) doc-raw))))
@ -63,4 +66,6 @@
(cdr doc-without-metas))) ;; cdr strips placeholder-root tag (cdr doc-without-metas))) ;; cdr strips placeholder-root tag
;; hide the exports that were only for internal use. ;; hide the exports that were only for internal use.
(provide metas doc (except-out (all-from-out 'inner) doc-raw #%top))))]))))])) (provide (rename-out [metas local-metas-export-name])
(rename-out [doc local-doc-export-name])
(except-out (all-from-out 'inner) doc-raw #%top)))))]))))]))

@ -9,7 +9,7 @@
(define (possible-meta-element? x) (define (possible-meta-element? x)
(and (txexpr? x) (equal? world:meta-tag-name (get-tag x)))) (and (txexpr? x) (equal? (world:get-meta-tag-name) (get-tag x))))
(define (trivial-meta-element? x) (define (trivial-meta-element? x)
@ -47,10 +47,11 @@
(or (and (list? x) (symbol? (first x)) (string? (second x))) (or (and (list? x) (symbol? (first x)) (string? (second x)))
(error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x))) (error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x)))
;; all metas are converted into "atomic meta" format ;; all metas are converted into "atomic meta" format
;; which is '(meta (key value ...)) ;; which is '(meta (key value ...))
(define (make-atomic-meta key . values) (define (make-atomic-meta key . values)
`(meta (,key ,@values))) `(,(world:get-meta-tag-name) (,key ,@values)))
(define (explode-meta-element me) (define (explode-meta-element me)
@ -62,10 +63,10 @@
(cond (cond
[(has-meta-attrs me) ; might have txexpr elements, so preserve them [(has-meta-attrs me) ; might have txexpr elements, so preserve them
(define attrs (get-attrs me)) (define attrs (get-attrs me))
(loop (make-txexpr 'meta (cdr attrs) (get-elements me)) (cons (apply make-atomic-meta (car attrs)) acc))] (loop (make-txexpr (world:get-meta-tag-name) (cdr attrs) (get-elements me)) (cons (apply make-atomic-meta (car attrs)) acc))]
[else ; has txexpr elements, but not meta-attrs [else ; has txexpr elements, but not meta-attrs
(define txexpr-elements (get-elements me)) ; elements were filtered for txexpr at loop entry (define txexpr-elements (get-elements me)) ; elements were filtered for txexpr at loop entry
(loop (make-txexpr 'meta null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])] (loop (make-txexpr (world:get-meta-tag-name) null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])]
[else (reverse acc)]))) [else (reverse acc)])))

@ -38,7 +38,7 @@
(define+provide/contract (decode-pagetree xs) (define+provide/contract (decode-pagetree xs)
(txexpr-elements? . -> . any/c) ; because pagetree is being explicitly validated (txexpr-elements? . -> . any/c) ; because pagetree is being explicitly validated
(validate-pagetree (validate-pagetree
(decode (cons world:pagetree-root-node xs) (decode (cons (world:get-pagetree-root-node) xs)
#:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs)) #:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs))
#:string-proc string->symbol))) ; because faster than ->pagenode #:string-proc string->symbol))) ; because faster than ->pagenode
@ -85,8 +85,8 @@
(define+provide/contract (make-project-pagetree project-dir) (define+provide/contract (make-project-pagetree project-dir)
(pathish? . -> . pagetree?) (pathish? . -> . pagetree?)
(with-handlers ([exn:fail? (λ(exn) (directory->pagetree project-dir))]) (with-handlers ([exn:fail? (λ(exn) (directory->pagetree project-dir))])
(define pagetree-source (build-path project-dir world:default-pagetree)) (define pagetree-source (build-path project-dir (world:get-default-pagetree)))
(cached-require pagetree-source world:main-pollen-export))) (cached-require pagetree-source (world:get-main-export))))
(define+provide/contract (parent pnish [pt (current-pagetree)]) (define+provide/contract (parent pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?)) (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))

@ -35,6 +35,7 @@
[(#f "help") (handle-help)] [(#f "help") (handle-help)]
[("start") (handle-start (path->directory-path first-arg-or-current-dir) port-arg)] [("start") (handle-start (path->directory-path first-arg-or-current-dir) port-arg)]
[("render") (handle-render (cons first-arg-or-current-dir (map very-nice-path (cdr (vector->list (current-command-line-arguments))))))] [("render") (handle-render (cons first-arg-or-current-dir (map very-nice-path (cdr (vector->list (current-command-line-arguments))))))]
[("version") (handle-version)]
[("clone" "publish") (handle-publish first-arg-or-current-dir rest-args arg-command-name)] [("clone" "publish") (handle-publish first-arg-or-current-dir rest-args arg-command-name)]
[else (handle-else arg-command-name)])))) [else (handle-else arg-command-name)]))))

@ -14,9 +14,9 @@
(λ (path-string p) (λ (path-string p)
(define read-inner (make-at-reader (define read-inner (make-at-reader
#:command-char (if (or (equal? reader-mode world:mode-template) #:command-char (if (or (equal? reader-mode world:mode-template)
(and (string? path-string) (regexp-match (pregexp (format "\\.~a$" world:template-source-ext)) path-string))) (and (string? path-string) (regexp-match (pregexp (format "\\.~a$" (world:get-template-source-ext))) path-string)))
world:template-command-marker (world:get-template-command-char)
world:command-marker) (world:get-command-char))
#:syntax? #t #:syntax? #t
#:inside? #t)) #:inside? #t))
(define file-contents (read-inner path-string p)) (define file-contents (read-inner path-string p))
@ -33,9 +33,9 @@
(let* ([file-ext-pattern (pregexp "\\w+$")] (let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))]) [here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))])
(cond (cond
[(equal? here-ext world:pagetree-source-ext) world:mode-pagetree] [(equal? here-ext (world:get-pagetree-source-ext)) world:mode-pagetree]
[(equal? here-ext world:markup-source-ext) world:mode-markup] [(equal? here-ext (world:get-markup-source-ext)) world:mode-markup]
[(equal? here-ext world:markdown-source-ext) world:mode-markdown] [(equal? here-ext (world:get-markdown-source-ext)) world:mode-markdown]
[else world:mode-preproc])) [else world:mode-preproc]))
reader-mode)) reader-mode))
;; change names of exports for local use ;; change names of exports for local use
@ -52,9 +52,9 @@
(module+ main (module+ main
(require txexpr racket/string) (require txexpr racket/string)
(if (or (equal? inner:parser-mode world:mode-preproc) (equal? inner:parser-mode world:mode-template)) (if (or (equal? inner:parser-mode world:mode-preproc) (equal? inner:parser-mode world:mode-template))
(display doc) (display ,(world:get-main-export))
(print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| (string-join (cdr (string-split (exn-message exn) ": ")) ": "))))]) (print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| (string-join (cdr (string-split (exn-message exn) ": ")) ": "))))])
(validate-txexpr doc)))))) (validate-txexpr ,(world:get-main-export)))))))
file-contents))) file-contents)))

@ -34,7 +34,7 @@
(module-test-internal (module-test-internal
(require racket/runtime-path) (require racket/runtime-path)
(define-runtime-path sample-dir "test-support/samples") (define-runtime-path sample-dir "test/data/samples")
(define samples (parameterize ([current-directory sample-dir]) (define samples (parameterize ([current-directory sample-dir])
(map path->complete-path (directory-list ".")))) (map path->complete-path (directory-list "."))))
(define-values (sample-01 sample-02 sample-03) (apply values samples)) (define-values (sample-01 sample-02 sample-03) (apply values samples))
@ -89,7 +89,7 @@
((or/c pagetree? pathish?) . -> . void?) ((or/c pagetree? pathish?) . -> . void?)
(define pagetree (if (pagetree? pagetree-or-path) (define pagetree (if (pagetree? pagetree-or-path)
pagetree-or-path pagetree-or-path
(cached-require pagetree-or-path world:main-pollen-export))) (cached-require pagetree-or-path (world:get-main-export))))
(parameterize ([current-directory (world:current-project-root)]) (parameterize ([current-directory (world:current-project-root)])
(for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree))))) (for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree)))))
@ -177,7 +177,7 @@
(file-needed-rerequire? source-path) ; called for its reqrequire side effect only, so dynamic-require below isn't cached (file-needed-rerequire? source-path) ; called for its reqrequire side effect only, so dynamic-require below isn't cached
(time (parameterize ([current-directory (->complete-path source-dir)]) (time (parameterize ([current-directory (->complete-path source-dir)])
;; BTW this next action has side effects: scribble will copy in its core files if they don't exist. ;; BTW this next action has side effects: scribble will copy in its core files if they don't exist.
((dynamic-require 'scribble/render 'render) (list (dynamic-require source-path world:main-pollen-export)) (list source-path)))) ((dynamic-require 'scribble/render 'render) (list (dynamic-require source-path (world:get-main-export))) (list source-path))))
(define result (file->string (->output-path source-path))) (define result (file->string (->output-path source-path)))
(delete-file (->output-path source-path)) ; because render promises the data, not the side effect (delete-file (->output-path source-path)) ; because render promises the data, not the side effect
result) result)
@ -187,7 +187,7 @@
(complete-path? . -> . (or/c string? bytes?)) (complete-path? . -> . (or/c string? bytes?))
(match-define-values (source-dir _ _) (split-path source-path)) (match-define-values (source-dir _ _) (split-path source-path))
(time (parameterize ([current-directory (->complete-path source-dir)]) (time (parameterize ([current-directory (->complete-path source-dir)])
(render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',world:main-pollen-export)))))) (render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',(world:get-main-export)))))))
(define/contract (render-markup-or-markdown-source source-path [maybe-template-path #f]) (define/contract (render-markup-or-markdown-source source-path [maybe-template-path #f])
@ -200,14 +200,14 @@
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(require pollen/include-template pollen/cache pollen/debug) (require pollen/include-template pollen/cache pollen/debug)
,(require-directory-require-files source-path) ,(require-directory-require-files source-path)
(let ([doc (cached-require ,(path->string source-path) ',world:main-pollen-export)] (let ([,(world:get-main-export) (cached-require ,(path->string source-path) ',(world:get-main-export))]
[metas (cached-require ,(path->string source-path) ',world:meta-pollen-export)]) [,(world:get-meta-export) (cached-require ,(path->string source-path) ',(world:get-meta-export))])
(local-require pollen/pagetree pollen/template pollen/top) (local-require pollen/pagetree pollen/template pollen/top)
(define here (metas->here metas)) (define here (metas->here ,(world:get-meta-export)))
(cond (cond
[(bytes? doc) doc] ; if doc is binary, just pass it through [(bytes? ,(world:get-main-export)) ,(world:get-main-export)] ; if main export is binary, just pass it through
[else [else
(include-template #:command-char ,world:command-marker (file ,(->string (find-relative-path source-dir template-path))))])))) (include-template #:command-char ,(world:get-command-char) (file ,(->string (find-relative-path source-dir template-path))))]))))
(time (parameterize ([current-directory source-dir]) ; because include-template wants to work relative to source location (time (parameterize ([current-directory source-dir]) ; because include-template wants to work relative to source location
(render-through-eval expr-to-eval)))) (render-through-eval expr-to-eval))))
@ -227,12 +227,12 @@
(filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f (filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f
(list (list
(parameterize ([current-directory (world:current-project-root)]) (parameterize ([current-directory (world:current-project-root)])
(let ([source-metas (cached-require source-path 'metas)]) (let ([source-metas (cached-require source-path (world:get-meta-export))])
(and ((->symbol world:template-meta-key) . in? . source-metas) (and ((->symbol (world:get-template-meta-key)) . in? . source-metas)
(build-path source-dir (select-from-metas (->string world:template-meta-key) source-metas))))) ; path based on metas (build-path source-dir (select-from-metas (->string (world:get-template-meta-key)) source-metas))))) ; path based on metas
(and (filename-extension output-path) (build-path (world:current-project-root) (and (filename-extension output-path) (build-path (world:current-project-root)
(add-ext world:default-template-prefix (get-ext output-path))))))) ; path to default template (add-ext (world:get-default-template-prefix) (get-ext output-path))))))) ; path to default template
(and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext world:fallback-template-prefix (get-ext output-path)))))))) ; fallback template (and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext (world:get-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template
(define/contract (file-needed-rerequire? source-path) (define/contract (file-needed-rerequire? source-path)

@ -9,7 +9,7 @@
@defmodule[pollen/cache] @defmodule[pollen/cache]
The slowest part of a @racket[render] is parsing and decoding the source file. Often, previewing a single source file necessarily means decoding others (for instance templates, or other source files that are linked into the main source file). But usually, only one source file is changing at a time. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" world:main-pollen-export)] and @code[(format "~a" world:meta-pollen-export)] — in the cache so they can be reused. The slowest part of a @racket[render] is parsing and decoding the source file. Often, previewing a single source file necessarily means decoding others (for instance templates, or other source files that are linked into the main source file). But usually, only one source file is changing at a time. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" world:main-export)] and @code[(format "~a" world:meta-export)] — in the cache so they can be reused.
@defparam[current-cache hash hash?]{A parameter that refers to the current cache. It is initialized with @racket[make-cache]. @defparam[current-cache hash hash?]{A parameter that refers to the current cache. It is initialized with @racket[make-cache].

@ -56,3 +56,15 @@
#'(begin #'(begin
(define-runtime-path id name) (define-runtime-path id name)
(image id xs ...)))])) (image id xs ...)))]))
(require (for-syntax racket/syntax))
(define-syntax (defoverridable stx)
(syntax-case stx ()
[(_ name predicate? desc ...)
(with-syntax ([world:name (format-id stx "world:~a" #'name)]
[world:get-name (format-id stx "world:get-~a" #'name)]
[local:name (format-id stx "local:~a" #'name)])
#'(deftogether ((defthing world:name predicate?)
(defproc (world:get-name) predicate?))
desc ...))]))

@ -93,6 +93,7 @@ Make a copy of the project directory on the desktop, but without any source file
If you're already in your project directory and want to publish somewhere other than the desktop, use @racket[raco pollen publish _. _dest-dir]. If you're already in your project directory and want to publish somewhere other than the desktop, use @racket[raco pollen publish _. _dest-dir].
@section{@racket[raco pollen version]}
Would you believe this prints the Pollen version number.

@ -331,7 +331,7 @@ But within a template, we need to tell Pollen how we want to convert the X-expre
Third, we need to include the content from our source file. By convention, every Pollen source file makes its output available through an exported variable named @code{doc}. A source file in preprocessor mode puts its text result in @code{doc}. And a source file in authoring mode puts its X-expression result in @code{doc}. So we put the variable @code{doc} inside the @code{body} tag. Third, we need to include the content from our source file. By convention, every Pollen source file makes its output available through an exported variable named @code{doc}. A source file in preprocessor mode puts its text result in @code{doc}. And a source file in authoring mode puts its X-expression result in @code{doc}. So we put the variable @code{doc} inside the @code{body} tag.
@margin-note{You can change the name to something other than @code{doc} by changing @racket[world:main-pollen-export].} @margin-note{You can change the name to something other than @code{doc} by changing @racket[world:main-export].}
@codeblock[#:keep-lang-line? #f]{ @codeblock[#:keep-lang-line? #f]{
#lang pollen #lang pollen

@ -1,5 +1,5 @@
#lang scribble/manual #lang scribble/manual
@(require "mb-tools.rkt")
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/render)) @(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/render))
@(define my-eval (make-base-eval)) @(define my-eval (make-base-eval))
@ -9,43 +9,76 @@
@defmodule[pollen/world] @defmodule[pollen/world]
A set of global values and parameters that are used throughout the Pollen system. If you don't like the defaults I've picked, change them. Global values that are used throughout the Pollen system.
All identifiers are exported with the prefix @racket[world:], and are so documented below. @section{Parameters}
I mean @italic{parameters} in the Racket sense, i.e. values that can be fed to @racket[parameterize].
@defthing[world:default-port integer?]
@defparam[world:current-server-port port integer?]{ @defparam[world:current-server-port port integer?]{
A parameter that sets the HTTP port for the project server. Initialized to @racket[world:default-port], which defaults to 8080.} A parameter that sets the HTTP port for the project server. Initialized to @racket[world:default-port].}
@deftogether[( @defparam[world:current-project-root port path?]{
@defthing[world:main-pollen-export symbol?] A parameter that holds the root directory of the current project (e.g., the directory where you launched @code{raco pollen start}).}
@defthing[world:meta-pollen-export symbol?]
)] @defparam[world:current-server-extras-path dir path?]{
The two exports from a compiled Pollen source file. Initialized to @racket['doc] and @racket['metas], respectively. A parameter that reports the path to the directory of support files for the project server. Initialized to @racket[#f], but set to a proper value when the server runs.}
@(defthing world:directory-require string?)
File implicitly required into every Pollen source file from its directory. Initialized to @filepath{directory-require.rkt}.
@defparam[world:check-directory-requires-in-render? check? boolean?]{ @defparam[world:check-directory-requires-in-render? check? boolean?]{
A parameter that determines whether the @racket[world:directory-require] file is checked for changes on every pass through @racket[render]. (Can be faster to turn this off if you don't need it.) Initialized to @racket[#t].} A parameter that determines whether the @racket[world:directory-require] file is checked for changes on every pass through @racket[render]. (Can be faster to turn this off if you don't need it.) Initialized to @racket[#t].}
@defthing[world:server-extras-dir string?]
Name of directory where server support files live. Initialized to @tt{server-extras}.
@defparam[world:current-server-extras-path dir path?]{
A parameter that reports the path to the directory of support files for the project server. Initialized to @racket[#f], but set to a proper value when the server runs.}
@section{Values that can be overwritten with @racket[local:]}
These values can be changed by overriding them in your @racket["directory-require.rkt"] source file. Use @racket[define] to make a variable with the same name as the one in @racket[pollen/world], but with the prefix @racket[local:] instead of @racket[world:]. Assign it whatever value you like. When Pollen runs, these definitions will supersede those in @racket[pollen/world].
For instance, suppose you wanted the main export of every Pollen source file to be called @racket[van-halen] rather than @racket[doc], the extension of Pollen markup files to be @racket[rock] rather than @racket[pm], and the command character to be @litchar{🎸} instead of @litchar{◊}. Your @racket["directory-require.rkt"] would include these defintions:
@fileblock["directory-require.rkt"
@codeblock{
#lang racket/base
(provide (all-defined-out))
(define local:main-export 'van-halen)
(define local:markup-source-ext 'rock)
(define local:command-char #\🎸)
}]
Though any of the values below can be overridden, it may not always be wise to do so. For instance, if you redefined @racket[world:fallback-template-prefix], you would simply break the fallback-template mechanism, because it would look for files that don't exist. But we don't live in a nanny state, so you are entrusted to say what you mean and accept the consequences.
Of course, you can restore the defaults simply by deleting these defined values from @racket["directory-require.rkt"].
These overridable values also come with a corresponding @racket[get-] function that will return the @racket[local:] value if it exists, otherwise the @racket[world:] value. In the example above, @racket[world:command-char] would be @litchar{◊} no matter what, but @racket[world:get-command-char] would return @litchar{🎸}.
@defoverridable[default-port integer?]{
Determines the default HTTP port for the project server. Initialized to @racket[8080].}
@defoverridable[main-export symbol?]{The main X-expression exported from a compiled Pollen source file. Initialized to @racket[doc].}
@defoverridable[meta-export symbol?]{The meta hashtable exported from a compiled Pollen source file. Initialized to @racket[metas].}
@defoverridable[world:meta-tag-name symbol?]{Name of the tag used to mark metas within Pollen source.}
@defoverridable[world:directory-require string?]{File implicitly required into every Pollen source file from its directory. Initialized to @filepath{directory-require.rkt}.}
@defoverridable[world:server-extras-dir string?]{Name of directory where server support files live. Initialized to @tt{server-extras}.}
@deftogether[( @deftogether[(
@defthing[world:preproc-source-ext symbol?] @defoverridable[preproc-source-ext symbol?]
@defthing[world:markup-source-ext symbol?] @defoverridable[markup-source-ext symbol?]
@defthing[world:markdown-source-ext symbol?] @defoverridable[markdown-source-ext symbol?]
@defthing[world:null-source-ext symbol?] @defoverridable[null-source-ext symbol?]
@defthing[world:pagetree-source-ext symbol?] @defoverridable[pagetree-source-ext symbol?]
@defthing[world:template-source-ext symbol?] @defoverridable[template-source-ext symbol?]
@defthing[world:scribble-source-ext symbol?] @defoverridable[scribble-source-ext symbol?]
)] )]
File extensions for Pollen source files, initialized to the following values: File extensions for Pollen source files, initialized to the following values:
@ -58,53 +91,32 @@ File extensions for Pollen source files, initialized to the following values:
@(linebreak)@racket[world:scribble-source-ext] = @code[(format "'~a" world:scribble-source-ext)] @(linebreak)@racket[world:scribble-source-ext] = @code[(format "'~a" world:scribble-source-ext)]
@defthing[world:decodable-extensions (listof symbol?)] @defoverridable[decodable-extensions (listof symbol?)]{File extensions that are eligible for decoding.}
File extensions that are eligible for decoding.
@deftogether[( @defoverridable[default-pagetree string?]{Pagetree that Pollen dashboard loads by default in each directory. Initialized to @filepath{index.ptree}.}
@(defthing world:mode-auto symbol?)
@(defthing world:mode-preproc symbol?)
@(defthing world:mode-markup symbol?)
@(defthing world:mode-markdown symbol?)
@(defthing world:mode-pagetree symbol?)
)]
Mode indicators for the Pollen reader and parser. Initialized to the following values:
@racket[world:mode-auto] = @code[(format "'~a" world:mode-auto)] @defoverridable[pagetree-root-node symbol?]{Name of the root node in a decoded pagetree. It's ignored by the code, so its only role is to clue you in that you're looking at something that came out of the pagetree decoder. Initialized to @code{'pagetree-root}.}
@(linebreak)@racket[world:mode-preproc] = @code[(format "'~a" world:mode-preproc)]
@(linebreak)@racket[world:mode-markup] = @code[(format "'~a" world:mode-markup)]
@(linebreak)@racket[world:mode-markdown] = @code[(format "'~a" world:mode-markdown)]
@(linebreak)@racket[world:mode-pagetree] = @code[(format "'~a" world:mode-pagetree)]
@defthing[world:default-pagetree string?]
Pagetree that Pollen dashboard loads by default in each directory. Initialized to @filepath{index.ptree}.
@defthing[world:pagetree-root-node symbol?] @defoverridable[command-char char?]{The magic character that indicates a Pollen command, function, or variable. Initialized to @racket[#\◊].}
Name of the root node in a decoded pagetree. It's ignored by the code, so its only role is to clue you in that you're looking at something that came out of the pagetree decoder. Initialized to @code{'pagetree-root}.
@defoverridable[default-template-prefix string?]{Prefix of the default template. Initialized to @code{"template"}.}
@defthing[world:command-marker char?]
The magic character that indicates a Pollen command, function, or variable. Initialized to @racket[#\◊].
@defthing[world:default-template-prefix string?] @defoverridable[fallback-template-prefix string?]{Used to generate the name of the fallback template (i.e., the template used to render a Pollen markup file when no other template can be found). Prefix is combined with the output suffix of the source file. Initialized to @code{"fallback"}.}
Prefix of the default template. Initialized to @code{"template"}.
@defthing[world:fallback-template-prefix string?]
Used to generate the name of the fallback template (i.e., the template used to render a Pollen markup file when no other template can be found). Prefix is combined with the output suffix of the source file. Initialized to @code{"fallback"}.
@defthing[world:template-meta-key symbol?] @defoverridable[template-meta-key symbol?]{Meta key used to store a template name for that particular source file. Initialized to @racket['template].}
Meta key used to store a template name for that particular source file. Initialized to @racket['template].
@deftogether[( @deftogether[(
@(defthing world:newline string?) @(defoverridable world:newline string?)
@(defthing world:linebreak-separator string?) @(defoverridable world:linebreak-separator string?)
@(defthing world:paragraph-separator string?) @(defoverridable world:paragraph-separator string?)
)] )]
Default separators used in decoding. The first two are initialized to @racket["\n"]; the third to @racket["\n\n"]. Default separators used in decoding. The first two are initialized to @racket["\n"]; the third to @racket["\n\n"].
@(defthing world:dashboard-css string?) @defoverridable[dashboard-css string?]{CSS file used for the dashboard. Initialized to @filepath{poldash.css}.}
CSS file used for the dashboard. Initialized to @filepath{poldash.css}.
@(defthing world:paths-excluded-from-dashboard (listof path?)) @defoverridable[paths-excluded-from-dashboard (listof path?)]{Paths not shown in the Pollen dashboard.}
Paths not shown in the Pollen dashboard.

@ -25,7 +25,7 @@
(meta ([charset "UTF-8"])) (meta ([charset "UTF-8"]))
(link ([rel "stylesheet"] (link ([rel "stylesheet"]
[type "text/css"] [type "text/css"]
[href ,(format "/~a" world:dashboard-css)]))) [href ,(format "/~a" (world:get-dashboard-css))])))
(body (body
,content-xexpr (div ((id "pollen-logo")))))) ,content-xexpr (div ((id "pollen-logo"))))))
@ -41,7 +41,7 @@
(define client (request-client-ip req)) (define client (request-client-ip req))
(define localhost-client "::1") (define localhost-client "::1")
(define url-string (url->string (request-uri req))) (define url-string (url->string (request-uri req)))
(message "request:" (string-replace url-string world:default-pagetree " dashboard") (message "request:" (string-replace url-string (world:get-default-pagetree) " dashboard")
(if (not (equal? client localhost-client)) (format "from ~a" client) ""))) (if (not (equal? client localhost-client)) (format "from ~a" client) "")))
;; pass string args to route, then ;; pass string args to route, then
@ -61,7 +61,7 @@
((complete-path?) (#:render boolean?) . ->* . txexpr?) ((complete-path?) (#:render boolean?) . ->* . txexpr?)
(when wants-render (render-from-source-or-output-path path)) (when wants-render (render-from-source-or-output-path path))
(dynamic-rerequire path) ; stores module mod date; reloads if it's changed (dynamic-rerequire path) ; stores module mod date; reloads if it's changed
(dynamic-require path world:main-pollen-export)) (dynamic-require path (world:get-main-export)))
;; todo: rewrite this test, obsolete since filename convention changed ;; todo: rewrite this test, obsolete since filename convention changed
;;(module+ test ;;(module+ test
@ -160,7 +160,7 @@
(define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps))) (define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps)))
(for/list ([i (in-range (length (cdr dirs)))]) (for/list ([i (in-range (length (cdr dirs)))])
(take (cdr dirs) (add1 i)))))) (take (cdr dirs) (add1 i))))))
`(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink world:default-pagetree))) ,(->string dir))) dirs dirlinks) "/")))) `(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink (world:get-default-pagetree)))) ,(->string dir))) dirs dirlinks) "/"))))
(define (make-path-row filename-path) (define (make-path-row filename-path)
(define filename (->string filename-path)) (define filename (->string filename-path))
@ -170,7 +170,7 @@
(append (list (append (list
(cond ; main cell (cond ; main cell
[(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard [(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
(cons (format "~a/~a" filename world:default-pagetree) (format "~a/" filename))] (cons (format "~a/~a" filename (world:get-default-pagetree)) (format "~a/" filename))]
[(and source (equal? (get-ext source) "scrbl")) [(and source (equal? (get-ext source) "scrbl"))
(cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(->string (find-relative-path dashboard-dir source)) ")")))] (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(->string (find-relative-path dashboard-dir source)) ")")))]
[source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))] [source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))]
@ -186,12 +186,12 @@
[(pagetree-source? filename) empty-cell] [(pagetree-source? filename) empty-cell]
[else (cons (format "out/~a" filename) "out")])))))) [else (cons (format "out/~a" filename) "out")]))))))
(define (ineligible-path? x) (member x world:paths-excluded-from-dashboard)) (define (ineligible-path? x) (member x (world:get-paths-excluded-from-dashboard)))
(define project-paths (define project-paths
(filter-not ineligible-path? (map ->path (pagetree->list (filter-not ineligible-path? (map ->path (pagetree->list
(if (file-exists? dashboard-ptree) (if (file-exists? dashboard-ptree)
(cached-require (->path dashboard-ptree) world:main-pollen-export) (cached-require (->path dashboard-ptree) (world:get-main-export))
(directory->pagetree dashboard-dir)))))) (directory->pagetree dashboard-dir))))))
(body-wrapper #:title (format "~a" dashboard-dir) (body-wrapper #:title (format "~a" dashboard-dir)

@ -20,12 +20,12 @@
[((string-arg) ... "xexpr" (string-arg)) route-xexpr] [((string-arg) ... "xexpr" (string-arg)) route-xexpr]
[else route-default])) [else route-default]))
(message (format "Welcome to Pollen ~a" world:pollen-version) (format "(Racket ~a)" (version))) (message (format "Welcome to Pollen ~a" (world:get-pollen-version)) (format "(Racket ~a)" (version)))
(message (format "Project root is ~a" (world:current-project-root))) (message (format "Project root is ~a" (world:current-project-root)))
(define server-name (format "http://localhost:~a" (world:current-server-port))) (define server-name (format "http://localhost:~a" (world:current-server-port)))
(message (format "Project server is ~a" server-name) "(Ctrl-C to exit)") (message (format "Project server is ~a" server-name) "(Ctrl-C to exit)")
(message (format "Project dashboard is ~a/~a" server-name world:default-pagetree)) (message (format "Project dashboard is ~a/~a" server-name (world:get-default-pagetree)))
(message "Ready to rock") (message "Ready to rock")
(parameterize ([error-print-width 1000] (parameterize ([error-print-width 1000]

@ -24,8 +24,8 @@
(define doc-result (select-from-doc key value-source)) (define doc-result (select-from-doc key value-source))
(and doc-result (car doc-result))) (and doc-result (car doc-result)))
(cond (cond
[(or (hash? value-source) (equal? value-source world:meta-pollen-export)) (select-from-metas key value-source)] [(or (hash? value-source) (equal? value-source (world:get-meta-export))) (select-from-metas key value-source)]
[(equal? value-source world:main-pollen-export) (do-doc-result)] [(equal? value-source (world:get-main-export)) (do-doc-result)]
[else [else
(define metas-result (and (not (txexpr? value-source)) (select-from-metas key value-source))) (define metas-result (and (not (txexpr? value-source)) (select-from-metas key value-source)))
(or metas-result (do-doc-result))])) (or metas-result (do-doc-result))]))
@ -86,7 +86,7 @@
[(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)] [(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)]
[else pagenode-or-path]))) [else pagenode-or-path])))
(if source-path (if source-path
(cached-require source-path world:meta-pollen-export) (cached-require source-path (world:get-meta-export))
(error (format "get-metas: no source found for '~a' in directory ~a" pagenode-or-path (current-directory))))) (error (format "get-metas: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))
@ -96,7 +96,7 @@
[(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)] [(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)]
[else pagenode-or-path]))) [else pagenode-or-path])))
(if source-path (if source-path
(cached-require source-path world:main-pollen-export) (cached-require source-path (world:get-main-export))
(error (format "get-doc: no source found for '~a' in directory ~a" pagenode-or-path (current-directory))))) (error (format "get-doc: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))

@ -0,0 +1,18 @@
#lang racket/base
(provide (all-defined-out))
(define (root . xs)
`(rootover ,@xs))
(define local:pollen-version "42")
(define local:preproc-source-ext 'ppover)
(define local:markup-source-ext 'pmover)
(define local:markdown-source-ext 'pmdover)
(define local:null-source-ext 'p)
(define local:pagetree-source-ext 'ptreeover)
(define local:command-char #\∆)
(define local:main-export 'docover)
(define local:meta-export 'metasover)
(define local:meta-tag-name 'metaover)

@ -0,0 +1,2 @@
#lang pollen
∆(number->string (+ 1 1))

@ -0,0 +1,3 @@
#lang pollen
∆metaover{∆dog{Roxy}}
∆(number->string (+ 1 1))

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,6 @@
#lang pollen
(require (prefix-in foo: "samples/sample-01.html.pm"))
test
====
|foo:doc|

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -0,0 +1,4 @@
#lang pollen
test
====

@ -1,4 +1,4 @@
#lang racket/base #lang at-exp racket/base
(require rackunit racket/port racket/system racket/runtime-path compiler/find-exe) (require rackunit racket/port racket/system racket/runtime-path compiler/find-exe)
(module test-default pollen (module test-default pollen
@ -32,21 +32,23 @@
;; define-runtime-path only allowed at top level ;; define-runtime-path only allowed at top level
(define-runtime-path test.ptree "../test-support/test.ptree") (define-runtime-path test.ptree "data/test.ptree")
(define-runtime-path test.html.pm "../test-support/test.html.pm") (define-runtime-path test.html.pm "data/test.html.pm")
(define-runtime-path test.html.pmd "../test-support/test.html.pmd") (define-runtime-path test-import.html.pm "data/test-import.html.pm")
(define-runtime-path test.html.pp "../test-support/test.html.pp") (define-runtime-path test.html.pmd "data/test.html.pmd")
(define-runtime-path test.no-ext "../test-support/test.no-ext") (define-runtime-path test.html.pp "data/test.html.pp")
(define-runtime-path test.no-ext "data/test.no-ext")
;; `find-exe` avoids reliance on $PATH of the host system ;; `find-exe` avoids reliance on $PATH of the host system
(define racket-path (find-exe)) (define racket-path (find-exe))
(when racket-path (when racket-path
(define (run path) (define (run path)
(define cmd-string (format "~a ~a" racket-path path)) (define cmd-string (format "'~a' ~a" racket-path path))
(with-output-to-string (λ() (system cmd-string)))) (with-output-to-string (λ() (system cmd-string))))
(check-equal? (run test.ptree) "'(pagetree-root test ====)") (check-equal? (run test.ptree) "'(pagetree-root test ====)")
(check-equal? (run test.html.pm) "'(root \"test\" \"\\n\" \"====\")") (check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")})
(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.pmd) "'(root (h1 ((id \"test\")) \"test\"))")
(check-equal? (run test.html.pp) "test\n====") (check-equal? (run test.html.pp) "test\n====")
(check-equal? (run test.no-ext) "test\n====")) (check-equal? (run test.no-ext) "test\n===="))

@ -0,0 +1,45 @@
#lang at-exp racket/base
(require rackunit racket/port racket/system racket/runtime-path compiler/find-exe pollen/world)
;; define-runtime-path only allowed at top level
(define-runtime-path override-dir "data/override")
(define-runtime-path test.ptree "data/override/test.ptree")
(define-runtime-path test.html.pm "data/override/test.html.pm")
(define-runtime-path test.html.pmd "data/override/test.html.pmd")
(define-runtime-path test.html.pp "data/override/test.html.pp")
(define-runtime-path test.ptreeover "data/override/test.ptreeover")
(define-runtime-path test.html.pmover "data/override/test.html.pmover")
(define-runtime-path test.html.pmdover "data/override/test.html.pmdover")
(define-runtime-path test.html.ppover "data/override/test.html.ppover")
(define-runtime-path test-cmd.html.ppover "data/override/test-cmd.html.ppover")
(define-runtime-path test-exports.html.ppover "data/override/test-exports.html.ppover")
(define-runtime-path test-require.html.pmover "data/override/test-require.html.pmover")
;; `find-exe` avoids reliance on $PATH of the host system
(define racket-path (find-exe))
;; parameterize needed to pick up override file
(parameterize ([current-directory override-dir]
[world:current-project-root override-dir])
(when racket-path
(define (run path)
(define cmd-string (format "'~a' ~a" racket-path path))
(with-output-to-string (λ() (system cmd-string))))
;; raco is in same dir as racket
(define path-to-raco (path->string (simplify-path (build-path (find-exe) 'up "raco"))))
;; files with ordinary extensions will not be recognized in override dir, and thus behave like preproc
(check-equal? (run test.ptree) "test\n====")
(check-equal? (run test.html.pm) "test\n====")
(check-equal? (run test.html.pmd) "test\n====")
(check-equal? (run test.html.pp) "test\n====")
(check-equal? (run test.ptreeover) "'(pagetree-root test ====)")
(check-equal? (run test.html.pmover) "'(rootover \"test\" \"\\n\" \"====\")")
(check-equal? (run test.html.pmdover) "'(rootover (h1 ((id \"test\")) \"test\"))")
(check-equal? (run test.html.ppover) "test\n====")
(check-equal? (run test-cmd.html.ppover) "2")
(check-equal? (dynamic-require test-exports.html.ppover 'docover) "\n2")
(check-equal? (hash-ref (dynamic-require test-exports.html.ppover 'metasover) 'dog) "Roxy")
(check-equal? (dynamic-require test-require.html.pmover 'docover) '(rootover "foobar"))
(check-equal? (with-output-to-string (λ _ (system (format "'~a' pollen version" path-to-raco)))) "42\n")))

@ -1,18 +1,41 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax))
(require racket/runtime-path) (require racket/runtime-path)
(provide (prefix-out world: (all-defined-out))) (provide (prefix-out world: (all-defined-out)))
(define pollen-version "0.001") (define current-project-root (make-parameter (current-directory)))
(define preproc-source-ext 'pp)
(define markup-source-ext 'pm)
(define markdown-source-ext 'pmd)
(define null-source-ext 'p)
(define pagetree-source-ext 'ptree)
(define template-source-ext 'pt)
(define scribble-source-ext 'scrbl)
(define directory-require "directory-require.rkt")
(define (get-path-to-override)
(build-path (current-project-root) directory-require))
;; parameters should not be made settable.
(define-syntax (define-settable stx)
(syntax-case stx ()
[(_ name default-value)
(with-syntax ([base-name (format-id stx "~a" #'name)]
[local:name (format-id stx "local:~a" #'name)]
[get-name (format-id stx "get-~a" #'name)]
[fail-thunk-name (format-id stx "fail-thunk-~a" #'name)] )
#'(begin
(define base-name default-value)
(define fail-thunk-name (λ _ base-name))
(define get-name (λ _ (with-handlers ([exn:fail? fail-thunk-name])
(dynamic-require (get-path-to-override) 'local:name fail-thunk-name))))))]))
(define-settable pollen-version "0.001")
(define-settable preproc-source-ext 'pp)
(define-settable markup-source-ext 'pm)
(define-settable markdown-source-ext 'pmd)
(define-settable null-source-ext 'p)
(define-settable pagetree-source-ext 'ptree)
(define-settable template-source-ext 'pt)
(define-settable scribble-source-ext 'scrbl)
;; these are deliberately not settable because they're just internal signalers, no effect on external interface
(define mode-auto 'auto) (define mode-auto 'auto)
(define mode-preproc 'pre) (define mode-preproc 'pre)
(define mode-markup 'markup) (define mode-markup 'markup)
@ -20,44 +43,40 @@
(define mode-pagetree 'ptree) (define mode-pagetree 'ptree)
(define mode-template 'template) (define mode-template 'template)
(define cache-filename "pollen.cache") (define-settable cache-filename "pollen.cache")
(define decodable-extensions (list markup-source-ext pagetree-source-ext)) (define-settable decodable-extensions (list (get-markup-source-ext) (get-pagetree-source-ext)))
(define default-pagetree "index.ptree") (define-settable default-pagetree (format "index.~a" (get-pagetree-source-ext)))
(define pagetree-root-node 'pagetree-root) (define-settable pagetree-root-node 'pagetree-root)
(define command-marker #\◊) (define-settable command-char #\◊)
(define template-command-marker #\∂) (define-settable template-command-char #\∂)
(define default-template-prefix "template") (define-settable default-template-prefix "template")
(define fallback-template-prefix "fallback") (define-settable fallback-template-prefix "fallback")
(define template-meta-key "template") (define-settable template-meta-key "template")
(define main-pollen-export 'doc) ; don't forget to change fallback template too (define-settable main-export 'doc) ; don't forget to change fallback template too
(define meta-pollen-export 'metas) (define-settable meta-export 'metas)
(define meta-tag-name 'meta) (define-settable meta-tag-name 'meta)
(define directory-require "directory-require.rkt") (define-settable newline "\n")
(define-settable linebreak-separator (get-newline))
(define newline "\n") (define-settable paragraph-separator "\n\n")
(define linebreak-separator newline)
(define paragraph-separator "\n\n")
(define paths-excluded-from-dashboard (define-settable paths-excluded-from-dashboard (map string->path (list "poldash.css" "compiled")))
(map string->path (list "poldash.css" "compiled")))
(define current-project-root (make-parameter (current-directory))) (define-settable default-port 8080)
(define default-port 8080) (define current-server-port (make-parameter (get-default-port)))
(define current-server-port (make-parameter default-port))
(define dashboard-css "poldash.css") (define-settable dashboard-css "poldash.css")
(define-runtime-path server-extras-dir "server-extras") (define-runtime-path server-extras-dir "server-extras")
(define current-server-extras-path (make-parameter server-extras-dir)) (define current-server-extras-path (make-parameter server-extras-dir))
(define check-directory-requires-in-render? (make-parameter #t)) (define check-directory-requires-in-render? (make-parameter #t))
(define publish-directory-name "publish") (define-settable publish-directory-name "publish")
Loading…
Cancel
Save