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

@ -33,17 +33,17 @@
#:exclude-tags [excluded-tags '()])
((xexpr/c)
(#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
#:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
#:txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?)
#:block-txexpr-proc (block-txexpr? . -> . xexpr?)
#:inline-txexpr-proc (txexpr? . -> . xexpr?)
#:string-proc (string? . -> . xexpr?)
#:symbol-proc (symbol? . -> . xexpr?)
#:valid-char-proc (valid-char? . -> . xexpr?)
#:cdata-proc (cdata? . -> . xexpr?)
#:exclude-tags (listof symbol?) ) . ->* . txexpr?)
#:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
#:txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?)
#:block-txexpr-proc (block-txexpr? . -> . xexpr?)
#:inline-txexpr-proc (txexpr? . -> . xexpr?)
#:string-proc (string? . -> . xexpr?)
#:symbol-proc (symbol? . -> . xexpr?)
#:valid-char-proc (valid-char? . -> . xexpr?)
#:cdata-proc (cdata? . -> . xexpr?)
#:exclude-tags (listof symbol?) ) . ->* . txexpr?)
(let loop ([x txexpr])
(cond
[(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)])
@ -132,8 +132,9 @@
;; insert nbsp between last two words
(define+provide/contract (nonbreaking-last-space x #:nbsp [nbsp (->string #\u00A0)]
#:minimum-word-length [minimum-word-length 6])
((txexpr?) (#:nbsp string? #:minimum-word-length integer?) . ->* . txexpr?)
#:minimum-word-length [minimum-word-length 6]
#: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
(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
(string-append (list->string (reverse (cdr other-chars))) (->string nbsp))
(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)))
(define (find-last-word-space x) ; recursively traverse xexpr
@ -213,8 +215,8 @@
;; turn the right items into <br> tags
(define+provide/contract (detect-linebreaks xc
#:separator [newline world:linebreak-separator]
#:insert [linebreak '(br)])
#:separator [newline world:linebreak-separator]
#:insert [linebreak '(br)])
((txexpr-elements?) (#:separator string? #:insert xexpr?) . ->* . txexpr-elements?)
;; todo: should this test be not block + not whitespace?
(define not-block? (λ(i) (not (block-txexpr? i))))
@ -295,7 +297,7 @@
#:separator [sep world:paragraph-separator]
#:linebreak-proc [linebreak-proc detect-linebreaks])
((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?))
. ->* . txexpr-elements?)
. ->* . txexpr-elements?)
;; prepare elements for paragraph testing
(define (prep-paragraph-flow xc)

@ -572,7 +572,7 @@ 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:

@ -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.
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 —
@codeblock|{
(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)))}|
[update with actual code]
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?])
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}
@defmodulelang[pollen]
[pollen]
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"]

@ -18,9 +18,9 @@
bytes?]
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.

@ -31,7 +31,7 @@ Name of directory where server support files live.
@defparam[world:current-server-extras-path dir path?
#: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[(

@ -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