updates

decode.rkt

@@ -33,15 +33,15 @@
                                  #:exclude-tags [excluded-tags '()])
   ((xexpr/c)  
    (#: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])
@@ -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])
+                                                 #: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
   (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]
+                                            #:separator [newline world:linebreak-separator]
-                                             #:insert [linebreak '(br)])
+                                            #: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)

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:

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|{
+[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.
 

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?]).
+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?]).

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"]
 

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.
 

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[(

tests/samples/sample-01.html.pm

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

tests/samples/sample-02.txt.pp

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

tests/samples/sample-03.txt.p

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

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"))

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))))
+
+

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)))))
+
+
+

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

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")))
+