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 [("render") `(begin
;; todo: take extensions off the comand line ;; 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") (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 [("clone") (let ([target-path
(if (> (len args) 1) (if (> (len args) 1)
(->path (get args 1)) (->path (get args 1))
@ -46,7 +46,7 @@ clone copies rendered files to desktop
markup-source? markup-source?
preproc-source? preproc-source?
template-source? template-source?
ptree-source? pagemap-source?
pollen-script? pollen-script?
magic-directory? magic-directory?
racket-file?))) racket-file?)))

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

@ -41,7 +41,7 @@
(let* ([file-ext-pattern (pregexp "\\w+$")] (let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern inner-here-path)))]) [here-ext (string->symbol (car (regexp-match file-ext-pattern inner-here-path)))])
(cond (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:markup-source-ext) world:reader-mode-markup]
[(equal? here-ext world:markdown-source-ext) world:reader-mode-markdown] [(equal? here-ext world:markdown-source-ext) world:reader-mode-markdown]
[else world:reader-mode-preproc])) [else world:reader-mode-preproc]))
@ -75,7 +75,7 @@
;; set up the 'doc export ;; set up the 'doc export
(require pollen/decode) (require pollen/decode)
(define doc (apply (cond (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. ;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[(or (equal? parser-mode world:reader-mode-markup) [(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 #lang racket/base
(require pollen/lang/reader-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 #lang racket/base
(require racket/file racket/rerequire racket/path racket/match) (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, ;; when you want to generate everything fresh,
@ -49,12 +49,12 @@
(for-each render-to-file-if-needed xs)) (for-each render-to-file-if-needed xs))
(define/contract+provide (render-ptree ptree-or-path) (define/contract+provide (render-pagemap pagemap-or-path)
((or/c ptree? pathish?) . -> . void?) ((or/c pagemap? pathish?) . -> . void?)
(define ptree (if (ptree? ptree-or-path) (define pagemap (if (pagemap? pagemap-or-path)
ptree-or-path pagemap-or-path
(cached-require ptree-or-path world:main-pollen-export))) (cached-require pagemap-or-path world:main-pollen-export)))
(apply render-batch (ptree->list ptree))) (apply render-batch (pagemap->list pagemap)))
(define/contract+provide (render-for-dev-server so-pathish #:force [force #f]) (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?)) [(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)]) (let-values ([(source-path output-path) (->source+output-paths so-path)])
(render-to-file-if-needed source-path output-path #:force force))] (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)) (void))
@ -164,7 +164,7 @@
(require-project-require-files) (require-project-require-files)
(let ([doc (cached-require ,source-path ',world:main-pollen-export)] (let ([doc (cached-require ,source-path ',world:main-pollen-export)]
[metas (cached-require ,source-path ',world:meta-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)))))) (include-template #:command-char ,world:template-field-delimiter ,(->string (find-relative-path source-dir template-path))))))
(time (parameterize ([current-directory source-dir]) (time (parameterize ([current-directory source-dir])
@ -225,7 +225,7 @@
pollen/file pollen/file
pollen/main pollen/main
pollen/lang/inner-lang-helper pollen/lang/inner-lang-helper
pollen/ptree pollen/pagemap
pollen/cache pollen/cache
sugar sugar
txexpr txexpr
@ -245,7 +245,7 @@
(list? . -> . bytes?) (list? . -> . bytes?)
(parameterize ([current-namespace (make-base-namespace)] (parameterize ([current-namespace (make-base-namespace)]
[current-output-port (current-error-port)] [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)) (for-each (λ(mod-name) (namespace-attach-module cache-ns mod-name))
`(web-server/templates `(web-server/templates
xml xml
@ -259,7 +259,7 @@
pollen/decode pollen/decode
pollen/file pollen/file
pollen/lang/inner-lang-helper pollen/lang/inner-lang-helper
pollen/ptree pollen/pagemap
pollen/cache pollen/cache
sugar sugar
txexpr txexpr

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

@ -1,81 +1,81 @@
#lang scribble/manual #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)) @(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[ @defproc[
(ptree? (pagemap?
[possible-ptree any/c]) [possible-pagemap any/c])
boolean?] 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 @examples[#:eval my-eval
(ptree? '(root index.html)) (pagemap? '(root index.html))
(ptree? '(root index.html index.html)) (pagemap? '(root index.html index.html))
(ptree? '(root index.html "index.html")) (pagemap? '(root index.html "index.html"))
(define nested-pt '(root 1.html 2.html (3.html 3a.html 3b.html))) (define nested-pmap '(root 1.html 2.html (3.html 3a.html 3b.html)))
(ptree? nested-pt) (pagemap? nested-pmap)
(ptree? `(root index.html ,nested-pt (subsection.html more.html))) (pagemap? `(root index.html ,nested-pmap (subsection.html more.html)))
(ptree? `(root index.html ,nested-pt (subsection.html ,nested-pt))) (pagemap? `(root index.html ,nested-pmap (subsection.html ,nested-pmap)))
] ]
@defproc[ @defproc[
(validate-ptree (validate-pagemap
[possible-ptree any/c]) [possible-pagemap any/c])
ptree?] pagemap?]
Like @racket[ptree?], but raises a descriptive error if @racket[_possible-ptree] is invalid, and otherwise returns @racket[_possible-ptree] itself. 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 @examples[#:eval my-eval
(validate-ptree '(root (mama.html son.html daughter.html) uncle.html)) (validate-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(validate-ptree `(root (,+ son.html daughter.html) uncle.html)) (validate-pagemap `(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 son.html) mama.html))
] ]
@defproc[ @defproc[
(pnode? (node?
[possible-pnode any/c]) [possible-node any/c])
boolean?] 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 @examples[#:eval my-eval
(map pnode? '(symbol index.html | silly |)) (map node? '(symbol index.html | silly |))
(map pnode? '(9.999 "index.html" (p "Hello") | |)) (map node? '(9.999 "index.html" (p "Hello") | |))
] ]
@defproc[ @defproc[
(pnodeish? (nodeish?
[v any/c]) [v any/c])
boolean?] 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 @examples[#:eval my-eval
(map pnodeish? '(9.999 "index.html" | |)) (map nodeish? '(9.999 "index.html" | |))
] ]
@defproc[ @defproc[
(->pnode (->node
[v pnodeish?]) [v nodeish?])
pnode?] node?]
Convert @racket[_v] to a pnode. Convert @racket[_v] to a node.
@examples[#:eval my-eval @examples[#:eval my-eval
(map pnodeish? '(symbol 9.999 "index.html" | silly |)) (map nodeish? '(symbol 9.999 "index.html" | silly |))
(map ->pnode '(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} @section{Navigation}
@defparam[current-ptree ptree ptree? @defparam[current-pagemap pagemap pagemap?
#:value #f]{ #: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[ @defproc[
(parent (parent
[p (or/c #f pnodeish?)] [p (or/c #f nodeish?)]
[ptree ptree? (current-ptree)]) [pagemap pagemap? (current-pagemap)])
(or/c #f pnode?)] (or/c #f node?)]
Find the parent pnode of @racket[_p] within @racket[_ptree]. Return @racket[#f] if there isn't one. Find the parent node of @racket[_p] within @racket[_pagemap]. Return @racket[#f] if there isn't one.
@examples[#:eval my-eval @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 'son.html)
(parent "mama.html") (parent "mama.html")
(parent (parent 'son.html)) (parent (parent 'son.html))
@ -105,13 +105,13 @@ Find the parent pnode of @racket[_p] within @racket[_ptree]. Return @racket[#f]
@defproc[ @defproc[
(children (children
[p (or/c #f pnodeish?)] [p (or/c #f nodeish?)]
[ptree ptree? (current-ptree)]) [pagemap pagemap? (current-pagemap)])
(or/c #f pnode?)] (or/c #f node?)]
Find the child pnodes of @racket[_p] within @racket[_ptree]. Return @racket[#f] if there aren't any. Find the child nodes of @racket[_p] within @racket[_pagemap]. Return @racket[#f] if there aren't any.
@examples[#:eval my-eval @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 'mama.html)
(children 'uncle.html) (children 'uncle.html)
(children 'root) (children 'root)
@ -121,13 +121,13 @@ Find the child pnodes of @racket[_p] within @racket[_ptree]. Return @racket[#f]
@defproc[ @defproc[
(siblings (siblings
[p (or/c #f pnodeish?)] [p (or/c #f nodeish?)]
[ptree ptree? (current-ptree)]) [pagemap pagemap? (current-pagemap)])
(or/c #f pnode?)] (or/c #f node?)]
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]. 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 @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 'son.html)
(siblings 'daughter.html) (siblings 'daughter.html)
(siblings 'mama.html) (siblings 'mama.html)
@ -138,20 +138,20 @@ Find the sibling pnodes of @racket[_p] within @racket[_ptree]. The list will inc
@defproc[ @defproc[
(previous (previous
[p (or/c #f pnodeish?)] [p (or/c #f nodeish?)]
[ptree ptree? (current-ptree)]) [pagemap pagemap? (current-pagemap)])
(or/c #f pnode?)] (or/c #f node?)]
@defproc[ @defproc[
(previous* (previous*
[p (or/c #f pnodeish?)] [p (or/c #f nodeish?)]
[ptree ptree? (current-ptree)]) [pagemap pagemap? (current-pagemap)])
(or/c #f (listof pnode?))] (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 @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 'daughter.html)
(previous 'son.html) (previous 'son.html)
(previous (previous 'daughter.html)) (previous (previous 'daughter.html))
@ -164,20 +164,20 @@ Return the pnode immediately before @racket[_p]. For @racket[previous*], return
@defproc[ @defproc[
(next (next
[p (or/c #f pnodeish?)] [p (or/c #f nodeish?)]
[ptree ptree? (current-ptree)]) [pagemap pagemap? (current-pagemap)])
(or/c #f pnode?)] (or/c #f node?)]
@defproc[ @defproc[
(next* (next*
[p (or/c #f pnodeish?)] [p (or/c #f nodeish?)]
[ptree ptree? (current-ptree)]) [pagemap pagemap? (current-pagemap)])
(or/c #f (listof pnode?))] (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 @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 'son.html)
(next 'daughter.html) (next 'daughter.html)
(next (next 'son.html)) (next (next 'son.html))

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

@ -5,7 +5,7 @@
(require web-server/http/request-structs) (require web-server/http/request-structs)
(require web-server/http/response-structs) (require web-server/http/response-structs)
(require 2htdp/image) (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)) (module+ test (require rackunit))
@ -177,12 +177,12 @@
(cond ; in cell (cond ; in cell
[source (cons (format "in/~a" source) "in")] [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]) [else empty-cell])
(cond ; out cell (cond ; out cell
[(directory-exists? (build-path dir filename)) (cons #f #f)] [(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")])))))) [else (cons (format "out/~a" filename) "out")]))))))
(define (ineligible-path? x) (or (not (visible? x)) (member x world:reserved-paths))) (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 path-is-directory? (λ(f) (directory-exists? (build-path dir f))))
(define subdirectories (filter path-is-directory? all-paths)) (define subdirectories (filter path-is-directory? all-paths))
(define files (filter-not path-is-directory? all-paths)) (define files (filter-not path-is-directory? all-paths))
(define ptree-sources (filter ptree-source? files)) (define pagemap-sources (filter pagemap-source? files))
(define other-files (filter-not ptree-source? files)) (define other-files (filter-not pagemap-source? files))
(define (sort-names xs) (sort xs #:key ->string string<?)) (define (sort-names xs) (sort xs #:key ->string string<?))
;; put subdirs in list ahead of files (so they appear at the top) ;; 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) (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))))) (unique-sorted-output-paths (directory-list dir)))))
(body-wrapper (body-wrapper

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

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

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

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

Loading…
Cancel
Save