diff --git a/decode.rkt b/decode.rkt index 7b1c4ac..f6c54da 100644 --- a/decode.rkt +++ b/decode.rkt @@ -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
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) diff --git a/scribblings/command.scrbl b/scribblings/command.scrbl index 4b8bbfe..f5251af 100644 --- a/scribblings/command.scrbl +++ b/scribblings/command.scrbl @@ -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: diff --git a/scribblings/decode.scrbl b/scribblings/decode.scrbl index 6acab7e..fc18d32 100644 --- a/scribblings/decode.scrbl +++ b/scribblings/decode.scrbl @@ -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. diff --git a/scribblings/pagetree.scrbl b/scribblings/pagetree.scrbl index 0a6ec82..3b7a9bd 100644 --- a/scribblings/pagetree.scrbl +++ b/scribblings/pagetree.scrbl @@ -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?]). \ No newline at end of file +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?]). \ No newline at end of file diff --git a/scribblings/pollen.scrbl b/scribblings/pollen.scrbl index a364255..6240fed 100644 --- a/scribblings/pollen.scrbl +++ b/scribblings/pollen.scrbl @@ -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"] diff --git a/scribblings/render.scrbl b/scribblings/render.scrbl index 7e8015c..e891191 100644 --- a/scribblings/render.scrbl +++ b/scribblings/render.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. diff --git a/scribblings/world.scrbl b/scribblings/world.scrbl index 946f555..cda9a02 100644 --- a/scribblings/world.scrbl +++ b/scribblings/world.scrbl @@ -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[( diff --git a/tests/samples/sample-01.html.pm b/tests/samples/sample-01.html.pm new file mode 100644 index 0000000..3c1b127 --- /dev/null +++ b/tests/samples/sample-01.html.pm @@ -0,0 +1,3 @@ +#lang pollen + +This is sample 01. \ No newline at end of file diff --git a/tests/samples/sample-02.txt.pp b/tests/samples/sample-02.txt.pp new file mode 100644 index 0000000..2d66803 --- /dev/null +++ b/tests/samples/sample-02.txt.pp @@ -0,0 +1,3 @@ +#lang pollen + +This is sample-02. \ No newline at end of file diff --git a/tests/samples/sample-03.txt.p b/tests/samples/sample-03.txt.p new file mode 100644 index 0000000..80c513c --- /dev/null +++ b/tests/samples/sample-03.txt.p @@ -0,0 +1 @@ +This is sample-03. \ No newline at end of file diff --git a/tests/test-file-tools.rkt b/tests/test-file-tools.rkt new file mode 100644 index 0000000..f07c924 --- /dev/null +++ b/tests/test-file-tools.rkt @@ -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")) \ No newline at end of file diff --git a/tests/test-langs.rkt b/tests/test-langs.rkt new file mode 100644 index 0000000..348b867 --- /dev/null +++ b/tests/test-langs.rkt @@ -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)))) + + diff --git a/tests/test-ptree.rkt b/tests/test-ptree.rkt new file mode 100644 index 0000000..1b66746 --- /dev/null +++ b/tests/test-ptree.rkt @@ -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))))) + + + diff --git a/tests/test-render.rkt b/tests/test-render.rkt new file mode 100644 index 0000000..38e684d --- /dev/null +++ b/tests/test-render.rkt @@ -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 + + diff --git a/tests/tests-decode.rkt b/tests/tests-decode.rkt new file mode 100644 index 0000000..81b4ce0 --- /dev/null +++ b/tests/tests-decode.rkt @@ -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 13–20—hob-nobs.") +(check-equal? (smart-quotes "\"Why,\" she could've asked, \"are we in O‘ahu watching 'Mame'?\"") + "“Why,” she could’ve asked, “are we in O‘ahu 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"))) +