pull/9/head
Matthew Butterick 11 years ago
parent 09e7709eee
commit 3c5c154379

@ -2,7 +2,7 @@
(require xml txexpr sugar/define) (require xml txexpr sugar/define)
(require "decode/block.rkt" "decode/typography.rkt" "debug.rkt") (require "decode/block.rkt" "decode/typography.rkt" "debug.rkt")
(provide (all-from-out "decode/typography.rkt")) (provide (all-from-out "decode/block.rkt" "decode/typography.rkt"))
(define+provide (to-string x) (define+provide (to-string x)

@ -152,11 +152,11 @@
(define+provide/contract (whitespace/nbsp? x) (define+provide/contract (whitespace/nbsp? x)
(any/c . -> . coerce/boolean?) (any/c . -> . coerce/boolean?)
(or (whitespace? x) (equal? (->string x) (->string #\u00AD)))) (or (whitespace? x) (equal? (->string x) (->string #\u00A0))))
;; is x a paragraph break? ;; is x a paragraph break?
(define (paragraph-break? x #:separator [sep world:paragraph-separator]) (define+provide/contract (paragraph-break? x #:separator [sep world: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)))
@ -185,7 +185,7 @@
;; Find adjacent newline characters in a list and merge them into one item ;; Find adjacent newline characters in a list and merge them into one item
;; Scribble, by default, makes each newline a separate list item ;; Scribble, by default, makes each newline a separate list item
;; In practice, this is worthless. ;; In practice, this is worthless.
(define (merge-newlines x) (define+provide/contract (merge-newlines x)
(txexpr-elements? . -> . txexpr-elements?) (txexpr-elements? . -> . txexpr-elements?)
(cond (cond
[(list? x) (do-merge (map merge-newlines x))] [(list? x) (do-merge (map merge-newlines x))]

@ -13,15 +13,6 @@
(except [exn:fail? (λ(e) #f)]))) (except [exn:fail? (λ(e) #f)])))
;; like pathish, but for directories
;; todo: is this contract too restrictive?
;; pathish doesn't require the path to exist,
;; but this one does.
(define+provide/contract (directory-pathish? x)
(any/c . -> . coerce/boolean?)
(and (pathish? x) (directory-exists? (->path x))))
;; compare directories by their exploded path elements, ;; compare directories by their exploded path elements,
;; not by equal?, which will give wrong result if no slash on the end ;; not by equal?, which will give wrong result if no slash on the end
(define+provide/contract (directories-equal? dirx diry) (define+provide/contract (directories-equal? dirx diry)
@ -39,7 +30,7 @@
(define+provide/contract (visible-files dir) (define+provide/contract (visible-files dir)
(directory-pathish? . -> . (listof path?)) (pathish? . -> . (listof path?))
(filter visible? (filter visible?
(map (λ(p) (find-relative-path dir p)) (map (λ(p) (find-relative-path dir p))
(filter file-exists? (filter file-exists?

@ -77,7 +77,7 @@
(define doc (apply (cond (define doc (apply (cond
[(equal? parser-mode world:reader-mode-ptree) [(equal? parser-mode world:reader-mode-ptree)
(λ xs (decode (cons world:ptree-root-node xs) (λ xs (decode (cons world:ptree-root-node xs)
#:xexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))] #:txexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) 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)

@ -1,11 +1,11 @@
#lang racket/base #lang racket/base
(require racket/path racket/bool) (require racket/path racket/bool xml)
(require "tools.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt") (require "tools.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt")
(define+provide (pnode? x) (define+provide (pnode? x)
(->boolean (try (not (whitespace? (->string x))) (->boolean (and (xexpr? x) (try (not (whitespace/nbsp? (->string x)))
(except [exn:fail? (λ(e) #f)])))) (except [exn:fail? (λ(e) #f)])))))
(define+provide/contract (pnode?/error x) (define+provide/contract (pnode?/error x)
@ -14,23 +14,14 @@
(define+provide (ptree? x) (define+provide (ptree? x)
(->boolean (and (txexpr? x) (andmap (λ(i) (or (pnode? i) (ptree? i))) x)))) (->boolean (and (txexpr? x)
(andmap (λ(i) (or (pnode? i) (ptree? i))) x)
(members-unique? (ptree->list x)))))
(define+provide/contract (file->ptree p)
(pathish? . -> . ptree?)
(cached-require (->path p) world:main-pollen-export))
(define+provide/contract (directory->ptree dir)
(directory-pathish? . -> . ptree?)
(let ([files (map remove-ext (filter (λ(x) (has-ext? x world:markup-source-ext)) (directory-list dir)))])
(ptree-root->ptree (cons world:ptree-root-node files))))
;; Try loading from ptree file, or failing that, synthesize ptree. ;; Try loading from ptree file, or failing that, synthesize ptree.
(define+provide/contract (make-project-ptree project-dir) (define+provide/contract (make-project-ptree project-dir)
(directory-pathish? . -> . ptree?) (pathish? . -> . ptree?)
(define ptree-source (build-path project-dir world:default-ptree)) (define ptree-source (build-path project-dir world:default-ptree))
(cached-require ptree-source world:main-pollen-export)) (cached-require ptree-source world:main-pollen-export))
@ -127,10 +118,10 @@
(define+provide/contract (ptree-source-decode . elements) (define+provide/contract (ptree-source-decode . elements)
(() #:rest pnodes-unique?/error . ->* . ptree?) (() #:rest pnodes-unique?/error . ->* . ptree?)
(ptree-root->ptree (decode (cons world:ptree-root-node elements) (ptree-root->ptree (decode (cons world:ptree-root-node elements)
#:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))) #:txexpr-elements-proc (λ(xs) (filter-not whitespace? xs)))))
(define current-ptree (make-parameter `(,world:ptree-root-node))) (define current-ptree (make-parameter #f))
(define current-url-context (make-parameter (world:current-project-root))) (define current-url-context (make-parameter (world:current-project-root)))
(provide current-ptree current-url-context) (provide current-ptree current-url-context)

@ -44,8 +44,8 @@ For instance, here's how @racket[decode] is attached to @racket['root] in @itali
@codeblock|{ @codeblock|{
(define (root . items) (define (root . items)
(decode (make-txexpr 'root null items) (decode (make-txexpr 'root null items)
#:xexpr-elements-proc detect-paragraphs #:txexpr-elements-proc detect-paragraphs
#:block-xexpr-proc #:block-txexpr-proc
(λ(bx) (wrap-hanging-quotes (nonbreaking-last-space bx))) (λ(bx) (wrap-hanging-quotes (nonbreaking-last-space bx)))
#:string-proc (compose1 smart-quotes smart-dashes)))}| #:string-proc (compose1 smart-quotes smart-dashes)))}|
@ -213,7 +213,7 @@ A predicate that returns @racket[#t] for any stringlike @racket[_v] that's entir
(whitespace? (string->symbol "\n\n ")) (whitespace? (string->symbol "\n\n "))
(whitespace? "") (whitespace? "")
(whitespace? '("" " " "\n\n\n" " \n")) (whitespace? '("" " " "\n\n\n" " \n"))
(define nonbreaking-space (format "~a" #\u00AD)) (define nonbreaking-space (format "~a" #\u00A0))
(whitespace? nonbreaking-space) (whitespace? nonbreaking-space)
] ]
@ -229,7 +229,7 @@ Like @racket[whitespace?], but also returns @racket[#t] for nonbreaking spaces.
(whitespace/nbsp? (string->symbol "\n\n ")) (whitespace/nbsp? (string->symbol "\n\n "))
(whitespace/nbsp? "") (whitespace/nbsp? "")
(whitespace/nbsp? '("" " " "\n\n\n" " \n")) (whitespace/nbsp? '("" " " "\n\n\n" " \n"))
(define nonbreaking-space (format "~a" #\u00AD)) (define nonbreaking-space (format "~a" #\u00A0))
(whitespace/nbsp? nonbreaking-space) (whitespace/nbsp? nonbreaking-space)
] ]

@ -156,7 +156,7 @@ path?]
[p pathish?]) [p pathish?])
path?] path?]
)] )]
Convert an output path @racket[_p] into the source path of the specified type that would produce this output path. Does not generate this source file nor verify that it exists. Convert an output path @racket[_p] into the source path of the specified type that would produce this output path. This function simply generates a path for a file — it does not ask whether the file exists.
@examples[#:eval my-eval @examples[#:eval my-eval
(define name "default.html") (define name "default.html")
@ -174,4 +174,11 @@ Convert an output path @racket[_p] into the source path of the specified type th
(->output-path (->output-path
[p pathish?]) [p pathish?])
path?] path?]
Convert a source path @racket[_p] into its corresponding output path. Convert a source path @racket[_p] into its corresponding output path. This function simply generates a path for a file — it does not ask whether the file exists.
@examples[#:eval my-eval
(->output-path "main.css.pp")
(->output-path "default.html.pm")
(->output-path "index.html.p")
(->output-path "file.scrbl")
]

@ -1,6 +1,6 @@
#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)) @(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/ptree txexpr sugar pollen/decode xml))
@(define my-eval (make-base-eval)) @(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/ptree)) @(my-eval `(require pollen pollen/ptree))
@ -9,21 +9,42 @@
@defmodule[pollen/ptree] @defmodule[pollen/ptree]
A @italic{ptree} — short for @italic{Pollen tree} — is a hierchical 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{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.
Books and other long documents are usually organized in a structured format at minimum they have a sequence of pages, but more often they have hierarchical sections with subsequences within. Individual Pollen source files don't know anything about how they're connected to other files. (Well, you could maintain this information within each source file, but this would be a poor use of human energy.) 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.
@defproc[ @defproc[
(ptree? (ptree?
[v any/c]) [v any/c])
boolean?] boolean?]
Test whether @racket[_v] is a valid ptree. A valid ptree is a @racket[txexpr?] whose elements are either @racket[pnode?] or @racket[ptree?]. Also, all the pnodes in a ptree must be unique. Test whether @racket[_v] is a valid ptree: a @racket[txexpr?] whose elements are either @racket[pnode?] or @racket[ptree?]. Also, all the pnodes in a ptree must be unique. The root node is ignored.
@examples[#:eval my-eval @examples[#:eval my-eval
(ptree? '(index.html)) (ptree? '(root index.html))
(ptree? '(index.html index.html)) (ptree? '(root index.html index.html))
(define nested-pt '(1.html 2.html (3.html 3a.html 3b.html))) (define nested-pt '(root 1.html 2.html (3.html 3a.html 3b.html)))
(ptree? nested-pt) (ptree? nested-pt)
(ptree? `(index.html ,nested-pt (subsection.html more.html))) (ptree? `(root index.html ,nested-pt (subsection.html more.html)))
(ptree? `(index.html ,nested-pt (subsection.html more.html) ,nested-pt)) (ptree? `(root index.html ,nested-pt (subsection.html ,nested-pt)))
] ]
@defproc[
(pnode?
[v any/c])
boolean?]
Test whether @racket[_v] is a valid pnode. Every leaf of a ptree is a pnode. A pnode can be any @racket[stringish?] value that is both an @racket[xexpr?] and not @racket[whitespace/nbsp?] In practice, your pnodes will likely be names of output files.
@examples[#:eval my-eval
(map pnode? (list 'symbol "string" "index.html" "\n\n ah! \n\n"))
(map pnode? (list 9.999 (string->path "index.html") '(p "Hello") "\n\n"))
]
@defparam[current-ptree ptree ptree?
#:value #f]{
A parameter that defines the default ptree used by ptree navigation functions if another is not explicitly specified.}
@defparam[current-url-context dir path?
#:value world:current-project-root]{
A parameter that defines the default directory used to resolve @racket[pnode->url]. Initialized to the root directory of the current project.}

@ -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") (require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "ptree.rkt" "cache.rkt")
(module+ test (require rackunit)) (module+ test (require rackunit))
@ -201,7 +201,7 @@
(append (sort-names subdirectories) (sort-names ptree-sources) (sort-names other-files))) (append (sort-names subdirectories) (sort-names ptree-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 (file->ptree dashfile))) (map ->path (ptree->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

@ -16,11 +16,6 @@
(check-true (pathish? "/Users/MB/home")) (check-true (pathish? "/Users/MB/home"))
(check-true (pathish? (->symbol "/Users/MB/home")))) (check-true (pathish? (->symbol "/Users/MB/home"))))
(module+ test
(check-true (directory-pathish? "/Users/"))
(check-false (directory-pathish? "foobarzooblish")))
(module+ test (module+ test
(check-true (directories-equal? "/Users/MB/foo" "/Users/MB/foo/")) (check-true (directories-equal? "/Users/MB/foo" "/Users/MB/foo/"))
(check-false (directories-equal? "/Users/MB/foo" "Users/MB/foo"))) (check-false (directories-equal? "/Users/MB/foo" "Users/MB/foo")))

@ -15,6 +15,7 @@
(check-true (ptree? '(foo))) (check-true (ptree? '(foo)))
(check-true (ptree? '(foo (hee)))) (check-true (ptree? '(foo (hee))))
(check-true (ptree? '(foo (hee (uncle "foo"))))) (check-true (ptree? '(foo (hee (uncle "foo")))))
(check-false (ptree? '(foo (hee hee (uncle "foo")))))
(define test-ptree-main `(ptree-main "foo" "bar" (one (two "three")))) (define test-ptree-main `(ptree-main "foo" "bar" (one (two "three"))))

Loading…
Cancel
Save