pull/9/head
Matthew Butterick 10 years ago
parent b2a27cd4df
commit 04e7a63583

@ -23,7 +23,6 @@
`(module pollen-lang-module pollen
(define reader-mode ',reader-mode)
(define here-path ,(path->string path-string))
(define here ,(path->string (path-replace-suffix (find-relative-path (world:current-project-root) path-string) "")))
,(require+provide-project-require-files path-string)
,@file-contents)
file-contents)))

@ -53,10 +53,9 @@
(apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw)
doc-raw)])
`(placeholder-root
,@(cons (meta 'here: here)
(cons (meta 'here-path: here-path)
;; cdr strips initial linebreak, but make sure doc-raw isn't blank
(if (and (list? doc-raw) (> 0 (length doc-raw))) (cdr doc-raw) doc-raw))))))
,@(cons (meta 'here-path: here-path)
;; cdr strips initial linebreak, but make sure doc-raw isn't blank
(if (and (list? doc-raw) (> 0 (length doc-raw))) (cdr doc-raw) doc-raw)))))
(define-values (doc-without-metas metas) (split-metas-to-hash doc-txexpr))

@ -1,4 +1,5 @@
#lang racket/base
(require racket/path)
(require "tools.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt")
@ -49,27 +50,27 @@
(cached-require pagemap-source world:main-pollen-export))
(define+provide/contract (parent p [pagemap (current-pagemap)])
(define+provide/contract (parent-node 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))))))
(ormap (λ(x) (parent-node node x)) (filter list? pagemap))))))
(define+provide/contract (children p [pagemap (current-pagemap)])
(define+provide/contract (child-nodes 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))))))
(ormap (λ(x) (child-nodes node x)) (filter list? pagemap))))))
(define+provide/contract (siblings p [pagemap (current-pagemap)])
(define+provide/contract (sibling-nodes p [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(children (parent p pagemap) pagemap))
(child-nodes (parent-node p pagemap) pagemap))
;; flatten tree to sequence
@ -79,7 +80,7 @@
(cdr (flatten pagemap)))
(define (adjacents side p [pagemap (current-pagemap)])
(define (adjacent-nodes side p [pagemap (current-pagemap)])
; ((symbol? (or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(and pagemap p
(let* ([node (->node p)]
@ -88,25 +89,33 @@
(and (not (empty? result)) result))))
(define+provide/contract (previous* node [pagemap (current-pagemap)])
(define+provide/contract (previous-nodes node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(adjacents 'left node pagemap))
(adjacent-nodes 'left node pagemap))
(define+provide/contract (next* node [pagemap (current-pagemap)])
(define+provide/contract (next-nodes node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f (listof node?)))
(adjacents 'right node pagemap))
(adjacent-nodes 'right node pagemap))
(define+provide/contract (previous node [pagemap (current-pagemap)])
(define+provide/contract (previous-node node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f node?))
(let ([result (previous* node pagemap)])
(let ([result (previous-nodes node pagemap)])
(and result (last result))))
(define+provide/contract (next node [pagemap (current-pagemap)])
(define+provide/contract (next-node node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . (or/c #f node?))
(let ([result (next* node pagemap)])
(let ([result (next-nodes node pagemap)])
(and result (first result))))
(define/contract+provide (path->node path)
(coerce/path? . -> . coerce/symbol?)
(->output-path (find-relative-path (world:current-project-root) (->complete-path path))))
(define+provide/contract (node-in-pagemap? node [pagemap (current-pagemap)])
(((or/c #f nodeish?)) (pagemap?) . ->* . boolean?)
(->boolean (and node (member node (pagemap->list pagemap)))))

@ -164,6 +164,7 @@
(let ([doc (cached-require ,source-path ',world:main-pollen-export)]
[metas (cached-require ,source-path ',world:meta-pollen-export)])
(local-require pollen/pagemap pollen/template pollen/top)
(define here (metas->here metas))
(include-template #:command-char ,world:template-field-delimiter ,(->string (find-relative-path source-dir template-path))))))
(time (parameterize ([current-directory source-dir]) ; because include-template wants to work relative to source location

@ -1,6 +1,6 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/pagemap 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 pollen/file))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/pagemap txexpr))
@ -11,6 +11,8 @@
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.
Pagemaps are made of @italic{nodes}. Usually these nodes will be names of output files in your project. (If you think it would've been more logical to call them ``pages,'' perhaps. When I think of a web page, I think of a file on a disk. Whereas nodes may — and often do — refer to files that don't yet exist.)
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[
@ -85,26 +87,26 @@ Convert @racket[_v] to a node.
@defparam[current-pagemap pagemap pagemap?
#:value #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].}
A parameter that defines the default pagemap used by pagemap navigation functions (e.g., @racket[parent-node], @racket[chidren], et al.) if another is not explicitly specified. Initialized to @racket[#f].}
@defproc[
(parent
(parent-node
[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.
Find the parent-node node of @racket[_p] within @racket[_pagemap]. Return @racket[#f] if there isn't one.
@examples[#:eval my-eval
(current-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(parent 'son.html)
(parent "mama.html")
(parent (parent 'son.html))
(parent (parent (parent 'son.html)))
(parent-node 'son.html)
(parent-node "mama.html")
(parent-node (parent-node 'son.html))
(parent-node (parent-node (parent-node 'son.html)))
]
@defproc[
(children
(child-nodes
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
@ -112,15 +114,15 @@ Find the child nodes of @racket[_p] within @racket[_pagemap]. Return @racket[#f]
@examples[#:eval my-eval
(current-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(children 'mama.html)
(children 'uncle.html)
(children 'root)
(map children (children 'root))
(child-nodes 'mama.html)
(child-nodes 'uncle.html)
(child-nodes 'root)
(map child-nodes (child-nodes 'root))
]
@defproc[
(siblings
(sibling-nodes
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
@ -128,61 +130,84 @@ Find the sibling nodes of @racket[_p] within @racket[_pagemap]. The list will in
@examples[#:eval my-eval
(current-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(siblings 'son.html)
(siblings 'daughter.html)
(siblings 'mama.html)
(sibling-nodes 'son.html)
(sibling-nodes 'daughter.html)
(sibling-nodes 'mama.html)
]
@deftogether[(
@defproc[
(previous
(previous-node
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
@defproc[
(previous*
(previous-nodes
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f (listof node?))]
)]
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.
Return the node immediately before @racket[_p]. For @racket[previous-nodes], 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-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(previous 'daughter.html)
(previous 'son.html)
(previous (previous 'daughter.html))
(previous 'mama.html)
(previous* 'daughter.html)
(previous* 'uncle.html)
(previous-node 'daughter.html)
(previous-node 'son.html)
(previous-node (previous-node 'daughter.html))
(previous-node 'mama.html)
(previous-nodes 'daughter.html)
(previous-nodes 'uncle.html)
]
@deftogether[(
@defproc[
(next
(next-node
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f node?)]
@defproc[
(next*
(next-nodes
[p (or/c #f nodeish?)]
[pagemap pagemap? (current-pagemap)])
(or/c #f (listof node?))]
)]
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.
Return the node immediately after @racket[_p]. For @racket[next-nodes], 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-pagemap '(root (mama.html son.html daughter.html) uncle.html))
(next 'son.html)
(next 'daughter.html)
(next (next 'son.html))
(next 'uncle.html)
(next* 'mama.html)
(next* 'daughter.html)
(next-node 'son.html)
(next-node 'daughter.html)
(next-node (next-node 'son.html))
(next-node 'uncle.html)
(next-nodes 'mama.html)
(next-nodes 'daughter.html)
]
@section{Utilities}
@defproc[
(pagemap->list
[pagemap pagemap?])
list?
]
Convert @racket[_pagemap] to a simple list, preserving order.
@defproc[
(node-in-pagemap?
[node node?]
[pagemap pagemap? (current-pagemap)])
boolean?
]
Report whether @racket[_node] is in @racket[_pagemap].
@defproc[
(path->node
[p pathish?])
node?
]
Convert path @racket[_p] to a node — meaning, make it relative to @racket[world:current-project-root], run it through @racket[->output-path], and convert it to a symbol. Does not tell you whether the resultant node actually exists in the current pagemap (for that, use @racket[node-in-pagemap?]).

@ -13,9 +13,9 @@ Convenience functions for templates. These are automatically imported into the @
@defproc[
(->html
[tx txexpr?])
[xexpr xexpr?])
string?]
Convert @racket[_tx] to an HTML string. Similar to @racket[xexpr->string], but consistent with the HTML spec, text that appears within @code{script} or @code{style} blocks will not be escaped.
Convert @racket[_xexpr] to an HTML string. Similar to @racket[xexpr->string], but consistent with the HTML spec, text that appears within @code{script} or @code{style} blocks will not be escaped.
@examples[#:eval my-eval
(define tx '(root (script "3 > 2") "Why is 3 > 2?"))

@ -167,7 +167,7 @@
[(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
(cons (format "~a/~a" filename world:dashboard-name) (format "~a/" filename))]
[(and source (equal? (get-ext source) "scrbl"))
(cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,source ")")))]
(cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(path->string (find-relative-path dashboard-dir source)) ")")))]
[source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))]
[else (cons filename filename)])

@ -22,7 +22,7 @@
(message (format "Welcome to Pollen ~a" world:pollen-version) (format "(Racket ~a)" (version)))
(message (format "Project root is ~a" (world:current-project-root)))
(define server-name (format "http://localhost:~a" world: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 dashboard is ~a/~a" server-name world:dashboard-name))
@ -36,7 +36,7 @@
[error-print-width 1000]
[current-cache (make-cache)])
(serve/servlet pollen-servlet
#:port world:server-port
#:port (world:current-server-port)
#:listen-ip #f
#:servlet-regexp #rx"" ; respond to top level
#:command-line? #t

@ -1,59 +1,64 @@
#lang racket/base
(require (for-syntax racket/base))
(require racket/string xml xml/path sugar/define sugar/container sugar/coerce/contract)
(require "tools.rkt" txexpr "world.rkt" "cache.rkt")
(require "tools.rkt" txexpr "world.rkt" "cache.rkt" "pagemap.rkt")
(require sugar/coerce/value)
(provide (all-from-out sugar/coerce/value))
(define/contract+provide (get-doc x)
(coerce/path? . -> . (or/c #f txexpr? string?))
(define source-path (->source-path x))
(define/contract+provide (metas->here metas)
(hash? . -> . node?)
(path->node ('here-path . from-metas . metas)))
(define/contract (get-doc node-or-path)
((or/c node? pathish?) . -> . (or/c txexpr? string?))
(define source-path (->source-path (cond
[(node? node-or-path) (node->path node-or-path)]
[else node-or-path])))
(if source-path
(cached-require source-path world:main-pollen-export)
(error (format "get-doc: no source found for '~a' in directory ~a" x (current-directory)))))
(error (format "get-doc: no source found for '~a' in directory ~a" node-or-path (current-directory)))))
(define/contract+provide (get-metas x)
(coerce/path? . -> . hash?)
(define source-path (->source-path x))
(define/contract (get-metas node-or-path)
((or/c node? pathish?) . -> . hash?)
(define source-path (->source-path (cond
[(node? node-or-path) (node->path node-or-path)]
[else node-or-path])))
(if source-path
(cached-require source-path world:meta-pollen-export)
(error (format "get-doc: no source found for '~a' in directory ~a" x (current-directory)))))
(error (format "get-metas: no source found for '~a' in directory ~a" node-or-path (current-directory)))))
(define (node->path node)
(build-path (world:current-project-root) (symbol->string node)))
(define/contract+provide (from-node query node)
(define+provide/contract (from-node query node)
(coerce/symbol? coerce/symbol? . -> . (or/c #f txexpr-element?))
(define node-path (build-path (world:current-project-root) (->string node)))
(define result (append (find-in-metas query node-path) (find-in-doc query node-path)))
(define result (from-node* query node))
(if (null? result) #f (car result)))
(define/contract+provide (find* query . nodes)
((coerce/symbol?) #:rest (listof symbol?) . ->* . (or/c #f txexpr-elements?))
(define (finder x)
(cond
[(hash? x) (find-in-metas query x)]
[(txexpr? x) (find-in-doc query x)]
[(pathish? x) (find* query (get-doc x) (get-metas x))]
[else null]))
(append-map finder nodes))
(define+provide/contract (from-node* query node)
(coerce/symbol? coerce/symbol? . -> . (listof txexpr-element?))
(define meta-result (from-metas query node))
(append (if meta-result (list meta-result) null) (from-doc query node)))
(define/contract+provide (find-in-metas query hash-or-path)
(coerce/symbol? (or/c hash? pathish?) . -> . (or/c #f txexpr-elements?))
(let ([metas (or (and (hash? hash-or-path) hash-or-path)
(get-metas (->path hash-or-path)))])
(with-handlers ([exn:fail? (λ(e) null)])
(list (hash-ref metas query)))))
(define/contract+provide (from-metas query node-or-metas)
(coerce/symbol? (or/c node? hash?) . -> . (or/c #f txexpr-element?))
(let ([metas (or (and (node? node-or-metas) (get-metas node-or-metas)) node-or-metas)])
(with-handlers ([exn:fail? (λ(e) #f)])
(hash-ref metas query))))
(define/contract+provide (find-in-doc query doc-or-path)
(coerce/symbol? (or/c txexpr? pathish?) . -> . (or/c #f txexpr-elements?))
(let ([doc (or (and (txexpr? doc-or-path) doc-or-path)
(get-doc (->path doc-or-path)))])
(define/contract+provide (from-doc query node-or-doc)
(coerce/symbol? (or/c node? txexpr?) . -> . (or/c #f txexpr-elements?))
(let ([doc (or (and (node? node-or-doc) (get-doc node-or-doc)) node-or-doc)])
(with-handlers ([exn:fail? (λ(e) null)])
(se-path*/list (list query) doc))))
@ -85,7 +90,3 @@
(map ->string (list body ...))))
"")]))
(module+ main
(parameterize ([current-directory (string->path "/Users/MB/git/bpt/down/")])
(get-doc "introduction.html")))

@ -55,7 +55,7 @@
(define current-project-root (make-parameter (current-directory)))
(define server-port 8088)
(define current-server-port (make-parameter 8088))
(define dashboard-name "index.pmap")
(define dashboard-css "poldash.css")

Loading…
Cancel
Save