pull/9/head
Matthew Butterick 11 years ago
parent 8ba138f904
commit 0cf98de6a1

@ -33,17 +33,17 @@
#:exclude-tags [excluded-tags '()]) #:exclude-tags [excluded-tags '()])
((xexpr/c) ((xexpr/c)
(#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) (#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
#:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) #:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
#:txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?) #:txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?)
#:block-txexpr-proc (block-txexpr? . -> . xexpr?) #:block-txexpr-proc (block-txexpr? . -> . xexpr?)
#:inline-txexpr-proc (txexpr? . -> . xexpr?) #:inline-txexpr-proc (txexpr? . -> . xexpr?)
#:string-proc (string? . -> . xexpr?) #:string-proc (string? . -> . xexpr?)
#:symbol-proc (symbol? . -> . xexpr?) #:symbol-proc (symbol? . -> . xexpr?)
#:valid-char-proc (valid-char? . -> . xexpr?) #:valid-char-proc (valid-char? . -> . xexpr?)
#:cdata-proc (cdata? . -> . xexpr?) #:cdata-proc (cdata? . -> . xexpr?)
#:exclude-tags (listof symbol?) ) . ->* . txexpr?) #:exclude-tags (listof symbol?) ) . ->* . txexpr?)
(let loop ([x txexpr]) (let loop ([x txexpr])
(cond (cond
[(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)]) [(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)])
@ -132,8 +132,9 @@
;; insert nbsp between last two words ;; insert nbsp between last two words
(define+provide/contract (nonbreaking-last-space x #:nbsp [nbsp (->string #\u00A0)] (define+provide/contract (nonbreaking-last-space x #:nbsp [nbsp (->string #\u00A0)]
#:minimum-word-length [minimum-word-length 6]) #:minimum-word-length [minimum-word-length 6]
((txexpr?) (#:nbsp string? #:minimum-word-length integer?) . ->* . txexpr?) #:last-word-proc [last-word-proc (λ(x) x)])
((txexpr?) (#:nbsp string? #:minimum-word-length integer? #:last-word-proc procedure?) . ->* . txexpr?)
;; todo: parameterize this, as it will be different for each project ;; todo: parameterize this, as it will be different for each project
(define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs (define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs
@ -149,7 +150,8 @@
; first char of other-chars will be the space, so use cdr ; first char of other-chars will be the space, so use cdr
(string-append (list->string (reverse (cdr other-chars))) (->string nbsp)) (string-append (list->string (reverse (cdr other-chars))) (->string nbsp))
(list->string (reverse other-chars)))) (list->string (reverse other-chars))))
`(,front-chars (span [[pollen "no-hyphens"]] ,(list->string (reverse last-word-chars))))) (define last-word (list->string (reverse last-word-chars)))
`(,front-chars ,(last-word-proc last-word))) ; don't concatenate last word bc last-word-proc might be a txexpr wrapper
(list str))) (list str)))
(define (find-last-word-space x) ; recursively traverse xexpr (define (find-last-word-space x) ; recursively traverse xexpr
@ -213,8 +215,8 @@
;; turn the right items into <br> tags ;; turn the right items into <br> tags
(define+provide/contract (detect-linebreaks xc (define+provide/contract (detect-linebreaks xc
#:separator [newline world:linebreak-separator] #:separator [newline world:linebreak-separator]
#:insert [linebreak '(br)]) #:insert [linebreak '(br)])
((txexpr-elements?) (#:separator string? #:insert xexpr?) . ->* . txexpr-elements?) ((txexpr-elements?) (#:separator string? #:insert xexpr?) . ->* . txexpr-elements?)
;; todo: should this test be not block + not whitespace? ;; todo: should this test be not block + not whitespace?
(define not-block? (λ(i) (not (block-txexpr? i)))) (define not-block? (λ(i) (not (block-txexpr? i))))
@ -295,7 +297,7 @@
#:separator [sep world:paragraph-separator] #:separator [sep world:paragraph-separator]
#:linebreak-proc [linebreak-proc detect-linebreaks]) #:linebreak-proc [linebreak-proc detect-linebreaks])
((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?)) ((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?))
. ->* . txexpr-elements?) . ->* . txexpr-elements?)
;; prepare elements for paragraph testing ;; prepare elements for paragraph testing
(define (prep-paragraph-flow xc) (define (prep-paragraph-flow xc)

@ -572,7 +572,7 @@ I agree.}
@racketoutput{@literal{'(div "Roomy!" "\n" "\n" "I agree.")}} @racketoutput{@literal{'(div "Roomy!" "\n" "\n" "I agree.")}}
For the long version, please see @secref{Spaces, Newlines, and Indentation}. For the long version, please see [future link: Spaces, Newlines, and Indentation].
Third, within a multiline text argument, newline characters become individual strings that are not merged with adjacent text. So what you end up with is a list of strings, not a single string. That's why in the last example, we got this: Third, within a multiline text argument, newline characters become individual strings that are not merged with adjacent text. So what you end up with is a list of strings, not a single string. That's why in the last example, we got this:

@ -41,17 +41,11 @@ Recursively process a @racket[_tagged-xexpr], usually the one exported from a Po
This function doesn't do much on its own. Rather, it provides the hooks upon which harder-working functions can be hung. This function doesn't do much on its own. Rather, it provides the hooks upon which harder-working functions can be hung.
Recall from @secref{Pollen mechanics} that any tag can have a function attached to it. By default, the @racket[_tagged-xexpr] from a source file is tagged with @racket[root]. So the typical way to use @racket[decode] is to attach your decoding functions to it, and then define @racket[root] to invoke your @racket[decode] function. Then it will be automatically applied to every @racket[doc] during compile. Recall from [future link: Pollen mechanics] that any tag can have a function attached to it. By default, the @racket[_tagged-xexpr] from a source file is tagged with @racket[root]. So the typical way to use @racket[decode] is to attach your decoding functions to it, and then define @racket[root] to invoke your @racket[decode] function. Then it will be automatically applied to every @racket[doc] during compile.
For instance, here's how @racket[decode] is attached to @racket[root] in @italic{Butterick's Practical Typography}. There's not much to it — For instance, here's how @racket[decode] is attached to @racket[root] in @italic{Butterick's Practical Typography}. There's not much to it —
@codeblock|{ [update with actual code]
(define (root . items)
(decode (make-txexpr 'root null items)
#:txexpr-elements-proc detect-paragraphs
#:block-txexpr-proc
(λ(bx) (wrap-hanging-quotes (nonbreaking-last-space bx)))
#:string-proc (compose1 smart-quotes smart-dashes)))}|
This illustrates another important point: even though @racket[decode] presents an imposing list of arguments, you're unlikely to use all of them at once. These represent possibilities, not requirements. For instance, let's see what happens when @racket[decode] is invoked without any of its optional arguments. This illustrates another important point: even though @racket[decode] presents an imposing list of arguments, you're unlikely to use all of them at once. These represent possibilities, not requirements. For instance, let's see what happens when @racket[decode] is invoked without any of its optional arguments.

@ -213,4 +213,4 @@ Report whether @racket[_pagenode] is in @racket[_pagetree].
[p pathish?]) [p pathish?])
pagenode? pagenode?
] ]
Convert path @racket[_p] to a pagenode — 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 pagenode actually exists in the current pagetree (for that, use @racket[in-pagetree?]). Convert path @racket[_p] to a pagenode — meaning, make it relative to @racket[current-project-root], run it through @racket[->output-path], and convert it to a symbol. Does not tell you whether the resultant pagenode actually exists in the current pagetree (for that, use @racket[in-pagetree?]).

@ -56,22 +56,22 @@ After that, you can update the package from the command line:
@section{Source formats} @section{Source formats}
@defmodulelang[pollen] [pollen]
This puts Pollen into automatic mode, where the source file is interpreted according to the file extension. This puts Pollen into automatic mode, where the source file is interpreted according to the file extension.
If the file extension is ``@(format ".~a" world:markup-source-ext)'', the source is interpreted as @racket[pollen/markup]. If the file extension is ``@(format ".~a" world:markup-source-ext)'', the source is interpreted as [pollen/markup].
If the file extension is ``@(format ".~a" world:preproc-source-ext)'', the source is interpreted as @racket[pollen/pre] (``pre'' stands for ``preprocessor''). If the file extension is ``@(format ".~a" world:preproc-source-ext)'', the source is interpreted as [pollen/pre] (``pre'' stands for ``preprocessor'').
If the file extension is ``@(format ".~a" world:markdown-source-ext)'', the source is interpreted as @racket[pollen/markdown]. If the file extension is ``@(format ".~a" world:markdown-source-ext)'', the source is interpreted as [pollen/markdown].
@defmodulelang[pollen/markup] [pollen/markup]
@defmodulelang[pollen/pre] [pollen/pre]
@defmodulelang[pollen/markdown] [pollen/markdown]
@include-section["command.scrbl"] @include-section["command.scrbl"]

@ -18,9 +18,9 @@
bytes?] bytes?]
Renders @racket[_source-path]. The rendering behavior depends on the type of source file: Renders @racket[_source-path]. The rendering behavior depends on the type of source file:
A @racketmodname[pollen/pre] file is rendered without a template. A [pollen/pre] file is rendered without a template.
A @racketmodname[pollen/markup] or @racketmodname[pollen/markdown] file is rendered with a template. If no template is provided with @racket[_template-path], Pollen finds one using @racket[get-template-for]. A [pollen/markup] or [pollen/markdown] file is rendered with a template. If no template is provided with @racket[_template-path], Pollen finds one using @racket[get-template-for].
Be aware that rendering with a template uses @racket[include-template] within @racket[eval]. For complex pages, it can be slow the first time. Caching is used to make subsequent requests faster. Be aware that rendering with a template uses @racket[include-template] within @racket[eval]. For complex pages, it can be slow the first time. Caching is used to make subsequent requests faster.

@ -31,7 +31,7 @@ Name of directory where server support files live.
@defparam[world:current-server-extras-path dir path? @defparam[world:current-server-extras-path dir path?
#:value #f]{ #:value #f]{
A parameter that reports the path to the directory of support files for the development server. Initialized to @racket[#f], but set to a proper value when @racketmodname[pollen/server] runs.} A parameter that reports the path to the directory of support files for the project server. Initialized to @racket[#f], but set to a proper value when the server runs.}
@deftogether[( @deftogether[(

@ -0,0 +1,3 @@
#lang pollen
This is sample 01.

@ -0,0 +1,3 @@
#lang pollen
This is sample-02.

@ -0,0 +1 @@
This is sample-03.

@ -0,0 +1,91 @@
#lang racket/base
(require rackunit "../file.rkt" "../world.rkt" sugar)
(check-true (sourceish? "foo.svg"))
(check-false (sourceish? "foo.gif"))
(check-true (urlish? (->path "/Users/MB/home.html")))
(check-true (urlish? "/Users/MB/home.html?foo=bar"))
(check-true (urlish? (->symbol "/Users/MB/home")))
(check-true (pathish? (->path "/Users/MB/home")))
(check-true (pathish? "/Users/MB/home"))
(check-true (pathish? (->symbol "/Users/MB/home")))
(check-true (directories-equal? "/Users/MB/foo" "/Users/MB/foo/"))
(check-false (directories-equal? "/Users/MB/foo" "Users/MB/foo"))
(check-equal? (get-enclosing-dir "/Users/MB/foo.txt") (->path "/Users/MB/"))
(check-equal? (get-enclosing-dir "/Users/MB/foo/") (->path "/Users/MB/"))
(check-true (has-binary-ext? "foo.MP3"))
(check-false (has-binary-ext? "foo.py"))
(define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt"))
(define-values (foo-path foo.txt-path foo.bar-path foo.bar.txt-path)
(apply values (map ->path foo-path-strings)))
;; test the sample paths before using them for other tests
(define foo-paths (list foo-path foo.txt-path foo.bar-path foo.bar.txt-path))
(for-each check-equal? (map ->string foo-paths) foo-path-strings)
(check-false (has-ext? foo-path 'txt))
(check-true (foo.txt-path . has-ext? . 'txt))
(check-true ((->path "foo.TXT") . has-ext? . 'txt))
(check-true (has-ext? foo.bar.txt-path 'txt))
(check-false (foo.bar.txt-path . has-ext? . 'doc)) ; wrong extension
(check-equal? (get-ext (->path "foo.txt")) "txt")
(check-false (get-ext "foo"))
(check-equal? (add-ext (string->path "foo") "txt") (string->path "foo.txt"))
(check-equal? (remove-ext foo-path) foo-path)
(check-equal? (remove-ext (->path ".foo.txt")) (->path ".foo.txt"))
(check-equal? (remove-ext foo.txt-path) foo-path)
(check-equal? (remove-ext foo.bar.txt-path) foo.bar-path)
(check-not-equal? (remove-ext foo.bar.txt-path) foo-path) ; does not remove all extensions
(check-equal? (remove-all-ext foo-path) foo-path)
(check-equal? (remove-all-ext foo.txt-path) foo-path)
(check-equal? (remove-all-ext (->path ".foo.txt")) (->path ".foo.txt"))
(check-not-equal? (remove-all-ext foo.bar.txt-path) foo.bar-path) ; removes more than one ext
(check-equal? (remove-all-ext foo.bar.txt-path) foo-path)
(check-true (preproc-source? "foo.pp"))
(check-false (preproc-source? "foo.bar"))
(check-false (preproc-source? #f))
(check-true (pagetree-source? (format "foo.~a" world:pagetree-source-ext)))
(check-false (pagetree-source? (format "~a.foo" world:pagetree-source-ext)))
(check-false (pagetree-source? #f))
(check-true (markup-source? "foo.pm"))
(check-false (markup-source? "foo.p"))
(check-false (markup-source? #f))
(check-true (template-source? "foo.html.pt"))
(check-false (template-source? "foo.html"))
(check-false (template-source? #f))
(check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp"))
(check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.pp"))
(check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
(check-equal? (->preproc-source-path 'foo) (->path "foo.pp"))
(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"))
(check-equal? (->output-path "foo.xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo.barml.p) (->path "foo.barml"))
(check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm"))
(check-equal? (->markup-source-path (->path "foo.html")) (->path "foo.html.pm"))
(check-equal? (->markup-source-path "foo") (->path "foo.pm"))
(check-equal? (->markup-source-path 'foo) (->path "foo.pm"))

@ -0,0 +1,34 @@
#lang racket/base
(require rackunit)
(module test-default pollen
"hello world")
(require (prefix-in default: 'test-default))
(check-equal? default:doc "hello world")
(module test-pre pollen/pre
"hello world")
(require (prefix-in pre: 'test-pre))
(check-equal? pre:doc "hello world")
(module test-markup pollen/markup
"hello world")
(require (prefix-in markup: 'test-markup))
(check-equal? markup:doc '(root "hello world"))
(module test-markdown pollen/markdown
"hello world")
(require (prefix-in markdown: 'test-markdown))
(check-equal? markdown:doc '(root (p () "hello world")))
(module test-ptree pollen/ptree
'(index (brother sister)))
(require (prefix-in ptree: 'test-ptree))
(check-equal? ptree:doc '(pagetree-root (index (brother sister))))

@ -0,0 +1,61 @@
#lang racket/base
(require rackunit)
(require "../pagetree.rkt" "../world.rkt")
(check-false (pagenode? "foo-bar"))
(check-false (pagenode? "Foo_Bar_0123"))
(check-true (pagenode? 'foo-bar))
(check-false (pagenode? "foo-bar.p"))
(check-false (pagenode? "/Users/MB/foo-bar"))
(check-false (pagenode? #f))
(check-false (pagenode? ""))
(check-false (pagenode? " "))
(check-true (pagetree? '(foo)))
(check-true (pagetree? '(foo (hee))))
(check-true (pagetree? '(foo (hee (uncle foo)))))
(check-false (pagetree? '(foo (hee hee (uncle foo)))))
(define test-pagetree `(pagetree-main foo bar (one (two three))))
;(define test-pagetree (pagetree-root->pagetree test-pagetree-main))
(check-equal? (parent 'three test-pagetree) 'two)
(check-equal? (parent "three" test-pagetree) 'two)
(check-false (parent #f test-pagetree))
(check-false (parent 'nonexistent-name test-pagetree))
(check-equal? (children 'one test-pagetree) '(two))
(check-equal? (children 'two test-pagetree) '(three))
(check-false (children 'three test-pagetree))
(check-false (children #f test-pagetree))
(check-false (children 'fooburger test-pagetree))
(check-equal? (siblings 'one test-pagetree) '(foo bar one))
(check-equal? (siblings 'foo test-pagetree) '(foo bar one))
(check-equal? (siblings 'two test-pagetree) '(two))
(check-false (siblings #f test-pagetree))
(check-false (siblings 'invalid-key test-pagetree))
(check-equal? (previous* 'one test-pagetree) '(foo bar))
(check-equal? (previous* 'three test-pagetree) '(foo bar one two))
(check-false (previous* 'foo test-pagetree))
(check-equal? (previous 'one test-pagetree) 'bar)
(check-equal? (previous 'three test-pagetree) 'two)
(check-false (previous 'foo test-pagetree))
(check-equal? (next 'foo test-pagetree) 'bar)
(check-equal? (next 'one test-pagetree) 'two)
(check-false (next 'three test-pagetree))
(check-equal? (pagetree->list test-pagetree) '(foo bar one two three))
(let ([sample-main `(world:pollen-tree-root-name foo bar (one (two three)))])
(check-equal? sample-main
`(world:pollen-tree-root-name foo bar (one (two three)))))

@ -0,0 +1,24 @@
#lang racket/base
(require rackunit)
(require "../render.rkt")
(require/expose "../render.rkt" (modification-date-hash make-mod-dates-key path->mod-date-value store-render-in-modification-dates modification-date-expired?))
(check-pred hash? modification-date-hash)
(define sample-dir (string->path "samples"))
(define samples (parameterize ([current-directory sample-dir])
(map path->complete-path (directory-list "."))))
(define-values (sample-01 sample-02 sample-03) (apply values samples))
(check-equal? (make-mod-dates-key samples) samples)
(check-false (path->mod-date-value (path->complete-path "garbage-path.zzz")))
(check-equal? (path->mod-date-value sample-01) (file-or-directory-modify-seconds sample-01))
(check-equal? (store-render-in-modification-dates sample-01 sample-02 sample-03) (void))
(check-true (hash-has-key? modification-date-hash (list sample-01 sample-02 sample-03)))
(check-true (modification-date-expired? sample-01)) ; because key hasn't been stored
(check-false (apply modification-date-expired? samples)) ; because files weren't changed

@ -0,0 +1,43 @@
#lang racket/base
(require pollen/decode rackunit txexpr)
(check-true (begin (register-block-tag 'barfoo) (block-txexpr? '(barfoo "foo"))))
(check-equal? (smart-dashes "I had --- maybe 13 -- 20 --- hob-nobs.") "I had—maybe 1320—hob-nobs.")
(check-equal? (smart-quotes "\"Why,\" she could've asked, \"are we in Oahu watching 'Mame'?\"")
"“Why,” she couldve asked, “are we in Oahu watching Mame?”")
;; todo: make some tougher tests, it gets flaky with edge cases
(check-equal? (nonbreaking-last-space '(p "Hi there")) '(p "Hi " "there")) ; nbsp in between last two words
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "Ø") '(p "HiØ" "there")) ; but let's make it visible
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_") '(p "Hi_up_" "there"))
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_" #:minimum-word-length 3)
'(p "Hi " "there"))
(check-equal? (nonbreaking-last-space '(p "Hi here" (em "ho there")) #:nbsp "Ø") '(p "Hi here" (em "hoØ" "there")))
(check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (dquo "" "Hi\" there")))
(check-equal? (wrap-hanging-quotes '(p "'Hi' there")) '(p (squo "" "Hi' there")))
(check-equal? (wrap-hanging-quotes '(p "'Hi' there") #:single-prepend '(foo ((bar "ino"))))
'(p (foo ((bar "ino")) "" "Hi' there")))
;; make sure txexpr without elements passes through unscathed
(check-equal? (wrap-hanging-quotes '(div ((style "height:2em")))) '(div ((style "height:2em"))))
(check-equal? (detect-linebreaks '("foo" "\n" "bar")) '("foo" (br) "bar"))
(check-equal? (detect-linebreaks '("\n" "foo" "\n" "bar" "\n")) '("\n" "foo" (br) "bar" "\n"))
(check-equal? (detect-linebreaks '((p "foo") "\n" (p "bar"))) '((p "foo") (p "bar")))
(check-equal? (detect-linebreaks '("foo" "\n" (p "bar"))) '("foo" (p "bar")))
(check-equal? (detect-linebreaks '("foo" "moo" "bar")) '("foo" "moo" "bar"))
(check-equal? (detect-linebreaks '("foo" "moo" "bar") #:insert "moo") '("foo" "moo" "bar"))
(check-equal? (detect-linebreaks '("foo" "\n\n" "bar")) '("foo" "\n\n" "bar"))
(check-equal? (merge-newlines '(p "\n" "foo" "\n" "\n" "bar" (em "\n" "\n" "\n")))
'(p "\n" "foo" "\n\n" "bar" (em "\n\n\n")))
Loading…
Cancel
Save