mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

rename world:get-* to world:current-*

Browse Source
pull/84/head
Matthew Butterick 9 years ago
parent 8f9190c237
commit 9410e1471f
17 changed files with 73 additions and 73 deletions
Show Stats Download Patch File Download Diff File

6
cache.rkt
Unescape Escape View File

@ -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:get-cache-filename))) (build-path (world:current-project-root) (world:current-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,8 +37,8 @@
(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:get-main-export) (dynamic-require path (world:get-main-export))) (hash-set! cache-hash (world:current-main-export) (dynamic-require path (world:current-main-export)))
(hash-set! cache-hash (world:get-meta-export) (dynamic-require path (world:get-meta-export))) (hash-set! cache-hash (world:current-meta-export) (dynamic-require path (world:current-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))

6
command.rkt
Unescape Escape View File

@ -19,11 +19,11 @@ 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) (warning: overwrites existing dest dir)
version print the version (~a)" ,(world:current-server-port) ,(world:get-pollen-version)))) version print the version (~a)" ,(world:current-server-port) ,(world:current-pollen-version))))
(define (handle-version) (define (handle-version)
`(displayln ,(world:get-pollen-version))) `(displayln ,(world:current-pollen-version)))
(define (handle-render path-args) (define (handle-render path-args)
@ -69,7 +69,7 @@ version print the version (~a)" ,(world:current-server-port) ,(wo
(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:get-publish-directory-name)))))) (build-path (find-system-path 'desk-dir) (string->path (if (equal? arg-command-name "clone") "clone" (world:current-publish-directory-name))))))
`(begin `(begin
(require racket/file pollen/file racket/list) (require racket/file pollen/file racket/list)

2
convert.rkt
Unescape Escape View File

@ -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:get-command-char) ,(get-tag x) (map ->string `(,(world:current-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))]

8
decode.rkt
Unescape Escape View File

@ -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:get-linebreak-separator)] #:separator [newline (world:current-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:get-paragraph-separator)]) (define+provide/contract (paragraph-break? x #:separator [sep (world:current-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:get-newline) x))) (and (string? x) (equal? (world:current-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:get-paragraph-separator)] #:separator [sep (world:current-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?)

14
file.rkt
Unescape Escape View File

@ -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 ([world:get-stem-source-ext (format-id stx "world:get-~a-source-ext" #'stem)] (with-syntax ([world:current-stem-source-ext (format-id stx "world:current-~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) (world:get-stem-source-ext))))) (->boolean (and (pathish? x) (has-ext? (->path x) (world:current-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) (world:get-stem-source-ext)) (add-ext (remove-ext* x) (world:current-stem-source-ext))
#f) #f)
#'(add-ext x (world:get-stem-source-ext))))) #'(add-ext x (world:current-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:get-pagetree-source-ext)))) (check-true (pagetree-source? (format "foo.~a" (world:current-pagetree-source-ext))))
(check-false (pagetree-source? (format "~a.foo" (world:get-pagetree-source-ext)))) (check-false (pagetree-source? (format "~a.foo" (world:current-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:get-cache-filename)))) (or (ends-with? (path->string path) (world:current-cache-filename))))
(define+provide (pollen-related-file? file) (define+provide (pollen-related-file? file)

6
main-base.rkt
Unescape Escape View File

@ -13,9 +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)))] (with-syntax ([local-meta-tag-name (format-id stx-arg (symbol->string (world:current-meta-tag-name)))]
[local-doc-export-name (format-id stx-arg (symbol->string (world:get-main-export)))] [local-doc-export-name (format-id stx-arg (symbol->string (world:current-main-export)))]
[local-metas-export-name (format-id stx-arg (symbol->string (world:get-meta-export)))]) [local-metas-export-name (format-id stx-arg (symbol->string (world:current-meta-export)))])
(syntax-protect (syntax-protect
#'(#%module-begin #'(#%module-begin
(module inner pollen/doclang-raw (module inner pollen/doclang-raw

8
metas.rkt
Unescape Escape View File

@ -9,7 +9,7 @@
(define (possible-meta-element? x) (define (possible-meta-element? x)
(and (txexpr? x) (equal? (world:get-meta-tag-name) (get-tag x)))) (and (txexpr? x) (equal? (world:current-meta-tag-name) (get-tag x))))
(define (trivial-meta-element? x) (define (trivial-meta-element? x)
@ -51,7 +51,7 @@
;; 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)
`(,(world:get-meta-tag-name) (,key ,@values))) `(,(world:current-meta-tag-name) (,key ,@values)))
(define (explode-meta-element me) (define (explode-meta-element me)
@ -63,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 (world:get-meta-tag-name) (cdr attrs) (get-elements me)) (cons (apply make-atomic-meta (car attrs)) acc))] (loop (make-txexpr (world:current-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 (world:get-meta-tag-name) null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])] (loop (make-txexpr (world:current-meta-tag-name) null (cdr txexpr-elements)) (cons (apply make-atomic-meta (car txexpr-elements)) acc))])]
[else (reverse acc)]))) [else (reverse acc)])))

6
pagetree.rkt
Unescape Escape View File

@ -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:get-pagetree-root-node) xs) (decode (cons (world:current-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:get-default-pagetree))) (define pagetree-source (build-path project-dir (world:current-default-pagetree)))
(cached-require pagetree-source (world:get-main-export)))) (cached-require pagetree-source (world:current-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?))

16
reader-base.rkt
Unescape Escape View File

@ -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:get-template-source-ext))) path-string))) (and (string? path-string) (regexp-match (pregexp (format "\\.~a$" (world:current-template-source-ext))) path-string)))
(world:get-template-command-char) (world:current-template-command-char)
(world:get-command-char)) (world:current-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:get-pagetree-source-ext)) world:mode-pagetree] [(equal? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree]
[(equal? here-ext (world:get-markup-source-ext)) world:mode-markup] [(equal? here-ext (world:current-markup-source-ext)) world:mode-markup]
[(equal? here-ext (world:get-markdown-source-ext)) world:mode-markdown] [(equal? here-ext (world:current-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 ,(world:get-main-export)) (display ,(world:current-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 ,(world:get-main-export))))))) (validate-txexpr ,(world:current-main-export)))))))
file-contents))) file-contents)))

26
render.rkt
Unescape Escape View File

@ -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:get-main-export)))) (cached-require pagetree-or-path (world:current-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:get-main-export))) (list source-path)))) ((dynamic-require 'scribble/render 'render) (list (dynamic-require source-path (world:current-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:get-main-export))))))) (render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',(world:current-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 ([,(world:get-main-export) (cached-require ,(path->string source-path) ',(world:get-main-export))] (let ([,(world:current-main-export) (cached-require ,(path->string source-path) ',(world:current-main-export))]
[,(world:get-meta-export) (cached-require ,(path->string source-path) ',(world:get-meta-export))]) [,(world:current-meta-export) (cached-require ,(path->string source-path) ',(world:current-meta-export))])
(local-require pollen/pagetree pollen/template pollen/top) (local-require pollen/pagetree pollen/template pollen/top)
(define here (metas->here ,(world:get-meta-export))) (define here (metas->here ,(world:current-meta-export)))
(cond (cond
[(bytes? ,(world:get-main-export)) ,(world:get-main-export)] ; if main export is binary, just pass it through [(bytes? ,(world:current-main-export)) ,(world:current-main-export)] ; if main export is binary, just pass it through
[else [else
(include-template #:command-char ,(world:get-command-char) (file ,(->string (find-relative-path source-dir template-path))))])))) (include-template #:command-char ,(world:current-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 (world:get-meta-export))]) (let ([source-metas (cached-require source-path (world:current-meta-export))])
(and ((->symbol (world:get-template-meta-key)) . in? . source-metas) (and ((->symbol (world:current-template-meta-key)) . in? . source-metas)
(build-path source-dir (select-from-metas (->string (world:get-template-meta-key)) source-metas))))) ; path based on metas (build-path source-dir (select-from-metas (->string (world:current-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:get-default-template-prefix) (get-ext output-path))))))) ; path to default template (add-ext (world:current-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:get-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template (and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext (world:current-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template
(define/contract (file-needed-rerequire? source-path) (define/contract (file-needed-rerequire? source-path)

4
scribblings/decode.scrbl
Unescape Escape View File

@ -320,7 +320,7 @@ In @racket[_str], convert three hyphens to an em dash, and two hyphens to an en
@defproc[ @defproc[
(detect-linebreaks (detect-linebreaks
[tagged-xexpr-elements txexpr-elements?] [tagged-xexpr-elements txexpr-elements?]
[#:separator linebreak-sep string? world:linebreak-separator] [#:separator linebreak-sep string? (world:current-linebreak-separator)]
[#:insert linebreak xexpr? '(br)]) [#:insert linebreak xexpr? '(br)])
txexpr-elements?] txexpr-elements?]
Within @racket[_tagged-xexpr-elements], convert occurrences of @racket[_linebreak-sep] (@racket["\n"] by default) to @racket[_linebreak], but only if @racket[_linebreak-sep] does not occur between blocks (see @racket[block-txexpr?]). Why? Because block-level elements automatically display on a new line, so adding @racket[_linebreak] would be superfluous. In that case, @racket[_linebreak-sep] just disappears. Within @racket[_tagged-xexpr-elements], convert occurrences of @racket[_linebreak-sep] (@racket["\n"] by default) to @racket[_linebreak], but only if @racket[_linebreak-sep] does not occur between blocks (see @racket[block-txexpr?]). Why? Because block-level elements automatically display on a new line, so adding @racket[_linebreak] would be superfluous. In that case, @racket[_linebreak-sep] just disappears.
@ -333,7 +333,7 @@ Within @racket[_tagged-xexpr-elements], convert occurrences of @racket[_linebrea
@defproc[ @defproc[
(detect-paragraphs (detect-paragraphs
[elements txexpr-elements?] [elements txexpr-elements?]
[#:separator paragraph-sep string? world:paragraph-separator] [#:separator paragraph-sep string? (world:current-paragraph-separator)]
[#:tag paragraph-tag symbol? 'p] [#:tag paragraph-tag symbol? 'p]
[#:linebreak-proc linebreak-proc (txexpr-elements? . -> . txexpr-elements?) detect-linebreaks] [#:linebreak-proc linebreak-proc (txexpr-elements? . -> . txexpr-elements?) detect-linebreaks]
[#:force? force-paragraph? boolean? #f]) [#:force? force-paragraph? boolean? #f])

4
scribblings/mb-tools.rkt
Unescape Escape View File

@ -63,8 +63,8 @@
(syntax-case stx () (syntax-case stx ()
[(_ name predicate? desc ...) [(_ name predicate? desc ...)
(with-syntax ([world:name (format-id stx "world:~a" #'name)] (with-syntax ([world:name (format-id stx "world:~a" #'name)]
[world:get-name (format-id stx "world:get-~a" #'name)] [world:current-name (format-id stx "world:current-~a" #'name)]
[local:name (format-id stx "local:~a" #'name)]) [local:name (format-id stx "local:~a" #'name)])
#'(deftogether ((defthing world:name predicate?) #'(deftogether ((defthing world:name predicate?)
(defproc (world:get-name) predicate?)) (defproc (world:current-name) predicate?))
desc ...))])) desc ...))]))

2
scribblings/world.scrbl
Unescape Escape View File

@ -55,7 +55,7 @@ Though any of the values below can be overridden, it may not always be wise to d
Of course, you can restore the defaults simply by deleting these defined values from @racket["directory-require.rkt"]. Of course, you can restore the defaults simply by deleting these defined values from @racket["directory-require.rkt"].
These settable values also come with a corresponding @racket[get-] function that will return the @racket[config] 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{🎸}. These settable values are each equipped with a corresponding @racket[world:current-]@racket[_settable-value] function that will return the value loaded from the @racket[config] submodule (if @racket[_settable-value] was defined there), otherwise the default given by @racket[world:]@racket[_settable-value]. For instance, @racket[world:command-char] will always be @litchar{◊}, but in the example above, @racket[world:current-command-char] would return @litchar{🎸}.
@defoverridable[default-port integer?]{ @defoverridable[default-port integer?]{

14
server-routes.rkt
Unescape Escape View File

@ -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:get-dashboard-css))]))) [href ,(format "/~a" (world:current-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:get-default-pagetree) " dashboard") (message "request:" (string-replace url-string (world:current-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:get-main-export))) (dynamic-require path (world:current-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:get-default-pagetree)))) ,(->string dir))) dirs dirlinks) "/")))) `(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink (world:current-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:get-default-pagetree)) (format "~a/" filename))] (cons (format "~a/~a" filename (world:current-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:get-paths-excluded-from-dashboard))) (define (ineligible-path? x) (member x (world:current-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:get-main-export)) (cached-require (->path dashboard-ptree) (world:current-main-export))
(directory->pagetree dashboard-dir)))))) (directory->pagetree dashboard-dir))))))
(body-wrapper #:title (format "~a" dashboard-dir) (body-wrapper #:title (format "~a" dashboard-dir)

4
server.rkt
Unescape Escape View File

@ -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:get-pollen-version)) (format "(Racket ~a)" (version))) (message (format "Welcome to Pollen ~a" (world:current-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:get-default-pagetree))) (message (format "Project dashboard is ~a/~a" server-name (world:current-default-pagetree)))
(message "Ready to rock") (message "Ready to rock")
(parameterize ([error-print-width 1000] (parameterize ([error-print-width 1000]

8
template.rkt
Unescape Escape View File

@ -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:get-meta-export))) (select-from-metas key value-source)] [(or (hash? value-source) (equal? value-source (world:current-meta-export))) (select-from-metas key value-source)]
[(equal? value-source (world:get-main-export)) (do-doc-result)] [(equal? value-source (world:current-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:get-meta-export)) (cached-require source-path (world:current-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:get-main-export)) (cached-require source-path (world:current-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)))))

12
world.rkt
Unescape Escape View File

@ -16,13 +16,13 @@
(syntax-case stx () (syntax-case stx ()
[(_ name default-value) [(_ name default-value)
(with-syntax ([base-name (format-id stx "~a" #'name)] (with-syntax ([base-name (format-id stx "~a" #'name)]
[get-name (format-id stx "get-~a" #'name)] [current-name (format-id stx "current-~a" #'name)]
[config-submodule (format-id stx "~a" config-submodule-name)] [config-submodule (format-id stx "~a" config-submodule-name)]
[fail-thunk-name (format-id stx "fail-thunk-~a" #'name)] ) [fail-thunk-name (format-id stx "fail-thunk-~a" #'name)] )
#'(begin #'(begin
(define base-name default-value) (define base-name default-value)
(define fail-thunk-name (λ _ base-name)) (define fail-thunk-name (λ _ base-name))
(define get-name (λ _ (with-handlers ([exn:fail? fail-thunk-name]) (define current-name (λ _ (with-handlers ([exn:fail? fail-thunk-name])
(dynamic-require `(submod ,(get-path-to-override) config-submodule) 'base-name fail-thunk-name))))))])) (dynamic-require `(submod ,(get-path-to-override) config-submodule) 'base-name fail-thunk-name))))))]))
(define-settable pollen-version "0.001") (define-settable pollen-version "0.001")
@ -45,9 +45,9 @@
(define-settable cache-filename "pollen.cache") (define-settable cache-filename "pollen.cache")
(define-settable decodable-extensions (list (get-markup-source-ext) (get-pagetree-source-ext))) (define-settable decodable-extensions (list (current-markup-source-ext) (current-pagetree-source-ext)))
(define-settable default-pagetree (format "index.~a" (get-pagetree-source-ext))) (define-settable default-pagetree (format "index.~a" (current-pagetree-source-ext)))
(define-settable pagetree-root-node 'pagetree-root) (define-settable pagetree-root-node 'pagetree-root)
(define-settable command-char #\◊) (define-settable command-char #\◊)
@ -62,7 +62,7 @@
(define-settable meta-tag-name 'meta) (define-settable meta-tag-name 'meta)
(define-settable newline "\n") (define-settable newline "\n")
(define-settable linebreak-separator (get-newline)) (define-settable linebreak-separator (current-newline))
(define-settable paragraph-separator "\n\n") (define-settable paragraph-separator "\n\n")
(define-settable paths-excluded-from-dashboard (map string->path (list "poldash.css" "compiled"))) (define-settable paths-excluded-from-dashboard (map string->path (list "poldash.css" "compiled")))
@ -70,7 +70,7 @@
(define-settable default-port 8080) (define-settable default-port 8080)
(define current-server-port (make-parameter (get-default-port))) (define current-server-port (make-parameter (current-default-port)))
(define-settable dashboard-css "poldash.css") (define-settable dashboard-css "poldash.css")

Write Preview
Loading…
Cancel
Save