change ptree to pagemap & pnode to node

pull/9/head
Matthew Butterick 11 years ago
parent b19d763621
commit 10b6bd446d

@ -29,9 +29,9 @@ clone copies rendered files to desktop
#|
[("render") `(begin
;; todo: take extensions off the comand line
(displayln "Render preproc & ptree files ...")
(displayln "Render preproc & pagemap files ...")
(require "render.rkt" "file-tools.rkt" "world.rkt")
(apply render-batch (append-map project-files-with-ext (list world:preproc-source-ext world:ptree-source-ext))))]
(apply render-batch (append-map project-files-with-ext (list world:preproc-source-ext world:pagemap-source-ext))))]
[("clone") (let ([target-path
(if (> (len args) 1)
(->path (get args 1))
@ -46,7 +46,7 @@ clone copies rendered files to desktop
markup-source?
preproc-source?
template-source?
ptree-source?
pagemap-source?
pollen-script?
magic-directory?
racket-file?)))

@ -21,7 +21,7 @@
;; helper function for ptree
;; helper function for pagemap
;; make paths absolute to test whether files exist,
;; then convert back to relative
(define+provide/contract (visible? path)
@ -78,7 +78,7 @@
(make-source-utility-functions preproc)
(make-source-utility-functions null)
(make-source-utility-functions ptree)
(make-source-utility-functions pagemap)
(make-source-utility-functions markup)
(make-source-utility-functions template)
(make-source-utility-functions scribble)

@ -41,7 +41,7 @@
(let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern inner-here-path)))])
(cond
[(equal? here-ext world:ptree-source-ext) world:reader-mode-ptree]
[(equal? here-ext world:pagemap-source-ext) world:reader-mode-pagemap]
[(equal? here-ext world:markup-source-ext) world:reader-mode-markup]
[(equal? here-ext world:markdown-source-ext) world:reader-mode-markdown]
[else world:reader-mode-preproc]))
@ -75,7 +75,7 @@
;; set up the 'doc export
(require pollen/decode)
(define doc (apply (cond
[(equal? parser-mode world:reader-mode-ptree) (λ xs ((dynamic-require 'pollen/ptree 'decode-ptree) xs))]
[(equal? parser-mode world:reader-mode-pagemap) (λ xs ((dynamic-require 'pollen/pagemap 'decode-pagemap) xs))]
;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[(or (equal? parser-mode world:reader-mode-markup)

@ -0,0 +1,112 @@
#lang racket/base
(require "tools.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt")
(define+provide current-pagemap (make-parameter #f))
(define+provide (node? x)
(->boolean (and (symbol? x) (try (not (whitespace/nbsp? (->string x)))
(except [exn:fail? (λ(e) #f)])))))
(define+provide (nodeish? x)
(try (node? (->symbol x))
(except [exn:fail? (λ(e) #f)])))
(define/contract+provide (->node x)
(nodeish? . -> . node?)
(->symbol x))
(define+provide/contract (decode-pagemap xs)
(txexpr-elements? . -> . any/c) ; because pagemap is being explicitly validated
(validate-pagemap
(decode (cons world:pagemap-root-node xs)
#:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs))
#:string-proc string->symbol))) ; because faster than ->node
(define+provide (validate-pagemap x)
(let ([nodes (pagemap->list x)])
(and
(andmap (λ(p) (or (node? p) (error (format "validate-pagemap: \"~a\" is not a valid node" p)))) nodes)
(try (members-unique?/error nodes)
(except [exn:fail? (λ(e) (error (format "validate-pagemap: ~a" (exn-message e))))]))
x)))
(define+provide (pagemap? x)
(try (->boolean (validate-pagemap x))
(except [exn:fail? (λ(e) #f)])))
;; Try loading from pagemap file, or failing that, synthesize pagemap.
(define+provide/contract (make-project-pagemap project-dir)
(pathish? . -> . pagemap?)
(define pagemap-source (build-path project-dir world:default-pagemap))
(cached-require pagemap-source world:main-pollen-export))
(define+provide/contract (parent p [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f node?))
(and pagemap p
(let ([node (->node p)])
(if (member node (map (λ(x) (if (list? x) (car x) x)) (cdr pagemap)))
(car pagemap)
(ormap (λ(x) (parent node x)) (filter list? pagemap))))))
(define+provide/contract (children p [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(and pagemap p
(let ([node (->node p)])
(if (equal? node (car pagemap))
(map (λ(x) (if (list? x) (car x) x)) (cdr pagemap))
(ormap (λ(x) (children node x)) (filter list? pagemap))))))
(define+provide/contract (siblings p [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(children (parent p pagemap) pagemap))
;; flatten tree to sequence
(define+provide/contract (pagemap->list pagemap)
(pagemap? . -> . (listof node?))
; use cdr to get rid of root tag at front
(cdr (flatten pagemap)))
(define (adjacents side p [pagemap (current-pagemap)])
; ((symbol? (or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(and pagemap p
(let* ([node (->node p)]
[proc (if (equal? side 'left) takef takef-right)]
[result (proc (pagemap->list pagemap) (λ(x) (not (equal? node x))))])
(and (not (empty? result)) result))))
(define+provide/contract (previous* node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(adjacents 'left node pagemap))
(define+provide/contract (next* node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(adjacents 'right node pagemap))
(define+provide/contract (previous node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f node?))
(let ([result (previous* node pagemap)])
(and result (last result))))
(define+provide/contract (next node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f node?))
(let ([result (next* node pagemap)])
(and result (first result))))

@ -1,4 +1,4 @@
#lang racket/base
(require pollen/lang/reader-base)
(make-reader-with-mode world:reader-mode-ptree)
(make-reader-with-mode world:reader-mode-pagemap)

@ -1,112 +0,0 @@
#lang racket/base
(require "tools.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt")
(define+provide current-ptree (make-parameter #f))
(define+provide (pnode? x)
(->boolean (and (symbol? x) (try (not (whitespace/nbsp? (->string x)))
(except [exn:fail? (λ(e) #f)])))))
(define+provide (pnodeish? x)
(try (pnode? (->symbol x))
(except [exn:fail? (λ(e) #f)])))
(define/contract+provide (->pnode x)
(pnodeish? . -> . pnode?)
(->symbol x))
(define+provide/contract (decode-ptree xs)
(txexpr-elements? . -> . any/c) ; because ptree is being explicitly validated
(validate-ptree
(decode (cons world:ptree-root-node xs)
#:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs))
#:string-proc string->symbol))) ; because faster than ->pnode
(define+provide (validate-ptree x)
(let ([pnodes (ptree->list x)])
(and
(andmap (λ(p) (or (pnode? p) (error (format "validate-ptree: \"~a\" is not a valid pnode" p)))) pnodes)
(try (members-unique?/error pnodes)
(except [exn:fail? (λ(e) (error (format "validate-ptree: ~a" (exn-message e))))]))
x)))
(define+provide (ptree? x)
(try (->boolean (validate-ptree x))
(except [exn:fail? (λ(e) #f)])))
;; Try loading from ptree file, or failing that, synthesize ptree.
(define+provide/contract (make-project-ptree project-dir)
(pathish? . -> . ptree?)
(define ptree-source (build-path project-dir world:default-ptree))
(cached-require ptree-source world:main-pollen-export))
(define+provide/contract (parent p [ptree (current-ptree)])
(((or/c #f pnodeish?)) (ptree?) . ->* . (or/c #f pnode?))
(and ptree p
(let ([pnode (->pnode p)])
(if (member pnode (map (λ(x) (if (list? x) (car x) x)) (cdr ptree)))
(car ptree)
(ormap (λ(x) (parent pnode x)) (filter list? ptree))))))
(define+provide/contract (children p [ptree (current-ptree)])
(((or/c #f pnodeish?)) (ptree?) . ->* . (or/c #f (listof pnode?)))
(and ptree p
(let ([pnode (->pnode p)])
(if (equal? pnode (car ptree))
(map (λ(x) (if (list? x) (car x) x)) (cdr ptree))
(ormap (λ(x) (children pnode x)) (filter list? ptree))))))
(define+provide/contract (siblings p [ptree (current-ptree)])
(((or/c #f pnodeish?)) (ptree?) . ->* . (or/c #f (listof pnode?)))
(children (parent p ptree) ptree))
;; flatten tree to sequence
(define+provide/contract (ptree->list ptree)
(ptree? . -> . (listof pnode?))
; use cdr to get rid of root tag at front
(cdr (flatten ptree)))
(define (adjacents side p [ptree (current-ptree)])
; ((symbol? (or/c #f pnodeish?)) (ptree?) . ->* . (or/c #f (listof pnode?)))
(and ptree p
(let* ([pnode (->pnode p)]
[proc (if (equal? side 'left) takef takef-right)]
[result (proc (ptree->list ptree) (λ(x) (not (equal? pnode x))))])
(and (not (empty? result)) result))))
(define+provide/contract (previous* pnode [ptree (current-ptree)])
(((or/c #f pnodeish?)) (ptree?) . ->* . (or/c #f (listof pnode?)))
(adjacents 'left pnode ptree))
(define+provide/contract (next* pnode [ptree (current-ptree)])
(((or/c #f pnodeish?)) (ptree?) . ->* . (or/c #f (listof pnode?)))
(adjacents 'right pnode ptree))
(define+provide/contract (previous pnode [ptree (current-ptree)])
(((or/c #f pnodeish?)) (ptree?) . ->* . (or/c #f pnode?))
(let ([result (previous* pnode ptree)])
(and result (last result))))
(define+provide/contract (next pnode [ptree (current-ptree)])
(((or/c #f pnodeish?)) (ptree?) . ->* . (or/c #f pnode?))
(let ([result (next* pnode ptree)])
(and result (first result))))

@ -1,6 +1,6 @@
#lang racket/base
(require racket/file racket/rerequire racket/path racket/match)
(require sugar "file.rkt" "cache.rkt" "world.rkt" "debug.rkt" "ptree.rkt" "project-requires.rkt")
(require sugar "file.rkt" "cache.rkt" "world.rkt" "debug.rkt" "pagemap.rkt" "project-requires.rkt")
;; when you want to generate everything fresh,
@ -49,12 +49,12 @@
(for-each render-to-file-if-needed xs))
(define/contract+provide (render-ptree ptree-or-path)
((or/c ptree? pathish?) . -> . void?)
(define ptree (if (ptree? ptree-or-path)
ptree-or-path
(cached-require ptree-or-path world:main-pollen-export)))
(apply render-batch (ptree->list ptree)))
(define/contract+provide (render-pagemap pagemap-or-path)
((or/c pagemap? pathish?) . -> . void?)
(define pagemap (if (pagemap? pagemap-or-path)
pagemap-or-path
(cached-require pagemap-or-path world:main-pollen-export)))
(apply render-batch (pagemap->list pagemap)))
(define/contract+provide (render-for-dev-server so-pathish #:force [force #f])
@ -64,7 +64,7 @@
[(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source?))
(let-values ([(source-path output-path) (->source+output-paths so-path)])
(render-to-file-if-needed source-path output-path #:force force))]
[(ptree-source? so-path) (render-ptree so-path)]))
[(pagemap-source? so-path) (render-pagemap so-path)]))
(void))
@ -164,7 +164,7 @@
(require-project-require-files)
(let ([doc (cached-require ,source-path ',world:main-pollen-export)]
[metas (cached-require ,source-path ',world:meta-pollen-export)])
(local-require pollen/debug pollen/ptree pollen/template pollen/top)
(local-require pollen/debug pollen/pagemap pollen/template pollen/top)
(include-template #:command-char ,world:template-field-delimiter ,(->string (find-relative-path source-dir template-path))))))
(time (parameterize ([current-directory source-dir])
@ -225,7 +225,7 @@
pollen/file
pollen/main
pollen/lang/inner-lang-helper
pollen/ptree
pollen/pagemap
pollen/cache
sugar
txexpr
@ -245,7 +245,7 @@
(list? . -> . bytes?)
(parameterize ([current-namespace (make-base-namespace)]
[current-output-port (current-error-port)]
[current-ptree (make-project-ptree (world:current-project-root))])
[current-pagemap (make-project-pagemap (world:current-project-root))])
(for-each (λ(mod-name) (namespace-attach-module cache-ns mod-name))
`(web-server/templates
xml
@ -259,7 +259,7 @@
pollen/decode
pollen/file
pollen/lang/inner-lang-helper
pollen/ptree
pollen/pagemap
pollen/cache
sugar
txexpr

@ -7,5 +7,5 @@
@include-section["cache.scrbl"]
@include-section["decode.scrbl"]
@include-section["file.scrbl"]
@include-section["ptree.scrbl"]
@include-section["pagemap.scrbl"]
@include-section["render.scrbl"]

@ -1,81 +1,81 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/ptree txexpr pollen/decode))
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/pagemap txexpr pollen/decode))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/ptree txexpr))
@(my-eval `(require pollen pollen/pagemap txexpr))
@title{Ptrees}
@title{pagemaps}
@defmodule[pollen/ptree]
@defmodule[pollen/pagemap]
A @italic{ptree} — short for @italic{Pollen tree} — is a hierarchical list of Pollen output files. A ptree source file has the extension @code[(format ".~a" world:ptree-source-ext)]. A ptree provides a convenient way of separating the structure of the pages from the page sources, and navigating around this structure.
A @italic{pagemap} is a hierarchical list of Pollen output files. A pagemap source file has the extension @code[(format ".~a" world:pagemap-source-ext)]. A pagemap provides a convenient way of separating the structure of the pages from the page sources, and navigating around this structure.
Books and other long documents are usually organized in a structured way — at minimum they have a sequence of pages, but more often they have sections with subsequences within. Individual Pollen source files don't know anything about how they're connected to other files. In theory, you could maintain this information within each source file. This would be a poor use of human energy. Let the ptree figure it out.
Books and other long documents are usually organized in a structured way — at minimum they have a sequence of pages, but more often they have sections with subsequences within. Individual Pollen source files don't know anything about how they're connected to other files. In theory, you could maintain this information within each source file. This would be a poor use of human energy. Let the pagemap figure it out.
@defproc[
(ptree?
[possible-ptree any/c])
(pagemap?
[possible-pagemap any/c])
boolean?]
Test whether @racket[_possible-ptree] is a valid ptree. It must be a @racket[txexpr?] where all elements are @racket[pnode?] and unique within @racket[_possible-ptree] (not counting the root node).
Test whether @racket[_possible-pagemap] is a valid pagemap. It must be a @racket[txexpr?] where all elements are @racket[node?] and unique within @racket[_possible-pagemap] (not counting the root node).
@examples[#:eval my-eval
(ptree? '(root index.html))
(ptree? '(root index.html index.html))
(ptree? '(root index.html "index.html"))
(define nested-pt '(root 1.html 2.html (3.html 3a.html 3b.html)))
(ptree? nested-pt)
(ptree? `(root index.html ,nested-pt (subsection.html more.html)))
(ptree? `(root index.html ,nested-pt (subsection.html ,nested-pt)))
(pagemap? '(root index.html))
(pagemap? '(root index.html index.html))
(pagemap? '(root index.html "index.html"))
(define nested-pmap '(root 1.html 2.html (3.html 3a.html 3b.html)))
(pagemap? nested-pmap)
(pagemap? `(root index.html ,nested-pmap (subsection.html more.html)))
(pagemap? `(root index.html ,nested-pmap (subsection.html ,nested-pmap)))
]
@defproc[
(validate-ptree
[possible-ptree any/c])
ptree?]
Like @racket[ptree?], but raises a descriptive error if @racket[_possible-ptree] is invalid, and otherwise returns @racket[_possible-ptree] itself.
(validate-pagemap
[possible-pagemap any/c])
pagemap?]
Like @racket[pagemap?], but raises a descriptive error if @racket[_possible-pagemap] is invalid, and otherwise returns @racket[_possible-pagemap] itself.
@examples[#:eval my-eval
(validate-ptree '(root (mama.html son.html daughter.html) uncle.html))
(validate-ptree `(root (,+ son.html daughter.html) uncle.html))
(validate-ptree '(root (mama.html son.html son.html) mama.html))
(validate-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(validate-pagemap `(root (,+ son.html daughter.html) uncle.html))
(validate-pagemap '(root (mama.html son.html son.html) mama.html))
]
@defproc[
(pnode?
[possible-pnode any/c])
(node?
[possible-node any/c])
boolean?]
Test whether @racket[_possible-pnode] is a valid pnode (short for ``ptree node''). A pnode can be any @racket[symbol?] that is not @racket[whitespace/nbsp?] Every leaf of a ptree is a pnode. In practice, your pnodes will likely be names of output files.
Test whether @racket[_possible-node] is a valid node (short for ``pagemap node''). A node can be any @racket[symbol?] that is not @racket[whitespace/nbsp?] Every leaf of a pagemap is a node. In practice, your nodes will likely be names of output files.
@margin-note{Pnodes are symbols (rather than strings) so that ptrees will be valid tagged X-expressions, which is a more convenient format for validation & processing.}
@margin-note{Nodes are symbols (rather than strings) so that pagemaps will be valid tagged X-expressions, which is a more convenient format for validation & processing.}
@examples[#:eval my-eval
(map pnode? '(symbol index.html | silly |))
(map pnode? '(9.999 "index.html" (p "Hello") | |))
(map node? '(symbol index.html | silly |))
(map node? '(9.999 "index.html" (p "Hello") | |))
]
@defproc[
(pnodeish?
(nodeish?
[v any/c])
boolean?]
Return @racket[#t] if @racket[_v] can be converted with @racket[->pnode].
Return @racket[#t] if @racket[_v] can be converted with @racket[->node].
@examples[#:eval my-eval
(map pnodeish? '(9.999 "index.html" | |))
(map nodeish? '(9.999 "index.html" | |))
]
@defproc[
(->pnode
[v pnodeish?])
pnode?]
Convert @racket[_v] to a pnode.
(->node
[v nodeish?])
node?]
Convert @racket[_v] to a node.
@examples[#:eval my-eval
(map pnodeish? '(symbol 9.999 "index.html" | silly |))
(map ->pnode '(symbol 9.999 "index.html" | silly |))
(map nodeish? '(symbol 9.999 "index.html" | silly |))
(map ->node '(symbol 9.999 "index.html" | silly |))
]
@ -83,20 +83,20 @@ Convert @racket[_v] to a pnode.
@section{Navigation}
@defparam[current-ptree ptree ptree?
@defparam[current-pagemap pagemap pagemap?
#:value #f]{
A parameter that defines the default ptree used by ptree navigation functions (e.g., @racket[parent], @racket[chidren], et al.) if another is not explicitly specified. Initialized to @racket[#f].}
A parameter that defines the default pagemap used by pagemap navigation functions (e.g., @racket[parent], @racket[chidren], et al.) if another is not explicitly specified. Initialized to @racket[#f].}
@defproc[
(parent
[p (or/c #f pnodeish?)]
[ptree ptree? (current-ptree)])
(or/c #f pnode?)]
Find the parent pnode of @racket[_p] within @racket[_ptree]. Return @racket[#f] if there isn't one.
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
Find the parent node of @racket[_p] within @racket[_pagemap]. Return @racket[#f] if there isn't one.
@examples[#:eval my-eval
(current-ptree '(root (mama.html son.html daughter.html) uncle.html))
(current-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(parent 'son.html)
(parent "mama.html")
(parent (parent 'son.html))
@ -105,13 +105,13 @@ Find the parent pnode of @racket[_p] within @racket[_ptree]. Return @racket[#f]
@defproc[
(children
[p (or/c #f pnodeish?)]
[ptree ptree? (current-ptree)])
(or/c #f pnode?)]
Find the child pnodes of @racket[_p] within @racket[_ptree]. Return @racket[#f] if there aren't any.
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
Find the child nodes of @racket[_p] within @racket[_pagemap]. Return @racket[#f] if there aren't any.
@examples[#:eval my-eval
(current-ptree '(root (mama.html son.html daughter.html) uncle.html))
(current-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(children 'mama.html)
(children 'uncle.html)
(children 'root)
@ -121,13 +121,13 @@ Find the child pnodes of @racket[_p] within @racket[_ptree]. Return @racket[#f]
@defproc[
(siblings
[p (or/c #f pnodeish?)]
[ptree ptree? (current-ptree)])
(or/c #f pnode?)]
Find the sibling pnodes of @racket[_p] within @racket[_ptree]. The list will include @racket[_p] itself. But the function will still return @racket[#f] if @racket[_ptree] is @racket[#f].
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
Find the sibling nodes of @racket[_p] within @racket[_pagemap]. The list will include @racket[_p] itself. But the function will still return @racket[#f] if @racket[_pagemap] is @racket[#f].
@examples[#:eval my-eval
(current-ptree '(root (mama.html son.html daughter.html) uncle.html))
(current-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(siblings 'son.html)
(siblings 'daughter.html)
(siblings 'mama.html)
@ -138,20 +138,20 @@ Find the sibling pnodes of @racket[_p] within @racket[_ptree]. The list will inc
@defproc[
(previous
[p (or/c #f pnodeish?)]
[ptree ptree? (current-ptree)])
(or/c #f pnode?)]
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
@defproc[
(previous*
[p (or/c #f pnodeish?)]
[ptree ptree? (current-ptree)])
(or/c #f (listof pnode?))]
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f (listof node?))]
)]
Return the pnode immediately before @racket[_p]. For @racket[previous*], return all the pnodes before @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any pnodes. The root node is ignored.
Return the node immediately before @racket[_p]. For @racket[previous*], return all the nodes before @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any nodes. The root node is ignored.
@examples[#:eval my-eval
(current-ptree '(root (mama.html son.html daughter.html) uncle.html))
(current-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(previous 'daughter.html)
(previous 'son.html)
(previous (previous 'daughter.html))
@ -164,20 +164,20 @@ Return the pnode immediately before @racket[_p]. For @racket[previous*], return
@defproc[
(next
[p (or/c #f pnodeish?)]
[ptree ptree? (current-ptree)])
(or/c #f pnode?)]
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
@defproc[
(next*
[p (or/c #f pnodeish?)]
[ptree ptree? (current-ptree)])
(or/c #f (listof pnode?))]
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f (listof node?))]
)]
Return the pnode immediately after @racket[_p]. For @racket[next*], return all the pnodes after @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any pnodes. The root node is ignored.
Return the node immediately after @racket[_p]. For @racket[next*], return all the nodes after @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any nodes. The root node is ignored.
@examples[#:eval my-eval
(current-ptree '(root (mama.html son.html daughter.html) uncle.html))
(current-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(next 'son.html)
(next 'daughter.html)
(next (next 'son.html))

@ -66,9 +66,9 @@ Render multiple @racket[_source-paths] in one go. This can be faster than @racke
@defproc*[
(
[(render-ptree [ptree ptree?]) void?]
[(render-ptree [ptree-source pathish?]) void?])]
Using @racket[_ptree], or a ptree loaded from @racket[_ptree-source], render the files included in that ptree using @racket[render-batch].
[(render-pagemap [pagemap pagemap?]) void?]
[(render-pagemap [pagemap-source pathish?]) void?])]
Using @racket[_pagemap], or a pagemap loaded from @racket[_pagemap-source], render the files included in that pagemap using @racket[render-batch].
@defproc[
(get-template-for

@ -5,7 +5,7 @@
(require web-server/http/request-structs)
(require web-server/http/response-structs)
(require 2htdp/image)
(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "ptree.rkt" "cache.rkt")
(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagemap.rkt" "cache.rkt")
(module+ test (require rackunit))
@ -177,12 +177,12 @@
(cond ; in cell
[source (cons (format "in/~a" source) "in")]
[(or (ptree-source? filename) (sourceish? filename)) (cons (format "in/~a" filename) "in")]
[(or (pagemap-source? filename) (sourceish? filename)) (cons (format "in/~a" filename) "in")]
[else empty-cell])
(cond ; out cell
[(directory-exists? (build-path dir filename)) (cons #f #f)]
[(ptree-source? filename) empty-cell]
[(pagemap-source? filename) empty-cell]
[else (cons (format "out/~a" filename) "out")]))))))
(define (ineligible-path? x) (or (not (visible? x)) (member x world:reserved-paths)))
@ -194,14 +194,14 @@
(define path-is-directory? (λ(f) (directory-exists? (build-path dir f))))
(define subdirectories (filter path-is-directory? all-paths))
(define files (filter-not path-is-directory? all-paths))
(define ptree-sources (filter ptree-source? files))
(define other-files (filter-not ptree-source? files))
(define pagemap-sources (filter pagemap-source? files))
(define other-files (filter-not pagemap-source? files))
(define (sort-names xs) (sort xs #:key ->string string<?))
;; put subdirs in list ahead of files (so they appear at the top)
(append (sort-names subdirectories) (sort-names ptree-sources) (sort-names other-files)))
(append (sort-names subdirectories) (sort-names pagemap-sources) (sort-names other-files)))
(define project-paths (filter-not ineligible-path? (if (file-exists? dashfile)
(map ->path (ptree->list (cached-require (->path dashfile) world:main-pollen-export)))
(map ->path (pagemap->list (cached-require (->path dashfile) world:main-pollen-export)))
(unique-sorted-output-paths (directory-list dir)))))
(body-wrapper

@ -13,7 +13,7 @@
(define-values (pollen-servlet _)
(dispatch-rules
[((string-arg) ... (? ptree-source?)) route-dashboard]
[((string-arg) ... (? pagemap-source?)) route-dashboard]
[((string-arg) ... "in" (string-arg)) route-in]
[((string-arg) ... "out" (string-arg)) route-out]
[((string-arg) ... "xexpr" (string-arg)) route-xexpr]

@ -71,9 +71,9 @@
(check-false (preproc-source? #f)))
(module+ test
(check-true (ptree-source? (format "foo.~a" world:ptree-source-ext)))
(check-false (ptree-source? (format "~a.foo" world:ptree-source-ext)))
(check-false (ptree-source? #f)))
(check-true (pagemap-source? (format "foo.~a" world:pagemap-source-ext)))
(check-false (pagemap-source? (format "~a.foo" world:pagemap-source-ext)))
(check-false (pagemap-source? #f)))
(module+ test
(check-true (markup-source? "foo.pm"))
(check-false (markup-source? "foo.p"))
@ -91,7 +91,7 @@
(check-equal? (->preproc-source-path "foo") (->path "foo.p"))
(check-equal? (->preproc-source-path 'foo) (->path "foo.p")))
(module+ test
(check-equal? (->output-path (->path "foo.ptree")) (->path "foo.ptree"))
(check-equal? (->output-path (->path "foo.pmap")) (->path "foo.pmap"))
(check-equal? (->output-path "foo.html") (->path "foo.html"))
(check-equal? (->output-path 'foo.html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html"))

@ -1,69 +1,69 @@
#lang racket/base
(require rackunit)
(require "../ptree.rkt" "../world.rkt")
(require "../pagemap.rkt" "../world.rkt")
(check-false (pnode? "foo-bar"))
(check-false (pnode? "Foo_Bar_0123"))
(check-true (pnode? 'foo-bar))
(check-false (pnode? "foo-bar.p"))
(check-false (pnode? "/Users/MB/foo-bar"))
(check-false (pnode? #f))
(check-false (pnode? ""))
(check-false (pnode? " "))
(check-false (node? "foo-bar"))
(check-false (node? "Foo_Bar_0123"))
(check-true (node? 'foo-bar))
(check-false (node? "foo-bar.p"))
(check-false (node? "/Users/MB/foo-bar"))
(check-false (node? #f))
(check-false (node? ""))
(check-false (node? " "))
(check-true (ptree? '(foo)))
(check-true (ptree? '(foo (hee))))
(check-true (ptree? '(foo (hee (uncle foo)))))
(check-false (ptree? '(foo (hee hee (uncle foo)))))
(check-true (pagemap? '(foo)))
(check-true (pagemap? '(foo (hee))))
(check-true (pagemap? '(foo (hee (uncle foo)))))
(check-false (pagemap? '(foo (hee hee (uncle foo)))))
(define test-ptree-main `(ptree-main foo bar (one (two three))))
(define test-ptree (ptree-root->ptree test-ptree-main))
(check-equal? (parent 'three test-ptree) 'two)
(check-equal? (parent "three" test-ptree) 'two)
(check-false (parent #f test-ptree))
(check-false (parent 'nonexistent-name test-ptree))
(define test-pagemap-main `(pagemap-main foo bar (one (two three))))
(define test-pagemap (pagemap-root->pagemap test-pagemap-main))
(check-equal? (parent 'three test-pagemap) 'two)
(check-equal? (parent "three" test-pagemap) 'two)
(check-false (parent #f test-pagemap))
(check-false (parent 'nonexistent-name test-pagemap))
(check-equal? (children 'one test-ptree) '(two))
(check-equal? (children 'two test-ptree) '(three))
(check-false (children 'three test-ptree))
(check-false (children #f test-ptree))
(check-false (children 'fooburger test-ptree))
(check-equal? (children 'one test-pagemap) '(two))
(check-equal? (children 'two test-pagemap) '(three))
(check-false (children 'three test-pagemap))
(check-false (children #f test-pagemap))
(check-false (children 'fooburger test-pagemap))
(check-equal? (siblings 'one test-ptree) '(foo bar one))
(check-equal? (siblings 'foo test-ptree) '(foo bar one))
(check-equal? (siblings 'two test-ptree) '(two))
(check-false (siblings #f test-ptree))
(check-false (siblings 'invalid-key test-ptree))
(check-equal? (siblings 'one test-pagemap) '(foo bar one))
(check-equal? (siblings 'foo test-pagemap) '(foo bar one))
(check-equal? (siblings 'two test-pagemap) '(two))
(check-false (siblings #f test-pagemapap))
(check-false (siblings 'invalid-key test-pagemap))
(check-equal? (previous* 'one test-ptree) '(foo bar))
(check-equal? (previous* 'three test-ptree) '(foo bar one two))
(check-false (previous* 'foo test-ptree))
(check-equal? (previous* 'one test-pagemap) '(foo bar))
(check-equal? (previous* 'three test-pagemap) '(foo bar one two))
(check-false (previous* 'foo test-pagemap))
(check-equal? (previous 'one test-ptree) 'bar)
(check-equal? (previous 'three test-ptree) 'two)
(check-false (previous 'foo test-ptree))
(check-equal? (previous 'one test-pagemap) 'bar)
(check-equal? (previous 'three test-pagemap) 'two)
(check-false (previous 'foo test-pagemap))
(check-equal? (next 'foo test-ptree) 'bar)
(check-equal? (next 'one test-ptree) 'two)
(check-false (next 'three test-ptree))
(check-equal? (next 'foo test-pagemap) 'bar)
(check-equal? (next 'one test-pagemap) 'two)
(check-false (next 'three test-pagemap))
(check-equal? (ptree->list test-ptree) '(foo bar one two three))
(check-equal? (pagemap->list test-pagemap) '(foo bar one two three))
(let ([sample-main `(world:pollen-tree-root-name foo bar (one (two three)))])
(check-equal? (ptree-root->ptree sample-main)
(check-equal? (pagemap-root->pagemap sample-main)
`(world:pollen-tree-root-name foo bar (one (two three)))))
(define files '("foo.html" "bar.html" "bar.html.p" "zap.html" "zap.xml"))
(check-equal? (pnode->url/paths 'foo.html files) "foo.html")
(check-equal? (pnode->url/paths 'bar.html files) "bar.html")
(check-equal? (node->url/paths 'foo.html files) "foo.html")
(check-equal? (node->url/paths 'bar.html files) "bar.html")
;; (check-equal? (name->url 'zap files) 'error) ;; todo: how to test error?
(check-false (pnode->url/paths 'hee files))
(check-false (node->url/paths 'hee files))
(set! test-ptree-main `(,world:ptree-root-node foo bar (one (two three))))
(check-equal? (ptree-root->ptree test-ptree-main)
`(,world:ptree-root-node foo bar (one (two three))))
(set! test-pagemap-main `(,world:pagemap-root-node foo bar (one (two three))))
(check-equal? (pagemap-root->pagemap test-pagemap-main)
`(,world:pagemap-root-node foo bar (one (two three))))

@ -8,7 +8,7 @@
(define markup-source-ext 'pm)
(define markdown-source-ext 'pmd)
(define null-source-ext 'p)
(define ptree-source-ext 'ptree)
(define pagemap-source-ext 'pmap)
(define template-source-ext 'pt)
(define scribble-source-ext 'scrbl)
@ -17,12 +17,12 @@
(define reader-mode-preproc 'pre)
(define reader-mode-markup 'markup)
(define reader-mode-markdown 'markdown)
(define reader-mode-ptree 'ptree)
(define reader-mode-pagemap 'pmap)
(define decodable-extensions (list markup-source-ext ptree-source-ext))
(define decodable-extensions (list markup-source-ext pagemap-source-ext))
(define default-ptree "index.ptree")
(define ptree-root-node 'ptree-root)
(define default-pagemap "index.pmap")
(define pagemap-root-node 'pagemap-root)
(define template-source-prefix "-")
(define expression-delimiter #\◊)
@ -57,7 +57,7 @@
(define server-port 8088)
(define dashboard-name "index.ptree")
(define dashboard-name "index.pmap")
(define dashboard-css "poldash.css")
(define current-module-root (make-parameter #f))

Loading…
Cancel
Save