pull/9/head
Matthew Butterick 11 years ago
commit d4b9642b34

13
.gitignore vendored

@ -1,9 +1,5 @@
# for Racket # for Racket
**/compiled/ compiled/
doc/*
*.dep
*.zo
# for Mac OS X # for Mac OS X
.DS_Store .DS_Store
@ -17,3 +13,10 @@ Icon
# Files that might appear on external disk # Files that might appear on external disk
.Spotlight-V100 .Spotlight-V100
.Trashes .Trashes
# generated documentation
pollen/doc/*
pollen/scribblings/*.js
pollen/scribblings/*.css
pollen/scribblings/*.html
pollen/scribblings/pollen/*

@ -0,0 +1,165 @@
GNU LESSER GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
This version of the GNU Lesser General Public License incorporates
the terms and conditions of version 3 of the GNU General Public
License, supplemented by the additional permissions listed below.
0. Additional Definitions.
As used herein, "this License" refers to version 3 of the GNU Lesser
General Public License, and the "GNU GPL" refers to version 3 of the GNU
General Public License.
"The Library" refers to a covered work governed by this License,
other than an Application or a Combined Work as defined below.
An "Application" is any work that makes use of an interface provided
by the Library, but which is not otherwise based on the Library.
Defining a subclass of a class defined by the Library is deemed a mode
of using an interface provided by the Library.
A "Combined Work" is a work produced by combining or linking an
Application with the Library. The particular version of the Library
with which the Combined Work was made is also called the "Linked
Version".
The "Minimal Corresponding Source" for a Combined Work means the
Corresponding Source for the Combined Work, excluding any source code
for portions of the Combined Work that, considered in isolation, are
based on the Application, and not on the Linked Version.
The "Corresponding Application Code" for a Combined Work means the
object code and/or source code for the Application, including any data
and utility programs needed for reproducing the Combined Work from the
Application, but excluding the System Libraries of the Combined Work.
1. Exception to Section 3 of the GNU GPL.
You may convey a covered work under sections 3 and 4 of this License
without being bound by section 3 of the GNU GPL.
2. Conveying Modified Versions.
If you modify a copy of the Library, and, in your modifications, a
facility refers to a function or data to be supplied by an Application
that uses the facility (other than as an argument passed when the
facility is invoked), then you may convey a copy of the modified
version:
a) under this License, provided that you make a good faith effort to
ensure that, in the event an Application does not supply the
function or data, the facility still operates, and performs
whatever part of its purpose remains meaningful, or
b) under the GNU GPL, with none of the additional permissions of
this License applicable to that copy.
3. Object Code Incorporating Material from Library Header Files.
The object code form of an Application may incorporate material from
a header file that is part of the Library. You may convey such object
code under terms of your choice, provided that, if the incorporated
material is not limited to numerical parameters, data structure
layouts and accessors, or small macros, inline functions and templates
(ten or fewer lines in length), you do both of the following:
a) Give prominent notice with each copy of the object code that the
Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the object code with a copy of the GNU GPL and this license
document.
4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
a) Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the Combined Work with a copy of the GNU GPL and this license
document.
c) For a Combined Work that displays copyright notices during
execution, include the copyright notice for the Library among
these notices, as well as a reference directing the user to the
copies of the GNU GPL and this license document.
d) Do one of the following:
0) Convey the Minimal Corresponding Source under the terms of this
License, and the Corresponding Application Code in a form
suitable for, and under terms that permit, the user to
recombine or relink the Application with a modified version of
the Linked Version to produce a modified Combined Work, in the
manner specified by section 6 of the GNU GPL for conveying
Corresponding Source.
1) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (a) uses at run time
a copy of the Library already present on the user's computer
system, and (b) will operate properly with a modified version
of the Library that is interface-compatible with the Linked
Version.
e) Provide Installation Information, but only if you would otherwise
be required to provide such information under section 6 of the
GNU GPL, and only to the extent that such information is
necessary to install and execute a modified version of the
Combined Work produced by recombining or relinking the
Application with a modified version of the Linked Version. (If
you use option 4d0, the Installation Information must accompany
the Minimal Corresponding Source and Corresponding Application
Code. If you use option 4d1, you must provide the Installation
Information in the manner specified by section 6 of the GNU GPL
for conveying Corresponding Source.)
5. Combined Libraries.
You may place library facilities that are a work based on the
Library side by side in a single library together with other library
facilities that are not Applications and are not covered by this
License, and convey such a combined library under terms of your
choice, if you do both of the following:
a) Accompany the combined library with a copy of the same work based
on the Library, uncombined with any other library facilities,
conveyed under the terms of this License.
b) Give prominent notice with the combined library that part of it
is a work based on the Library, and explaining where to find the
accompanying uncombined form of the same work.
6. Revised Versions of the GNU Lesser General Public License.
The Free Software Foundation may publish revised and/or new versions
of the GNU Lesser General Public License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the
Library as you received it specifies that a certain numbered version
of the GNU Lesser General Public License "or any later version"
applies to it, you have the option of following the terms and
conditions either of that published version or of any later version
published by the Free Software Foundation. If the Library as you
received it does not specify a version number of the GNU Lesser
General Public License, you may choose any version of the GNU Lesser
General Public License ever published by the Free Software Foundation.
If the Library as you received it specifies that a proxy can decide
whether future versions of the GNU Lesser General Public License shall
apply, that proxy's public statement of acceptance of any version is
permanent authorization for you to choose that version for the
Library.

@ -0,0 +1,4 @@
Pollen
------
A book-publishing system written in Racket.

@ -0,0 +1,49 @@
#lang racket/base
(require racket/rerequire "world.rkt")
;; The cache is a hash with paths as keys.
;; The cache values are also hashes, with key/value pairs for that path.
(provide reset-cache current-cache make-cache cached-require cache-ref)
(define (make-cache) (make-hash))
(define current-cache (make-parameter (make-cache)))
(define (reset-cache) (hash-clear! (current-cache)))
(define (->complete-path path-string)
(path->complete-path (if (string? path-string) (string->path path-string) path-string)))
(define (cache-ref path-string)
(hash-ref (current-cache) (->complete-path path-string)))
(define (cache-has-key? path)
(hash-has-key? (current-cache) path))
(define (cache path)
(dynamic-rerequire path)
(hash-set! (current-cache) path (make-hash))
(define cache-hash (cache-ref path))
(hash-set! cache-hash 'mod-time (file-or-directory-modify-seconds path))
(hash-set! cache-hash world:main-pollen-export (dynamic-require path world:main-pollen-export))
(hash-set! cache-hash world:meta-pollen-export (dynamic-require path world:meta-pollen-export))
(void))
(define (cached-require path-string key)
(when (not (current-cache)) (error "cached-require: No cache set up."))
(define path
(with-handlers ([exn:fail? (λ(exn) (error (format "cached-require: ~a is not a valid path" path-string)))])
(->complete-path path-string)))
(when (not (file-exists? path)) (error (format "cached-require: ~a does not exist" (path->string path))))
(when (or (not (cache-has-key? path))
(> (file-or-directory-modify-seconds path) (hash-ref (cache-ref path) 'mod-time)))
(cache path))
(hash-ref (cache-ref path) key))

@ -1,62 +1,62 @@
#lang racket #lang racket/base
(require pollen/world)
(define-syntax (handle-pollen-command stx) (provide (all-defined-out))
(datum->syntax stx
(let ([arg (if (= (vector-length (current-command-line-arguments)) 0) (define (handle-help)
"" `(displayln (format "Pollen commands:
(vector-ref (current-command-line-arguments) 0))]) help show this message
(case arg start [dir] [port] starts project server in dir (default is current dir)
[("start") (default port is ~a)
`(require (planet mb/pollen/server))] render [dir] render project in dir (default is current dir)
[("regenerate") render path render file
`(begin clone copy project to desktop without source files" ,(world:current-server-port))))
(displayln "Regenerate all...")
(require (planet mb/pollen/regenerate)) (define (handle-render dir-or-path rest-args)
(regenerate-all-files))] `(begin
[("clone") (require pollen/render pollen/world pollen/file sugar)
(let ([target-path (if (> (vector-length (current-command-line-arguments)) 1) (parameterize ([current-directory (world:current-project-root)])
(string->path (vector-ref (current-command-line-arguments) 1)) (define dir-or-path ,dir-or-path)
(build-path (find-system-path 'desk-dir) (string->path "clone")))]) (apply render-batch (map ->complete-path (if (not (directory-exists? dir-or-path))
(begin
`(begin (displayln (format "Rendering ~a" dir-or-path))
(displayln "Clone & bone...") (cons dir-or-path ',rest-args))
(require racket/file) (begin
(require (planet mb/pollen/tools)) (displayln (format "Rendering preproc & pagetree files in directory ~a" dir-or-path))
(apply append (map (λ(proc) (filter proc (directory-list dir-or-path))) (list preproc-source? pagetree-source?))))))))))
(define (pollen-related-file? file)
(any (list
pollen-source? (define (handle-start directory [port #f])
preproc-source? (if (not (directory-exists? directory))
template-source? (error (format "~a is not a directory" directory))
pmap-source? `(begin
pollen-script? (require pollen/server pollen/world)
magic-directory? (parameterize ([world:current-project-root ,directory]
racket-file?) ,@(if port (list `(world:current-server-port ,port)) null))
file)) (start-server)))))
(define (delete-it path)
(when (directory-exists? path) (define (handle-clone directory rest-args)
(delete-directory/files path)) (define target-path (or
(when (file-exists? path) (and rest-args (not (null? rest-args)) (path->complete-path (string->path (car rest-args))))
(delete-file path))) (build-path (find-system-path 'desk-dir) (string->path world:clone-directory-name))))
(let ([source-dir (current-directory)] `(begin
[target-dir ,target-path]) (displayln "Cloning ...")
(when (directory-exists? target-dir) (require racket/file pollen/file)
(delete-directory/files target-dir)) (define (delete-it path)
(copy-directory/files source-dir target-dir) (cond
(map delete-it (find-files pollen-related-file? target-dir)) [(directory-exists? path) (delete-directory/files path)]
(displayln (format "Completed to ~a" ,target-path)) [(file-exists? path) (delete-file path)]))
)))] (define source-dir ,directory)
[("") (when (not (directory-exists? source-dir)) (error (format "clone error: source directory ~a does not exist" source-dir)))
`(displayln "No command given")] (define target-dir ,target-path)
[else (when (directory-exists? target-dir) (delete-directory/files target-dir))
(let ([possible-file (string->path arg)]) (copy-directory/files source-dir target-dir)
(if (file-exists? possible-file) (for-each delete-it (find-files pollen-related-file? target-dir))
`(begin (displayln (format "Completed to ~a" ,target-path))))
(require (planet mb/pollen/regenerate))
(displayln (format "Regenerating ~a" (path->string ,possible-file))) (define (handle-else command)
(regenerate ,possible-file)) `(if (regexp-match #rx"(shit|fuck)" ,command)
`(displayln (format "No command defined for ~a" ,arg))))])))) (displayln (let ([responses '("Cursing at free software? Really?" "How uncouth." "Same to you, buddy.")])
(list-ref responses (random (length responses)))))
(handle-pollen-command) (displayln (format "unknown command ~a" ,command))))

@ -0,0 +1,46 @@
#lang racket/base
(require sugar txexpr racket/list racket/string pollen/world xml html racket/file racket/match css-tools/html)
(define (attrs->pollen attrs)
(string-join (flatten (map (λ(pair) (list (format "'~a:" (car pair)) (format "\"~a\"" (cadr pair)))) attrs)) " "))
(define/contract+provide (xexpr->pollen x #:p-breaks [p-breaks #f])
((xexpr?) (#:p-breaks boolean?) . ->* . string?)
(let loop ([x x])
(cond
[(and p-breaks (txexpr? x) (equal? (car x) 'p) (apply string-append `("\n" ,@(map ->string (map loop (get-elements x))) "\n")))]
[(txexpr? x) (apply string-append
(map ->string `(,world:command-marker ,(get-tag x)
,@(if (not (null? (get-attrs x))) `("[" ,(attrs->pollen (get-attrs x)) "]") null)
,@(if (not (null? (get-elements x))) `("{" ,@(map loop (get-elements x)) "}" ) null))))]
[(symbol? x) (loop (entity->integer x))]
[(number? x) (format "~a" (integer->char x))]
[else x])))
(define/contract+provide (html->pollen html-string #:p-breaks [p-breaks #f])
((string?) (#:p-breaks boolean?) . ->* . string?)
(use-html-spec #f)
(define xexpr-results
(let loop ([elem (read-html-as-xml (open-input-string html-string))])
(match elem
[(struct pcdata (start stop string)) string]
[(struct entity (start stop entity)) entity]
[(struct attribute (start stop key value)) (list key value)]
[(struct element (start stop name attributes content)) `(,name ,(map loop attributes) ,@(map loop content))]
[(list elements ...) (map loop elements)]
[else (format "unknown item: ~a" elem)])))
; xexpr-results will be a list with whitespace elements, so strip those out
(xexpr->pollen #:p-breaks p-breaks (car (filter-not (λ(x) (and (string? x) (regexp-match #px"\\s+" x))) xexpr-results))))
(module+ main
; (xexpr->pollen '(p "You are puppy"))
; (xexpr->pollen '(p ((class "foo")) "You are puppy"))
; (xexpr->pollen '(p ((class "foo")) "You are" "\n\n" "puppy"))
; (xexpr->pollen '(p ((class "foo")) "You are " (em "so") " puppy"))
; (display (html->pollen #:p-breaks #t (file->string "index.html"))))
)

@ -1,157 +0,0 @@
#lang racket/base
(require racket/string racket/list)
(require (planet mb/pollen/readability))
;;;;;;;;;;;;;;;;;;;;;;;;;;
; CSS Helper functions.
; use these either in CSS style block,
; or inline style.
;;;;;;;;;;;;;;;;;;;;;;;;;
(define css-property-prefixes '("-moz-" "-webkit-" "-o-" "-ms-" ""))
(define (join-css-strings properties)
(define line-ending ";\n")
(define out-string (string-join properties line-ending))
(if (ends-with? out-string line-ending) ; might already have the line ending, so don't duplicate it
out-string
(string-append out-string line-ending)))
(define (make-css-strings property-prefixes property-suffix values)
; general function for creating groups of css properties
; with browser prefixes and one value
(define (map-suffix suffix prefixes)
(map (ƒ(prefix) (string-append prefix suffix)) prefixes))
(define (join-css-prop-and-value p v)
(string-join (list (str p) (str v)) ": "))
(define properties (map-suffix property-suffix property-prefixes))
; if single value provided, convert to list of values
; so that it will work with map in the next step
(when (not (list? values))
(set! values (make-list (len properties) values)))
(map join-css-prop-and-value properties values))
(define (make-css-columns #:count count #:gap [gap #f])
; shorthand for css column declaration
(join-css-strings (append
(make-css-strings css-property-prefixes "column-count" count)
(if gap
(make-css-strings css-property-prefixes "column-gap" gap)
empty))))
(define (make-css-avoid-column-break-inside)
; this gets applied to list items to keep them from breaking across columns
; however it doesn't work in Firefox due to bug; workaround is stupid
(join-css-strings (append
(make-css-strings css-property-prefixes "column-break-inside" "avoid")
(make-css-strings css-property-prefixes "break-inside" "avoid-column"))))
(define (make-css-transition property duration #:timing-function [timing-function #f] #:delay [delay #f])
(define transition-prefixes '("-moz-" "-webkit-" ""))
(join-css-strings (append
(make-css-strings transition-prefixes "transition-property" property)
(make-css-strings transition-prefixes "transition-duration" duration)
(if timing-function
(make-css-strings transition-prefixes "transition-timing-function" timing-function)
empty)
(if delay
(make-css-strings transition-prefixes "transition-delay" delay)
empty))))
(define (make-css-ot-features feature-tags [feature-values 1])
; if single value provided, upconvert to list
(when (not (list? feature-tags))
(set! feature-tags (list feature-tags)))
; same here: convert single value into list
(when (not (list? feature-values))
(let ([single-value feature-values])
(set! feature-values (make-list (len feature-tags) single-value))))
; use single quotes in the formatter because css string might be used in an inline tag
; with form style="[string]" so double quotes are irritating
(define feature-tag-string (string-join (map (ƒ(tag value) (format "'~a' ~a" tag value)) feature-tags feature-values) ", "))
; I hate accommodating old browsers but I'll make an exception because OT support is
; critical to most MB projects
; if this comes before new-style -moz- declaration, it will work for all.
(define feature-tag-string-old-firefox (string-join (map (ƒ(tag value) (format "'~a=~a'" tag value)) feature-tags feature-values) ", "))
(define feature-tag-property "font-feature-settings")
(join-css-strings (append
(make-css-strings '("-moz-") feature-tag-property feature-tag-string-old-firefox)
(make-css-strings css-property-prefixes feature-tag-property feature-tag-string))))
(define (make-css-hyphens [value "auto"])
(join-css-strings (make-css-strings css-property-prefixes "hyphens" value)))
(define (make-css-background-gradient colors [stops #f] #:radial [radial #f] #:horizontal [horizontal #f])
; this doesn't handle old-style webkit syntax. todo: add it? I think I don't care
; check inputs for failure
(when (or (not (list? colors)) (< (len colors) 2))
(error "Not enough colors to make gradient in" colors))
(when (and stops (< (len stops) (len colors)))
(error "Not enough stops for given number of colors in" stops))
(when (not stops) ; distribute colors evenly between 0 and 100
; new-stops is range of steps incremented properly and rounded to int, then append 100 to end
(let ([new-stops `(,@(map int (range 0 100 (/ 100 (sub1 (len colors))))) 100)])
; convert to list of percentages
(set! stops (map (ƒ(x) (format "~a%" x)) new-stops))))
; color / percentage pairs separated by commas
(define color-stop-string (string-join (map (ƒ(color stop) (format "~a ~a" color stop)) colors stops) ", "))
; set up gradient options
(define gradient-type (if radial "radial" "linear"))
(define gradient-direction (if horizontal "left" "top"))
; can't use standard make-css-strings in this case because the prefixes appear in the value,
; not in the property (which is always "background")
(define gradient-strings (map (ƒ(prefix) (format "background: ~a~a-gradient(~a, ~a)" prefix gradient-type gradient-direction color-stop-string)) css-property-prefixes))
; just fill with the last color if gradient not available
(define fallback-string (format "background: ~a" (last colors)))
; put fallback string at front of list
(join-css-strings (cons fallback-string gradient-strings)))
(define (make-css-small-caps)
(join-css-strings (list "text-transform: lowercase" (make-css-ot-features "c2sc"))))
(define (make-css-caps)
(join-css-strings (list "text-transform: uppercase" (make-css-ot-features "case"))))
(define (make-css-kerning)
(join-css-strings (list "text-rendering: optimizeLegibility" (make-css-ot-features "kern"))))
(define (make-css-ligatures)
(join-css-strings (list "text-rendering: optimizeLegibility" (make-css-ot-features "liga"))))
; editability can't be handled as pure css because firefox requires extra content-editable attribute.
; does it still? todo: further research, maybe this can be css only.
(define (editable . stuff)
(define editable-string (make-css-editable))
`(div ((style ,editable-string)(contenteditable "true")) ,@stuff))
(define (make-css-editable)
(join-css-strings (list "user-modify: read-write"
"-moz-user-modify: read-write"
"-webkit-user-modify: read-write-plaintext-only"
"outline-style: none")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide (all-defined-out))

@ -0,0 +1,78 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(require racket/date racket/string)
(require sugar/debug sugar/define)
(provide (all-from-out sugar/debug))
; todo: contracts, tests, docs
; debug utilities
(define months (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
(define last-message-time #f)
(define (seconds-since-last-message)
(define now (current-seconds))
(define then last-message-time)
(set! last-message-time now)
(if then
(- now then)
"0"))
(define (zero-fill str count)
(set! str (format "~a" str))
(if (> (string-length str) count)
str
(string-append (make-string (- count (string-length str)) #\0) str)))
(define+provide (make-datestamp)
(define date (current-date))
(define date-fields (map (λ(x) (zero-fill x 2))
(list
(date-day date)
(list-ref months (sub1 (date-month date)))
(date-year date)
)))
(string-join date-fields "-"))
(define+provide (make-timestamp)
(define date (current-date))
(define time-fields (map (λ(x) (zero-fill x 2))
(list
; (date-day date)
; (list-ref months (sub1 (date-month date)))
(if (<= (date-hour date) 12)
(date-hour date) ; am hours + noon hour
(modulo (date-hour date) 12)) ; pm hours after noon hour
(date-minute date)
(date-second date))))
(string-append (string-join time-fields ":") (if (< (date-hour date) 12) "am" "pm")))
(define (make-debug-timestamp)
(format "[~a ∆~as]" (make-timestamp) (seconds-since-last-message)))
;; creates pollen-logger and associated functions:
;; log-pollen-fatal, log-pollen-error, log-pollen-warning,
;; log-pollen-info, and log-pollen-debug
(define-logger pollen)
(define-syntax (make-message-logger-functions stx)
(syntax-case stx ()
[(_ stem)
(with-syntax ([message-stem (format-id stx "message-~a" #'stem)]
[log-pollen-stem (format-id stx "log-pollen-~a" #'stem)])
#'(begin
;; does file have particular extension
(define+provide (message-stem . items)
(log-pollen-stem (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))))]))
(make-message-logger-functions fatal)
(make-message-logger-functions error)
(make-message-logger-functions warning)
(make-message-logger-functions info)
(make-message-logger-functions debug)
(define+provide (message . items)
(displayln (string-join `(,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))

@ -0,0 +1,320 @@
#lang racket/base
(require xml txexpr sugar racket/match racket/list (prefix-in html: css-tools/html))
(require "debug.rkt" "world.rkt")
(define+provide (to-string x)
(if (string? x)
x ; fast exit for strings
(with-handlers ([exn:fail? (λ(exn) (error (format "Pollen decoder: can't convert ~v to ~a" x 'string)))])
(cond
[(equal? '() x) ""]
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[(path? x) (path->string x)]
[(char? x) (format "~a" x)]
;; todo: guard against weird shit like lists of procedures
[(or (list? x) (hash? x) (vector? x)) (format "~v" x)] ; ok to convert datatypes
[else (error)])))) ; but things like procedures should throw an error
;; decoder wireframe
(define+provide/contract (decode txexpr
#:txexpr-tag-proc [txexpr-tag-proc (λ(x)x)]
#:txexpr-attrs-proc [txexpr-attrs-proc (λ(x)x)]
#:txexpr-elements-proc [txexpr-elements-proc (λ(x)x)]
#:block-txexpr-proc [block-txexpr-proc (λ(x)x)]
#:inline-txexpr-proc [inline-txexpr-proc (λ(x)x)]
#:string-proc [string-proc (λ(x)x)]
#:symbol-proc [symbol-proc (λ(x)x)]
#:valid-char-proc [valid-char-proc (λ(x)x)]
#:cdata-proc [cdata-proc (λ(x)x)]
#: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?)
(let loop ([x txexpr])
(cond
[(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)])
(if (member tag excluded-tags)
x ; because it's excluded
;; we apply processing here rather than do recursive descent on the pieces
;; because if we send them back through loop, certain element types are ambiguous
;; e.g., ((p "foo")) tests out as both txexpr-attrs and txexpr-elements
(let ([decoded-txexpr
(apply make-txexpr (list (txexpr-tag-proc tag)
(txexpr-attrs-proc attrs)
(map loop (txexpr-elements-proc elements))))])
((if (block-txexpr? decoded-txexpr)
block-txexpr-proc
inline-txexpr-proc) decoded-txexpr))))]
[(string? x) (string-proc x)]
[(symbol? x) (symbol-proc x)]
[(valid-char? x) (valid-char-proc x)]
[(cdata? x) (cdata-proc x)]
[else (error "decode: can't decode" x)])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Blocks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; initial set of block tags: from html
(define+provide project-block-tags
(make-parameter html:block-tags))
;; tags are inline unless they're registered as block tags.
(define+provide/contract (block-txexpr? x)
(any/c . -> . boolean?)
(and (txexpr? x) (member (get-tag x) (project-block-tags)) #t))
(define+provide/contract (register-block-tag tag)
(txexpr-tag? . -> . void?)
(project-block-tags (cons tag (project-block-tags))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Typography
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-replacer query+replacement)
(let ([queries (map car query+replacement)]
[replacements (map second query+replacement)])
;; reverse because first in list should be first applied to str (and compose1 works right-to-left)
(apply compose1 (reverse (map (λ(query replacement) (λ(str) (regexp-replace* query str replacement))) queries replacements)))))
(define+provide/contract (smart-dashes str)
(string? . -> . string?)
(define dashes
;; fix em dashes first, else they'll be mistaken for en dashes
;; \\s is whitespace + #\u00A0 is nonbreaking space
'((#px"[\\s#\u00A0]*(---|—)[\\s#\u00A0]*" "") ; em dash
(#px"[\\s#\u00A0]*(--|)[\\s#\u00A0]*" ""))) ; en dash
((make-replacer dashes) str))
(define+provide/contract (smart-quotes str)
(string? . -> . string?)
(define quotes
'((#px"(?<=\\w)'(?=\\w)" "") ; apostrophe
(#px"(?<!\\w)'(?=\\w)" "") ; single_at_beginning
(#px"(?<=\\S)'(?!\\w)" "") ; single_at_end
(#px"(?<!\\w)\"(?=\\w)" "") ; double_at_beginning
(#px"(?<=\\S)\"(?!\\w)" ""))) ; double_at_end
((make-replacer quotes) str))
;; insert nbsp between last two words
(define+provide/contract (nonbreaking-last-space x #:nbsp [nbsp (->string #\u00A0)]
#: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
(define (replace-last-space str)
(if (#\space . in? . str)
(let ([reversed-str-list (reverse (string->list str))]
[reversed-nbsp (reverse (string->list (->string nbsp)))])
(define-values (last-word-chars other-chars)
(splitf-at reversed-str-list (λ(i) (not (eq? i #\space)))))
(define front-chars (if (< (len last-word-chars) minimum-word-length) ; OK for long words to be on their own line
; 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))))
(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
(cond
[(string? x) (replace-last-space x)] ; todo: this assumes a paragraph only has one string in it.
[(txexpr? x)
(let-values([(tag attr elements) (txexpr->values x)])
(if (> (length elements) 0) ; elements is list of xexprs
(let-values ([(all-but-last last) (split-at elements (sub1 (length elements)))])
(define result (find-last-word-space (car last)))
(define result-items (if (txexpr? result) (list result) result)) ; might be txexpr, or list of new elements
(make-txexpr tag attr `(,@all-but-last ,@result-items)))
x))]
[else x]))
(if ((car x) . in? . tags-to-pay-attention-to)
(find-last-word-space x)
x))
; wrap initial quotes for hanging punctuation
; todo: improve this
; does not handle <p>“<em>thing</em> properly
(define+provide/contract (wrap-hanging-quotes nx
#:single-prepend [single-pp '(squo)]
#:double-prepend [double-pp '(dquo)])
((txexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . txexpr?)
(define two-or-more-char-string? (λ(i) (and (string? i) (>= (len i) 2))))
(define-values (tag attr elements) (txexpr->values nx))
(make-txexpr tag attr
(if (and (list? elements) (not (empty? elements)))
(let ([new-car-elements (match (car elements)
[(? two-or-more-char-string? tcs)
(define str-first (get tcs 0))
(define str-rest (get tcs 1 'end))
(cond
[(str-first . in? . '("\"" ""))
;; can wrap with any inline tag
;; so that linebreak detection etc still works
`(,@double-pp ,(->string #\“) ,str-rest)]
[(str-first . in? . '("\'" ""))
`(,@single-pp ,(->string #\) ,str-rest)]
[else tcs])]
[(? txexpr? nx) (wrap-hanging-quotes nx)]
[else (car elements)])])
(cons new-car-elements (cdr elements)))
elements)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Lines, blocks, paragraphs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; turn the right items into <br> tags
(define+provide/contract (detect-linebreaks xc
#: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))))
(filter-not empty?
(for/list ([i (len xc)])
(let ([item (get xc i)])
(cond
;; skip first and last
[(or (= i 0) (= i (sub1 (len xc)))) item]
[(equal? item newline)
(match (get xc (- i 1) (+ i 2)) ; a three-element slice with x[i] in the middle
;; only convert if neither adjacent tag is a block
;; (because blocks automatically force a newline before & after)
[(list (? not-block?) newline (? not-block?)) linebreak]
[else empty])] ; otherwise delete
[else item])))))
;; recursive whitespace test
(define+provide/contract (whitespace? x)
(any/c . -> . coerce/boolean?)
(cond
[(equal? "" x) #t] ; empty string is deemed whitespace
[(or (string? x) (symbol? x)) (regexp-match #px"^\\s+$" (->string x))]
[(or (list? x) (vector? x)) (andmap whitespace? (->list x))]
[else #f]))
(define+provide/contract (whitespace/nbsp? x)
(any/c . -> . coerce/boolean?)
(or (whitespace? x) (equal? (->string x) (->string #\u00A0))))
;; is x a paragraph break?
(define+provide/contract (paragraph-break? x #:separator [sep world:paragraph-separator])
((any/c) (#:separator pregexp?) . ->* . coerce/boolean?)
(define paragraph-pattern (pregexp (format "^~a+$" sep)))
(and (string? x) (regexp-match paragraph-pattern x)))
(define (newline? x)
(and (string? x) (equal? world:newline x)))
(define (not-newline? x)
(not (newline? x)))
(define (do-merge xs [acc '()])
(if (empty? xs)
acc
;; Try to peel the newlines off the front.
(let-values ([(leading-newlines remainder) (splitf-at xs newline?)])
(if (not (empty? leading-newlines)) ; if you got newlines ...
;; combine them into a string and append them to the accumulator,
;; and recurse on the rest
(do-merge remainder (append acc (list (apply string-append leading-newlines))))
;; otherwise peel off elements up to the next newline, append them to accumulator,
;; and recurse on the rest
(do-merge (dropf remainder not-newline?)
(append acc (takef remainder not-newline?)))))))
;; Find adjacent newline characters in a list and merge them into one item
;; Scribble, by default, makes each newline a separate list item
;; In practice, this is worthless.
(define+provide/contract (merge-newlines x)
(txexpr-elements? . -> . txexpr-elements?)
(cond
[(list? x) (do-merge (map merge-newlines x))]
[else x]))
;; detect paragraphs
;; todo: unit tests
(define+provide/contract (detect-paragraphs elements #:tag [tag 'p]
#: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?)
;; prepare elements for paragraph testing
(define (prep-paragraph-flow xc)
(linebreak-proc (merge-newlines (trim xc whitespace?))))
(define my-paragraph-break? (λ(x) (and (paragraph-break? x #:separator sep) #t)))
(define (wrap-paragraph xc)
(match xc
[(list (? block-txexpr? bx)) bx] ; leave a single block xexpr alone
[else (make-txexpr tag empty xc)])) ; otherwise wrap in p tag
(let ([elements (prep-paragraph-flow elements)])
(if (ormap my-paragraph-break? elements) ; need this condition to prevent infinite recursion
(map wrap-paragraph (splitf-at* elements my-paragraph-break?)) ; split into ¶¶
elements)))

File diff suppressed because one or more lines are too long

@ -0,0 +1,308 @@
/* See the beginning of "manual.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk, .RktErr {
font-family: 'Source Code Pro', monospace;
white-space: inherit;
font-size: 1rem;
}
/* this selctor grabs the first linked Racket symbol
in a definition box (i.e., the symbol being defined) */
a.RktValDef, a.RktStxDef, a.RktSymDef,
span.RktValDef, span.RktStxDef, span.RktSymDef
{
font-size: 1.15rem;
color: black;
font-weight: 600;
}
.inheritedlbl {
font-family: 'Fira', sans;
}
.RBackgroundLabelInner {
font-family: inherit;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 95%;
margin-top: 0.5em;
text-align: left;
background-color: inherit;
}
.inherited td {
font-size: 82%;
padding-left: 0.5rem;
line-height: 1.3;
text-indent: 0;
padding-right: 0;
}
.inheritedlbl {
font-style: normal;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eee;
}
.RktInBG {
background-color: #eee;
}
.refcolumn .RktInBG {
background-color: white;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: inherit;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
font-weight: 400;
}
.RktVar {
position: relative;
left: -1px; font-style: italic;
color: #444;
}
.SVInsetFlow .RktVar {
font-weight: 400;
color: #444;
}
.RktSym {
color: inherit;
}
.RktValLink, .RktStxLink, .RktModLink {
text-decoration: none;
color: #07A;
font-weight: 500;
font-size: 1rem;
}
/* for syntax links within headings */
h2 a.RktStxLink, h3 a.RktStxLink, h4 a.RktStxLink, h5 a.RktStxLink,
h2 a.RktValLink, h3 a.RktValLink, h4 a.RktValLink, h5 a.RktValLink,
h2 .RktSym, h3 .RktSym, h4 .RktSym, h5 .RktSym,
h2 .RktMod, h3 .RktMod, h4 .RktMod, h5 .RktMod,
h2 .RktVal, h3 .RktVal, h4 .RktVal, h5 .RktVal,
h2 .RktPn, h3 .RktPn, h4 .RktPn, h5 .RktPn {
color: #333;
font-size: 1.65rem;
font-weight: 400;
}
.toptoclink .RktStxLink, .toclink .RktStxLink,
.toptoclink .RktValLink, .toclink .RktValLink,
.toptoclink .RktModLink, .toclink .RktModLink {
color: inherit;
}
.tocset .RktValLink, .tocset .RktStxLink, .tocset .RktModLink {
color: black;
font-weight: 400;
font-size: 0.9rem;
}
.tocset td a.tocviewselflink .RktValLink,
.tocset td a.tocviewselflink .RktStxLink,
.tocset td a.tocviewselflink .RktMod,
.tocset td a.tocviewselflink .RktSym {
font-weight: lighter;
color: white;
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together { /* for definitions grouped together in one box */
width: 100%;
border-top: 2px solid white;
}
tbody > tr:first-child > td > .together {
border-top: 0px; /* erase border on first instance of together */
}
.RktBlk {
white-space: pre;
text-align: left;
}
.highlighted {
font-size: 1rem;
background-color: #fee;
}
.defmodule {
font-family: 'Source Code Pro';
padding: 0.25rem 0.75rem 0.25rem 0.5rem;
margin-bottom: 1rem;
width: 100%;
background-color: hsl(60, 29%, 94%);
}
.defmodule a {
color: #444;
}
.defmodule td span.hspace:first-child {
position: absolute;
width: 0;
display: inline-block;
}
.defmodule .RpackageSpec .Smaller,
.defmodule .RpackageSpec .stt {
font-size: 1rem;
}
.specgrammar {
float: none;
padding-left: 1em;
}
.RBibliography td {
vertical-align: text-top;
padding-top: 1em;
}
.leftindent {
margin-left: 2rem;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.SCodeFlow .Rfilebox {
margin-left: -1em; /* see 17.2 of guide, module languages */
}
.Rfiletitle {
text-align: right;
background-color: #eee;
}
.SCodeFlow .Rfiletitle {
border-top: 1px dotted gray;
border-right: 1px dotted gray;
}
.Rfilename {
border-top: 0;
border-right: 0;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: inherit;
}
.Rfilecontent {
margin: 0.5em;
}
.RpackageSpec {
padding-right: 0;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0.20rem; /* sensitive to monospaced font choice */
text-align: right;
z-index: 0;
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
color: gray;
}
.RpackageSpec .Smaller {
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}

@ -0,0 +1,724 @@
/* See the beginning of "scribble.css".
This file is used by the `scribble/manual` language, along with
"manual-racket.css". */
@import url("manual-fonts.css");
* {
margin: 0;
padding: 0;
}
@media all {html {font-size: 15px;}}
@media all and (max-width:940px){html {font-size: 14px;}}
@media all and (max-width:850px){html {font-size: 13px;}}
@media all and (max-width:830px){html {font-size: 12px;}}
@media all and (max-width:740px){html {font-size: 11px;}}
/* CSS seems backward: List all the classes for which we want a
particular font, so that the font can be changed in one place. (It
would be nicer to reference a font definition from all the places
that we want it.)
As you read the rest of the file, remember to double-check here to
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
font-family: 'Source Code Pro', monospace;
white-space: inherit;
font-size: 1rem;
}
.stt {
font-weight: 500;
}
h2 .stt {
font-size: 2.7rem;
}
.toptoclink .stt {
font-size: inherit;
}
.toclink .stt {
font-size: 90%;
}
.RpackageSpec .stt {
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
}
h3 .stt, h4 .stt, h5 .stt {
color: #333;
font-size: 1.65rem;
font-weight: 400;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .sroman, i {
font-family: 'Charter', serif;
font-size: 1.18rem;
}
/* Sans-serif: */
.version, .versionNoNav, .ssansserif {
font-family: 'Fira', sans-serif;
}
.ssansserif {
font-family: 'Fira';
font-weight: 500;
font-size: 0.9em;
}
.tocset .ssansserif {
font-size: 100%;
}
/* ---------------------------------------- */
p, .SIntrapara {
display: block;
margin: 0 0 1em 0;
line-height: 1.4;
}
li {
list-style-position: outside;
margin-left: 1.2em;
}
h1, h2, h3, h4, h5, h6, h7, h8 {
font-family: 'Fira';
font-weight: 300;
font-size: 1.6rem;
color: #333;
margin-top: inherit;
margin-bottom: 1rem;
line-height: 1.25;
-moz-font-feature-settings: 'tnum=1';
-moz-font-feature-settings: 'tnum' 1;
-webkit-font-feature-settings: 'tnum' 1;
-o-font-feature-settings: 'tnum' 1;
-ms-font-feature-settings: 'tnum' 1;
font-feature-settings: 'tnum' 1;
}
h3, h4, h5, h6, h7, h8 {
border-top: 1px solid black;
}
h2 { /* per-page main title */
font-family: 'Miso';
font-weight: bold;
margin-top: 4rem;
font-size: 3rem;
line-height: 1.1;
width: 90%;
}
h3, h4, h5, h6, h7, h8 {
margin-top: 2em;
padding-top: 0.1em;
margin-bottom: 0.75em;
}
/* ---------------------------------------- */
/* Main */
body {
color: black;
background-color: white;
}
.maincolumn {
width: auto;
margin-top: 4rem;
margin-left: 17rem;
margin-right: 2rem;
margin-bottom: 10rem; /* to avoid fixed bottom nav bar */
max-width: 700px;
min-width: 370px; /* below this size, code samples don't fit */
}
a {
text-decoration: inherit;
}
a, .toclink, .toptoclink, .tocviewlink, .tocviewselflink, .tocviewtoggle, .plainlink,
.techinside, .techoutside:hover, .techinside:hover {
color: #07A;
}
a:hover {
text-decoration: underline;
}
/* ---------------------------------------- */
/* Navigation */
.navsettop, .navsetbottom {
left: 0;
width: 15rem;
height: 6rem;
font-family: 'Fira';
font-size: 0.9rem;
border-bottom: 0px solid hsl(216, 15%, 70%);
background-color: inherit;
padding: 0;
}
.navsettop {
position: absolute;
top: 0;
left: 0;
margin-bottom: 0;
border-bottom: 0;
}
.navsettop a, .navsetbottom a {
color: black;
}
.navsettop a:hover, .navsetbottom a:hover {
background: hsl(216, 78%, 95%);
text-decoration: none;
}
.navleft, .navright {
position: static;
float: none;
margin: 0;
white-space: normal;
}
.navleft a {
display: inline-block;
}
.navright a {
display: inline-block;
text-align: center;
}
.navleft a, .navright a, .navright span {
display: inline-block;
padding: 0.5rem;
min-width: 1rem;
}
.navright {
height: 2rem;
white-space: nowrap;
}
.navsetbottom {
display: none;
}
.nonavigation {
color: #889;
}
.searchform {
display: block;
margin: 0;
padding: 0;
border-bottom: 1px solid #eee;
height: 4rem;
}
.searchbox {
font-size: 1rem;
width: 12rem;
margin: 1rem;
padding: 0.25rem;
vertical-align: middle;
background-color: white;
}
#search_box {
font-size: 0.8rem;
}
/* ---------------------------------------- */
/* Version */
.versionbox {
position: absolute;
float: none;
top: 0.25rem;
left: 17rem;
z-index: 11000;
height: 2em;
font-size: 70%;
font-weight: lighter;
width: inherit;
margin: 0;
}
.version, .versionNoNav {
font-size: inherit;
}
.version:before, .versionNoNav:before {
content: "v.";
}
/* ---------------------------------------- */
/* Margin notes */
/* cancel scribble.css styles: */
.refpara, .refelem {
position: static;
float: none;
height: auto;
width: auto;
margin: 0;
}
.refcolumn {
position: static;
display: block;
width: auto;
font-size: inherit;
margin: 2rem;
margin-left: 2rem;
padding: 0.5em;
padding-left: 0.75em;
padding-right: 1em;
background: hsl(60, 29%, 94%);
border: 1px solid #ccb;
border-left: 0.4rem solid #ccb;
}
.refcontent p {
line-height: 1.5;
margin: 0;
}
.refcontent p + p {
margin-top: 1em;
}
.refcontent a {
font-weight: 400;
}
.refpara, .refparaleft {
top: -1em;
}
@media all and (max-width:600px) {
.refcolumn {
margin-left: 0;
margin-right: 0;
}
}
@media all and (min-width:1260px) {
.refcolumn {
position: absolute;
left: 66rem; right: 3em;
margin: 0;
float: right;
max-width: 18rem;
}
}
.refcontent {
font-family: 'Fira';
font-size: 1rem;
line-height: 1.6;
margin: 0 0 0 0;
}
.refparaleft, .refelemleft {
position: relative;
float: left;
right: 2em;
height: 0em;
width: 13em;
margin: 0em 0em 0em -13em;
}
.refcolumnleft {
background-color: hsl(60, 29%, 94%);
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid hsl(60, 29%, 94%);
margin: 0 0 0 0;
}
/* ---------------------------------------- */
/* Table of contents, left margin */
.tocset {
position: absolute;
float: none;
left: 0;
top: 0rem;
width: 14rem;
padding: 7rem 0.5rem 0.5rem 0.5rem;
background-color: hsl(216, 15%, 70%);
margin: 0;
}
.tocset td {
vertical-align: text-top;
padding-bottom: 0.4rem;
padding-left: 0.2rem;
line-height: 1.1;
font-family: 'Fira';
-moz-font-feature-settings: 'tnum=1';
-moz-font-feature-settings: 'tnum' 1;
-webkit-font-feature-settings: 'tnum' 1;
-o-font-feature-settings: 'tnum' 1;
-ms-font-feature-settings: 'tnum' 1;
font-feature-settings: 'tnum' 1;
}
.tocset td a {
color: black;
font-weight: 400;
}
.tocview {
text-align: left;
background-color: inherit;
}
.tocview td, .tocsub td {
line-height: 1.3;
}
.tocview table, .tocsub table {
width: 90%;
}
.tocset td a.tocviewselflink {
font-weight: lighter;
font-size: 110%; /* monospaced styles below don't need to enlarge */
color: white;
}
.tocviewselflink {
text-decoration: none;
}
.tocsub {
text-align: left;
margin-top: 0.5em;
background-color: inherit;
}
.tocviewlist, .tocsublist {
margin-left: 0.2em;
margin-right: 0.2em;
padding-top: 0.2em;
padding-bottom: 0.2em;
}
.tocviewlist table {
font-size: 82%;
}
.tocviewlisttopspace {
margin-bottom: 1em;
}
.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
margin-left: 0.4em;
border-left: 1px solid #99a;
padding-left: 0.8em;
}
.tocviewsublist {
margin-bottom: 1em;
}
.tocviewsublist table,
.tocviewsublistonly table,
.tocviewsublisttop table,
.tocviewsublistbottom table,
table.tocsublist {
font-size: 1rem;
}
.tocviewsublist td, .tocviewsublistbottom td, .tocviewsublisttop td, .tocsub td,
.tocviewsublistonly td {
font-size: 90%;
}
.tocviewtoggle {
font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
}
.tocsublist td {
padding-left: 0.5rem;
padding-top: 0.25rem;
text-indent: 0;
}
.tocsublinknumber {
font-size: 100%;
}
.tocsublink {
font-size: 82%;
text-decoration: none;
}
.tocsubseclink {
font-size: 100%;
text-decoration: none;
}
.tocsubnonseclink {
font-size: 82%;
text-decoration: none;
margin-left: 1rem;
padding-left: 0;
display: inline-block;
}
/* the label "on this page" */
.tocsubtitle {
display: block;
font-size: 62%;
font-family: 'Fira';
font-weight: bolder;
font-style: normal;
letter-spacing: 2px;
text-transform: uppercase;
margin: 0.5em;
}
.toptoclink {
font-weight: bold;
font-size: 110%
}
/* hack to add space around .toptoclink because markup is all td */
.toptoclink:after {
content: " ";
font-size: 3rem;
}
.toclink {
font-size: inherit;
}
/* ---------------------------------------- */
/* Some inline styles */
.indexlink {
text-decoration: none;
}
pre {
margin-left: 2em;
}
blockquote {
margin-left: 2em;
margin-right: 2em;
margin-bottom: 1em;
}
.SCodeFlow {
border-left: 1px dotted black;
padding-left: 1em;
padding-right: 1em;
margin-top: 1em;
margin-bottom: 1em;
margin-left: 0em;
margin-right: 2em;
white-space: nowrap;
line-height: 1.5;
}
.SCodeFlow img {
margin-top: 0.5em;
margin-bottom: 0.5em;
}
.boxed {
margin: 0;
margin-top: 2em;
padding: 0.25em;
padding-bottom: 0.5em;
background: #f3f3f3;
box-sizing:border-box;
border-top: 1px solid #99b;
background: hsl(216, 78%, 95%);
background: -moz-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -webkit-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -o-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -ms-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
}
blockquote > blockquote.SVInsetFlow {
/* resolves issue in e.g. /reference/notation.html */
margin-top: 0em;
}
.leftindent .SVInsetFlow { /* see e.g. section 4.5 of Racket Guide */
margin-top: 1em;
margin-bottom: 1em;
}
.SVInsetFlow a, .SCodeFlow a {
color: #07A;
font-weight: 500;
}
.SubFlow {
display: block;
margin: 0em;
}
.boxed {
width: 100%;
background-color: inherit;
}
.techoutside { text-decoration: none; }
.SAuthorListBox {
position: static;
float: none;
font-family: 'Fira';
font-weight: 300;
font-size: 110%;
margin-top: 1rem;
margin-bottom: 3rem;
width: 30rem;
height: auto;
}
.author > a { /* email links within author block */
font-weight: inherit;
color: inherit;
}
.SAuthorList {
font-size: 82%;
}
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}
/* phone + tablet styles */
@media all and (max-width:720px){
@media all and (max-width:720px){
@media all {html {font-size: 15px;}}
@media all and (max-width:700px){html {font-size: 14px;}}
@media all and (max-width:630px){html {font-size: 13px;}}
@media all and (max-width:610px){html {font-size: 12px;}}
@media all and (max-width:550px){html {font-size: 11px;}}
@media all and (max-width:520px){html {font-size: 10px;}}
.navsettop, .navsetbottom {
display: block;
position: absolute;
width: 100%;
height: 4rem;
border: 0;
background-color: hsl(216, 15%, 70%);
}
.searchform {
display: inline;
border: 0;
}
.navright {
position: absolute;
right: 1.5rem;
margin-top: 1rem;
border: 0px solid red;
}
.navsetbottom {
display: block;
margin-top: 8rem;
}
.tocset {
display: none;
}
.tocset table, .tocset tbody, .tocset tr, .tocset td {
display: inline;
}
.tocview {
display: none;
}
.tocsub .tocsubtitle {
display: none;
}
.versionbox {
top: 4.5rem;
left: 1rem; /* same distance as main-column */
z-index: 11000;
height: 2em;
font-size: 70%;
font-weight: lighter;
}
.maincolumn {
margin-left: 1em;
margin-top: 7rem;
margin-bottom: 0rem;
}
}
}
/* print styles : hide the navigation elements */
@media print {
.tocset,
.navsettop,
.navsetbottom { display: none; }
.maincolumn {
width: auto;
margin-right: 13em;
margin-left: 0;
}
}

@ -0,0 +1,249 @@
/* See the beginning of "scribble.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk {
font-family: monospace;
white-space: inherit;
}
/* Serif: */
.inheritedlbl {
font-family: serif;
}
/* Sans-serif: */
.RBackgroundLabelInner {
font-family: sans-serif;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 100%;
margin-top: 0.5em;
text-align: left;
background-color: #ECF5F5;
}
.inherited td {
font-size: 82%;
padding-left: 1em;
text-indent: -0.8em;
padding-right: 0.2em;
}
.inheritedlbl {
font-style: italic;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eeeeee;
}
.RktInBG {
background-color: #eeeeee;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: black;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
}
.RktVar {
color: #262680;
font-style: italic;
}
.RktSym {
color: #262680;
}
.RktSymDef { /* used with RktSym at def site */
}
.RktValLink {
text-decoration: none;
color: blue;
}
.RktValDef { /* used with RktValLink at def site */
}
.RktModLink {
text-decoration: none;
color: blue;
}
.RktStxLink {
text-decoration: none;
color: black;
}
.RktStxDef { /* used with RktStxLink at def site */
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together {
width: 100%;
}
.prototype, .argcontract, .RBoxed {
white-space: nowrap;
}
.prototype td {
vertical-align: text-top;
}
.RktBlk {
white-space: inherit;
text-align: left;
}
.RktBlk tr {
white-space: inherit;
}
.RktBlk td {
vertical-align: baseline;
white-space: inherit;
}
.argcontract td {
vertical-align: text-top;
}
.highlighted {
background-color: #ddddff;
}
.defmodule {
width: 100%;
background-color: #F5F5DC;
}
.specgrammar {
float: right;
}
.RBibliography td {
vertical-align: text-top;
}
.leftindent {
margin-left: 1em;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.Rfilebox {
}
.Rfiletitle {
text-align: right;
margin: 0em 0em 0em 0em;
}
.Rfilename {
border-top: 1px solid #6C8585;
border-right: 1px solid #6C8585;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: #ECF5F5;
}
.Rfilecontent {
margin: 0em 0em 0em 0em;
}
.RpackageSpec {
padding-right: 0.5em;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0px;
text-align: right;
color: white;
z-index: 0;
font-weight: bold;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}
/* ---------------------------------------- */
/* History */
.SHistory {
font-size: 82%;
}

@ -0,0 +1,165 @@
// Common functionality for PLT documentation pages
// Page Parameters ------------------------------------------------------------
var page_query_string =
(location.href.search(/\?([^#]+)(?:#|$)/) >= 0) && RegExp.$1;
var page_args =
((function(){
if (!page_query_string) return [];
var args = page_query_string.split(/[&;]/);
for (var i=0; i<args.length; i++) {
var a = args[i];
var p = a.indexOf('=');
if (p >= 0) args[i] = [a.substring(0,p), a.substring(p+1)];
else args[i] = [a, false];
}
return args;
})());
function GetPageArg(key, def) {
for (var i=0; i<page_args.length; i++)
if (page_args[i][0] == key) return unescape(page_args[i][1]);
return def;
}
function MergePageArgsIntoLink(a) {
if (page_args.length == 0 ||
(!a.attributes["data-pltdoc"]) || (a.attributes["data-pltdoc"].value == ""))
return;
a.href.search(/^([^?#]*)(?:\?([^#]*))?(#.*)?$/);
if (RegExp.$2.length == 0) {
a.href = RegExp.$1 + "?" + page_query_string + RegExp.$3;
} else {
// need to merge here, precedence to arguments that exist in `a'
var i, j;
var prefix = RegExp.$1, str = RegExp.$2, suffix = RegExp.$3;
var args = str.split(/[&;]/);
for (i=0; i<args.length; i++) {
j = args[i].indexOf('=');
if (j) args[i] = args[i].substring(0,j);
}
var additions = "";
for (i=0; i<page_args.length; i++) {
var exists = false;
for (j=0; j<args.length; j++)
if (args[j] == page_args[i][0]) { exists = true; break; }
if (!exists) str += "&" + page_args[i][0] + "=" + page_args[i][1];
}
a.href = prefix + "?" + str + suffix;
}
}
// Cookies --------------------------------------------------------------------
// Actually, try localStorage (a la HTML 5), first.
function GetCookie(key, def) {
try {
var v = localStorage[key];
if (!v) v = def;
return v;
} catch (e) {
var i, cookiestrs;
try {
if (document.cookie.length <= 0) return def;
cookiestrs = document.cookie.split(/; */);
} catch (e) { return def; }
for (i = 0; i < cookiestrs.length; i++) {
var cur = cookiestrs[i];
var eql = cur.indexOf('=');
if (eql >= 0 && cur.substring(0,eql) == key)
return unescape(cur.substring(eql+1));
}
return def;
}
}
function SetCookie(key, val) {
try {
localStorage[key] = val;
} catch(e) {
var d = new Date();
d.setTime(d.getTime()+(365*24*60*60*1000));
try {
document.cookie =
key + "=" + escape(val) + "; expires="+ d.toGMTString() + "; path=/";
} catch (e) {}
}
}
// note that this always stores a directory name, ending with a "/"
function SetPLTRoot(ver, relative) {
var root = location.protocol + "//" + location.host
+ NormalizePath(location.pathname.replace(/[^\/]*$/, relative));
SetCookie("PLT_Root."+ver, root);
}
// adding index.html works because of the above
function GotoPLTRoot(ver, relative) {
var u = GetCookie("PLT_Root."+ver, null);
if (u == null) return true; // no cookie: use plain up link
// the relative path is optional, default goes to the toplevel start page
if (!relative) relative = "index.html";
location = u + relative;
return false;
}
// Utilities ------------------------------------------------------------------
var normalize_rxs = [/\/\/+/g, /\/\.(\/|$)/, /\/[^\/]*\/\.\.(\/|$)/];
function NormalizePath(path) {
var tmp, i;
for (i = 0; i < normalize_rxs.length; i++)
while ((tmp = path.replace(normalize_rxs[i], "/")) != path) path = tmp;
return path;
}
// `noscript' is problematic in some browsers (always renders as a
// block), use this hack instead (does not always work!)
// document.write("<style>mynoscript { display:none; }</style>");
// Interactions ---------------------------------------------------------------
function DoSearchKey(event, field, ver, top_path) {
var val = field.value;
if (event && event.keyCode == 13) {
var u = GetCookie("PLT_Root."+ver, null);
if (u == null) u = top_path; // default: go to the top path
u += "search/index.html?q=" + escape(val);
if (page_query_string) u += "&" + page_query_string;
location = u;
return false;
}
return true;
}
function TocviewToggle(glyph, id) {
var s = document.getElementById(id).style;
var expand = s.display == "none";
s.display = expand ? "block" : "none";
glyph.innerHTML = expand ? "&#9660;" : "&#9658;";
}
// Page Init ------------------------------------------------------------------
// Note: could make a function that inspects and uses window.onload to chain to
// a previous one, but this file needs to be required first anyway, since it
// contains utilities for all other files.
var on_load_funcs = [];
function AddOnLoad(fun) { on_load_funcs.push(fun); }
window.onload = function() {
for (var i=0; i<on_load_funcs.length; i++) on_load_funcs[i]();
};
AddOnLoad(function(){
var links = document.getElementsByTagName("a");
for (var i=0; i<links.length; i++) MergePageArgsIntoLink(links[i]);
var label = GetPageArg("ctxtname",false);
if (!label) return;
var indicator = document.getElementById("contextindicator");
if (!indicator) return;
indicator.innerHTML = label;
indicator.style.display = "block";
});

@ -0,0 +1,480 @@
/* This file is used by default by all Scribble documents.
See also "manual.css", which is added by default by the
`scribble/manual` language. */
/* CSS seems backward: List all the classes for which we want a
particular font, so that the font can be changed in one place. (It
would be nicer to reference a font definition from all the places
that we want it.)
As you read the rest of the file, remember to double-check here to
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
font-family: monospace;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .sroman, i {
font-family: serif;
}
/* Sans-serif: */
.version, .versionNoNav, .ssansserif {
font-family: sans-serif;
}
.ssansserif {
font-size: 80%;
font-weight: bold;
}
/* ---------------------------------------- */
p, .SIntrapara {
display: block;
margin: 1em 0;
}
h2 { /* per-page main title */
margin-top: 0;
}
h3, h4, h5, h6, h7, h8 {
margin-top: 1.75em;
margin-bottom: 0.5em;
}
.SSubSubSubSection {
font-weight: bold;
font-size: 0.83em; /* should match h5; from HTML 4 reference */
}
/* Needed for browsers like Opera, and eventually for HTML 4 conformance.
This means that multiple paragraphs in a table element do not have a space
between them. */
table p {
margin-top: 0;
margin-bottom: 0;
}
/* ---------------------------------------- */
/* Main */
body {
color: black;
background-color: #ffffff;
}
table td {
padding-left: 0;
padding-right: 0;
}
.maincolumn {
width: 43em;
margin-right: -40em;
margin-left: 15em;
}
.main {
text-align: left;
}
/* ---------------------------------------- */
/* Navigation */
.navsettop, .navsetbottom {
background-color: #f0f0e0;
padding: 0.25em 0 0.25em 0;
}
.navsettop {
margin-bottom: 1.5em;
border-bottom: 2px solid #e0e0c0;
}
.navsetbottom {
margin-top: 2em;
border-top: 2px solid #e0e0c0;
}
.navleft {
margin-left: 1ex;
position: relative;
float: left;
white-space: nowrap;
}
.navright {
margin-right: 1ex;
position: relative;
float: right;
white-space: nowrap;
}
.nonavigation {
color: #e0e0e0;
}
.searchform {
display: inline;
margin: 0;
padding: 0;
}
.searchbox {
width: 16em;
margin: 0px;
padding: 0px;
background-color: #eee;
border: 1px solid #ddd;
text-align: center;
vertical-align: middle;
}
#contextindicator {
position: fixed;
background-color: #c6f;
color: #000;
font-family: monospace;
font-weight: bold;
padding: 2px 10px;
display: none;
right: 0;
bottom: 0;
}
/* ---------------------------------------- */
/* Version */
.versionbox {
position: relative;
float: right;
left: 2em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.version {
font-size: small;
}
.versionNoNav {
font-size: xx-small; /* avoid overlap with author */
}
.version:before, .versionNoNav:before {
content: "Version ";
}
/* ---------------------------------------- */
/* Margin notes */
.refpara, .refelem {
position: relative;
float: right;
left: 2em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.refpara, .refparaleft {
top: -1em;
}
.refcolumn {
background-color: #F5F5DC;
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid #F5F5DC;
margin: 0 0 0 0;
}
.refcontent {
margin: 0 0 0 0;
}
.refcontent p {
margin-top: 0;
margin-bottom: 0;
}
.refparaleft, .refelemleft {
position: relative;
float: left;
right: 2em;
height: 0em;
width: 13em;
margin: 0em 0em 0em -13em;
}
.refcolumnleft {
background-color: #F5F5DC;
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid #F5F5DC;
margin: 0 0 0 0;
}
/* ---------------------------------------- */
/* Table of contents, inline */
.toclink {
text-decoration: none;
color: blue;
font-size: 85%;
}
.toptoclink {
text-decoration: none;
color: blue;
font-weight: bold;
}
/* ---------------------------------------- */
/* Table of contents, left margin */
.tocset {
position: relative;
float: left;
width: 12.5em;
margin-right: 2em;
}
.tocset td {
vertical-align: text-top;
}
.tocview {
text-align: left;
background-color: #f0f0e0;
}
.tocsub {
text-align: left;
margin-top: 0.5em;
background-color: #f0f0e0;
}
.tocviewlist, .tocsublist {
margin-left: 0.2em;
margin-right: 0.2em;
padding-top: 0.2em;
padding-bottom: 0.2em;
}
.tocviewlist table {
font-size: 82%;
}
.tocviewlisttopspace {
margin-bottom: 1em;
}
.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
margin-left: 0.4em;
border-left: 1px solid #bbf;
padding-left: 0.8em;
}
.tocviewsublist {
margin-bottom: 1em;
}
.tocviewsublist table,
.tocviewsublistonly table,
.tocviewsublisttop table,
.tocviewsublistbottom table {
font-size: 75%;
}
.tocviewtitle * {
font-weight: bold;
}
.tocviewlink {
text-decoration: none;
color: blue;
}
.tocviewselflink {
text-decoration: underline;
color: blue;
}
.tocviewtoggle {
text-decoration: none;
color: blue;
font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
}
.tocsublist td {
padding-left: 1em;
text-indent: -1em;
}
.tocsublinknumber {
font-size: 82%;
}
.tocsublink {
font-size: 82%;
text-decoration: none;
}
.tocsubseclink {
font-size: 82%;
text-decoration: none;
}
.tocsubnonseclink {
font-size: 82%;
text-decoration: none;
padding-left: 0.5em;
}
.tocsubtitle {
font-size: 82%;
font-style: italic;
margin: 0.2em;
}
/* ---------------------------------------- */
/* Some inline styles */
.indexlink {
text-decoration: none;
}
.nobreak {
white-space: nowrap;
}
pre { margin-left: 2em; }
blockquote { margin-left: 2em; }
ol { list-style-type: decimal; }
ol ol { list-style-type: lower-alpha; }
ol ol ol { list-style-type: lower-roman; }
ol ol ol ol { list-style-type: upper-alpha; }
.SCodeFlow {
display: block;
margin-left: 1em;
margin-bottom: 0em;
margin-right: 1em;
margin-top: 0em;
white-space: nowrap;
}
.SVInsetFlow {
display: block;
margin-left: 0em;
margin-bottom: 0em;
margin-right: 0em;
margin-top: 0em;
}
.SubFlow {
display: block;
margin: 0em;
}
.boxed {
width: 100%;
background-color: #E8E8FF;
}
.hspace {
}
.slant {
font-style: oblique;
}
.badlink {
text-decoration: underline;
color: red;
}
.plainlink {
text-decoration: none;
color: blue;
}
.techoutside { text-decoration: underline; color: #b0b0b0; }
.techoutside:hover { text-decoration: underline; color: blue; }
/* .techinside:hover doesn't work with FF, .techinside:hover>
.techinside doesn't work with IE, so use both (and IE doesn't
work with inherit in the second one, so use blue directly) */
.techinside { color: black; }
.techinside:hover { color: blue; }
.techoutside:hover>.techinside { color: inherit; }
.SCentered {
text-align: center;
}
.imageleft {
float: left;
margin-right: 0.3em;
}
.Smaller {
font-size: 82%;
}
.Larger {
font-size: 122%;
}
/* A hack, inserted to break some Scheme ids: */
.mywbr {
display: inline-block;
height: 0;
width: 0;
font-size: 1px;
}
.compact li p {
margin: 0em;
padding: 0em;
}
.noborder img {
border: 0;
}
.SAuthorListBox {
position: relative;
float: right;
left: 2em;
top: -2.5em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.SAuthorList {
font-size: 82%;
}
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}
/* print styles : hide the navigation elements */
@media print {
.tocset,
.navsettop,
.navsetbottom { display: none; }
.maincolumn {
width: auto;
margin-right: 13em;
margin-left: 0;
}
}

@ -1,28 +0,0 @@
#lang racket
;; A slightly nicer version of doclang where the parameters are keyword-based
;; rather than positional. Delegates off to the original doclang.
(require (prefix-in doclang: "doclang_raw.rkt")
(for-syntax racket/base
syntax/parse))
(provide (except-out (all-from-out racket) #%module-begin)
(rename-out [*module-begin #%module-begin]))
;; Module wrapper ----------------------------------------
(define-syntax (*module-begin stx)
(syntax-parse stx
[(_ (~or (~optional (~seq #:id id))
(~optional (~seq #:post-process post-process))
(~optional (~seq #:exprs exprs)))
...
. body)
(with-syntax ([id (or (attribute id)
#'doc)]
[post-process (or (attribute post-process)
#'values)]
[exprs (or (attribute exprs)
#'())])
#'(doclang:#%module-begin id post-process exprs . body))]))

@ -0,0 +1,136 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(require racket/contract racket/path)
(require (only-in racket/path filename-extension))
(require "world.rkt" sugar)
;; for files like svg that are not source in pollen terms,
;; but have a textual representation separate from their display.
(define+provide/contract (sourceish? x)
(any/c . -> . coerce/boolean?)
(define sourceish-extensions (list "svg"))
(try ((get-ext x) . in? . sourceish-extensions)
(except [exn:fail? (λ(e) #f)])))
;; compare directories by their exploded path elements,
;; not by equal?, which will give wrong result if no slash on the end
(define+provide/contract (directories-equal? dirx diry)
(coerce/path? coerce/path? . -> . coerce/boolean?)
(equal? (explode-path dirx) (explode-path diry)))
;; helper function for pagetree
;; make paths absolute to test whether files exist,
;; then convert back to relative
(define+provide/contract (visible? path)
(coerce/path? . -> . coerce/boolean?)
(not ((->string path) . starts-with? . ".")))
(define+provide/contract (visible-files dir)
(pathish? . -> . (listof path?))
(filter visible?
(map (λ(p) (find-relative-path dir p))
(filter file-exists?
(directory-list dir #:build? #t)))))
(define-syntax (make-source-utility-functions stx)
(syntax-case stx ()
[(_ stem)
(let ([stem-datum (syntax->datum #'stem)])
(with-syntax ([file-ext (format-id stx "world:~a-source-ext" #'stem)]
[stem-source? (format-id stx "~a-source?" #'stem)]
[get-stem-source (format-id stx "get-~a-source" #'stem)]
[has-stem-source? (format-id stx "has-~a-source?" #'stem)]
[has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)]
[->stem-source-path (format-id stx "->~a-source-path" #'stem)]
[->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)])
#`(begin
;; does file have particular extension
(define+provide (stem-source? x)
(->boolean (and (pathish? x) (has-ext? (->path x) file-ext))))
(define+provide (get-stem-source x)
(and (pathish? x)
(let ([source-path (->stem-source-path (->path x))])
(and source-path (file-exists? source-path) source-path))))
;; does the source-ified version of the file exist
(define+provide (has-stem-source? x)
(->boolean (get-stem-source x)))
;; it's a file-ext source file, or a file that's the result of a file-ext source
(define+provide (has/is-stem-source? x)
(->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?)))))
;; add the file extension if it's not there
(define+provide/contract (->stem-source-path x)
(pathish? . -> . (or/c #f path?))
(define result (if (stem-source? x)
x
#,(if (equal? stem-datum 'scribble)
#'(if (x . has-ext? . 'html) ; different logic for scribble sources
(add-ext (remove-all-ext x) file-ext)
#f)
#'(add-ext x file-ext))))
(and result (->path result)))
;; coerce either a source or output file to both
(define+provide/contract (->stem-source+output-paths path)
(pathish? . -> . (values path? path?))
(values (->complete-path (->stem-source-path path))
(->complete-path (->output-path path)))))))]))
(make-source-utility-functions preproc)
(make-source-utility-functions null)
(make-source-utility-functions pagetree)
(make-source-utility-functions markup)
(make-source-utility-functions markdown)
(make-source-utility-functions template)
(make-source-utility-functions scribble)
(define/contract+provide (->source-path path)
(coerce/path? . -> . (or/c #f path?))
(ormap (λ(proc) (proc path)) (list get-markup-source get-markdown-source get-preproc-source get-null-source get-scribble-source)))
(define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?)
(cond
[(or (markup-source? x) (preproc-source? x) (null-source? x) (markdown-source? x) (template-source? x)) (remove-ext x)]
[(scribble-source? x) (add-ext (remove-ext x) 'html)]
[else x]))
(define+provide/contract (project-files-with-ext ext)
(coerce/symbol? . -> . (listof complete-path?))
(map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list (world:current-project-root)))))
(define+provide (racket-source? x)
(->boolean (and (pathish? x) (has-ext? (->path x) 'rkt))))
;; to identify unsaved sources in DrRacket
(define (unsaved-source? path-string)
((substring (->string path-string) 0 7) . equal? . "unsaved"))
(define+provide (magic-directory? path)
(and (directory-exists? path)
(or (ends-with? (path->string path) "compiled"))))
(define+provide (pollen-related-file? file)
(ormap (λ(proc) (proc file)) (list
preproc-source?
markup-source?
markdown-source?
template-source?
pagetree-source?
scribble-source?
null-source?
racket-source?
magic-directory?)))

@ -1,527 +0,0 @@
""" Hyphenation, using Frank Liang's algorithm.
This module provides a single function to hyphenate words. hyphenate_word takes
a string (the word), and returns a list of parts that can be separated by hyphens.
>>> hyphenate_word("hyphenation")
['hy', 'phen', 'ation']
>>> hyphenate_word("supercalifragilisticexpialidocious")
['su', 'per', 'cal', 'ifrag', 'ilis', 'tic', 'ex', 'pi', 'ali', 'do', 'cious']
>>> hyphenate_word("project")
['project']
Ned Batchelder, July 2007.
This Python code is in the public domain.
"""
import re
__version__ = '1.0.20070709'
class Hyphenator:
def __init__(self, patterns, exceptions=''):
self.tree = {}
for pattern in patterns.split():
self._insert_pattern(pattern)
self.exceptions = {}
for ex in exceptions.split():
# Convert the hyphenated pattern into a point array for use later.
self.exceptions[ex.replace('-', '')] = [0] + [ int(h == '-') for h in re.split(r"[a-z]", ex) ]
def _insert_pattern(self, pattern):
# Convert the a pattern like 'a1bc3d4' into a string of chars 'abcd'
# and a list of points [ 1, 0, 3, 4 ].
chars = re.sub('[0-9]', '', pattern)
points = [ int(d or 0) for d in re.split("[.a-z]", pattern) ]
# Insert the pattern into the tree. Each character finds a dict
# another level down in the tree, and leaf nodes have the list of
# points.
tree= self.tree
for char in chars:
if char not in tree:
tree[char] = {}
tree = tree[char]
tree[None] = points
def hyphenate_word(self, word):
""" Given a word, returns a list of pieces, broken at the possible
hyphenation points.
"""
# Short words aren't hyphenated.
if len(word) <= 4:
return [word]
# If the word is an exception, get the stored points.
if word.lower() in self.exceptions:
points = self.exceptions[word.lower()]
else:
work = '.' + word.lower() + '.'
points = [0] * (len(work)+1)
for i in range(len(work)):
tree = self.tree
for char in work[i:]:
if char in tree:
tree = tree[char]
if None in tree:
point = tree[None]
for j in range(len(point)):
points[i+j] = max(points[i+j], point[j])
else:
break
# No hyphens in the first two chars or the last two.
points[1] = points[2] = points[-2] = points[-3] = 0
# Examine the points to build the pieces list.
pieces = ['']
print word
print points
for char, point in zip(word, points[2:]):
print char, point
pieces[-1] += char
if point % 2:
pieces.append('')
print pieces
return pieces
patterns = (
# Knuth and Liang's original hyphenation patterns from classic TeX.
# In the public domain.
"""
.ach4 .ad4der .af1t .al3t .am5at .an5c .ang4 .ani5m .ant4 .an3te .anti5s .ar5s
.ar4tie .ar4ty .as3c .as1p .as1s .aster5 .atom5 .au1d .av4i .awn4 .ba4g .ba5na
.bas4e .ber4 .be5ra .be3sm .be5sto .bri2 .but4ti .cam4pe .can5c .capa5b .car5ol
.ca4t .ce4la .ch4 .chill5i .ci2 .cit5r .co3e .co4r .cor5ner .de4moi .de3o .de3ra
.de3ri .des4c .dictio5 .do4t .du4c .dumb5 .earth5 .eas3i .eb4 .eer4 .eg2 .el5d
.el3em .enam3 .en3g .en3s .eq5ui5t .er4ri .es3 .eu3 .eye5 .fes3 .for5mer .ga2
.ge2 .gen3t4 .ge5og .gi5a .gi4b .go4r .hand5i .han5k .he2 .hero5i .hes3 .het3
.hi3b .hi3er .hon5ey .hon3o .hov5 .id4l .idol3 .im3m .im5pin .in1 .in3ci .ine2
.in2k .in3s .ir5r .is4i .ju3r .la4cy .la4m .lat5er .lath5 .le2 .leg5e .len4
.lep5 .lev1 .li4g .lig5a .li2n .li3o .li4t .mag5a5 .mal5o .man5a .mar5ti .me2
.mer3c .me5ter .mis1 .mist5i .mon3e .mo3ro .mu5ta .muta5b .ni4c .od2 .odd5
.of5te .or5ato .or3c .or1d .or3t .os3 .os4tl .oth3 .out3 .ped5al .pe5te .pe5tit
.pi4e .pio5n .pi2t .pre3m .ra4c .ran4t .ratio5na .ree2 .re5mit .res2 .re5stat
.ri4g .rit5u .ro4q .ros5t .row5d .ru4d .sci3e .self5 .sell5 .se2n .se5rie .sh2
.si2 .sing4 .st4 .sta5bl .sy2 .ta4 .te4 .ten5an .th2 .ti2 .til4 .tim5o5 .ting4
.tin5k .ton4a .to4p .top5i .tou5s .trib5ut .un1a .un3ce .under5 .un1e .un5k
.un5o .un3u .up3 .ure3 .us5a .ven4de .ve5ra .wil5i .ye4 4ab. a5bal a5ban abe2
ab5erd abi5a ab5it5ab ab5lat ab5o5liz 4abr ab5rog ab3ul a4car ac5ard ac5aro
a5ceou ac1er a5chet 4a2ci a3cie ac1in a3cio ac5rob act5if ac3ul ac4um a2d ad4din
ad5er. 2adi a3dia ad3ica adi4er a3dio a3dit a5diu ad4le ad3ow ad5ran ad4su 4adu
a3duc ad5um ae4r aeri4e a2f aff4 a4gab aga4n ag5ell age4o 4ageu ag1i 4ag4l ag1n
a2go 3agog ag3oni a5guer ag5ul a4gy a3ha a3he ah4l a3ho ai2 a5ia a3ic. ai5ly
a4i4n ain5in ain5o ait5en a1j ak1en al5ab al3ad a4lar 4aldi 2ale al3end a4lenti
a5le5o al1i al4ia. ali4e al5lev 4allic 4alm a5log. a4ly. 4alys 5a5lyst 5alyt
3alyz 4ama am5ab am3ag ama5ra am5asc a4matis a4m5ato am5era am3ic am5if am5ily
am1in ami4no a2mo a5mon amor5i amp5en a2n an3age 3analy a3nar an3arc anar4i
a3nati 4and ande4s an3dis an1dl an4dow a5nee a3nen an5est. a3neu 2ang ang5ie
an1gl a4n1ic a3nies an3i3f an4ime a5nimi a5nine an3io a3nip an3ish an3it a3niu
an4kli 5anniz ano4 an5ot anoth5 an2sa an4sco an4sn an2sp ans3po an4st an4sur
antal4 an4tie 4anto an2tr an4tw an3ua an3ul a5nur 4ao apar4 ap5at ap5ero a3pher
4aphi a4pilla ap5illar ap3in ap3ita a3pitu a2pl apoc5 ap5ola apor5i apos3t
aps5es a3pu aque5 2a2r ar3act a5rade ar5adis ar3al a5ramete aran4g ara3p ar4at
a5ratio ar5ativ a5rau ar5av4 araw4 arbal4 ar4chan ar5dine ar4dr ar5eas a3ree
ar3ent a5ress ar4fi ar4fl ar1i ar5ial ar3ian a3riet ar4im ar5inat ar3io ar2iz
ar2mi ar5o5d a5roni a3roo ar2p ar3q arre4 ar4sa ar2sh 4as. as4ab as3ant ashi4
a5sia. a3sib a3sic 5a5si4t ask3i as4l a4soc as5ph as4sh as3ten as1tr asur5a a2ta
at3abl at5ac at3alo at5ap ate5c at5ech at3ego at3en. at3era ater5n a5terna
at3est at5ev 4ath ath5em a5then at4ho ath5om 4ati. a5tia at5i5b at1ic at3if
ation5ar at3itu a4tog a2tom at5omiz a4top a4tos a1tr at5rop at4sk at4tag at5te
at4th a2tu at5ua at5ue at3ul at3ura a2ty au4b augh3 au3gu au4l2 aun5d au3r
au5sib aut5en au1th a2va av3ag a5van ave4no av3era av5ern av5ery av1i avi4er
av3ig av5oc a1vor 3away aw3i aw4ly aws4 ax4ic ax4id ay5al aye4 ays4 azi4er azz5i
5ba. bad5ger ba4ge bal1a ban5dag ban4e ban3i barbi5 bari4a bas4si 1bat ba4z 2b1b
b2be b3ber bbi4na 4b1d 4be. beak4 beat3 4be2d be3da be3de be3di be3gi be5gu 1bel
be1li be3lo 4be5m be5nig be5nu 4bes4 be3sp be5str 3bet bet5iz be5tr be3tw be3w
be5yo 2bf 4b3h bi2b bi4d 3bie bi5en bi4er 2b3if 1bil bi3liz bina5r4 bin4d bi5net
bi3ogr bi5ou bi2t 3bi3tio bi3tr 3bit5ua b5itz b1j bk4 b2l2 blath5 b4le. blen4
5blesp b3lis b4lo blun4t 4b1m 4b3n bne5g 3bod bod3i bo4e bol3ic bom4bi bon4a
bon5at 3boo 5bor. 4b1ora bor5d 5bore 5bori 5bos4 b5ota both5 bo4to bound3 4bp
4brit broth3 2b5s2 bsor4 2bt bt4l b4to b3tr buf4fer bu4ga bu3li bumi4 bu4n
bunt4i bu3re bus5ie buss4e 5bust 4buta 3butio b5uto b1v 4b5w 5by. bys4 1ca
cab3in ca1bl cach4 ca5den 4cag4 2c5ah ca3lat cal4la call5in 4calo can5d can4e
can4ic can5is can3iz can4ty cany4 ca5per car5om cast5er cas5tig 4casy ca4th
4cativ cav5al c3c ccha5 cci4a ccompa5 ccon4 ccou3t 2ce. 4ced. 4ceden 3cei 5cel.
3cell 1cen 3cenc 2cen4e 4ceni 3cent 3cep ce5ram 4cesa 3cessi ces5si5b ces5t cet4
c5e4ta cew4 2ch 4ch. 4ch3ab 5chanic ch5a5nis che2 cheap3 4ched che5lo 3chemi
ch5ene ch3er. ch3ers 4ch1in 5chine. ch5iness 5chini 5chio 3chit chi2z 3cho2
ch4ti 1ci 3cia ci2a5b cia5r ci5c 4cier 5cific. 4cii ci4la 3cili 2cim 2cin c4ina
3cinat cin3em c1ing c5ing. 5cino cion4 4cipe ci3ph 4cipic 4cista 4cisti 2c1it
cit3iz 5ciz ck1 ck3i 1c4l4 4clar c5laratio 5clare cle4m 4clic clim4 cly4 c5n 1co
co5ag coe2 2cog co4gr coi4 co3inc col5i 5colo col3or com5er con4a c4one con3g
con5t co3pa cop3ic co4pl 4corb coro3n cos4e cov1 cove4 cow5a coz5e co5zi c1q
cras5t 5crat. 5cratic cre3at 5cred 4c3reta cre4v cri2 cri5f c4rin cris4 5criti
cro4pl crop5o cros4e cru4d 4c3s2 2c1t cta4b ct5ang c5tant c2te c3ter c4ticu
ctim3i ctu4r c4tw cud5 c4uf c4ui cu5ity 5culi cul4tis 3cultu cu2ma c3ume cu4mi
3cun cu3pi cu5py cur5a4b cu5ria 1cus cuss4i 3c4ut cu4tie 4c5utiv 4cutr 1cy cze4
1d2a 5da. 2d3a4b dach4 4daf 2dag da2m2 dan3g dard5 dark5 4dary 3dat 4dativ 4dato
5dav4 dav5e 5day d1b d5c d1d4 2de. deaf5 deb5it de4bon decan4 de4cil de5com
2d1ed 4dee. de5if deli4e del5i5q de5lo d4em 5dem. 3demic dem5ic. de5mil de4mons
demor5 1den de4nar de3no denti5f de3nu de1p de3pa depi4 de2pu d3eq d4erh 5derm
dern5iz der5s des2 d2es. de1sc de2s5o des3ti de3str de4su de1t de2to de1v dev3il
4dey 4d1f d4ga d3ge4t dg1i d2gy d1h2 5di. 1d4i3a dia5b di4cam d4ice 3dict 3did
5di3en d1if di3ge di4lato d1in 1dina 3dine. 5dini di5niz 1dio dio5g di4pl dir2
di1re dirt5i dis1 5disi d4is3t d2iti 1di1v d1j d5k2 4d5la 3dle. 3dled 3dles.
4dless 2d3lo 4d5lu 2dly d1m 4d1n4 1do 3do. do5de 5doe 2d5of d4og do4la doli4
do5lor dom5iz do3nat doni4 doo3d dop4p d4or 3dos 4d5out do4v 3dox d1p 1dr
drag5on 4drai dre4 drea5r 5dren dri4b dril4 dro4p 4drow 5drupli 4dry 2d1s2 ds4p
d4sw d4sy d2th 1du d1u1a du2c d1uca duc5er 4duct. 4ducts du5el du4g d3ule dum4be
du4n 4dup du4pe d1v d1w d2y 5dyn dy4se dys5p e1a4b e3act ead1 ead5ie ea4ge
ea5ger ea4l eal5er eal3ou eam3er e5and ear3a ear4c ear5es ear4ic ear4il ear5k
ear2t eart3e ea5sp e3ass east3 ea2t eat5en eath3i e5atif e4a3tu ea2v eav3en
eav5i eav5o 2e1b e4bel. e4bels e4ben e4bit e3br e4cad ecan5c ecca5 e1ce ec5essa
ec2i e4cib ec5ificat ec5ifie ec5ify ec3im eci4t e5cite e4clam e4clus e2col
e4comm e4compe e4conc e2cor ec3ora eco5ro e1cr e4crem ec4tan ec4te e1cu e4cul
ec3ula 2e2da 4ed3d e4d1er ede4s 4edi e3dia ed3ib ed3ica ed3im ed1it edi5z 4edo
e4dol edon2 e4dri e4dul ed5ulo ee2c eed3i ee2f eel3i ee4ly ee2m ee4na ee4p1
ee2s4 eest4 ee4ty e5ex e1f e4f3ere 1eff e4fic 5efici efil4 e3fine ef5i5nite
3efit efor5es e4fuse. 4egal eger4 eg5ib eg4ic eg5ing e5git5 eg5n e4go. e4gos
eg1ul e5gur 5egy e1h4 eher4 ei2 e5ic ei5d eig2 ei5gl e3imb e3inf e1ing e5inst
eir4d eit3e ei3th e5ity e1j e4jud ej5udi eki4n ek4la e1la e4la. e4lac elan4d
el5ativ e4law elaxa4 e3lea el5ebra 5elec e4led el3ega e5len e4l1er e1les el2f
el2i e3libe e4l5ic. el3ica e3lier el5igib e5lim e4l3ing e3lio e2lis el5ish
e3liv3 4ella el4lab ello4 e5loc el5og el3op. el2sh el4ta e5lud el5ug e4mac e4mag
e5man em5ana em5b e1me e2mel e4met em3ica emi4e em5igra em1in2 em5ine em3i3ni
e4mis em5ish e5miss em3iz 5emniz emo4g emoni5o em3pi e4mul em5ula emu3n e3my
en5amo e4nant ench4er en3dic e5nea e5nee en3em en5ero en5esi en5est en3etr e3new
en5ics e5nie e5nil e3nio en3ish en3it e5niu 5eniz 4enn 4eno eno4g e4nos en3ov
en4sw ent5age 4enthes en3ua en5uf e3ny. 4en3z e5of eo2g e4oi4 e3ol eop3ar e1or
eo3re eo5rol eos4 e4ot eo4to e5out e5ow e2pa e3pai ep5anc e5pel e3pent ep5etitio
ephe4 e4pli e1po e4prec ep5reca e4pred ep3reh e3pro e4prob ep4sh ep5ti5b e4put
ep5uta e1q equi3l e4q3ui3s er1a era4b 4erand er3ar 4erati. 2erb er4bl er3ch
er4che 2ere. e3real ere5co ere3in er5el. er3emo er5ena er5ence 4erene er3ent
ere4q er5ess er3est eret4 er1h er1i e1ria4 5erick e3rien eri4er er3ine e1rio
4erit er4iu eri4v e4riva er3m4 er4nis 4ernit 5erniz er3no 2ero er5ob e5roc ero4r
er1ou er1s er3set ert3er 4ertl er3tw 4eru eru4t 5erwau e1s4a e4sage. e4sages
es2c e2sca es5can e3scr es5cu e1s2e e2sec es5ecr es5enc e4sert. e4serts e4serva
4esh e3sha esh5en e1si e2sic e2sid es5iden es5igna e2s5im es4i4n esis4te esi4u
e5skin es4mi e2sol es3olu e2son es5ona e1sp es3per es5pira es4pre 2ess es4si4b
estan4 es3tig es5tim 4es2to e3ston 2estr e5stro estruc5 e2sur es5urr es4w eta4b
eten4d e3teo ethod3 et1ic e5tide etin4 eti4no e5tir e5titio et5itiv 4etn et5ona
e3tra e3tre et3ric et5rif et3rog et5ros et3ua et5ym et5z 4eu e5un e3up eu3ro
eus4 eute4 euti5l eu5tr eva2p5 e2vas ev5ast e5vea ev3ell evel3o e5veng even4i
ev1er e5verb e1vi ev3id evi4l e4vin evi4v e5voc e5vu e1wa e4wag e5wee e3wh ewil5
ew3ing e3wit 1exp 5eyc 5eye. eys4 1fa fa3bl fab3r fa4ce 4fag fain4 fall5e 4fa4ma
fam5is 5far far5th fa3ta fa3the 4fato fault5 4f5b 4fd 4fe. feas4 feath3 fe4b
4feca 5fect 2fed fe3li fe4mo fen2d fend5e fer1 5ferr fev4 4f1f f4fes f4fie
f5fin. f2f5is f4fly f2fy 4fh 1fi fi3a 2f3ic. 4f3ical f3ican 4ficate f3icen
fi3cer fic4i 5ficia 5ficie 4fics fi3cu fi5del fight5 fil5i fill5in 4fily 2fin
5fina fin2d5 fi2ne f1in3g fin4n fis4ti f4l2 f5less flin4 flo3re f2ly5 4fm 4fn
1fo 5fon fon4de fon4t fo2r fo5rat for5ay fore5t for4i fort5a fos5 4f5p fra4t
f5rea fres5c fri2 fril4 frol5 2f3s 2ft f4to f2ty 3fu fu5el 4fug fu4min fu5ne
fu3ri fusi4 fus4s 4futa 1fy 1ga gaf4 5gal. 3gali ga3lo 2gam ga5met g5amo gan5is
ga3niz gani5za 4gano gar5n4 gass4 gath3 4gativ 4gaz g3b gd4 2ge. 2ged geez4
gel4in ge5lis ge5liz 4gely 1gen ge4nat ge5niz 4geno 4geny 1geo ge3om g4ery 5gesi
geth5 4geto ge4ty ge4v 4g1g2 g2ge g3ger gglu5 ggo4 gh3in gh5out gh4to 5gi. 1gi4a
gia5r g1ic 5gicia g4ico gien5 5gies. gil4 g3imen 3g4in. gin5ge 5g4ins 5gio 3gir
gir4l g3isl gi4u 5giv 3giz gl2 gla4 glad5i 5glas 1gle gli4b g3lig 3glo glo3r g1m
g4my gn4a g4na. gnet4t g1ni g2nin g4nio g1no g4non 1go 3go. gob5 5goe 3g4o4g
go3is gon2 4g3o3na gondo5 go3ni 5goo go5riz gor5ou 5gos. gov1 g3p 1gr 4grada
g4rai gran2 5graph. g5rapher 5graphic 4graphy 4gray gre4n 4gress. 4grit g4ro
gruf4 gs2 g5ste gth3 gu4a 3guard 2gue 5gui5t 3gun 3gus 4gu4t g3w 1gy 2g5y3n
gy5ra h3ab4l hach4 hae4m hae4t h5agu ha3la hala3m ha4m han4ci han4cy 5hand.
han4g hang5er hang5o h5a5niz han4k han4te hap3l hap5t ha3ran ha5ras har2d hard3e
har4le harp5en har5ter has5s haun4 5haz haz3a h1b 1head 3hear he4can h5ecat h4ed
he5do5 he3l4i hel4lis hel4ly h5elo hem4p he2n hena4 hen5at heo5r hep5 h4era
hera3p her4ba here5a h3ern h5erou h3ery h1es he2s5p he4t het4ed heu4 h1f h1h
hi5an hi4co high5 h4il2 himer4 h4ina hion4e hi4p hir4l hi3ro hir4p hir4r his3el
his4s hith5er hi2v 4hk 4h1l4 hlan4 h2lo hlo3ri 4h1m hmet4 2h1n h5odiz h5ods ho4g
hoge4 hol5ar 3hol4e ho4ma home3 hon4a ho5ny 3hood hoon4 hor5at ho5ris hort3e
ho5ru hos4e ho5sen hos1p 1hous house3 hov5el 4h5p 4hr4 hree5 hro5niz hro3po
4h1s2 h4sh h4tar ht1en ht5es h4ty hu4g hu4min hun5ke hun4t hus3t4 hu4t h1w
h4wart hy3pe hy3ph hy2s 2i1a i2al iam4 iam5ete i2an 4ianc ian3i 4ian4t ia5pe
iass4 i4ativ ia4tric i4atu ibe4 ib3era ib5ert ib5ia ib3in ib5it. ib5ite i1bl
ib3li i5bo i1br i2b5ri i5bun 4icam 5icap 4icar i4car. i4cara icas5 i4cay iccu4
4iceo 4ich 2ici i5cid ic5ina i2cip ic3ipa i4cly i2c5oc 4i1cr 5icra i4cry ic4te
ictu2 ic4t3ua ic3ula ic4um ic5uo i3cur 2id i4dai id5anc id5d ide3al ide4s i2di
id5ian idi4ar i5die id3io idi5ou id1it id5iu i3dle i4dom id3ow i4dr i2du id5uo
2ie4 ied4e 5ie5ga ield3 ien5a4 ien4e i5enn i3enti i1er. i3esc i1est i3et 4if.
if5ero iff5en if4fr 4ific. i3fie i3fl 4ift 2ig iga5b ig3era ight3i 4igi i3gib
ig3il ig3in ig3it i4g4l i2go ig3or ig5ot i5gre igu5i ig1ur i3h 4i5i4 i3j 4ik
i1la il3a4b i4lade i2l5am ila5ra i3leg il1er ilev4 il5f il1i il3ia il2ib il3io
il4ist 2ilit il2iz ill5ab 4iln il3oq il4ty il5ur il3v i4mag im3age ima5ry
imenta5r 4imet im1i im5ida imi5le i5mini 4imit im4ni i3mon i2mu im3ula 2in.
i4n3au 4inav incel4 in3cer 4ind in5dling 2ine i3nee iner4ar i5ness 4inga 4inge
in5gen 4ingi in5gling 4ingo 4ingu 2ini i5ni. i4nia in3io in1is i5nite. 5initio
in3ity 4ink 4inl 2inn 2i1no i4no4c ino4s i4not 2ins in3se insur5a 2int. 2in4th
in1u i5nus 4iny 2io 4io. ioge4 io2gr i1ol io4m ion3at ion4ery ion3i io5ph ior3i
i4os io5th i5oti io4to i4our 2ip ipe4 iphras4 ip3i ip4ic ip4re4 ip3ul i3qua
iq5uef iq3uid iq3ui3t 4ir i1ra ira4b i4rac ird5e ire4de i4ref i4rel4 i4res ir5gi
ir1i iri5de ir4is iri3tu 5i5r2iz ir4min iro4g 5iron. ir5ul 2is. is5ag is3ar
isas5 2is1c is3ch 4ise is3er 3isf is5han is3hon ish5op is3ib isi4d i5sis is5itiv
4is4k islan4 4isms i2so iso5mer is1p is2pi is4py 4is1s is4sal issen4 is4ses
is4ta. is1te is1ti ist4ly 4istral i2su is5us 4ita. ita4bi i4tag 4ita5m i3tan
i3tat 2ite it3era i5teri it4es 2ith i1ti 4itia 4i2tic it3ica 5i5tick it3ig
it5ill i2tim 2itio 4itis i4tism i2t5o5m 4iton i4tram it5ry 4itt it3uat i5tud
it3ul 4itz. i1u 2iv iv3ell iv3en. i4v3er. i4vers. iv5il. iv5io iv1it i5vore
iv3o3ro i4v3ot 4i5w ix4o 4iy 4izar izi4 5izont 5ja jac4q ja4p 1je jer5s 4jestie
4jesty jew3 jo4p 5judg 3ka. k3ab k5ag kais4 kal4 k1b k2ed 1kee ke4g ke5li k3en4d
k1er kes4 k3est. ke4ty k3f kh4 k1i 5ki. 5k2ic k4ill kilo5 k4im k4in. kin4de
k5iness kin4g ki4p kis4 k5ish kk4 k1l 4kley 4kly k1m k5nes 1k2no ko5r kosh4 k3ou
kro5n 4k1s2 k4sc ks4l k4sy k5t k1w lab3ic l4abo laci4 l4ade la3dy lag4n lam3o
3land lan4dl lan5et lan4te lar4g lar3i las4e la5tan 4lateli 4lativ 4lav la4v4a
2l1b lbin4 4l1c2 lce4 l3ci 2ld l2de ld4ere ld4eri ldi4 ld5is l3dr l4dri le2a
le4bi left5 5leg. 5legg le4mat lem5atic 4len. 3lenc 5lene. 1lent le3ph le4pr
lera5b ler4e 3lerg 3l4eri l4ero les2 le5sco 5lesq 3less 5less. l3eva lev4er.
lev4era lev4ers 3ley 4leye 2lf l5fr 4l1g4 l5ga lgar3 l4ges lgo3 2l3h li4ag li2am
liar5iz li4as li4ato li5bi 5licio li4cor 4lics 4lict. l4icu l3icy l3ida lid5er
3lidi lif3er l4iff li4fl 5ligate 3ligh li4gra 3lik 4l4i4l lim4bl lim3i li4mo
l4im4p l4ina 1l4ine lin3ea lin3i link5er li5og 4l4iq lis4p l1it l2it. 5litica
l5i5tics liv3er l1iz 4lj lka3 l3kal lka4t l1l l4law l2le l5lea l3lec l3leg l3lel
l3le4n l3le4t ll2i l2lin4 l5lina ll4o lloqui5 ll5out l5low 2lm l5met lm3ing
l4mod lmon4 2l1n2 3lo. lob5al lo4ci 4lof 3logic l5ogo 3logu lom3er 5long lon4i
l3o3niz lood5 5lope. lop3i l3opm lora4 lo4rato lo5rie lor5ou 5los. los5et
5losophiz 5losophy los4t lo4ta loun5d 2lout 4lov 2lp lpa5b l3pha l5phi lp5ing
l3pit l4pl l5pr 4l1r 2l1s2 l4sc l2se l4sie 4lt lt5ag ltane5 l1te lten4 ltera4
lth3i l5ties. ltis4 l1tr ltu2 ltur3a lu5a lu3br luch4 lu3ci lu3en luf4 lu5id
lu4ma 5lumi l5umn. 5lumnia lu3o luo3r 4lup luss4 lus3te 1lut l5ven l5vet4 2l1w
1ly 4lya 4lyb ly5me ly3no 2lys4 l5yse 1ma 2mab ma2ca ma5chine ma4cl mag5in 5magn
2mah maid5 4mald ma3lig ma5lin mal4li mal4ty 5mania man5is man3iz 4map ma5rine.
ma5riz mar4ly mar3v ma5sce mas4e mas1t 5mate math3 ma3tis 4matiza 4m1b mba4t5
m5bil m4b3ing mbi4v 4m5c 4me. 2med 4med. 5media me3die m5e5dy me2g mel5on mel4t
me2m mem1o3 1men men4a men5ac men4de 4mene men4i mens4 mensu5 3ment men4te me5on
m5ersa 2mes 3mesti me4ta met3al me1te me5thi m4etr 5metric me5trie me3try me4v
4m1f 2mh 5mi. mi3a mid4a mid4g mig4 3milia m5i5lie m4ill min4a 3mind m5inee
m4ingl min5gli m5ingly min4t m4inu miot4 m2is mis4er. mis5l mis4ti m5istry 4mith
m2iz 4mk 4m1l m1m mma5ry 4m1n mn4a m4nin mn4o 1mo 4mocr 5mocratiz mo2d1 mo4go
mois2 moi5se 4mok mo5lest mo3me mon5et mon5ge moni3a mon4ism mon4ist mo3niz
monol4 mo3ny. mo2r 4mora. mos2 mo5sey mo3sp moth3 m5ouf 3mous mo2v 4m1p mpara5
mpa5rab mpar5i m3pet mphas4 m2pi mpi4a mp5ies m4p1in m5pir mp5is mpo3ri mpos5ite
m4pous mpov5 mp4tr m2py 4m3r 4m1s2 m4sh m5si 4mt 1mu mula5r4 5mult multi3 3mum
mun2 4mup mu4u 4mw 1na 2n1a2b n4abu 4nac. na4ca n5act nag5er. nak4 na4li na5lia
4nalt na5mit n2an nanci4 nan4it nank4 nar3c 4nare nar3i nar4l n5arm n4as nas4c
nas5ti n2at na3tal nato5miz n2au nau3se 3naut nav4e 4n1b4 ncar5 n4ces. n3cha
n5cheo n5chil n3chis nc1in nc4it ncour5a n1cr n1cu n4dai n5dan n1de nd5est.
ndi4b n5d2if n1dit n3diz n5duc ndu4r nd2we 2ne. n3ear ne2b neb3u ne2c 5neck 2ned
ne4gat neg5ativ 5nege ne4la nel5iz ne5mi ne4mo 1nen 4nene 3neo ne4po ne2q n1er
nera5b n4erar n2ere n4er5i ner4r 1nes 2nes. 4nesp 2nest 4nesw 3netic ne4v n5eve
ne4w n3f n4gab n3gel nge4n4e n5gere n3geri ng5ha n3gib ng1in n5git n4gla ngov4
ng5sh n1gu n4gum n2gy 4n1h4 nha4 nhab3 nhe4 3n4ia ni3an ni4ap ni3ba ni4bl ni4d
ni5di ni4er ni2fi ni5ficat n5igr nik4 n1im ni3miz n1in 5nine. nin4g ni4o 5nis.
nis4ta n2it n4ith 3nitio n3itor ni3tr n1j 4nk2 n5kero n3ket nk3in n1kl 4n1l n5m
nme4 nmet4 4n1n2 nne4 nni3al nni4v nob4l no3ble n5ocl 4n3o2d 3noe 4nog noge4
nois5i no5l4i 5nologis 3nomic n5o5miz no4mo no3my no4n non4ag non5i n5oniz 4nop
5nop5o5li nor5ab no4rary 4nosc nos4e nos5t no5ta 1nou 3noun nov3el3 nowl3 n1p4
npi4 npre4c n1q n1r nru4 2n1s2 ns5ab nsati4 ns4c n2se n4s3es nsid1 nsig4 n2sl
ns3m n4soc ns4pe n5spi nsta5bl n1t nta4b nter3s nt2i n5tib nti4er nti2f n3tine
n4t3ing nti4p ntrol5li nt4s ntu3me nu1a nu4d nu5en nuf4fe n3uin 3nu3it n4um
nu1me n5umi 3nu4n n3uo nu3tr n1v2 n1w4 nym4 nyp4 4nz n3za 4oa oad3 o5a5les oard3
oas4e oast5e oat5i ob3a3b o5bar obe4l o1bi o2bin ob5ing o3br ob3ul o1ce och4
o3chet ocif3 o4cil o4clam o4cod oc3rac oc5ratiz ocre3 5ocrit octor5a oc3ula
o5cure od5ded od3ic odi3o o2do4 odor3 od5uct. od5ucts o4el o5eng o3er oe4ta o3ev
o2fi of5ite ofit4t o2g5a5r og5ativ o4gato o1ge o5gene o5geo o4ger o3gie 1o1gis
og3it o4gl o5g2ly 3ogniz o4gro ogu5i 1ogy 2ogyn o1h2 ohab5 oi2 oic3es oi3der
oiff4 oig4 oi5let o3ing oint5er o5ism oi5son oist5en oi3ter o5j 2ok o3ken ok5ie
o1la o4lan olass4 ol2d old1e ol3er o3lesc o3let ol4fi ol2i o3lia o3lice ol5id.
o3li4f o5lil ol3ing o5lio o5lis. ol3ish o5lite o5litio o5liv olli4e ol5ogiz
olo4r ol5pl ol2t ol3ub ol3ume ol3un o5lus ol2v o2ly om5ah oma5l om5atiz om2be
om4bl o2me om3ena om5erse o4met om5etry o3mia om3ic. om3ica o5mid om1in o5mini
5ommend omo4ge o4mon om3pi ompro5 o2n on1a on4ac o3nan on1c 3oncil 2ond on5do
o3nen on5est on4gu on1ic o3nio on1is o5niu on3key on4odi on3omy on3s onspi4
onspir5a onsu4 onten4 on3t4i ontif5 on5um onva5 oo2 ood5e ood5i oo4k oop3i o3ord
oost5 o2pa ope5d op1er 3opera 4operag 2oph o5phan o5pher op3ing o3pit o5pon
o4posi o1pr op1u opy5 o1q o1ra o5ra. o4r3ag or5aliz or5ange ore5a o5real or3ei
ore5sh or5est. orew4 or4gu 4o5ria or3ica o5ril or1in o1rio or3ity o3riu or2mi
orn2e o5rof or3oug or5pe 3orrh or4se ors5en orst4 or3thi or3thy or4ty o5rum o1ry
os3al os2c os4ce o3scop 4oscopi o5scr os4i4e os5itiv os3ito os3ity osi4u os4l
o2so os4pa os4po os2ta o5stati os5til os5tit o4tan otele4g ot3er. ot5ers o4tes
4oth oth5esi oth3i4 ot3ic. ot5ica o3tice o3tif o3tis oto5s ou2 ou3bl ouch5i
ou5et ou4l ounc5er oun2d ou5v ov4en over4ne over3s ov4ert o3vis oviti4 o5v4ol
ow3der ow3el ow5est ow1i own5i o4wo oy1a 1pa pa4ca pa4ce pac4t p4ad 5pagan
p3agat p4ai pain4 p4al pan4a pan3el pan4ty pa3ny pa1p pa4pu para5bl par5age
par5di 3pare par5el p4a4ri par4is pa2te pa5ter 5pathic pa5thy pa4tric pav4 3pay
4p1b pd4 4pe. 3pe4a pear4l pe2c 2p2ed 3pede 3pedi pedia4 ped4ic p4ee pee4d pek4
pe4la peli4e pe4nan p4enc pen4th pe5on p4era. pera5bl p4erag p4eri peri5st
per4mal perme5 p4ern per3o per3ti pe5ru per1v pe2t pe5ten pe5tiz 4pf 4pg 4ph.
phar5i phe3no ph4er ph4es. ph1ic 5phie ph5ing 5phisti 3phiz ph2l 3phob 3phone
5phoni pho4r 4phs ph3t 5phu 1phy pi3a pian4 pi4cie pi4cy p4id p5ida pi3de 5pidi
3piec pi3en pi4grap pi3lo pi2n p4in. pind4 p4ino 3pi1o pion4 p3ith pi5tha pi2tu
2p3k2 1p2l2 3plan plas5t pli3a pli5er 4plig pli4n ploi4 plu4m plum4b 4p1m 2p3n
po4c 5pod. po5em po3et5 5po4g poin2 5point poly5t po4ni po4p 1p4or po4ry 1pos
pos1s p4ot po4ta 5poun 4p1p ppa5ra p2pe p4ped p5pel p3pen p3per p3pet ppo5site
pr2 pray4e 5preci pre5co pre3em pref5ac pre4la pre3r p3rese 3press pre5ten pre3v
5pri4e prin4t3 pri4s pris3o p3roca prof5it pro3l pros3e pro1t 2p1s2 p2se ps4h
p4sib 2p1t pt5a4b p2te p2th pti3m ptu4r p4tw pub3 pue4 puf4 pul3c pu4m pu2n
pur4r 5pus pu2t 5pute put3er pu3tr put4ted put4tin p3w qu2 qua5v 2que. 3quer
3quet 2rab ra3bi rach4e r5acl raf5fi raf4t r2ai ra4lo ram3et r2ami rane5o ran4ge
r4ani ra5no rap3er 3raphy rar5c rare4 rar5ef 4raril r2as ration4 rau4t ra5vai
rav3el ra5zie r1b r4bab r4bag rbi2 rbi4f r2bin r5bine rb5ing. rb4o r1c r2ce
rcen4 r3cha rch4er r4ci4b rc4it rcum3 r4dal rd2i rdi4a rdi4er rdin4 rd3ing 2re.
re1al re3an re5arr 5reav re4aw r5ebrat rec5oll rec5ompe re4cre 2r2ed re1de
re3dis red5it re4fac re2fe re5fer. re3fi re4fy reg3is re5it re1li re5lu r4en4ta
ren4te re1o re5pin re4posi re1pu r1er4 r4eri rero4 re5ru r4es. re4spi ress5ib
res2t re5stal re3str re4ter re4ti4z re3tri reu2 re5uti rev2 re4val rev3el
r5ev5er. re5vers re5vert re5vil rev5olu re4wh r1f rfu4 r4fy rg2 rg3er r3get
r3gic rgi4n rg3ing r5gis r5git r1gl rgo4n r3gu rh4 4rh. 4rhal ri3a ria4b ri4ag
r4ib rib3a ric5as r4ice 4rici 5ricid ri4cie r4ico rid5er ri3enc ri3ent ri1er
ri5et rig5an 5rigi ril3iz 5riman rim5i 3rimo rim4pe r2ina 5rina. rin4d rin4e
rin4g ri1o 5riph riph5e ri2pl rip5lic r4iq r2is r4is. ris4c r3ish ris4p ri3ta3b
r5ited. rit5er. rit5ers rit3ic ri2tu rit5ur riv5el riv3et riv3i r3j r3ket rk4le
rk4lin r1l rle4 r2led r4lig r4lis rl5ish r3lo4 r1m rma5c r2me r3men rm5ers
rm3ing r4ming. r4mio r3mit r4my r4nar r3nel r4ner r5net r3ney r5nic r1nis4 r3nit
r3niv rno4 r4nou r3nu rob3l r2oc ro3cr ro4e ro1fe ro5fil rok2 ro5ker 5role.
rom5ete rom4i rom4p ron4al ron4e ro5n4is ron4ta 1room 5root ro3pel rop3ic ror3i
ro5ro ros5per ros4s ro4the ro4ty ro4va rov5el rox5 r1p r4pea r5pent rp5er. r3pet
rp4h4 rp3ing r3po r1r4 rre4c rre4f r4reo rre4st rri4o rri4v rron4 rros4 rrys4
4rs2 r1sa rsa5ti rs4c r2se r3sec rse4cr rs5er. rs3es rse5v2 r1sh r5sha r1si
r4si4b rson3 r1sp r5sw rtach4 r4tag r3teb rten4d rte5o r1ti rt5ib rti4d r4tier
r3tig rtil3i rtil4l r4tily r4tist r4tiv r3tri rtroph4 rt4sh ru3a ru3e4l ru3en
ru4gl ru3in rum3pl ru2n runk5 run4ty r5usc ruti5n rv4e rvel4i r3ven rv5er.
r5vest r3vey r3vic rvi4v r3vo r1w ry4c 5rynge ry3t sa2 2s1ab 5sack sac3ri s3act
5sai salar4 sal4m sa5lo sal4t 3sanc san4de s1ap sa5ta 5sa3tio sat3u sau4 sa5vor
5saw 4s5b scan4t5 sca4p scav5 s4ced 4scei s4ces sch2 s4cho 3s4cie 5scin4d scle5
s4cli scof4 4scopy scour5a s1cu 4s5d 4se. se4a seas4 sea5w se2c3o 3sect 4s4ed
se4d4e s5edl se2g seg3r 5sei se1le 5self 5selv 4seme se4mol sen5at 4senc sen4d
s5ened sen5g s5enin 4sentd 4sentl sep3a3 4s1er. s4erl ser4o 4servo s1e4s se5sh
ses5t 5se5um 5sev sev3en sew4i 5sex 4s3f 2s3g s2h 2sh. sh1er 5shev sh1in sh3io
3ship shiv5 sho4 sh5old shon3 shor4 short5 4shw si1b s5icc 3side. 5sides 5sidi
si5diz 4signa sil4e 4sily 2s1in s2ina 5sine. s3ing 1sio 5sion sion5a si2r sir5a
1sis 3sitio 5siu 1siv 5siz sk2 4ske s3ket sk5ine sk5ing s1l2 s3lat s2le slith5
2s1m s3ma small3 sman3 smel4 s5men 5smith smol5d4 s1n4 1so so4ce soft3 so4lab
sol3d2 so3lic 5solv 3som 3s4on. sona4 son4g s4op 5sophic s5ophiz s5ophy sor5c
sor5d 4sov so5vi 2spa 5spai spa4n spen4d 2s5peo 2sper s2phe 3spher spho5 spil4
sp5ing 4spio s4ply s4pon spor4 4spot squal4l s1r 2ss s1sa ssas3 s2s5c s3sel
s5seng s4ses. s5set s1si s4sie ssi4er ss5ily s4sl ss4li s4sn sspend4 ss2t ssur5a
ss5w 2st. s2tag s2tal stam4i 5stand s4ta4p 5stat. s4ted stern5i s5tero ste2w
stew5a s3the st2i s4ti. s5tia s1tic 5stick s4tie s3tif st3ing 5stir s1tle 5stock
stom3a 5stone s4top 3store st4r s4trad 5stratu s4tray s4trid 4stry 4st3w s2ty
1su su1al su4b3 su2g3 su5is suit3 s4ul su2m sum3i su2n su2r 4sv sw2 4swo s4y
4syc 3syl syn5o sy5rin 1ta 3ta. 2tab ta5bles 5taboliz 4taci ta5do 4taf4 tai5lo
ta2l ta5la tal5en tal3i 4talk tal4lis ta5log ta5mo tan4de tanta3 ta5per ta5pl
tar4a 4tarc 4tare ta3riz tas4e ta5sy 4tatic ta4tur taun4 tav4 2taw tax4is 2t1b
4tc t4ch tch5et 4t1d 4te. tead4i 4teat tece4 5tect 2t1ed te5di 1tee teg4 te5ger
te5gi 3tel. teli4 5tels te2ma2 tem3at 3tenan 3tenc 3tend 4tenes 1tent ten4tag
1teo te4p te5pe ter3c 5ter3d 1teri ter5ies ter3is teri5za 5ternit ter5v 4tes.
4tess t3ess. teth5e 3teu 3tex 4tey 2t1f 4t1g 2th. than4 th2e 4thea th3eas the5at
the3is 3thet th5ic. th5ica 4thil 5think 4thl th5ode 5thodic 4thoo thor5it
tho5riz 2ths 1tia ti4ab ti4ato 2ti2b 4tick t4ico t4ic1u 5tidi 3tien tif2 ti5fy
2tig 5tigu till5in 1tim 4timp tim5ul 2t1in t2ina 3tine. 3tini 1tio ti5oc tion5ee
5tiq ti3sa 3tise tis4m ti5so tis4p 5tistica ti3tl ti4u 1tiv tiv4a 1tiz ti3za
ti3zen 2tl t5la tlan4 3tle. 3tled 3tles. t5let. t5lo 4t1m tme4 2t1n2 1to to3b
to5crat 4todo 2tof to2gr to5ic to2ma tom4b to3my ton4ali to3nat 4tono 4tony
to2ra to3rie tor5iz tos2 5tour 4tout to3war 4t1p 1tra tra3b tra5ch traci4
trac4it trac4te tras4 tra5ven trav5es5 tre5f tre4m trem5i 5tria tri5ces 5tricia
4trics 2trim tri4v tro5mi tron5i 4trony tro5phe tro3sp tro3v tru5i trus4 4t1s2
t4sc tsh4 t4sw 4t3t2 t4tes t5to ttu4 1tu tu1a tu3ar tu4bi tud2 4tue 4tuf4 5tu3i
3tum tu4nis 2t3up. 3ture 5turi tur3is tur5o tu5ry 3tus 4tv tw4 4t1wa twis4 4two
1ty 4tya 2tyl type3 ty5ph 4tz tz4e 4uab uac4 ua5na uan4i uar5ant uar2d uar3i
uar3t u1at uav4 ub4e u4bel u3ber u4bero u1b4i u4b5ing u3ble. u3ca uci4b uc4it
ucle3 u3cr u3cu u4cy ud5d ud3er ud5est udev4 u1dic ud3ied ud3ies ud5is u5dit
u4don ud4si u4du u4ene uens4 uen4te uer4il 3ufa u3fl ugh3en ug5in 2ui2 uil5iz
ui4n u1ing uir4m uita4 uiv3 uiv4er. u5j 4uk u1la ula5b u5lati ulch4 5ulche
ul3der ul4e u1len ul4gi ul2i u5lia ul3ing ul5ish ul4lar ul4li4b ul4lis 4ul3m
u1l4o 4uls uls5es ul1ti ultra3 4ultu u3lu ul5ul ul5v um5ab um4bi um4bly u1mi
u4m3ing umor5o um2p unat4 u2ne un4er u1ni un4im u2nin un5ish uni3v un3s4 un4sw
unt3ab un4ter. un4tes unu4 un5y un5z u4ors u5os u1ou u1pe uper5s u5pia up3ing
u3pl up3p upport5 upt5ib uptu4 u1ra 4ura. u4rag u4ras ur4be urc4 ur1d ure5at
ur4fer ur4fr u3rif uri4fic ur1in u3rio u1rit ur3iz ur2l url5ing. ur4no uros4
ur4pe ur4pi urs5er ur5tes ur3the urti4 ur4tie u3ru 2us u5sad u5san us4ap usc2
us3ci use5a u5sia u3sic us4lin us1p us5sl us5tere us1tr u2su usur4 uta4b u3tat
4ute. 4utel 4uten uten4i 4u1t2i uti5liz u3tine ut3ing ution5a u4tis 5u5tiz u4t1l
ut5of uto5g uto5matic u5ton u4tou uts4 u3u uu4m u1v2 uxu3 uz4e 1va 5va. 2v1a4b
vac5il vac3u vag4 va4ge va5lie val5o val1u va5mo va5niz va5pi var5ied 3vat 4ve.
4ved veg3 v3el. vel3li ve4lo v4ely ven3om v5enue v4erd 5vere. v4erel v3eren
ver5enc v4eres ver3ie vermi4n 3verse ver3th v4e2s 4ves. ves4te ve4te vet3er
ve4ty vi5ali 5vian 5vide. 5vided 4v3iden 5vides 5vidi v3if vi5gn vik4 2vil
5vilit v3i3liz v1in 4vi4na v2inc vin5d 4ving vio3l v3io4r vi1ou vi4p vi5ro
vis3it vi3so vi3su 4viti vit3r 4vity 3viv 5vo. voi4 3vok vo4la v5ole 5volt 3volv
vom5i vor5ab vori4 vo4ry vo4ta 4votee 4vv4 v4y w5abl 2wac wa5ger wag5o wait5
w5al. wam4 war4t was4t wa1te wa5ver w1b wea5rie weath3 wed4n weet3 wee5v wel4l
w1er west3 w3ev whi4 wi2 wil2 will5in win4de win4g wir4 3wise with3 wiz5 w4k
wl4es wl3in w4no 1wo2 wom1 wo5ven w5p wra4 wri4 writa4 w3sh ws4l ws4pe w5s4t 4wt
wy4 x1a xac5e x4ago xam3 x4ap xas5 x3c2 x1e xe4cuto x2ed xer4i xe5ro x1h xhi2
xhil5 xhu4 x3i xi5a xi5c xi5di x4ime xi5miz x3o x4ob x3p xpan4d xpecto5 xpe3d
x1t2 x3ti x1u xu3a xx4 y5ac 3yar4 y5at y1b y1c y2ce yc5er y3ch ych4e ycom4 ycot4
y1d y5ee y1er y4erf yes4 ye4t y5gi 4y3h y1i y3la ylla5bl y3lo y5lu ymbol5 yme4
ympa3 yn3chr yn5d yn5g yn5ic 5ynx y1o4 yo5d y4o5g yom4 yo5net y4ons y4os y4ped
yper5 yp3i y3po y4poc yp2ta y5pu yra5m yr5ia y3ro yr4r ys4c y3s2e ys3ica ys3io
3ysis y4so yss4 ys1t ys3ta ysur4 y3thin yt3ic y1w za1 z5a2b zar2 4zb 2ze ze4n
ze4p z1er ze3ro zet4 2z1i z4il z4is 5zl 4zm 1zo zo4m zo5ol zte4 4z1z2 z4zy
"""
# Extra patterns, from ushyphmax.tex, dated 2005-05-30.
# Copyright (C) 1990, 2004, 2005 Gerard D.C. Kuiken.
# Copying and distribution of this file, with or without modification,
# are permitted in any medium without royalty provided the copyright
# notice and this notice are preserved.
#
# These patterns are based on the Hyphenation Exception Log
# published in TUGboat, Volume 10 (1989), No. 3, pp. 337-341,
# and a large number of incorrectly hyphenated words not yet published.
"""
.con5gr .de5riva .dri5v4 .eth1y6l1 .eu4ler .ev2 .ever5si5b .ga4s1om1 .ge4ome
.ge5ot1 .he3mo1 .he3p6a .he3roe .in5u2t .kil2n3i .ko6r1te1 .le6ices .me4ga1l
.met4ala .mim5i2c1 .mi1s4ers .ne6o3f .noe1th .non1e2m .poly1s .post1am .pre1am
.rav5en1o .semi5 .sem4ic .semid6 .semip4 .semir4 .sem6is4 .semiv4 .sph6in1
.spin1o .ta5pes1tr .te3legr .to6pog .to2q .un3at5t .un5err5 .vi2c3ar .we2b1l
.re1e4c a5bolic a2cabl af6fish am1en3ta5b anal6ys ano5a2c ans5gr ans3v anti1d
an3ti1n2 anti1re a4pe5able ar3che5t ar2range as5ymptot ath3er1o1s at6tes.
augh4tl au5li5f av3iou back2er. ba6r1onie ba1thy bbi4t be2vie bi5d2if bil2lab
bio5m bi1orb bio1rh b1i3tive blan2d1 blin2d1 blon2d2 bor1no5 bo2t1u1l brus4q
bus6i2er bus6i2es buss4ing but2ed. but4ted cad5e1m cat1a1s2 4chs. chs3hu chie5vo
cig3a3r cin2q cle4ar co6ph1o3n cous2ti cri3tie croc1o1d cro5e2co c2tro3me6c
1cu2r1ance 2d3alone data1b dd5a5b d2d5ib de4als. de5clar1 de2c5lina de3fin3iti
de2mos des3ic de2tic dic1aid dif5fra 3di1methy di2ren di2rer 2d1lead 2d1li2e
3do5word dren1a5l drif2t1a d1ri3pleg5 drom3e5d d3tab du2al. du1op1o1l ea4n3ies
e3chas edg1l ed1uling eli2t1is e1loa en1dix eo3grap 1e6p3i3neph1 e2r3i4an.
e3spac6i eth1y6l1ene 5eu2clid1 feb1rua fermi1o 3fich fit5ted. fla1g6el flow2er.
3fluor gen2cy. ge3o1d ght1we g1lead get2ic. 4g1lish 5glo5bin 1g2nac gnet1ism
gno5mo g2n1or. g2noresp 2g1o4n3i1za graph5er. griev1 g1utan hair1s ha2p3ar5r
hatch1 hex2a3 hite3sid h3i5pel1a4 hnau3z ho6r1ic. h2t1eou hypo1tha id4ios
ifac1et ign4it ignit1er i4jk im3ped3a infra1s2 i5nitely. irre6v3oc i1tesima
ith5i2l itin5er5ar janu3a japan1e2s je1re1m 1ke6ling 1ki5netic 1kovian k3sha
la4c3i5e lai6n3ess lar5ce1n l3chai l3chil6d1 lead6er. lea4s1a 1lec3ta6b
le3g6en2dre 1le1noid lith1o5g ll1fl l2l3ish l5mo3nell lo1bot1o1 lo2ges. load4ed.
load6er. l3tea lth5i2ly lue1p 1lunk3er 1lum5bia. 3lyg1a1mi ly5styr ma1la1p m2an.
man3u1sc mar1gin1 medi2c med3i3cin medio6c1 me3gran3 m2en. 3mi3da5b 3milita
mil2l1ag mil5li5li mi6n3is. mi1n2ut1er mi1n2ut1est m3ma1b 5maph1ro1 5moc1ra1t
mo5e2las mol1e5c mon4ey1l mono3ch mo4no1en moro6n5is mono1s6 moth4et2 m1ou3sin
m5shack2 mu2dro mul2ti5u n3ar4chs. n3ch2es1t ne3back 2ne1ski n1dieck nd3thr
nfi6n3ites 4n5i4an. nge5nes ng1ho ng1spr nk3rup n5less 5noc3er1os nom1a6l
nom5e1no n1o1mist non1eq non1i4so 5nop1oly. no1vemb ns5ceiv ns4moo ntre1p
obli2g1 o3chas odel3li odit1ic oerst2 oke1st o3les3ter oli3gop1o1 o1lo3n4om
o3mecha6 onom1ic o3norma o3no2t1o3n o3nou op1ism. or4tho3ni4t orth1ri or5tively
o4s3pher o5test1er o5tes3tor oth3e1o1s ou3ba3do o6v3i4an. oxi6d1ic pal6mat
parag6ra4 par4a1le param4 para3me pee2v1 phi2l3ant phi5lat1e3l pi2c1a3d pli2c1ab
pli5nar poin3ca 1pole. poly1e po3lyph1ono 1prema3c pre1neu pres2pli pro2cess
proc3i3ty. pro2g1e 3pseu2d pseu3d6o3d2 pseu3d6o3f2 pto3mat4 p5trol3 pu5bes5c
quain2t1e qu6a3si3 quasir6 quasis6 quin5tes5s qui3v4ar r1abolic 3rab1o1loi
ra3chu r3a3dig radi1o6g r2amen 3ra4m5e1triz ra3mou ra5n2has ra1or r3bin1ge
re2c3i1pr rec5t6ang re4t1ribu r3ial. riv1o1l 6rk. rk1ho r1krau 6rks. r5le5qu
ro1bot1 ro5e2las ro5epide1 ro3mesh ro1tron r3pau5li rse1rad1i r1thou r1treu
r1veil rz1sc sales3c sales5w 5sa3par5il sca6p1er sca2t1ol s4chitz schro1ding1
1sci2utt scrap4er. scy4th1 sem1a1ph se3mes1t se1mi6t5ic sep3temb shoe1st sid2ed.
side5st side5sw si5resid sky1sc 3slova1kia 3s2og1a1my so2lute 3s2pace 1s2pacin
spe3cio spher1o spi2c1il spokes5w sports3c sports3w s3qui3to s2s1a3chu1 ss3hat
s2s3i4an. s5sign5a3b 1s2tamp s2t1ant5shi star3tli sta1ti st5b 1stor1ab strat1a1g
strib5ut st5scr stu1pi4d1 styl1is su2per1e6 1sync 1syth3i2 swimm6 5tab1o1lism
ta3gon. talk1a5 t1a1min t6ap6ath 5tar2rh tch1c tch3i1er t1cr teach4er. tele2g
tele1r6o 3ter1gei ter2ic. t3ess2es tha4l1am tho3don th1o5gen1i tho1k2er thy4l1an
thy3sc 2t3i4an. ti2n3o1m t1li2er tolo2gy tot3ic trai3tor1 tra1vers travers3a3b
treach1e tr4ial. 3tro1le1um trof4ic. tro3fit tro1p2is 3trop1o5les 3trop1o5lis
t1ro1pol3it tsch3ie ttrib1ut1 turn3ar t1wh ty2p5al ua3drati uad1ratu u5do3ny
uea1m u2r1al. uri4al. us2er. v1ativ v1oir5du1 va6guer vaude3v 1verely. v1er1eig
ves1tite vi1vip3a3r voice1p waste3w6a2 wave1g4 w3c week1n wide5sp wo4k1en
wrap3aro writ6er. x1q xquis3 y5che3d ym5e5try y1stro yes5ter1y z3ian. z3o1phr
z2z3w
""")
exceptions = """
as-so-ciate as-so-ciates dec-li-na-tion oblig-a-tory phil-an-thropic present
presents project projects reci-procity re-cog-ni-zance ref-or-ma-tion
ret-ri-bu-tion ta-ble
"""
hyphenator = Hyphenator(patterns, exceptions)
hyphenate_word = hyphenator.hyphenate_word
del patterns
del exceptions
if __name__ == '__main__':
import sys
if len(sys.argv) > 1:
for word in sys.argv[1:]:
print '-'.join(hyphenate_word(word))
else:
import doctest
doctest.testmod(verbose=True)

@ -1,165 +0,0 @@
#lang racket/base
(require racket/string racket/list)
(require (planet mb/pollen/hyphenation-data))
(require (planet mb/pollen/readability))
(require (planet mb/pollen/tools))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hyphenate.rkt
;;; Racket port of Ned Batchelder's hyphenate.py
;;; http://nedbatchelder.com/code/modules/hyphenate.html
;;; (in the public domain)
;;; which in turn was an implementation
;;; of the Liang hyphenation algorithm in TeX
;;; (also in the public domain)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide (all-defined-out))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Exceptions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-exceptions exception-data)
(define (make-key x)
(string-replace x "-" ""))
(define (make-value x)
(list->vector (cons 0 (map (ƒ(x) (int (=str x "-"))) (regexp-split #px"[a-z]" x)))))
(make-hash
(map (ƒ(x) (cons (make-key x) (make-value x))) exception-data)))
; global data, so this only needs to be defined once
(define exceptions (make-exceptions exception-data))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Helper functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-pattern-tree pattern-data)
(define tree (make-hash))
(define (insert-pattern pat)
(let* ([chars (regexp-replace* #px"[0-9]" pat "")]
[points (map (λ(x) (int x)) (regexp-split #px"[.a-z]" pat))]
[tree tree])
(for ([char chars])
(when (not (in? tree char))
(change tree char (make-hash)))
(set! tree (get tree char)))
(change tree empty points)))
(map insert-pattern pattern-data)
tree)
; global data, so this only needs to be defined once
(define pattern-tree (make-pattern-tree pattern-data))
(define (make-points word)
(define (make-zeroes points)
; controls hyphenation zone from edges of word
; todo: parameterize this setting
; todo: does this count end-of-word punctuation? it shouldn't.
(map (ƒ(i) (change points i 0)) (list 1 2 (- (len points) 2) (- (len points) 3)))
points)
(let* ([word (to-lc word)]
[points
(if (in? exceptions word)
(get exceptions word)
(let* ([work (str "." word ".")]
[points (make-vector (add1 (len work)) 0)])
(for ([i (len work)])
(let ([tree pattern-tree])
(for ([char (get work i 'end)]
#:break (not (in? tree char)))
(set! tree (get tree char))
(when (in? tree empty)
(let ([point (get tree empty)])
(for ([j (len point)])
(change points (+ i j) (max (get points (+ i j)) (get point j)))))))))
points))])
; make-zeroes controls minimum hyphenation distance from edge.
; todo: dropping first 2 elements is needed for mysterious reasons to be documented later
; see python code for why
(get (make-zeroes points) 2 'end)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Main function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (hyphenate-word word #:filter [filter (λ(x)x)])
; Given a word, returns a list of pieces,
; broken at the possible hyphenation points.
(if (or (<= (len word) 4) (filter word))
; Short words aren't hyphenated.
(as-list word)
; Examine the points to build the pieces list.
(string-split ; split on whitespace
(list->string ; concatenate chars
(flatten ; get rid of cons pairs
(for/list ([char word] [point (make-points word)])
(if (even? point)
char ; even point denotes character
(cons char #\ )))))))) ; odd point denotes char + syllable
(define (hyphenate-string text #:joiner [joiner (integer->char #x00AD)] #:filter [filter (λ(x)x)])
(regexp-replace* #px"\\w+" text (ƒ(word) (string-join (hyphenate-word word #:filter filter) (as-string joiner)))))
(define (capitalized? word)
; match property = \\p
; match unicode uppercase = {Lu}
(regexp-match #px"\\p{Lu}" (get word 0)))
(define (hyphenate x #:only [only-proc (ƒ(x) x)]) ; recursively hyphenate strings within xexpr
(define exclusions '(style script)) ; omit these from ever being hyphenated
(define inclusions '(p aside))
(define (capitalized-or-ligated? word)
; filter function for hyphenate
; filtering ligatable words because once the soft hyphens go in,
; the browser won't automatically substitute the ligs.
; so it looks weird, because some are ligated and some not.
; not ideal, because it removes hyphenation options but ... whatever
(or (capitalized? word) (any (ƒ(lig) (regexp-match lig word)) '("ff" "fi" "fl" "ffi" "ffl"))))
(cond
; todo: the only-proc semantics are illogical.
; main issue: keep it out of tags like <style> that parse as textual elements, but are not.
; So two choices, opt-out or opt-in.
; Problem with opt-out: is set of outlier tags like <style> well-defined?
; Won't it make hyphenation naturally overinclusive?
; Problem with opt-in: conceals a lot of tags that naturally live inside other tags
; only reaches text at the "root level" of the tag.
[(named-xexpr? x) (if (and (in? inclusions (car x)) (not (in? exclusions (car x))))
(map-xexpr-content hyphenate x)
(map-xexpr-content hyphenate x #:only named-xexpr?))] ; only process subxexprs
[(string? x)
; hyphenate everything but last word
; todo: problem here is that it's string-based, not paragraph based.
; meaning, the last word of every STRING gets exempted,
; even if that word doesn't fall at the end of a block.
; should work the way nonbreak spacer works.
; todo: question - should hyphenator ignore possible ligature pairs, like fi?
; because auto ligatures will skip combos with a soft hyphen between
; regexp matches everything up to last word, and allows trailing whitespace
; parenthesized matches become series of lambda arguments. Arity must match
; [^\\s\u00A0] = characters that are neither whitespace nor nbsp (which is not included in \s)
; +\\s*$ = catches trailing whitespace up to end
(regexp-replace #px"(.*?)([^\\s\u00A0]+\\s*$)"
x
; by default, filter out capitalized words and words with ligatable combos
; m0 m1 m2 are the match groups from regexp-replace
(ƒ(m0 m1 m2) (string-append (hyphenate-string m1 #:filter capitalized-or-ligated?) m2)))]
[else x]))
(module+ main
(hyphenate '(p "circular firing squad") #:only (ƒ(xexpr) (in? '(p) (first xexpr)))))

File diff suppressed because one or more lines are too long

@ -0,0 +1,5 @@
#lang info
(define collection "pollen")
(define deps '("base" "txexpr" "sugar" "markdown"))
(define scribblings '(("scribblings/pollen.scrbl" (multi-page))))
(define raco-commands '(("pollen" pollen/raco "issue Pollen command" #f)))

@ -1,27 +0,0 @@
#lang racket/base
(require (only-in scribble/reader make-at-reader)
(only-in (planet mb/pollen/world) POLLEN_EXPRESSION_DELIMITER))
(provide (rename-out [mb-read read]
[mb-read-syntax read-syntax])
read-inner
)
(define read-inner
(make-at-reader #:command-char POLLEN_EXPRESSION_DELIMITER
#:syntax? #t
#:inside? #t))
(define (mb-read p)
(syntax->datum
(mb-read-syntax (object-name p) p)))
(define (make-output-datum i)
`(module pollen-lang-module (planet mb/pollen)
,@i))
(define (mb-read-syntax name p)
(define i (read-inner name p))
(datum->syntax i
(make-output-datum i)
i))

@ -1,18 +0,0 @@
#lang racket
(require (planet mb/pollen/syntax))
; for now, body is deemed a block, not inline
;todo: is this legit? Why is body inline?
(define block-tags
'(address article aside audio blockquote body canvas dd div dl fieldset figcaption figure footer form h1 h2 h3 h4 h5 h6 header hgroup noscript ol output p pre section table tfoot ul video))
; for now, map is omitted because it's a Racket keyword
; for now, style, script, and link are omitted because they shouldn't be wrapped
(define inline-tags
'(a abbr acronym applet area b base basefont bdo big br button caption center cite code col colgroup del dir dfn dt em embed font frame framesethead hr html i iframe img input ins isindex kbd label legend li menu meta noframes object optgroup option param q s samp select small span strike strong sub sup tbody td textarea th thead title tr tt u var xmp))
(define tags (append block-tags inline-tags))
(provide (all-defined-out))

@ -0,0 +1,116 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax) pollen/world)
(provide (all-defined-out) (all-from-out pollen/world))
(define-syntax (define+provide-module-begin-in-mode stx)
(syntax-case stx ()
[(_ mode-arg)
(with-syntax ([new-module-begin (format-id stx "new-module-begin")])
#'(begin
(provide (except-out (all-from-out racket/base) #%module-begin)
(rename-out [new-module-begin #%module-begin]))
(define-syntax (new-module-begin stx-arg)
(syntax-case stx-arg ()
[(_ body-exprs (... ...))
(syntax-protect
#'(#%module-begin
(module inner pollen/doclang-raw
;; doclang_raw is a version of scribble/doclang with the decoder disabled
;; first three lines are positional arguments for doclang-raw
doc-raw ; id of export
(λ(x) x) ; post-process function
() ; prepended exprs
;; Change behavior of undefined identifiers with #%top
;; Get project values from world
(require pollen/top pollen/world)
(provide (all-from-out pollen/top pollen/world))
;; for anything defined in pollen source file
(provide (all-defined-out))
body-exprs (... ...))
(require 'inner)
;; if reader-here-path is undefined, it will become a proc courtesy of #%top
;; therefore that's how we can detect if it's undefined
(define here-path (if (procedure? reader-here-path) "anonymous-module" reader-here-path))
;; set the parser mode based on reader mode
;; todo: this won't work with inline submodules
(define parser-mode
(if (not (procedure? reader-mode))
(if (equal? reader-mode world:mode-auto)
(let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (string->symbol (car (regexp-match file-ext-pattern here-path)))])
(cond
[(equal? here-ext world:pagetree-source-ext) world:mode-pagetree]
[(equal? here-ext world:markup-source-ext) world:mode-markup]
[(equal? here-ext world:markdown-source-ext) world:mode-markdown]
[else world:mode-preproc]))
reader-mode)
mode-arg))
;; Split out the metas.
(define (split-metas-to-hash x)
(define (meta-key x) (car (caadr x)))
(define (meta-value x) (cadr (caadr x)))
(define is-meta-element? (λ(x) (and (list? x) ; possible txexpr
(= (length x) 2) ; = tag + attribute
(equal? 'meta (car x)) ; tag is 'meta
(symbol? (meta-key x)) ; attribute key is symbol
(string? (meta-value x))))) ; attribute value is string
(define (splitter x)
(define meta-acc null)
(define (split-metas x)
(cond
[(list? x) (define-values (new-metas rest) (values (filter is-meta-element? x) (filter (compose1 not is-meta-element?) x)))
(set! meta-acc (append new-metas meta-acc))
(map split-metas rest)]
[else x]))
(define result (split-metas x))
(values result meta-acc))
(define-values (doc-without-metas meta-elements) (splitter x))
(define meta-element->assoc (λ(x) (let ([key (meta-key x)][value (meta-value x)]) (cons key value))))
(define metas (make-hash (map meta-element->assoc meta-elements)))
(values doc-without-metas metas))
(define doc-with-metas
(let ([doc-raw (if (equal? parser-mode world:mode-markdown)
(apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw)
doc-raw)])
`(placeholder-root
,@(cons (meta 'here-path: here-path)
;; cdr strips initial linebreak, but make sure doc-raw isn't blank
(if (and (list? doc-raw) (> (length doc-raw) 0) (equal? (car doc-raw) "\n")) (cdr doc-raw) doc-raw)))))
(define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas))
;; set up the 'doc export
(require pollen/decode)
(define doc (apply (cond
[(equal? parser-mode world:mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))]
;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[(or (equal? parser-mode world:mode-markup)
(equal? parser-mode world:mode-markdown)) root]
;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish
(cdr doc-without-metas))) ;; cdr strips placeholder-root tag
(provide metas doc
;; hide the exports that were only for internal use.
(except-out (all-from-out 'inner) doc-raw #%top))
;; for output in DrRacket
(module+ main
(if (or (equal? parser-mode world:mode-preproc) (equal? parser-mode world:mode-template))
(display doc)
(print doc)))))]))))]))

@ -1,92 +0,0 @@
#lang racket
(require (for-syntax (planet mb/pollen/tools)
(planet mb/pollen/world)))
(require (planet mb/pollen/tools)
(planet mb/pollen/world))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Look for a pp-requires directory local to the source file.
;; If it exists, get list of rkt files
;; and require + provide them.
;; This will be resolved in the context of current-directory.
;; So when called from outside the project directory,
;; current-directory must be properly set with 'parameterize'
(require racket/contract/region)
(define-for-syntax (is-rkt-file? x) (has-ext? x 'rkt))
(define-for-syntax (make-complete-path x)
(define-values (start_dir name _ignore)
(split-path (path->complete-path x)))
(build-path start_dir EXTRAS_DIR name))
(define-syntax (require-and-provide-extras stx)
(if (directory-exists? EXTRAS_DIR)
(letrec
([files (map make-complete-path (filter is-rkt-file? (directory-list EXTRAS_DIR)))]
[files-in-require-form
(map (ƒ(x) `(file ,(path->string x))) files)])
(datum->syntax stx
`(begin
(require ,@files-in-require-form)
(provide (all-from-out ,@files-in-require-form)))))
; if no files to import, do nothing
#'(begin))) ; tried (void) here but it doesn't work: prints <void>
; todo: merge with function above
(define-syntax (require-extras stx)
(if (directory-exists? EXTRAS_DIR)
(letrec
([files (map make-complete-path (filter is-rkt-file? (directory-list EXTRAS_DIR)))]
[files-in-require-form
(map (ƒ(x) `(file ,(path->string x))) files)])
(datum->syntax stx
`(begin
(require ,@files-in-require-form))))
; if no files to import, do nothing
#'(begin)))
; AHA! This is how to make an identifier secretly behave as a runtime function
; first, define the function as syntax-rule
(define-syntax-rule (get-here)
(begin ; define-syntax-rule must have a single expression in the body
; also, even though begin permits defines,
; macro might be used in an expression context, whereupon they will cause an error.
; so best to use let
(let ([ccr (current-contract-region)]) ; trick for getting current module name
(when (list? ccr) ; if contract-region is called from within submodule, you get a list
(set! ccr (car ccr))) ; in which case, just grab the path from the front
(if (equal? 'pollen-lang-module ccr) ; what happens if the file isn't yet saved in drracket
'nowhere ; thus you are nowhere
(let-values ([(here-dir here-name ignored) (split-path ccr)])
(path->string (remove-ext here-name)))))))
; then, apply a separate syntax transform to the identifier itself
; can't do this in one step, because if the macro goes from identifier to function definition,
; macro processor will evaluate the body at compile-time, not runtime.
(define-syntax here
(ƒ(stx) (datum->syntax stx '(get-here))))
; function to strip metas out of body and consolidate them separately
(define (split-metas body)
(define meta-list '())
(define (&split-metas x)
(cond
[(and (named-xexpr? x) (equal? 'meta (car x)))
(begin
(set! meta-list (cons x meta-list))
empty)]
[(named-xexpr? x) ; handle named-xexpr
(let-values([(name attr body) (xexplode x)])
(make-xexpr name attr (&split-metas body)))]
[(list? x) (map &split-metas x)]
[else x]))
(values (remove-empty (&split-metas body)) (reverse meta-list)))
(provide (all-defined-out))

@ -1,33 +0,0 @@
#lang racket/base
(require (only-in (planet mb/pollen/tools) as-list trim-whitespace))
(provide (except-out (all-from-out racket/base) #%module-begin)
(rename-out [module-begin #%module-begin]))
(require (only-in scribble/text output))
(define-syntax-rule (module-begin expr ...)
(#%module-begin
; We want our module language to support require & provide
; which are only supported at the module level, so ...
; create a submodule to contain the input
; and export as needed
; doclang2_raw is a clone of scribble/doclang2 with decode disabled
; helpful because it collects & exports content via 'doc
(module pollen-inner (planet mb/pollen/doclang2_raw)
(require (planet mb/pollen/tools)
web-server/templates ; for subtemplating
(planet mb/pollen/main-helper)) ; for split-metas and get-here
(require-and-provide-extras) ; brings in the project require files
expr ...) ; body of module
(require 'pollen-inner) ; provides 'doc
(define text (trim-whitespace (as-list doc))) ; if single line, text will be a string
(provide text (all-from-out 'pollen-inner))
(output text)))

@ -1,73 +1,7 @@
#lang racket/base #lang racket/base
(require (only-in (planet mb/pollen/tools) as-list named-xexpr? decode tee ƒ) (require pollen/main-base)
(only-in (planet mb/pollen/main-helper) split-metas require-extras)) (define+provide-module-begin-in-mode world:mode-preproc) ; because default mode in submodule is preproc
(provide (except-out (all-from-out racket/base) #%module-begin) (module reader racket/base
(rename-out [module-begin #%module-begin])) (require pollen/reader-base)
(define+provide-reader-in-mode world:mode-auto)) ; because default mode in file is auto
(define-syntax-rule (module-begin expr ...)
(#%module-begin
; this is here only so that dynamic-rerequire of a pollen module
; transitively reloads the extras also.
; if this isn't here, then dynamic-rerequire can't see them
; and thus they are not tracked for changes.
(require-extras)
; We want our module language to support require & provide
; which are only supported at the module level, so ...
; create a submodule to contain the input
; and export as needed
; doclang2_raw is a clone of scribble/doclang2 with decode disabled
; helpful because it collects & exports content via 'doc
(module pollen-inner (planet mb/pollen/doclang2_raw)
(require (planet mb/pollen/tools)
(planet mb/pollen/template) ; for navigation functions
(planet mb/pollen/main-helper)) ; for split-metas and get-here
(require-and-provide-extras) ; brings in the project require files
; #%top binding catches ids that aren't defined
; here, convert them to basic xexpr
; #%top is a syntax transformer that returns a function
; ƒ x captures all the args (vs. ƒ(x), which only catches one)
; and id is not spliced because it's syntax, not a true variable
(define-syntax-rule (#%top . id)
(ƒ x `(id ,@x)))
expr ... ; body of module
(define inner-here here) ; set up a hook for 'here (different name to avoid macrofication)
(provide (all-defined-out))
(provide (all-from-out ; pollen file should bring its requires
(planet mb/pollen/tools)
(planet mb/pollen/template))))
(require 'pollen-inner) ; provides 'doc
(define text (as-list doc)) ; if single line, text will be a string
(set! text (if (named-xexpr? text) ; different setup depending on whether we have
`(main ,text) ; a whole xexpr or
`(main ,@text))) ; just xexpr content
; take out the metas so they don't goof up decoding
(define-values (raw-main metas) (split-metas text))
; splice in any included files
; todo: is this a safe operation?
; assume that main will never have an attr field
; because attr would parse out as content.
(set! raw-main (splice-xexpr-content raw-main))
; decode
(define main (decode raw-main))
; append metas to decoded
(when metas
(set! main (append main metas)))
(provide main text ; module language add-ons
(except-out (all-from-out 'pollen-inner) inner-here) ; everything from user
(rename-out (inner-here here))) ; change back to 'here
(module+ main
((tee (ƒ(x)x) (ƒ(x)(format "named-xexpr? ~a" (named-xexpr? main)))) main))))

@ -0,0 +1,7 @@
#lang racket/base
(require pollen/main-base)
(define+provide-module-begin-in-mode world:mode-markdown)
(module reader racket/base
(require pollen/reader-base)
(define+provide-reader-in-mode world:mode-markdown))

@ -0,0 +1,7 @@
#lang racket/base
(require pollen/main-base)
(define+provide-module-begin-in-mode world:mode-markup)
(module reader racket/base
(require pollen/reader-base)
(define+provide-reader-in-mode world:mode-markup))

@ -0,0 +1,139 @@
#lang racket/base
(require racket/path racket/list)
(require "file.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt")
(define+provide current-pagetree (make-parameter #f))
(define+provide (pagenode? x)
(->boolean (and (symbol? x) (try (not (whitespace/nbsp? (->string x)))
(except [exn:fail? (λ(e) #f)])))))
(define+provide (pagenodeish? x)
(try (pagenode? (->symbol x))
(except [exn:fail? (λ(e) #f)])))
(define/contract+provide (->pagenode x)
(pagenodeish? . -> . pagenode?)
(->symbol x))
(define+provide/contract (decode-pagetree xs)
(txexpr-elements? . -> . any/c) ; because pagetree is being explicitly validated
(validate-pagetree
(decode (cons world:pagetree-root-node xs)
#:txexpr-elements-proc (λ(xs) (filter (compose1 not whitespace?) xs))
#:string-proc string->symbol))) ; because faster than ->pagenode
(define+provide (validate-pagetree x)
(and (txexpr? x)
(let ([pagenodes (pagetree->list x)])
(and
(andmap (λ(p) (or (pagenode? p) (error (format "validate-pagetree: \"~a\" is not a valid pagenode" p)))) pagenodes)
(try (members-unique?/error pagenodes)
(except [exn:fail? (λ(e) (error (format "validate-pagetree: ~a" (exn-message e))))]))
x))))
(define+provide (pagetree? x)
(try (->boolean (validate-pagetree x))
(except [exn:fail? (λ(e) #f)])))
(define+provide/contract (directory->pagetree dir)
(coerce/path? . -> . pagetree?)
(define (unique-sorted-output-paths xs)
(define output-paths (map ->output-path xs))
(define all-paths (filter visible? (remove-duplicates output-paths)))
(define path-is-directory? (λ(f) (directory-exists? (build-path dir f))))
(define-values (subdirectories files) (partition path-is-directory? all-paths))
(define-values (pagetree-sources other-files) (partition pagetree-source? files))
(define (sort-names xs) (sort xs #:key ->string string<?))
;; put subdirs in list ahead of files (so they appear at the top)
(append (sort-names subdirectories) (sort-names pagetree-sources) (sort-names other-files)))
(if (directory-exists? dir )
(decode-pagetree (map ->symbol (unique-sorted-output-paths (directory-list dir))))
(error (format "directory->pagetree: directory ~a doesn't exist" dir))))
;; Try loading from pagetree file, or failing that, synthesize pagetree.
(define+provide/contract (make-project-pagetree project-dir)
(pathish? . -> . pagetree?)
(with-handlers ([exn:fail? (λ(exn) (directory->pagetree project-dir))])
(define pagetree-source (build-path project-dir world:default-pagetree))
(cached-require pagetree-source world:main-pollen-export)))
(define+provide/contract (parent pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))
(and pt pnish
(let ([pagenode (->pagenode pnish)])
(if (member pagenode (map (λ(x) (if (list? x) (car x) x)) (cdr pt)))
(car pt)
(ormap (λ(x) (parent pagenode x)) (filter list? pt))))))
(define+provide/contract (children p [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f (listof pagenode?)))
(and pt p
(let ([pagenode (->pagenode p)])
(if (equal? pagenode (car pt))
(map (λ(x) (if (list? x) (car x) x)) (cdr pt))
(ormap (λ(x) (children pagenode x)) (filter list? pt))))))
(define+provide/contract (siblings pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f (listof pagenode?)))
(children (parent pnish pt) pt))
;; flatten tree to sequence
(define+provide/contract (pagetree->list pt)
(pagetree? . -> . (listof pagenode?))
; use cdr to get rid of root tag at front
(cdr (flatten pt)))
(define (adjacents side pnish [pt (current-pagetree)])
; ((symbol? (or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f (listof pagenode?)))
(and pt pnish
(let* ([pagenode (->pagenode pnish)]
[proc (if (equal? side 'left) takef takef-right)]
[result (proc (pagetree->list pt) (λ(x) (not (equal? pagenode x))))])
(and (not (empty? result)) result))))
(define+provide/contract (previous* pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f (listof pagenode?)))
(adjacents 'left pnish pt))
(define+provide/contract (next* pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f (listof pagenode?)))
(adjacents 'right pnish pt))
(define+provide/contract (previous pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))
(let ([result (previous* pnish pt)])
(and result (last result))))
(define+provide/contract (next pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))
(let ([result (next* pnish pt)])
(and result (first result))))
(define/contract+provide (path->pagenode path)
(coerce/path? . -> . coerce/symbol?)
(->output-path (find-relative-path (world:current-project-root) (->complete-path path))))
(define+provide/contract (in-pagetree? pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . boolean?)
(->boolean (and pnish (member pnish (pagetree->list pt)))))

@ -0,0 +1,7 @@
#lang racket/base
(require pollen/main-base)
(define+provide-module-begin-in-mode world:mode-preproc)
(module reader racket/base
(require pollen/reader-base)
(define+provide-reader-in-mode world:mode-preproc))

@ -1,27 +0,0 @@
#lang racket/base
(require (only-in scribble/reader make-at-reader)
(only-in (planet mb/pollen/world) POLLEN_EXPRESSION_DELIMITER))
(provide (rename-out [mb-read read]
[mb-read-syntax read-syntax])
read-inner
)
(define read-inner
(make-at-reader #:command-char POLLEN_EXPRESSION_DELIMITER
#:syntax? #t
#:inside? #t))
(define (mb-read p)
(syntax->datum
(mb-read-syntax (object-name p) p)))
(define (make-output-datum i)
`(module lang-module (planet mb/pollen/main-pre)
,@i))
(define (mb-read-syntax name p)
(define i (read-inner name p))
(datum->syntax i
(make-output-datum i)
i))

@ -0,0 +1,28 @@
#lang racket/base
(require "world.rkt" sugar/define sugar/coerce/contract)
(define/contract+provide (get-project-require-files source-path) ; keep contract local to ensure coercion
(coerce/path? . -> . (or/c #f (listof path?)))
(define possible-requires (list (simplify-path (build-path source-path 'up world:project-require))))
(and (andmap file-exists? possible-requires) possible-requires))
(define+provide/contract (require+provide-project-require-files here-path #:provide [provide #t])
(coerce/path? . -> . (or/c list? void?))
(define (put-file-in-require-form file)
`(file ,(path->string file)))
(define project-require-files (get-project-require-files here-path))
(if project-require-files
(let ([files-in-require-form (map put-file-in-require-form project-require-files)])
`(begin
(require ,@files-in-require-form)
,@(if provide
(list `(provide (all-from-out ,@files-in-require-form)))
'())))
'(begin)))
(define+provide (require-project-require-files here-path)
(require+provide-project-require-files here-path #:provide #f))

@ -0,0 +1,7 @@
#lang racket/base
(require pollen/main-base)
(define+provide-module-begin-in-mode world:mode-pagetree)
(module reader racket/base
(require pollen/reader-base)
(define+provide-reader-in-mode world:mode-pagetree))

@ -0,0 +1,38 @@
#lang racket/base
(require (for-syntax racket/base pollen/command))
;; Handle commands from raco
(define-for-syntax args (current-command-line-arguments))
(define-for-syntax arg-command-name (with-handlers ([exn:fail? (λ(exn) #f)]) (vector-ref args 0)))
(define-for-syntax first-arg-or-current-dir
(with-handlers ([exn:fail? (λ(exn) (current-directory))])
(path->complete-path (simplify-path (string->path (vector-ref args 1))))))
(define-for-syntax rest-args
(with-handlers ([exn:fail? (λ(exn) #f)])
(cddr (vector->list (current-command-line-arguments)))))
(define-for-syntax port-arg
(with-handlers ([exn:fail? (λ(exn) #f)])
(string->number (vector-ref args 2))))
(define-for-syntax (command-error error-string)
`(displayln (string-append "Error: ", error-string)))
;; we work in syntax layer because 'start' has to require pollen/server,
;; which is slow, and needs to happen at the top level.
(define-syntax (select-syntax-for-command stx)
(datum->syntax stx
(case arg-command-name
[(#f "help") (handle-help)]
[("start") (handle-start first-arg-or-current-dir port-arg)]
[("render") (handle-render first-arg-or-current-dir rest-args)]
[("clone") (handle-clone first-arg-or-current-dir rest-args)]
[else (handle-else arg-command-name)])))
(select-syntax-for-command)

@ -1,200 +0,0 @@
#lang racket/base
(require (only-in racket/list empty? range))
(require (only-in racket/format ~a ~v))
(require (only-in racket/string string-join))
(require (prefix-in williams: (planet williams/describe/describe)))
(require racket/date)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utility functions for readability
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide (all-defined-out))
; lambda alias
; won't work as simple define because λ is specially handled in reader
(define-syntax-rule (ƒ x ...) (λ x ...))
(define (describe x)
(williams:describe x)
x)
; report the current value of the variable, then return it
(define-syntax-rule (report var)
(begin
(message 'var "=" var)
var))
; debug utilities
(define (message . x)
(define (zfill s n)
(set! s (as-string s))
(if (> (string-length s) n)
s
(string-append (make-string (- n (string-length s)) #\0) s)))
(define (make-date-string)
(define d (current-date))
(define df (map (ƒ(x) (zfill x 2)) (list (date-month d)(date-day d)(date-year d)(modulo (date-hour d) 12)(date-minute d)(date-second d)(if (< (date-hour d) 12) "am" "pm"))))
(apply format "[~a.~a.~a ~a:~a:~a~a]" df))
(displayln (string-join `(,(make-date-string) ,@(map (ƒ(x)(if (string? x) x (~v x))) x))) (current-error-port)))
(define (exists? x)
; neither empty nor false
(and (not (empty? x)) x))
#|(define (=str . xs)
(let ([tester (car xs)])
(all (ƒ(x) (equal? tester x)) (map as-string (cdr xs)))))|#
(define (=str . xs)
(let* ([xs (map as-string xs)]
[tester (car xs)])
(all (ƒ(x) (equal? tester x)) (cdr xs))))
(define (int x)
(cond
[(integer? x) x]
[(boolean? x) (if x 1 0)]
[(real? x) (floor x)]
[(string? x) (if (= (len x) 1)
(int (car (string->list x))) ; treat as char
(int (string->number x)))]
[(symbol? x) (int (as-string x))]
[(char? x) (char->integer x)]
[(empty? x) 0]
[(or (list? x) (hash? x) (vector? x)) (len x)]
[else (error "Can't convert to integer:" x)]))
(define (str . x)
(string-join (map as-string x) ""))
(define (len x)
(cond
[(list? x) (length x)]
[(string? x) (string-length x)]
[(symbol? x) (len (as-string x))]
[(vector? x) (vector-length x)]
[(hash? x) (len (hash-keys x))]
[else #f]))
(define (change x i value)
; general-purpose mutable data object setter
(cond
[(vector? x) (vector-set! x i value)]
[(hash? x) (hash-set! x i value)]
[else (error "Can't set this datatype using !")]))
(define (get x i [j #f])
(when (and (or (list? x) (string? x) (vector? x)) j)
(cond
[(and (real? j) (< j 0)) (set! j (+ (len x) j))]
[(equal? j 'end) (set! j (len x))]))
(cond
[(list? x) (if j
(for/list ([index (range i j)])
(get x index))
(list-ref x i))]
[(vector? x) (if j
(for/vector ([index (range i j)])
(get x index))
(vector-ref x i))]
[(string? x) (if j
(substring x i j)
(get x i (add1 i)))]
[(symbol? x) (as-symbol (get (as-string x) i j))]
[(hash? x) (if j
(error "get: third arg not supported for hash")
(hash-ref x i))]
[else #f]))
(define (in? container element)
(cond
[(list? container) (member element container)]
[(hash? container) (hash-has-key? container element)]
; todo: should this handle arbitrary-length substrings?
; leaning toward no, because it breaks the string-as-array-of-characters abstraction
[(string? container) (let ([result (in? (map as-string (string->list container)) (as-string element))])
(if result
(string-join result "")
#f))]
[(symbol? container) (let ([result (in? (as-string container) element)])
(if result
(as-symbol result)
result))]
[else #f]))
(define (to-lc x)
(string-downcase x))
(define (to-uc x)
(string-upcase x))
; python-style string testers
(define (starts-with? string starter)
(if (<= (len starter) (len string))
(equal? (get string 0 (len starter)) starter)
#f))
(define (ends-with? string ender)
(if (<= (len ender) (len string) )
(equal? (get string (- (len string) (len ender)) 'end) ender)
#f))
; coercions
(define (as-path thing)
(set! thing
(if (string? thing)
(string->path thing)
thing))
(when (not (path? thing)) (error (format "Can't make ~a into path" thing)))
thing)
(define (as-list thing)
(set! thing
(if (not (list? thing))
(list thing)
thing))
(when (not (list? thing)) (error (format "Can't make ~a into list" thing)))
thing)
; nice way of converting to string
(define (as-string x)
(set! x (cond
[(empty? x) ""]
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[(path? x) (path->string x)]
[(char? x) (~a x)]
[else x]))
(when (not (string? x)) (error (format "Can't make ~a into string" x)))
x)
; nice way of converting to symbol
; todo: on bad input, it will pop a string error rather than symbol error
(define (as-symbol thing)
(string->symbol (as-string thing)))
; nice way of converting to path
(define (as-complete-path thing)
(path->complete-path (as-path thing)))
; any & all & none
(define (any tests things)
(ormap (ƒ(test) (ormap test (as-list things))) (as-list tests)))
(define (all tests things)
(andmap (ƒ(test) (andmap test (as-list things))) (as-list tests)))
(define (none test things) (not (any test things)))
; Other possibilities
; trim
; split

@ -0,0 +1,39 @@
#lang racket/base
(require (only-in scribble/reader make-at-reader) pollen/world racket/path pollen/project)
(provide define+provide-reader-in-mode (all-from-out pollen/world))
(define (make-custom-read custom-read-syntax-proc)
(λ(p)
(syntax->datum
(custom-read-syntax-proc (object-name p) p))))
(define (make-custom-read-syntax reader-mode)
(λ (path-string p)
(define read-inner (make-at-reader
#:command-char (if (or (equal? reader-mode world:mode-template)
(and (string? path-string) (regexp-match (pregexp (format "\\.~a$" world:template-source-ext)) path-string)))
world:template-command-marker
world:command-marker)
#:syntax? #t
#:inside? #t))
(define file-contents (read-inner path-string p))
(datum->syntax file-contents
`(module pollen-lang-module pollen
(define reader-mode ',reader-mode)
(define reader-here-path ,(cond
[(symbol? path-string) (symbol->string path-string)]
[(equal? path-string "unsaved editor") path-string]
[else (path->string path-string)]))
,(require+provide-project-require-files path-string)
,@file-contents)
file-contents)))
(define-syntax-rule (define+provide-reader-in-mode mode)
(begin
(define reader-mode mode)
(define custom-read-syntax (make-custom-read-syntax reader-mode))
(define custom-read (make-custom-read custom-read-syntax))
(provide (rename-out [custom-read read] [custom-read-syntax read-syntax]))))

@ -1,188 +0,0 @@
#lang racket
(require xml/path)
(require (planet mb/pollen/world))
(require (planet mb/pollen/tools))
(require (planet mb/pollen/template))
(require racket/rerequire)
; hash of mod-dates takes lists of paths as keys,
; and lists of modification times as values.
; Reason: a templated page is a combination of two source files.
; Because templates have a one-to-many relationship with source files,
; Need to track template mod-date for each source file.
; Otherwise a changed template will get reloaded only once,
; and after that get reported as being up to date.
; Possible: store hash on disk so mod records are preserved
; between development sessions (prob a worthless optimization)
(define mod-dates (make-hash))
(define (mod-date . paths)
(set! paths (flatten paths))
(when (all file-exists? paths)
(map file-or-directory-modify-seconds paths)))
(define (log-refresh . paths)
(set! paths (flatten paths))
(change mod-dates paths (mod-date paths)))
(define (source-needs-refresh? . paths)
(set! paths (flatten paths))
(or (not (in? mod-dates paths)) ; no mod date
(not (equal? (mod-date paths) (get mod-dates paths))))) ; data changed
; when you want to generate everything fresh, but not force everything
(define (reset-mod-dates)
(let [(keys (hash-keys mod-dates))]
(map (ƒ(k) (hash-remove mod-dates k)) keys)))
; helper functions for regenerate functions
(define pollen-file-root (current-directory))
(define (regenerate-file f)
(let ([path (build-path pollen-file-root f)])
(displayln (format "Regenerating: ~a" f))
(regenerate path)))
(define (regenerate-pmap-pages pmap)
(define pmap-sequence
(make-page-sequence (main->tree (dynamic-require pmap 'main))))
(displayln (format "Regenerating pages from pollen map: ~a" (filename-of pmap)))
(for-each regenerate-file pmap-sequence))
(define (get-pollen-files-with-ext ext)
(filter (ƒ(f) (has-ext? f ext)) (directory-list pollen-file-root)))
; burn all files
(define (regenerate-all-files)
(reset-mod-dates)
(define all-preproc-files (get-pollen-files-with-ext POLLEN_PREPROC_EXT))
(for-each regenerate-file all-preproc-files)
(define all-pollen-maps (get-pollen-files-with-ext POLLEN_MAP_EXT))
(for-each regenerate-pmap-pages all-pollen-maps)
(displayln "Completed"))
(define (regenerate path #:force [force #f])
; dispatches path-in to the right place
(define (needs-preproc? path)
; it's a preproc source file, or a file that's the result of a preproc source
(any (list preproc-source? has-preproc-source?) path))
(define (needs-template? path)
; it's a pollen source file
; or a file (e.g., html) that has a pollen source file
(any (list pollen-source? has-pollen-source?) path))
(let ([path (as-complete-path path)])
(cond
[(needs-preproc? path) (do-preproc path #:force force)]
[(needs-template? path) (do-template path #:force force)]
[(pmap-source? path) (regenerate-pmap-pages path)])))
(define (regenerate-message path)
(message "Regenerated:" (as-string (file-name-from-path path))))
(define (do-preproc path #:force [force #f])
; set up preproc-in-path & preproc-out-path values
(let-values
([(preproc-in-path preproc-out-path)
(if (preproc-source? path)
(values path (make-preproc-out-path path))
(values (make-preproc-in-path path) path))])
(when (and (file-exists? preproc-in-path)
(or force
(not (file-exists? preproc-out-path))
(source-needs-refresh? preproc-in-path)))
(log-refresh preproc-in-path)
; use single quotes to escape spaces in pathnames
(define command
(format "~a '~a' > '~a'" RACKET_PATH preproc-in-path preproc-out-path))
; discard output using open-output-nowhere
(parameterize ([current-output-port (open-output-nowhere)])
(system command))
(regenerate-message preproc-out-path))))
(define (do-template path [template-name empty] #:force [force #f])
; take full path or filename
; return full path of templated file
(define source-path (as-complete-path
(if (pollen-source? path)
path
(make-pollen-source-path path))))
(define-values (source-dir source-name ignored) (split-path source-path))
; get body out of source file (to retrieve template name)
; use dynamic-rerequire to force refresh for dynamic-require,
; otherwise it will cache
; parameterize needed because source files have relative requires
(define file-was-reloaded-port (open-output-string))
(parameterize ([current-directory source-dir]
[current-error-port file-was-reloaded-port])
; by default, rerequire reports reloads to error port.
; so capture this message to find out if anything was reloaded.
(dynamic-rerequire source-path))
(define file-was-reloaded?
(> (string-length (get-output-string file-was-reloaded-port)) 0))
; set template, regenerate, get data
; first, if no template name provided, look it up
(when (or (empty? template-name) (not (file-exists? (build-path source-dir template-name))))
; get template name out of meta fields.
; todo: template file in body may not refer to a file that exists.
; todo: consider whether file-was-reloaded could change metas
; (because here, I'm retrieving them from existing source)
(define meta-hash (make-meta-hash (put source-path)))
(set! template-name (hash-ref-or meta-hash TEMPLATE_META_KEY DEFAULT_TEMPLATE)))
(define template-path (build-path source-dir template-name))
; refresh template (it might have its own p file)
(regenerate template-path #:force force)
; calculate new path for generated file:
; base from source + ext from template
(define generated-path (build-path source-dir (add-ext (remove-ext source-name) (get-ext template-path))))
; do we need to refresh?
(when (or force
(not (file-exists? generated-path))
(source-needs-refresh? source-path template-path)
file-was-reloaded?)
(log-refresh source-path template-path)
; Templates are part of the compile operation.
; Therefore no way to arbitrarily invoke template at run-time.
; This routine creates a new namespace and compiles the template within it.
; Todo: performance improvement would be to make a macro
; that pre-compiles all known templates into their own functions.
; then apply-template can either look for one of those functions,
; if the template exists,
; or if not found, use the eval technique.
(define page-result
; parameterize current-directory to make file requires work
(parameterize ([current-namespace (make-base-empty-namespace)]
[current-directory source-dir]
[current-output-port (open-output-nowhere)])
(namespace-require 'racket) ; use namespace-require for FIRST require, then eval after
(eval '(require (planet mb/pollen/template)) (current-namespace))
; import source into eval space,
; automatically sets up main & metas & here
(eval `(require ,(path->string source-name)) (current-namespace))
(eval `(include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,template-name) (current-namespace))))
(display-to-file #:exists 'replace page-result generated-path)
(regenerate-message generated-path)))
(provide regenerate regenerate-all-files)

@ -0,0 +1,278 @@
#lang racket/base
(require racket/file racket/rerequire racket/path racket/match)
(require sugar "file.rkt" "cache.rkt" "world.rkt" "debug.rkt" "pagetree.rkt" "project.rkt")
;; when you want to generate everything fresh,
;; but without having to #:force everything.
;; render functions will always go when no mod-date is found.
(define (reset-modification-dates)
(set! modification-date-hash (make-hash)))
;; mod-dates is a hash that takes lists of paths as keys,
;; and lists of modification times as values.
(define modification-date-hash #f)
(reset-modification-dates)
;; using internal contracts to provide some extra safety (negligible performance hit)
(define/contract (make-mod-dates-key paths)
((listof (or/c #f complete-path?)) . -> . (listof (or/c #f complete-path?)))
paths) ; for now, this does nothing; maybe later, it will do more
(define/contract (path->mod-date-value path)
((or/c #f complete-path?) . -> . (or/c #f integer?))
(and path (file-exists? path) (file-or-directory-modify-seconds path)))
(define/contract (store-render-in-modification-dates . rest-paths)
(() #:rest (listof (or/c #f complete-path?)) . ->* . void?)
(define key (make-mod-dates-key rest-paths))
(hash-set! modification-date-hash key (map path->mod-date-value key)))
(define/contract (modification-date-expired? . rest-paths)
(() #:rest (listof (or/c #f complete-path?)) . ->* . boolean?)
(define key (make-mod-dates-key rest-paths))
(or (not (key . in? . modification-date-hash)) ; no stored mod date
(not (equal? (map path->mod-date-value key) (get modification-date-hash key))))) ; data has changed
(define/contract+provide (render-batch . xs)
(() #:rest (listof pathish?) . ->* . void?)
;; Why not just (map render ...)?
;; Because certain files will pass through multiple times (e.g., templates)
;; And with render, they would be rendered repeatedly.
;; Using reset-modification-dates is sort of like session control.
(reset-modification-dates)
(for-each (λ(x) ((if (pagetree-source? x)
render-pagetree
render-from-source-or-output-path) x)) xs))
(define/contract+provide (render-pagetree pagetree-or-path)
((or/c pagetree? pathish?) . -> . void?)
(define pagetree (if (pagetree? pagetree-or-path)
pagetree-or-path
(cached-require pagetree-or-path world:main-pollen-export)))
(parameterize ([current-directory (world:current-project-root)])
(for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree)))))
(define/contract+provide (render-from-source-or-output-path so-pathish #:force [force #f])
((pathish?) (#:force boolean?) . ->* . void?)
(let ([so-path (->complete-path so-pathish)]) ; so-path = source or output path (could be either)
(cond
[(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?))
(let-values ([(source-path output-path) (->source+output-paths so-path)])
(render-to-file-if-needed source-path output-path #:force force))]
[(pagetree-source? so-path) (render-pagetree so-path)]))
(void))
(define/contract (->source+output-paths source-or-output-path)
(complete-path? . -> . (values complete-path? complete-path?))
;; file-proc returns two values, but ormap only wants one
(define file-proc (ormap (λ(test file-proc) (and (test source-or-output-path) file-proc))
(list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?)
(list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths ->scribble-source+output-paths ->markdown-source+output-paths ->template-source+output-paths)))
(file-proc source-or-output-path))
(define (project-requires-changed? source-path)
(define project-require-files (get-project-require-files source-path))
(define rerequire-results (and project-require-files (map file-needed-rerequire? project-require-files)))
(define requires-changed? (and rerequire-results (ormap (λ(x) x) rerequire-results)))
(when requires-changed?
(begin
(message "render: project requires have changed, resetting cache & file-modification table")
(reset-cache) ; because stored data is obsolete
(reset-modification-dates))) ; because rendered files are obsolete
requires-changed?)
(define/contract (render-needed? source-path template-path output-path)
(complete-path? (or/c #f complete-path?) complete-path? . -> . boolean?)
(or (not (file-exists? output-path))
(modification-date-expired? source-path template-path)
(and (not (null-source? source-path)) (file-needed-rerequire? source-path))
(and (world:check-project-requires-in-render?) (project-requires-changed? source-path))))
(define/contract+provide (render-to-file-if-needed source-path [template-path #f] [maybe-output-path #f] #:force [force #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?) #:force boolean?) . ->* . void?)
(define output-path (or maybe-output-path (->output-path source-path)))
(define template-path (get-template-for source-path))
(when (or force (render-needed? source-path template-path output-path))
(render-to-file source-path template-path output-path)))
(define/contract+provide (render-to-file source-path [template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?)
(define output-path (or maybe-output-path (->output-path source-path)))
(display-to-file (render source-path template-path) output-path #:exists 'replace))
(define/contract+provide (render source-path [template-path #f])
((complete-path?) ((or/c #f complete-path?)) . ->* . bytes?)
(define render-proc
(cond
[(ormap (λ(test render-proc) (and (test source-path) render-proc))
(list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?)
(list render-null-source render-preproc-source render-markup-or-markdown-source render-scribble-source render-markup-or-markdown-source render-preproc-source))]
[else (error (format "render: no rendering function found for ~a" source-path))]))
(message (format "render: ~a" (file-name-from-path source-path)))
(store-render-in-modification-dates source-path template-path) ; todo?: this may need to go after render
(apply render-proc (cons source-path (if template-path (list template-path) null))))
(define/contract (render-null-source source-path)
(complete-path? . -> . bytes?)
;; All this does is copy the source. Hence, "null".
;; todo: add test to avoid copying if unnecessary (good idea in case the file is large)
(file->bytes source-path))
(define/contract (render-scribble-source source-path)
(complete-path? . -> . bytes?)
(match-define-values (source-dir _ _) (split-path source-path))
(file-needed-rerequire? source-path) ; called for its reqrequire side effect only, so dynamic-require below isn't cached
(time (parameterize ([current-directory (->complete-path source-dir)])
;; BTW this next action has side effects: scribble will copy in its core files if they don't exist.
((dynamic-require 'scribble/render 'render) (list (dynamic-require source-path world:main-pollen-export)) (list source-path))))
(define result (file->bytes (->output-path source-path)))
(delete-file (->output-path source-path)) ; because render promises the data, not the side effect
result)
(define/contract (render-preproc-source source-path)
(complete-path? . -> . bytes?)
(match-define-values (source-dir _ _) (split-path source-path))
(time (parameterize ([current-directory (->complete-path source-dir)])
(render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',world:main-pollen-export))))))
(define/contract (render-markup-or-markdown-source source-path [maybe-template-path #f])
((complete-path?) ((or/c #f complete-path?)) . ->* . bytes?)
(match-define-values (source-dir _ _) (split-path source-path))
(define template-path (or maybe-template-path (get-template-for source-path)))
(render-from-source-or-output-path template-path) ; because template might have its own preprocessor source
(define expr-to-eval
`(begin
(require (for-syntax racket/base))
(require web-server/templates pollen/cache pollen/debug)
,(require-project-require-files source-path)
(let ([doc (cached-require ,source-path ',world:main-pollen-export)]
[metas (cached-require ,source-path ',world:meta-pollen-export)])
(local-require pollen/pagetree pollen/template pollen/top)
(define here (metas->here metas))
(include-template #:command-char ,world:command-marker ,(->string (find-relative-path source-dir template-path))))))
(time (parameterize ([current-directory source-dir]) ; because include-template wants to work relative to source location
(render-through-eval expr-to-eval))))
(define/contract (templated-source? path)
(complete-path? . -> . boolean?)
(or (markup-source? path) (markdown-source? path)))
(define/contract+provide (get-template-for source-path)
(complete-path? . -> . (or/c #f complete-path?))
(match-define-values (source-dir _ _) (split-path source-path))
(and (templated-source? source-path) ; doesn't make sense if it's not a templated source format
(or ; Build the possible paths and use the first one that either exists, or has existing source (template, preproc, or null)
(ormap (λ(p) (if (ormap file-exists? (list p (->template-source-path p) (->preproc-source-path p) (->null-source-path p))) p #f))
(filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f
(list
(parameterize ([current-directory (world:current-project-root)])
(let ([source-metas (cached-require source-path 'metas)])
(and ((->symbol world:template-meta-key) . in? . source-metas)
(build-path source-dir (get source-metas (->string world:template-meta-key)))))) ; path based on metas
(build-path (world:current-project-root)
(add-ext world:default-template-prefix (get-ext (->output-path source-path))))))) ; path to default template
(build-path (world:current-server-extras-path) world:fallback-template)))) ; fallback template
(define/contract (file-needed-rerequire? source-path)
(complete-path? . -> . boolean?)
(define-values (source-dir source-name _) (split-path source-path))
;; use dynamic-rerequire now to force render for cached-require later,
;; otherwise the source file will get cached by compiler
(define port-for-catching-file-info (open-output-string))
(parameterize ([current-directory source-dir]
[current-error-port port-for-catching-file-info])
(dynamic-rerequire source-path))
;; if the file needed to be reloaded, there will be a message in the port
(> (len (get-output-string port-for-catching-file-info)) 0))
;; cache some modules to speed up eval.
;; Do it in separate module so as not to pollute this one.
;; todo: macrofy these lists of modules
;; Don't, however, put the project-requires here,
;; because they will no longer be subject to rerequire.
(module my-module-cache racket/base
(require web-server/templates
xml
racket/port
racket/file
racket/rerequire
racket/contract
racket/list
racket/match
racket/syntax
pollen/cache
pollen/debug
pollen/decode
pollen/file
pollen/main
pollen/reader-base
pollen/pagetree
pollen/tag
pollen/template
pollen/world
pollen/project
sugar
txexpr
hyphenate)
(define-namespace-anchor my-module-cache-ns-anchor)
(provide my-module-cache-ns-anchor))
(require 'my-module-cache)
(define cache-ns (namespace-anchor->namespace my-module-cache-ns-anchor))
(define/contract (render-through-eval expr-to-eval)
(list? . -> . bytes?)
(parameterize ([current-namespace (make-base-namespace)]
[current-output-port (current-error-port)]
[current-pagetree (make-project-pagetree (world:current-project-root))])
(for-each (λ(mod-name) (namespace-attach-module cache-ns mod-name))
`(web-server/templates
xml
racket/port
racket/file
racket/rerequire
racket/contract
racket/list
racket/match
racket/syntax
pollen/debug
pollen/cache
pollen/decode
pollen/file
pollen/main
pollen/reader-base
pollen/pagetree
pollen/project
pollen/tag
pollen/template
pollen/world
sugar
txexpr
hyphenate))
(string->bytes/utf-8 (eval expr-to-eval (current-namespace)))))

@ -0,0 +1,12 @@
#lang scribble/manual
@title{Acknowledgments}
One curious aspect of free software is that you can appropriate the benefits of other people's work while making it look like your own. No such legerdemain here. Whatever effort I've put into Pollen is dwarfed by the epic accomplishments of the Racket development team. I thank all of them — especially @link["https://www.cs.utah.edu/~mflatt/"]{Matthew Flatt}, @link["http://faculty.cs.byu.edu/~jay/home/"]{Jay McCarthy}, and @link["http://www.ccs.neu.edu/home/matthias/"]{Matthias Felleisen} — for making this tremendous tool available, for adding several features I suggested, and for patiently answering my dumb questions over the months.
But the best tools do more than get the job done. They create an incentive to undertake jobs you wouldn't have attempted before. Racket encouraged me to become a better programmer so I could create Pollen. Likewise, I hope that Pollen encourages you to make things you couldn't before.
Thank you to Greg Hendershott for his Markdown parser.
MB

@ -0,0 +1,51 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/cache pollen/render pollen/file sugar))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen))
@title{Cache}
@defmodule[pollen/cache]
The slowest part of a @racket[render] is parsing and decoding the source file. Often, previewing a single source file necessarily means decoding others (for instance templates, or other source files that are linked into the main source file). But usually, only one source file is changing at a time. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" world:main-pollen-export)] and @code[(format "~a" world:meta-pollen-export)] — in the cache so they can be reused.
@defparam[current-cache hash hash?
#:value (make-cache)]{A parameter that refers to the current cache. It is initialized with @racket[make-cache].
The cache is a hash table that uses the complete path of a source file as its keys. The value associated with each of these keys is a subcache — another hash table with keys @racket['doc], @racket['metas] (for storing the exports of the source file) and @racket['mod-time] (for storing the modification time, provided by @racket[file-or-directory-modify-seconds]).}
@defproc[
(cached-require
[source-path pathish?]
[key (or/c 'doc 'metas 'mod-time)])
(or/c txexpr? hash? integer?)]
Similar to @racket[(dynamic-require _source-path _key)], except that it first tries to retrieve the requested value out of @racket[current-cache]. If it's not there, or out of date, @racket[dynamic-require] is used to update the value.
The only keys supported are @racket['doc], @racket['metas], and @racket['mod-time].
If you want the speed benefit of the cache, you should @bold{always} use @racket[cached-require] to get data from Pollen source files. That doesn't mean you can't still use functions like @racket[require], @racket[local-require], and @racket[dynamic-require]. They'll just be slower.
@defproc[
(make-cache)
hash?]
Initializes @racket[current-cache].
@defproc[
(reset-cache)
void?]
Clears @racket[current-cache]. When only the nuclear option will do.
@defproc[
(cache-ref
[source-path pathish?])
hash?]
Returns the subcache associated with the key @racket[_source-path], which will itself be a hash table. See @racket[current-cache].

@ -0,0 +1,633 @@
#lang scribble/manual
@(require scribble/bnf scribble/eval "utils.rkt"
(for-syntax racket/base)
(for-label (only-in scribble/reader
use-at-readtable) pollen/world pollen/tag))
@(define read-eval (make-base-eval))
@(interaction-eval #:eval read-eval (require (for-syntax racket/base)))
@(define (at-exp-racket)
@racket[#, @hash-lang[] #, @racketmodname[at-exp] #, @racketidfont{racket}])
@title[#:tag "reader"]{◊ command overview}
@section{The golden rule}
Pollen uses a special character — the @italic{lozenge}, which looks like this: ◊ — to mark commands within a Pollen source file. So when you put a ◊ in your source, whatever comes next will be treated as a command. If you don't, it will just be interpreted as plain text.
@section{The lozenge glyph (◊)}
I chose the lozenge as the command marker because a) it appears in almost every font, b) it's barely used in ordinary typesetting, c) it's not used in any programming language that I know of, and d) its shape and color allow it to stand out easily in code without being distracting.
Here's how you type it:
@bold{Mac}: option + shift + V
@(linebreak)
@bold{Windows}:
@(linebreak)
@bold{Ubuntu}:
Still, if you don't want to use the lozenge as your command marker, you can use something else. Set Pollen's @racket[world:command-marker] value to whatever character you want.
@margin-note{Scribble uses the @"@" sign as a delimiter. It's not a bad choice if you only work with Racket files. But as you use Pollen to work on other kinds of text-based files that commonly contain @"@" signs — HTML pages especially — it gets cumbersome. So I changed it.}
But don't knock the lozenge till you try it.
@;--------------------------------------------------------------------
@section{The two command modes: text mode & Racket mode}
Pollen commands can be entered in one of two modes: @italic{text mode} or @italic{Racket mode}. Both modes start with a lozenge (@litchar["◊"]):
@racketblock[
@#,BNF-seq[@litchar["◊"] @nonterm{command name} @litchar{[} @nonterm{Racket arguments ...} @litchar{]} @litchar["{"] @nonterm{text argument} @litchar["}"]]
@#,BNF-seq[@litchar["◊"]
@litchar{(} @nonterm{Racket expression} @litchar{)}]
]
@bold{Text-mode commands}
A text-mode command has the three possible parts after the @litchar["◊"]:
@itemlist[
@item{The @italic{command name} appears immediately after the @litchar["◊"]. Typically it's a short word.}
@item{The @italic{Racket arguments} appear between square brackets. Pollen is partly an interface to the Racket programming language. These arguments are entered using Racket conventions — e.g., a @tt{string of text} needs to be put in quotes as a @code{"string of text"}. If you like programming, you'll end up using these frequently. If you don't, you won't.}
@item{The @italic{text argument} appears between braces (aka curly brackets). You can put any ordinary text here. Unlike with the Racket arguments, you don't put quotes around the text.}
]
Each of the three parts is optional. You can also nest commands within each other. However:
@itemlist[
@item{You can never have spaces between the three parts.}
@item{Whatever parts you use must always appear in the order above.}
]
Here are a few examples of correct text-mode commands:
@codeblock|{
#lang pollen
◊variable-name
◊tag{Text inside the tag.}
◊tag['attr: "value"]{Text inside the tag}
◊get-customer-id["Brennan Huff"]
◊tag{His ID is ◊get-customer-id["Brennan Huff"].}
}|
And some incorrect examples:
@codeblock|{
#lang pollen
◊tag {Text inside the tag.} ; space between first and second parts
◊tag[Text inside the tag] ; text argument needs to be within braces
◊tag{Text inside the tag}['attr: "value"] ; wrong order
}|
The next section describes each of these parts in detail.
@bold{Racket-mode commands}
If you're familiar with Racket expressions, you can use the Racket-mode commands to embed them within Pollen source files. It's simple: any Racket expression can become a Pollen command by adding @litchar["◊"] to the front. So in Racket, this code:
@codeblock|{
#lang racket
(define song "Revolution")
(format "~a #~a" song (* 3 3))
}|
Can be converted to Pollen like so:
@codeblock|{
#lang pollen
◊(define song "Revolution")
◊(format "~a #~a" song (* 3 3))
}|
And in DrRacket, they produce the same output:
@nested[#:style 'inset]{@racketoutput{Revolution #9}}
Beyond that, there's not much to say about Racket mode — any valid expression you can write in Racket will also be a valid Racket-mode Pollen command.
@bold{The relationship of text mode and Racket mode}
Even if you don't plan to write a lot of Racket-mode commands, you should be aware that under the hood, Pollen is converting all commands in text mode to Racket mode. So a text-mode command that looks like this:
@racketblock[
◊headline[#:size 'enormous]{Man Bites Dog!}
]
Is actually being turned into a Racket-mode command like this:
@racketblock[
(headline #:size 'enormous "Man Bites Dog!")
]
Thus a text-mode command is just an alternate way of writing a Racket-mode command. (More broadly, all of Pollen is just an alternate way of using Racket.)
The corollary is that you can always write Pollen commands using whichever mode is more convenient or readable. For instance, the earlier example, written in the Racket mode:
@codeblock|{
#lang pollen
◊(define song "Revolution")
◊(format "~a #~a" song (* 3 3))
}|
Can be rewritten using text mode:
@codeblock|{
#lang pollen
◊define[song]{Revolution}
◊format["~a #~a" song (* 3 3)]
}|
And it will work the same way.
@;--------------------------------------------------------------------
@subsection{The command name}
In Pollen, you'll typically use the command name for one of four purposes:
@itemlist[
@item{To invoke a tag function.}
@item{To invoke another function.}
@item{To insert the value of a variable.}
@item{To insert a comment.}
]
@;--------------------------------------------------------------------
@subsubsection{Invoking tag functions}
By default, Pollen treats every command name as a @italic{tag function}. As the name implies, a tag function creates a tagged X-expression with the command name as the tag, and the text argument as the content.
@codeblock|{
#lang pollen
◊strong{Fancy Sauce, $1}
}|
@racketoutput{@literal{'(strong "Fancy Sauce, $1")}}
To streamline markup, Pollen doesn't restrict you to a certain set of tags, nor does it make you define your tag functions ahead of time. Just type a tag, and you can start using it.
@codeblock|{
#lang pollen
◊utterlyridiculoustagname{Oh really?}
}|
@racketoutput{@literal{'(utterlyridiculoustagname "Oh really?")}}
The one restriction is that you can't invent names for tag functions that are already being used for other commands. For instance, @tt{map} is a name permanently reserved by the Racket function @racket[map]. It's also a rarely-used HTML tag. But gosh, you really want to use it. Problem is, if you invoke it directly, Pollen will think you mean the other @racket[map]:
@codeblock|{
#lang pollen
◊map{Fancy Sauce, $1}
}|
@racketerror{map: arity mismatch;@(linebreak)
the expected number of arguments does not match the given number@(linebreak)
  given: 1@(linebreak)
  arguments...:@(linebreak)
    "Fancy Sauce, $1"}
What to do? Read on.
@;--------------------------------------------------------------------
@subsubsection{Invoking other functions}
Though every command name starts out as a tag function, it doesn't necessarily end there. You have two options for invoking other functions: defining your own , or invoking others from Racket.
@bold{Defining your own functions}
Use the @racket[define] command to create your own function for a command name. After that, when you use the command name, you'll get the new behavior. For instance, recall this example showing the default tag-function behavior:
@codeblock|{
#lang pollen
◊strong{Fancy Sauce, $1}
}|
@racketoutput{@literal{'(strong "Fancy Sauce, $1")}}
We can define @tt{strong} to do something else, like add to the text:
@codeblock|{
#lang pollen
◊(define (strong text) `(strong ,(format "Hey! Listen up! ~a" text)))
◊strong{Fancy Sauce, $1}
}|
@racketoutput{@literal{'(strong "Hey! Listen up! Fancy Sauce, $1")}}
The replacement function has to accept any arguments that might get passed along, but it doesn't have to do anything with them. For instance, this function definition won't work because @tt{strong} is going to get a text argument that it's not defined to handle:
@codeblock|{
#lang pollen
◊(define (strong) '(fib "1 1 2 3 5 8 13 ..."))
◊strong{Fancy Sauce, $1}
}|
@racketerror{strong: arity mismatch;@(linebreak)
the expected number of arguments does not match the given number@(linebreak)
  expected: 0@(linebreak)
  given: 1@(linebreak)
  arguments...:@(linebreak)
    "Fancy Sauce, $1"}
Whereas in this version, @tt{strong} accepts an argument called @tt{text}, but then ignores it:
@codeblock|{
#lang pollen
◊(define (strong text) '(fib "1 1 2 3 5 8 13 ..."))
◊strong{Fancy Sauce, $1}
}|
@racketoutput{@literal{'(fib "1 1 2 3 5 8 13 ...")}}
You can attach any behavior to a command name. As your project evolves, you can also update the behavior of a command name. In that way, Pollen commands become a set of hooks to which you can attach more elaborate processing.
@bold{Using Racket functions}
You aren't limited to functions you define. Any function from Racket, or any Racket library, can be invoked directly by using it as a command name. Here's the function @racket[range], which creates a list of numbers:
@codeblock|{
#lang pollen
◊range[1 20]
}|
@racketoutput{@literal{'(range 1 20)}}
Hold on — that's not what we want. Where's the list of numbers? The problem here is that we didn't explicitly import the @racketmodname[racket/list] library, which contains the definition for @racket[range]. (If you need to find out what library contains a certain function, the Racket documentation will tell you.) Without @racketmodname[racket/list], Pollen just thinks we're trying to use @tt{range} as a tag function (and if we had been, then @racketoutput{@literal{'(range 1 20)}} would've been the right result).
We fix this by using the @racket[require] command to bring in the @racketmodname[racket/list] library, which contains the @racket[range] we want:
@codeblock|{
#lang pollen
◊(require racket/list)
◊range[1 20]
}|
@racketoutput{@literal{'(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)}}
Of course, you can also invoke Racket functions indirectly, by attaching them to functions you define for command names:
@codeblock|{
#lang pollen
◊(require racket/list)
◊(define (rick start finish) (range start finish))
◊rick[1 20]
}|
@racketoutput{@literal{'(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)}}
Let's return to the problem that surfaced in the last section — the fact that some command names can't be used as tag functions because they're already being used for other things. You can work around this by defining your own tag function with a non-conflicting name.
For instance, suppose we want to use @tt{map} as a tag even though Racket is using it for its own function called @racket[map]. First, we invent a command name that doesn't conflict. Let's call it @code{my-map}. As you learned above, Pollen will treat a new command name as a tag function by default:
@codeblock|{
#lang pollen
◊my-map{How I would love this to be a map.}
}|
@racketoutput{@literal{'(my-map "How I would love this to be a map.")}}
But @code{my-map} is not the tag we want. We need to define @code{my-map} to be a tag function for @tt{map}. We can do this with the Pollen helper @racket[make-tag-function]. That function lives in @racketmodname[pollen/tag], so we @racket[require] that too:
@codeblock|{
#lang pollen
◊(require pollen/tag)
◊(define my-map (make-tag-function 'map))
◊my-map{How I would love this to be a map.}
}|
@racketoutput{@literal{'(map "How I would love this to be a map.")}}
Problem solved.
@;--------------------------------------------------------------------
@subsubsection{Inserting the value of a variable}
A Pollen command name usually refers to a function, but it can also refer to a @italic{variable}, which is a data value. Once you define the variable, you can insert it into your source by using the ◊ notation without any other arguments:
@codeblock|{
#lang pollen
◊(define foo "bar")
The value of foo is ◊foo
}|
@racketoutput{@literal{The value of foo is bar}}
Be careful — if you include arguments, even blank ones, Pollen will treat the command name as a function. This won't work, because a variable is not a function:
@margin-note{To understand what happens here, recall the relationship between Pollen's command modes. The text-mode command @code{◊foo[]} becomes the Racket-mode command @code{(foo)}, which after variable substitution becomes @code{("bar")}. If you try to evaluate @code{("bar")} — e.g., in DrRacket — you'll get the same error.}
@codeblock|{
#lang pollen
◊(define foo "bar")
The value of foo is ◊foo[]
}|
@racketerror{application: not a procedure;@(linebreak)
expected a procedure that can be applied to arguments@(linebreak)
  given: "bar"@(linebreak)
  arguments...: [none]}
The reason we can simply drop @code{◊foo} into the text argument of another Pollen command is that the variable @code{foo} holds a string (i.e., a text value). When appropriate, Pollen will convert a variable to a string in a sensible way. For instance, numbers are easily converted:
@codeblock|{
#lang pollen
◊(define zam 42)
The value of zam is ◊zam
}|
@racketoutput{@literal{The value of zam is 42}}
If the variable holds a container datatype (like a @racket[list], @racket[hash], or @racket[vector]), Pollen will produce the Racket text representation of the item. Here, @tt{zam} is a @racket[list] of integers:
@codeblock|{
#lang pollen
◊(define zam (list 1 2 3))
The value of zam is ◊zam
}|
@racketoutput{@literal{The value of zam is '(1 2 3)}}
This feature is included for your convenience as an author. But in general, your readers won't want to see the Racket representation of a container. So in these cases, you should convert to a string manually in some sensible way. Here, the integers in the list are converted to strings, which are then combined using @racket[string-join] from the @racketmodname[racket/string] library:
@codeblock|{
#lang pollen
◊(require racket/string)
◊(define zam (list 1 2 3))
The value of zam is ◊string-join[(map number->string zam)]{ and }
}|
@racketoutput{@literal{The value of zam is 1 and 2 and 3}}
Pollen will still produce an error if you try to convert an esoteric value to a string. Here, @tt{zam} is the addition function (@racket[+]):
@codeblock|{
#lang pollen
◊(define zam +)
The value of zam is ◊zam
}|
@racketerror{Pollen decoder: can't convert #<procedure:+> to string}
One special case to know about. In the examples above, there's a word space between the variable and the other text. But suppose you need to insert a variable into text so that there's no space in between. The simple ◊ notation won't work, because it won't be clear where the variable name ends and the text begins.
For instance, suppose we want to use a variable @tt{edge} next to the string @tt{px}:
@codeblock|{
#lang pollen
◊(define edge 100)
p { margin-left: ◊edgepx; }
}|
@racketerror{Pollen decoder: can't convert #<procedure:...t/pollen/tag.rkt:6:2> to string}
The example fails because Pollen reads the whole string after the @litchar{◊} as the single variable name @tt{edgepx}. Since @tt{edgepx} isn't defined, it's treated as a tag function, and since Pollen can't convert a function to a string, we get an error.
In these situations, surround the variable name with vertical bars @litchar{◊|}like so@litchar{|} to explicitly indicate where the variable name ends. The bars are not treated as part of the name, nor are they included in the result. Once we do that, we get what we intended:
@codeblock|{
#lang pollen
◊(define edge 100)
p { margin-left: ◊|edge|px; }
}|
@racketoutput{p { margin-left: 100px; }}
If you use this notation when you don't need to, nothing bad will happen. The vertical bars are always ignored.
@codeblock|{
#lang pollen
◊(define edge 100)
The value of edge is ◊|edge| pixels}
}|
@racketoutput{The value of edge is 100 pixels}
@;--------------------------------------------------------------------
@subsubsection{Inserting a comment}
Two options.
To comment out the rest of a single line, use a lozenge followed by a semicolon @litchar{◊;}.
@codeblock|{
#lang pollen
◊span{This is not a comment}
◊span{Nor is this} ◊;span{But this is}
}|
@racketoutput{@literal{'(span "This is not a comment")} @(linebreak)
@literal{'(span "Nor is this")}}
To comment out a multiline block, use the lozengesemicolon signal @litchar{◊;} with curly braces, @litchar{◊;@"{"}like so@litchar{@"}"}.
@codeblock|{
#lang pollen
◊;{
◊span{This is not a comment}
◊span{Nor is this} ◊;span{But this is}
}
Actually, it's all a comment now
}|
@racketoutput{@literal{Actually, it's all a comment now}}
@;--------------------------------------------------------------------
@subsection{The Racket arguments}
The middle part of a text-mode Pollen command contains the @italic{Racket arguments} @litchar{[}between square brackets.@litchar{]} Most often, you'll see these used to pass extra information to commands that operate on text.
For instance, tag functions. Recall from before that any not-yet-defined command name in Pollen is treated as a tag function:
@codeblock|{
#lang pollen
◊title{The Beginning of the End}
}|
@racketoutput{@literal{'(title "The Beginning of the End")}}
But what if you wanted to add attributes to this tag, so that it comes out like this?
@racketoutput{@literal{'(title ((class "red")(id "first")) "The Beginning of the End")}}
You can do it with Racket arguments.
Here's the hard way. You can type out your list of attributes in Racket format and drop them into the brackets as a single argument:
@codeblock|{
#lang pollen
◊title['((class "red")(id "first"))]{The Beginning of the End}
}|
@racketoutput{@literal{'(title ((class "red") (id "first")) "The Beginning of the End")}}
But that's a lot of parentheses to think about. So here's the easy way. Anytime you use a tag function, there's a shortcut for inserting attributes. You can enter them as a series of @racket[symbol] / @racket[string] pairs between the Racket-argument brackets. The only caveat is that the symbols have to begin with a quote mark @litchar{'} and end with a colon @litchar{:}. So taken together, they look like this:
@codeblock|{
#lang pollen
◊title['class: "red" 'id: "first"]{The Beginning of the End}
}|
@racketoutput{@literal{'(title ((class "red") (id "first")) "The Beginning of the End")}}
Racket arguments can be any valid Racket expressions. For instance, this will also work:
@codeblock|{
#lang pollen
◊title['class: (format "~a" (* 6 7)) 'id: "first"]{The Beginning of the End}
}|
@racketoutput{@literal{'(title ((class "42") (id "first")) "The Beginning of the End")}}
Since Pollen commands are really just Racket arguments underneath, you can use those too. Here, we'll define a variable called @tt{name} and use it in the Racket arguments of @tt{title}:
@codeblock|{
#lang pollen
◊(define name "Brennan")
◊title['class: "red" 'id: ◊name]{The Beginning of the End}
}|
@racketoutput{@literal{'(title ((class "read") (id "Brennan")) "The Beginning of the End")}}
You can also use this area for @italic{keyword arguments}. Keyword arguments can be used to provide options for a particular Pollen command, to avoid redundancy. Suppose that instead of using the @tt{h1 ... h6} tags, you want to consolidate them into one command called @tt{heading} and select the level separately. You can do this with a keyword, in this case @racket[#:level], which is passed as a Racket argument:
@codeblock|{
#lang pollen
◊(define (heading #:level which text)
`(,(string->symbol (format "h~a" which)) ,text))
◊heading[#:level 1]{Major league}
◊heading[#:level 2]{Minor league}
◊heading[#:level 6]{Trivial league}
}|
@racketoutput{@literal{'(h1 "Major league")} @(linebreak)
@literal{'(h2 "Minor league")} @(linebreak)
@literal{'(h6 "Trivial league")}
}
@;--------------------------------------------------------------------
@subsection{The text argument}
The third part of a text-mode Pollen command is the text argument. The text argument @litchar{@"{"}appears between curly braces@litchar{@"}"}. It can contain any text you want. The text argument can also contain other Pollen commands with their own text arguments. And they can contain other Pollen commands ... and so on, all the way down.
@codeblock|{
#lang pollen
◊div{Do it again. ◊div{And again. ◊div{And yet again.}}}
}|
@racketoutput{@literal{'(div "Do it again. " (div "And again. " (div "And yet again.")))}}
Three small details to know about the text argument.
First, the only character that needs special handling in a text argument is the lozenge @litchar{◊}. A lozenge ordinarily marks a new command. So if you want an actual lozenge to appear in the text, you have to escape it by typing @litchar{◊"◊"}.
@codeblock|{
#lang pollen
◊definition{This is the lozenge: ◊"◊"}
}|
@racketoutput{@literal{'(definition "This is the lozenge: ◊")}}
Second, the whitespace-trimming policy. Here's the short version: if there's a carriage return at either end of the text argument, it is trimmed, and whitespace at the end of each line is selectively trimmed in an intelligent way. So this text argument, with carriage returns on the ends:
@codeblock|{
#lang pollen
◊div{
Roomy!
I agree.
}
}|
@racketoutput{@literal{'(div "Roomy!" "\n" "\n" "I agree.")}}
Yields the same result as this one:
@codeblock|{
#lang pollen
◊div{Roomy!
I agree.}
}|
@racketoutput{@literal{'(div "Roomy!" "\n" "\n" "I agree.")}}
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:
@racketoutput{@literal{'(div "Roomy!" "\n" "\n" "I agree.")}}
Instead of this:
@racketoutput{@literal{'(div "Roomy!\n\nI agree.")}}
Under most circumstances, these two tagged X-expressions will behave the same way. The biggest exception is with functions. A function that operates on multiline text arguments needs to be able to handle an indefinite number of strings. For instance, this @tt{jejune} function only accepts a single argument. It will work with a single-line text argument, because that produces a single string:
@codeblock|{
#lang pollen
◊(define (jejune text)
`(jejune ,text))
◊jejune{Irrational confidence}
}|
@racketoutput{@literal{'(jejune "Irrational confidence")}}
But watch what happens with a multiline text argument:
@codeblock|{
#lang pollen
◊(define (jejune text)
`(jejune ,text))
◊jejune{Deeply
chastened}
}|
@racketerror{jejune: arity mismatch;@(linebreak)
the expected number of arguments does not match the given number@(linebreak)
  expected: 1@(linebreak)
  given: 3@(linebreak)
  arguments...:@(linebreak)
   "Deeply"@(linebreak)
   "\n"@(linebreak)
   "chastened"}
The answer is to use a @italic{rest argument} in the function, which takes the ``rest'' of the arguments — however many there may be — and combines them into a single @racket[list]. If we rewrite @tt{jejune} with a rest argument, we can fix the problem:
@codeblock|{
#lang pollen
◊(define (jejune . texts)
`(jejune ,@texts))
◊jejune{Deeply
chastened}
}|
@racketoutput{@literal{'(jejune "Deeply" "\n" "chastened")}}
@section{Further reading}
The Pollen language is a variant of Racket's own text-processing language, called Scribble. So many things that are true about Scribble are also true about Pollen. For the sake of clarity & brevity, I've omitted them from this summary. But if you want the full story:
[insert]

@ -0,0 +1,318 @@
#lang scribble/manual
@(require scribble/eval pollen/decode pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/cache pollen/decode txexpr xml))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/decode xml racket/list txexpr))
@title{Decode}
@defmodule[pollen/decode]
The @racket[doc] export of a Pollen markup file is a simple X-expression. @italic{Decoding} refers to any post-processing of this X-expression. The @racket[pollen/decode] module provides tools for creating decoders.
The decode step can happen separately from the compilation of the file. But you can also attach a decoder to the markup file's @racket[root] node, so the decoding happens automatically when the markup is compiled, and thus automatically incorporated into @racket[doc]. (Following this approach, you could also attach multiple decoders to different tags within @racket[doc].)
You can, of course, embed function calls within Pollen markup. But since markup is optimized for authors, decoding is useful for operations that can or should be moved out of the authoring layer.
One example is presentation and layout. For instance, @racket[detect-paragraphs] is a decoder function that lets authors mark paragraphs in their source simply by using two carriage returns.
Another example is conversion of output into a particular data format. Most Pollen functions are optimized for HTML output, but one could write a decoder that targets another format.
@defproc[
(decode
[tagged-xexpr txexpr?]
[#:txexpr-tag-proc txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) (λ(tag) tag)]
[#:txexpr-attrs-proc txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) (λ(attrs) attrs)]
[#:txexpr-elements-proc txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?) (λ(elements) elements)]
[#:block-txexpr-proc block-txexpr-proc (block-txexpr? . -> . xexpr?) (λ(tx) tx)]
[#:inline-txexpr-proc inline-txexpr-proc (txexpr? . -> . xexpr?) (λ(tx) tx)]
[#:string-proc string-proc (string? . -> . xexpr?) (λ(str) str)]
[#:symbol-proc symbol-proc (symbol? . -> . xexpr?) (λ(sym) sym)]
[#:valid-char-proc valid-char-proc (valid-char? . -> . xexpr?) (λ(vc) vc)]
[#:cdata-proc cdata-proc (cdata? . -> . xexpr?) (λ(cdata) cdata)]
[#:exclude-tags tags-to-exclude (listof symbol?) null]
)
txexpr?]
Recursively process a @racket[_tagged-xexpr], usually the one exported from a Pollen source file as @racket[doc].
This function doesn't do much on its own. Rather, it provides the hooks upon which harder-working functions can be hung.
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 —
[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.
@examples[#:eval my-eval
(define tx '(root "I wonder" (em "why") "this works."))
(decode tx)
]
Right — nothing. That's because the default value for the decoding arguments is the identity function, @racket[(λ(x)x)]. So all the input gets passed through intact unless another action is specified.
The @racket[_*-proc] arguments of @racket[decode] take procedures that are applied to specific categories of elements within @racket[_txexpr].
The @racket[_txexpr-tag-proc] argument is a procedure that handles X-expression tags.
@examples[#:eval my-eval
(define tx '(p "I'm from a strange" (strong "namespace")))
(code:comment @#,t{Tags are symbols, so a tag-proc should return a symbol})
(decode tx #:txexpr-tag-proc (λ(t) (string->symbol (format "ns:~a" t))))
]
The @racket[_txexpr-attrs-proc] argument is a procedure that handles lists of X-expression attributes. (The @racketmodname[txexpr] module, included at no extra charge with Pollen, includes useful helper functions for dealing with these attribute lists.)
@examples[#:eval my-eval
(define tx '(p [[id "first"]] "If I only had a brain."))
(code:comment @#,t{Attrs is a list, so cons is OK for simple cases})
(decode tx #:txexpr-attrs-proc (λ(attrs) (cons '[class "PhD"] attrs )))
]
Note that @racket[_txexpr-attrs-proc] will change the attributes of every tagged X-expression, even those that don't have attributes. This is useful, because sometimes you want to add attributes where none existed before. But be careful, because the behavior may make your processing function overinclusive.
@examples[#:eval my-eval
(define tx '(div (p [[id "first"]] "If I only had a brain.")
(p "Me too.")))
(code:comment @#,t{This will insert the new attribute everywhere})
(decode tx #:txexpr-attrs-proc (λ(attrs) (cons '[class "PhD"] attrs )))
(code:comment @#,t{This will add the new attribute only to non-null attribute lists})
(decode tx #:txexpr-attrs-proc
(λ(attrs) (if (null? attrs) attrs (cons '[class "PhD"] attrs ))))
]
The @racket[_txexpr-elements-proc] argument is a procedure that operates on the list of elements that represents the content of each tagged X-expression. Note that each element of an X-expression is subject to two passes through the decoder: once now, as a member of the list of elements, and also later, through its type-specific decoder (i.e., @racket[_string-proc], @racket[_symbol-proc], and so on).
@examples[#:eval my-eval
(define tx '(div "Double" "\n" "toil" amp "trouble"))
(code:comment @#,t{Every element gets doubled ...})
(decode tx #:txexpr-elements-proc (λ(es) (append-map (λ(e) `(,e ,e)) es)))
(code:comment @#,t{... but only strings get capitalized})
(decode tx #:txexpr-elements-proc (λ(es) (append-map (λ(e) `(,e ,e)) es))
#:string-proc (λ(s) (string-upcase s)))
]
So why do you need @racket[_txexpr-elements-proc]? Because some types of element decoding depend on context, thus it's necessary to handle the elements as a group. For instance, the doubling function above, though useless, requires handling the element list as a whole, because elements are being added.
A more useful example: paragraph detection. The behavior is not merely a @racket[map] across each element:
@examples[#:eval my-eval
(define (paras tx) (decode tx #:txexpr-elements-proc detect-paragraphs))
(code:comment @#,t{Context matters. Trailing whitespace is ignored ...})
(paras '(body "The first paragraph." "\n\n"))
(code:comment @#,t{... but whitespace between strings is converted to a break.})
(paras '(body "The first paragraph." "\n\n" "And another."))
(code:comment @#,t{A combination of both types})
(paras '(body "The first paragraph." "\n\n" "And another." "\n\n"))
]
The @racket[_block-txexpr-proc] argument and the @racket[_inline-txexpr-proc] arguments are procedures that operate on tagged X-expressions. If the X-expression meets the @racket[block-txexpr?] test, it is processed by @racket[_block-txexpr-proc]. Otherwise, it is processed by @racket[_inline-txexpr-proc]. Thus every tagged X-expression will be handled by one or the other. Of course, if you want block and inline elements to be handled the same way, you can set @racket[_block-txexpr-proc] and @racket[_inline-txexpr-proc] to be the same procedure.
@examples[#:eval my-eval
(define tx '(div "Please" (em "mind the gap") (h1 "Tuesdays only")))
(define add-ns (λ(tx) (make-txexpr
(string->symbol (format "ns:~a" (get-tag tx)))
(get-attrs tx)
(get-elements tx))))
(code:comment @#,t{div and h1 are block elements, so this will only affect them})
(decode tx #:block-txexpr-proc add-ns)
(code:comment @#,t{em is an inline element, so this will only affect it})
(decode tx #:inline-txexpr-proc add-ns)
(code:comment @#,t{this will affect all elements})
(decode tx #:block-txexpr-proc add-ns #:inline-txexpr-proc add-ns)
]
The @racket[_string-proc], @racket[_symbol-proc], @racket[_valid-char-proc], and @racket[_cdata-proc] arguments are procedures that operate on X-expressions that are strings, symbols, valid-chars, and CDATA, respectively. Deliberately, the output contracts for these procedures accept any kind of X-expression (meaning, the procedure can change the X-expression type).
@examples[#:eval my-eval
(code:comment @#,t{A div with string, entity, character, and cdata elements})
(define tx `(div "Moe" amp 62 ,(cdata #f #f "3 > 2;")))
(define rulify (λ(x) '(hr)))
(code:comment @#,t{The rulify function is selectively applied to each})
(print (decode tx #:string-proc rulify))
(print (decode tx #:symbol-proc rulify))
(print (decode tx #:valid-char-proc rulify))
(print (decode tx #:cdata-proc rulify))
]
Finally, the @racket[_tags-to-exclude] argument is a list of tags that will be exempted from decoding. Though you could get the same result by testing the input within the individual decoding functions, that's tedious and potentially slower.
@examples[#:eval my-eval
(define tx '(p "I really think" (em "italics") "should be lowercase."))
(decode tx #:string-proc (λ(s) (string-upcase s)))
(decode tx #:string-proc (λ(s) (string-upcase s)) #:exclude-tags '(em))
]
The @racket[_tags-to-exclude] argument is useful if you're decoding source that's destined to become HTML. According to the HTML spec, material within a @racket[<style>] or @racket[<script>] block needs to be preserved literally. In this example, if the CSS and JavaScript blocks are capitalized, they won't work. So exclude @racket['(style script)], and problem solved.
@examples[#:eval my-eval
(define tx '(body (h1 [[class "Red"]] "Let's visit Planet Telex.")
(style [[type "text/css"]] ".Red {color: green;}")
(script [[type "text/javascript"]] "var area = h * w;")))
(decode tx #:string-proc (λ(s) (string-upcase s)))
(decode tx #:string-proc (λ(s) (string-upcase s))
#:exclude-tags '(style script))
]
@section{Block}
Because it's convenient, Pollen categorizes tagged X-expressions into two categories: @italic{block} and @italic{inline}. Why is it convenient? When using @racket[decode], you often want to treat the two categories differently. Not that you have to. But this is how you can.
@defparam[project-block-tags block-tags (listof txexpr-tag?)
#:value html-block-tags]{
A parameter that defines the set of tags that @racket[decode] will treat as blocks. This parameter is initialized with the HTML block tags, namely:
@code[(format "~a" (dynamic-require 'css-tools/html 'block-tags))]}
@defproc[
(register-block-tag
[tag txexpr-tag?])
void?]
Adds a tag to @racket[project-block-tags] so that @racket[block-txexpr?] will report it as a block, and @racket[decode] will process it with @racket[_block-txexpr-proc] rather than @racket[_inline-txexpr-proc].
Pollen tries to do the right thing without being told. But this is the rare case where you have to be explicit. If you introduce a tag into your markup that you want treated as a block, you @bold{must} use this function to identify it, or you will get spooky behavior later on.
For instance, @racket[detect-paragraphs] knows that block elements in the markup shouldn't be wrapped in a @racket[p] tag. So if you introduce a new block element called @racket[bloq] without registering it as a block, misbehavior will follow:
@examples[#:eval my-eval
(define (paras tx) (decode tx #:txexpr-elements-proc detect-paragraphs))
(paras '(body "I want to be a paragraph." "\n\n" (bloq "But not me.")))
(code:comment @#,t{Wrong: bloq should not be wrapped})
]
But once you register @racket[bloq] as a block, order is restored:
@examples[#:eval my-eval
(define (paras tx) (decode tx #:txexpr-elements-proc detect-paragraphs))
(register-block-tag 'bloq)
(paras '(body "I want to be a paragraph." "\n\n" (bloq "But not me.")))
(code:comment @#,t{Right: bloq is treated as a block})
]
If you find the idea of registering block tags unbearable, good news. The @racket[project-block-tags] include the standard HTML block tags by default. So if you just want to use things like @racket[div] and @racket[p] and @racket[h1h6], you'll get the right behavior for free.
@examples[#:eval my-eval
(define (paras tx) (decode tx #:txexpr-elements-proc detect-paragraphs))
(paras '(body "I want to be a paragraph." "\n\n" (div "But not me.")))
]
@defproc[
(block-txexpr?
[v any/c])
boolean?]
Predicate that tests whether @racket[_v] is a tagged X-expression, and if so, whether the tag is among the @racket[project-block-tags]. If not, it is treated as inline. To adjust how this test works, use @racket[register-block-tag].
@section{Typography}
An assortment of typography & layout functions, designed to be used with @racket[decode]. These aren't hard to write. So if you like these, use them. If not, make your own.
@defproc[
(whitespace?
[v any/c])
boolean?]
A predicate that returns @racket[#t] for any stringlike @racket[_v] that's entirely whitespace, but also the empty string, as well as lists and vectors that are made only of @racket[whitespace?] members. Following the @racket[regexp-match] convention, @racket[whitespace?] does not return @racket[#t] for a nonbreaking space. If you prefer that behavior, use @racket[whitespace/nbsp?].
@examples[#:eval my-eval
(whitespace? "\n\n ")
(whitespace? (string->symbol "\n\n "))
(whitespace? "")
(whitespace? '("" " " "\n\n\n" " \n"))
(define nonbreaking-space (format "~a" #\u00A0))
(whitespace? nonbreaking-space)
]
@defproc[
(whitespace/nbsp?
[v any/c])
boolean?]
Like @racket[whitespace?], but also returns @racket[#t] for nonbreaking spaces.
@examples[#:eval my-eval
(whitespace/nbsp? "\n\n ")
(whitespace/nbsp? (string->symbol "\n\n "))
(whitespace/nbsp? "")
(whitespace/nbsp? '("" " " "\n\n\n" " \n"))
(define nonbreaking-space (format "~a" #\u00A0))
(whitespace/nbsp? nonbreaking-space)
]
@defproc[
(smart-quotes
[str string?])
string?]
Convert straight quotes in @racket[_str] to curly according to American English conventions.
@examples[#:eval my-eval
(define tricky-string
"\"Why,\" she could've asked, \"are we in Oahu watching 'Mame'?\"")
(display tricky-string)
(display (smart-quotes tricky-string))
]
@defproc[
(smart-dashes
[str string?])
string?]
In @racket[_str], convert three hyphens to an em dash, and two hyphens to an en dash, and remove surrounding spaces.
@examples[#:eval my-eval
(define tricky-string "I had a few --- OK, like 6--8 --- thin mints.")
(display tricky-string)
(display (smart-dashes tricky-string))
(code:comment @#,t{Monospaced font not great for showing dashes, but you get the idea})
]
@defproc[
(detect-linebreaks
[tagged-xexpr-elements txexpr-elements?]
[#:separator linebreak-sep string? world:linebreak-separator]
[#:insert linebreak xexpr? '(br)])
txexpr-elements?]
Within @racket[_tagged-xexpr-elements], convert occurrences of @racket[_linebreak-sep] (@racket["\n"] by default) to @racket[_linebreak], but only if @racket[_linebreak-sep] does not occur between blocks (see @racket[block-txexpr?]). Why? Because block-level elements automatically display on a new line, so adding @racket[_linebreak] would be superfluous. In that case, @racket[_linebreak-sep] just disappears.
@examples[#:eval my-eval
(detect-linebreaks '(div "Two items:" "\n" (em "Eggs") "\n" (em "Bacon")))
(detect-linebreaks '(div "Two items:" "\n" (div "Eggs") "\n" (div "Bacon")))
]
@defproc[
(detect-paragraphs
[elements txexpr-elements?]
[#:separator paragraph-sep string? world:paragraph-separator]
[#:tag paragraph-tag symbol? 'p]
[#:linebreak-proc linebreak-proc (txexpr-elements? . -> . txexpr-elements?) detect-linebreaks])
txexpr-elements?]
Find paragraphs within @racket[_elements], as denoted by @racket[_paragraph-sep], and wrap them with @racket[_paragraph-tag], unless the @racket[_element] is already a @racket[block-txexpr?] (because in that case, the wrapping is superfluous). Thus, as a consequence, if @racket[_paragraph-sep] occurs between two blocks, it's ignored.
The @racket[_paragraph-tag] argument sets the tag used to wrap paragraphs.
The @racket[_linebreak-proc] argument allows you to use a different linebreaking procedure other than the usual @racket[detect-linebreaks].
@examples[#:eval my-eval
(detect-paragraphs '("First para" "\n\n" "Second para"))
(detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line"))
(detect-paragraphs '("First para" "\n\n" (div "Second block")))
(detect-paragraphs '((div "First block") "\n\n" (div "Second block")))
(detect-paragraphs '("First para" "\n\n" "Second para") #:tag 'ns:p)
(detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (detect-linebreaks x #:insert '(newline))))
]

@ -0,0 +1,184 @@
#lang scribble/manual
@(require scribble/eval pollen/render pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/file sugar/coerce/value))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/file))
@title{File}
@defmodule[pollen/file]
A utility module that provides functions for working with Pollen source and output files. The tests rely on file extensions specified in @racket[pollen/world].
Pollen handles six kinds of source files:
@bold{Preprocessor}, with file extension @code[(format ".~a" world:preproc-source-ext)].
@bold{Markup}, with file extension @code[(format ".~a" world:markup-source-ext)].
@bold{Template}, with file extension @code[(format ".~a" world:template-source-ext)].
@bold{Null}, with file extension @code[(format ".~a" world:null-source-ext)].
@bold{Scribble}, with file extension @code[(format ".~a" world:scribble-source-ext)].
For each kind of Pollen source file, the corresponding output file is generated by removing the extension from the name of the source file. So the preprocessor source file @code["default.css.pp"] would become @code["default.css"]. Scribble files work differently — the corresponding output file is the source file but with an @racket[html] extension rather than @racket[scrbl]. So @code["pollen.scrbl"] would become @code["pollen.html"].
@deftogether[
(@defproc[
(preproc-source?
[v any/c])
boolean?]
@defproc[
(markup-source?
[v any/c])
boolean?]
@defproc[
(template-source?
[v any/c])
boolean?]
@defproc[
(null-source?
[v any/c])
boolean?]
@defproc[
(scribble-source?
[v any/c])
boolean?]
@defproc[
(pagetree-source?
[v any/c])
boolean?]
)]
Test whether @racket[_v] is a path representing a source file of the specified type, based on file extension.
@examples[#:eval my-eval
(preproc-source? "main.css.pp")
(markup-source? "default.html.pm")
(template-source? "main.html.pt")
(null-source? "index.html.p")
(scribble-source? "file.scrbl")
(pagetree-source? "index.ptree")
]
@deftogether[
(@defproc[
(has-preproc-source?
[v any/c])
boolean?]
@defproc[
(has-markup-source?
[v any/c])
boolean?]
@defproc[
(has-template-source?
[v any/c])
boolean?]
@defproc[
(has-null-source?
[v any/c])
boolean?]
@defproc[
(has-scribble-source?
[v any/c])
boolean?]
)]
Test whether @racket[_v] is the output path for an existing source file of the specified type.
@deftogether[
(@defproc[
(has/is-preproc-source?
[v any/c])
boolean?]
@defproc[
(has/is-markup-source?
[v any/c])
boolean?]
@defproc[
(has/is-template-source?
[v any/c])
boolean?]
@defproc[
(has/is-null-source?
[v any/c])
boolean?]
@defproc[
(has/is-scribble-source?
[v any/c])
boolean?]
)]
Test whether @racket[_v] is a path representing a source file of the specified type, or is the output path for an existing source file of the specified type. In other words, @racket[has/is-preproc-source?] is equivalent to @racket[(or (preproc-source? v) (has-preproc-source? v))].
@deftogether[
(@defproc[
(->preproc-source-path
[p pathish?])
path?]
@defproc[
(->markup-source-path
[p pathish?])
path?]
@defproc[
(->template-source-path
[p pathish?])
path?]
@defproc[
(->null-source-path
[p pathish?])
path?]
@defproc[
(->scribble-source-path
[p pathish?])
path?]
)]
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
(define name "default.html")
(->preproc-source-path name)
(->markup-source-path name)
(->template-source-path name)
(->scribble-source-path name)
(->null-source-path name)
]
@defproc[
(->output-path
[p pathish?])
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")
]

@ -0,0 +1,15 @@
#lang scribble/manual
@title[#:style 'toc]{Module reference}
@local-table-of-contents[]
@include-section["cache.scrbl"]
@include-section["decode.scrbl"]
@include-section["file.scrbl"]
@include-section["pagetree.scrbl"]
@include-section["render.scrbl"]
@include-section["template.scrbl"]
@include-section["tag.scrbl"]
@include-section["top.scrbl"]
@include-section["world.scrbl"]

@ -0,0 +1,216 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/pagetree txexpr pollen/decode pollen/file))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/pagetree txexpr))
@title{Pagetree}
@defmodule[pollen/pagetree]
A @italic{pagetree} is a hierarchical list of Pollen output files. A pagetree source file has the extension @code[(format ".~a" world:pagetree-source-ext)]. A pagetree provides a convenient way of separating the structure of the pages from the page sources, and navigating around this structure.
Pagetrees are made of @italic{pagenodes}. Usually these pagenodes will be names of output files in your project. (If you think it would've been more logical to just call them ``pages,'' perhaps. When I think of a web page, I think of a file on a disk. Whereas pagenodes may — and often do — refer to files that don't yet exist.)
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 pagetree figure it out.
@defproc[
(pagetree?
[possible-pagetree any/c])
boolean?]
Test whether @racket[_possible-pagetree] is a valid pagetree. It must be a @racket[txexpr?] where all elements are @racket[pagenode?], and each is unique within @racket[_possible-pagetree] (not counting the root node).
@examples[#:eval my-eval
(pagetree? '(root index.html))
(pagetree? '(root duplicate.html duplicate.html))
(pagetree? '(root index.html "string.html"))
(define nested-ptree '(root 1.html 2.html (3.html 3a.html 3b.html)))
(pagetree? nested-ptree)
(pagetree? `(root index.html ,nested-ptree (subsection.html more.html)))
(code:comment @#,t{Nesting a subtree twice creates duplication})
(pagetree? `(root index.html ,nested-ptree (subsection.html ,nested-ptree)))
]
@defproc[
(validate-pagetree
[possible-pagetree any/c])
pagetree?]
Like @racket[pagetree?], but raises a descriptive error if @racket[_possible-pagetree] is invalid, and otherwise returns @racket[_possible-pagetree] itself.
@examples[#:eval my-eval
(validate-pagetree '(root (mama.html son.html daughter.html) uncle.html))
(validate-pagetree `(root (,+ son.html daughter.html) uncle.html))
(validate-pagetree '(root (mama.html son.html son.html) mama.html))
]
@defproc[
(pagenode?
[possible-pagenode any/c])
boolean?]
Test whether @racket[_possible-pagenode] is a valid pagenode. A pagenode can be any @racket[symbol?] that is not @racket[whitespace/nbsp?] Every leaf of a pagetree is a pagenode. In practice, your pagenodes will likely be names of output files.
@margin-note{Pagenodes are symbols (rather than strings) so that pagetrees will be valid tagged X-expressions, which is a more convenient format for validation & processing.}
@examples[#:eval my-eval
(code:comment @#,t{Three symbols, the third one annoying but valid})
(map pagenode? '(symbol index.html | silly |))
(code:comment @#,t{A number, a string, a txexpr, and a whitespace symbol})
(map pagenode? '(9.999 "index.html" (p "Hello") | |))
]
@defproc[
(pagenodeish?
[v any/c])
boolean?]
Return @racket[#t] if @racket[_v] can be converted with @racket[->pagenode].
@examples[#:eval my-eval
(map pagenodeish? '(9.999 "index.html" | |))
]
@defproc[
(->pagenode
[v pagenodeish?])
pagenode?]
Convert @racket[_v] to a pagenode.
@examples[#:eval my-eval
(map pagenodeish? '(symbol 9.999 "index.html" | silly |))
(map ->pagenode '(symbol 9.999 "index.html" | silly |))
]
@section{Navigation}
@defparam[current-pagetree pagetree pagetree?
#:value #f]{
A parameter that defines the default pagetree used by pagetree navigation functions (e.g., @racket[parent-pagenode], @racket[chidren], et al.) if another is not explicitly specified. Initialized to @racket[#f].}
@defproc[
(parent
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
(or/c #f pagenode?)]
Find the parent pagenode of @racket[_p] within @racket[_pagetree]. Return @racket[#f] if there isn't one.
@examples[#:eval my-eval
(current-pagetree '(root (mama.html son.html daughter.html) uncle.html))
(parent 'son.html)
(parent "mama.html")
(parent (parent 'son.html))
(parent (parent (parent 'son.html)))
]
@defproc[
(children
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
(or/c #f pagenode?)]
Find the child pagenodes of @racket[_p] within @racket[_pagetree]. Return @racket[#f] if there aren't any.
@examples[#:eval my-eval
(current-pagetree '(root (mama.html son.html daughter.html) uncle.html))
(children 'mama.html)
(children 'uncle.html)
(children 'root)
(map children (children 'root))
]
@defproc[
(siblings
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
(or/c #f pagenode?)]
Find the sibling pagenodes of @racket[_p] within @racket[_pagetree]. The list will include @racket[_p] itself. But the function will still return @racket[#f] if @racket[_pagetree] is @racket[#f].
@examples[#:eval my-eval
(current-pagetree '(root (mama.html son.html daughter.html) uncle.html))
(siblings 'son.html)
(siblings 'daughter.html)
(siblings 'mama.html)
]
@deftogether[(
@defproc[
(previous
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
(or/c #f pagenode?)]
@defproc[
(previous*
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
(or/c #f (listof pagenode?))]
)]
Return the pagenode immediately before @racket[_p]. For @racket[previous*], return all the pagenodes before @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any pagenodes. The root pagenode is ignored.
@examples[#:eval my-eval
(current-pagetree '(root (mama.html son.html daughter.html) uncle.html))
(previous 'daughter.html)
(previous 'son.html)
(previous (previous 'daughter.html))
(previous 'mama.html)
(previous* 'daughter.html)
(previous* 'uncle.html)
]
@deftogether[(
@defproc[
(next
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
(or/c #f pagenode?)]
@defproc[
(next*
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
(or/c #f (listof pagenode?))]
)]
Return the pagenode immediately after @racket[_p]. For @racket[next*], return all the pagenodes after @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any pagenodes. The root pagenode is ignored.
@examples[#:eval my-eval
(current-pagetree '(root (mama.html son.html daughter.html) uncle.html))
(next 'son.html)
(next 'daughter.html)
(next (next 'son.html))
(next 'uncle.html)
(next* 'mama.html)
(next* 'daughter.html)
]
@section{Utilities}
@defproc[
(pagetree->list
[pagetree pagetree?])
list?
]
Convert @racket[_pagetree] to a simple list. Equivalent to a pre-order depth-first traversal of @racket[_pagetree].
@defproc[
(in-pagetree?
[pagenode pagenode?]
[pagetree pagetree? (current-pagetree)])
boolean?
]
Report whether @racket[_pagenode] is in @racket[_pagetree].
@defproc[
(path->pagenode
[p pathish?])
pagenode?
]
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?]).

@ -0,0 +1,87 @@
#lang scribble/manual
@(require scribble/eval pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen))
@title[#:style 'toc]{Pollen: the book is a program}
@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
Pollen is a publishing system that helps authors create beautiful and functional web-based books. Pollen includes tools for writing, designing, programming, testing, and publishing.
I used Pollen to create my book @link["http://practicaltypography.com"]{Butterick's Practical Typography}. Sure, go take a look. Is it better than the last digital book you encountered? Yes it is. Would you like your book to look like that? If so, keep reading.
At the core of Pollen is an argument:
@itemlist[#:style 'unordered
@item{First, that digital books should be the best books we've ever had. So far, they're not even close.}
@item{Second, that because digital books are software, an author shouldn't think of a book as merely data. @bold{The book is a program.}}
@item{Third, that the way we make digital books better than their predecessors is by exploiting this programmability.}]
That's what Pollen is for.
Not that you need to be a programmer to use Pollen. On the contrary, the Pollen language is markup-based, so you can write & edit text naturally. But when you want to automate repetitive tasks, add cross-references, or pull in data from other sources, you can access a full programming language from within the text.
That language is Racket. I chose Racket because while the idea for Pollen had been with me for several years, it simply wasn't possible to build it with other languages. So if it's unfamiliar to you, don't panic. It was unfamiliar to me. Once you see what you can do with Pollen & Racket, you may be persuaded. I was.
Or, if you can find a better digital-publishing tool, use that. But I'm never going back to the way I used to work.
@local-table-of-contents[]
@include-section["acknowledgments.scrbl"]
@section{Installation}
Install Racket, which includes DrRacket.
Install Pollen from the command line:
@verbatim{raco pkg install pollen}
After that, you can update the package from the command line:
@verbatim{raco pkg update pollen}
@include-section["quick.scrbl"]
@section{Source formats}
[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 [pollen/markup].
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 [pollen/markdown].
[pollen/markup]
[pollen/pre]
[pollen/markdown]
@include-section["command.scrbl"]
@include-section["module-reference.scrbl"]
@section{License & source code}
This module is licensed under the LGPL.
Source repository at @link["http://github.com/mbutterick/pollen"]{http://github.com/mbutterick/pollen}. Suggestions & corrections welcome.

@ -0,0 +1,358 @@
#lang scribble/manual
@title{Quick start}
@(define (link-tt url) (link url (tt url)))
@section{Creating a source file}
Assuming you've installed Racket & Pollen, launch DrRacket.
Open a new document. Change the top line to:
@racketmod[pollen]
The first line of every Pollen source file will start with @tt{#lang pollen}.
@section{Running a source file}
Add a second line to your source file so it reads:
@racketmod[pollen
Hello world]
Click the @onscreen{Run} button. In the interactions window, you'll see the result:
@nested[#:style 'code-inset]{@racketvalfont{Hello world}}
Not bad. I think Pollen just won the @link["http://en.wikipedia.org/wiki/List_of_Hello_world_program_examples"]{Hello World Competition}.
You can work with Pollen source files in any text editor. The key advantage of DrRacket is that you can preview the results by running the file.
Try editing your source file:
@racketmod[pollen
Goodbye Stranger
Breakfast in America
Take the Long Way Home]
You don't have to use Supertramp song titles. Any text will do. When you click @onscreen{Run} again, you'll see whatever you typed:
@nested[#:style 'code-inset]{@racketvalfont{Goodbye Stranger}@(linebreak)@racketvalfont{Breakfast in America}@(linebreak)@racketvalfont{Take the Long Way Home}}
We won't do it a third time. You get the point — any plain text is valid within a Pollen source file, and gets printed as is. You never have to perform the incantations of typical programming languages:
@verbatim{
print "Hello world"
document.write('Hello world');
printf("Hello world");
}
In Pollen, what you write is what you get.
@section{Naming, saving, and rendering a source file}
Save this file with the name @tt{hello.txt.pp} in any convenient directory. The desktop is fine.
Open a terminal window and issue two commands:
@verbatim{
> cd [directory containing your file]
> raco pollen render hello.txt.pp}
After a moment, a new file will appear called @tt{hello.txt}. Let's see what's in it:
@verbatim{
> cat hello.txt
Goodbye Stranger
Breakfast in America
Take the Long Way Home
}
You've just learned three things:
@itemlist[
@item{Pollen commands in the terminal begin with @tt{raco pollen}, followed by a specific command (in this case @tt{render}) and sometimes an argument (in this case @tt{hello.txt.pp}).}
@item{The @tt{render} command takes the ouput from your source file — meaning, the result you previewed in DrRacket in the previous step — and saves it to another file.}
@item{The name of the output file is the same as the source file, minus the Pollen source extension. So @tt{hello.txt.pp} becomes @tt{hello.txt}.}
]
Try editing the text in the @tt{hello.txt.pp} source file and running @tt{raco pollen render hello.txt.pp} again. The old @tt{hello.txt} will be replaced with a new one showing your changes. And so you've learned a fourth thing:
@itemlist[
@item{Pollen works by rendering output files from source files. Output files can be overwritten. Therefore, you should only make edits to your source files.}
]
@section{The project server}
You've just learned two ways to see the output of a Pollen source file — first, you ran it in DrRacket. Then, you rendered it to an output file.
Now here's a third: the Pollen project server. Here's how you start it. Return to your terminal window and issue two commands:
@verbatim{
> cd [directory containing your hello.txt.pp file]
> raco pollen start}
After a moment, you'll see the startup message:
@verbatim{
Welcome to Pollen 0.001 (Racket 6.0.0.5)
Project root is /path/to/your/directory
Project server is http://localhost:8080 (Ctrl-C to exit)
Project dashboard is http://localhost:8080/index.ptree
Ready to rock}
Open a web browser and point it at @link-tt{http://localhost:8080/index.ptree}. The top of the window will say @tt{Project root}. Below that will be a listing of the files in the directory.
Among them will be @tt{hello.txt}, with a greyed-out @tt{.pp} extension. Click on it, and you'll be taken to @link-tt{http://localhost:8080/hello.txt}, where you'll see:
@verbatim{
Goodbye Stranger
Breakfast in America
Take the Long Way Home
}
That's the boring part. Here's the good part. Leave the project server running. Open your source file again in DrRacket and edit it as follows:
@racketmod[#:file "hello.txt.pp" pollen
Mean Street
Panama
Hear About It Later]
Go back to your web browser and reload @link-tt{http://localhost:8080/hello.txt}. Now you'll see this:
@verbatim{
Mean Street
Panama
Hear About It Later}
Notice what happened — the Pollen project server dynamically regenerated the output file (@tt{hello.txt}) from the source file (@tt{hello.txt.pp}) after you edited the source. If you like, try making some more changes to @tt{hello.txt.pp}, and reloading the browser to see the updates in @tt{hello.txt}.
@section{Intermission}
That covers input & output. Now let's circle back and look at what else you can do with Pollen (beyond the epic achievement of displaying plain text in a web browser).
For the rest of this tutorial, I recommend keeping two windows on screen: a web-browser window pointed at your project server (the main URL is @link-tt{http://localhost:8080/index.ptree}) and the DrRacket editing window.
@section{Pollen as a preprocessor}
A @italic{preprocessor} is a tool for making systematic, automated changes to a source file before the main processing happens. A preprocessor can also be used to add programming logic to files that otherwise don't support it.
For instance, HTML. In DrRacket, create a new file called @tt{margin.html.pp} in your project directory:
@racketmod[#:file "margin.html.pp" pollen
<body style="margin: 5em; border:1px solid black">
5em is the inset.
</body>]
The ``@tt{.pp}'' file extension — which you saw before, with @tt{hello.txt.pp} — stands for ``Pollen preprocessor.'' You can use the Pollen preprocessor with any text-based file by inserting @tt{#lang pollen} as the first line, and adding the @tt{.pp} file extension.
But for now, go to your @link["http://localhost:8080/index.ptree"]{project dashboard} and click on @link["http://localhost:8080/margin.html"]{@tt{margin.html}}. You should see a black box containing the text ``5em is the inset.''
Let's suppose you want to change the inset to 30%. Without a preprocessor, you'd have to search & replace each value. But with a preprocessor, you can move the inset value into a variable, and update it from that one location. So first, introduce a variable called @tt{my-inset} by using the @racket[define] command:
@racketmod[#:file "margin.html.pp" pollen
◊define[my-inset]{30%}
<body style="margin: 10em; border:1px solid black">
10em is the inset.
</body>
]
The ◊ character is called a @italic{lozenge}. In Pollen, the lozenge is a special character that marks anything Pollen should interpret as a command (rather than plain text). The whole command @tt{◊define[my-inset]{30%}} means ``create a variable called @tt{my-inset} and give it the value @tt{30%}.''
Then put the variable into the HTML like so, this time using the ◊ character with the variable name in the two places the value appears:
@racketmod[#:file "margin.html.pp" pollen
◊define[my-inset]{30%}
<body style="margin: ◊my-inset; border:1px solid black">
◊my-inset is the inset.
</body>
]
Now reload @link["http://localhost:8080/margin.html"]{@tt{margin.html}}. You'll see that the size of the margin has changed (because of the change to the @tt{style} attribute) and so has the text of the HTML. If you like, try editing @tt{my-inset} with different values and reloading the page. You can also try using @racket[define] to create another variable (for instance, to change the color of the box border).
Still, this is the tiniest tip of the iceberg. The Pollen preprocessor gives you access to everything in the Racket programming language — including math functions, text manipulation, and so on.
@section{Markdown mode}
When used as a preprocessor, Pollen's rule is that what you write is what you get. But if you're targeting HTML, who wants to type out all those @tt{<tedious>tags</tedious>}? You can make Pollen do the heavy lifting by using it as a source decoder.
For instance, Markdown mode. Markdown is a simplified @link["https://daringfireball.net/projects/markdown/"]{notation system} for HTML. You can use Pollen's Markdown decoder by inserting @tt{#lang pollen} as the first line, and adding the @tt{.pmd} file extension.
Try it. In DrRacket, create a file with the following lines and save it as @tt{downtown.html.pmd}:
@racketmod[#:file "downtown.html.pmd" pollen
Pollen + Markdown
-----------------
+ You **wanted** it — you #,(racketfont "_got_") it.
+ [search for Racket](https://google.com/search?q=racket)
]
As before, go to the @link["http://localhost:8080/index.ptree"]{dashboard} for the project server. This time, click the link for @link["http://localhost:8080/downtown.html"]{@tt{downtown.html}}. You'll see something like this:
@nested[#:style 'code-inset]{
@bold{@larger{Pollen + Markdown}}
@nested[#:style 'inset]{@itemlist[
@item{You @bold{wanted} it — you @italic{got} it.}
@item{@link["https://google.com/search?q=racket"]{search for Racket}}
]}}
As usual, you're welcome to edit @tt{downtown.html.pmd} and then refresh the web browser to see the changes.
In Markdown mode, you can still embed Pollen commands within the source as you did in preprocessor mode. Just keep in mind that your commands need to produce valid Markdown (as opposed to raw HTML). For instance, use @tt{define} to create a variable called @tt{metal}, and insert it into the Markdown:
@racketmod[#:file "downtown.html.pmd" pollen
◊define[metal]{Plutonium}
Pollen + ◊metal
--------
+ You **wanted** ◊metal — you #,(racketfont "_got_") it.
+ [search for ◊metal](https://google.com/search?q=◊metal)
]
Refresh @link["http://localhost:8080/downtown.html"]{@tt{downtown.html}} in the browser:
@nested[#:style 'code-inset]{
@bold{@larger{Pollen + Plutonium}}
@nested[#:style 'inset]{@itemlist[
@item{You @bold{wanted} Plutonium — you @italic{got} it.}
@item{@link["https://google.com/search?q=Plutonium"]{search for Plutonium}}
]}}
Pollen is handling two tasks here: interpreting the commands in the source, and then converting the Markdown to HTML. But what if you wanted to use Pollen as a preprocessor that outputs a Markdown file? No problem — just change the source name from @tt{downtown.html.pmd} to @tt{downtown.md.pp}. Changing the extension from @tt{.pmd} to @tt{.pp} switches Pollen from Markdown mode back to preprocessor mode. And changing the base name from @tt{downtown.html} to @tt{downtown.md} updates the name of the output file.
@section{Markup mode}
If all you need to do is produce basic HTML, Markdown is great. But if you need to do semantic markup or other kinds of custom markup, it's not flexible enough.
In that case, you can use Pollen markup mode. To use Pollen markup, insert @tt{#lang pollen} as the first line of your source file, and add a @tt{.pm} file extension.
Compared to Markdown mode, Pollen markup mode is wide open. Markdown mode gives you a limited set of formatting tools (i.e., the ones supported by Markdown). But in markup mode, you can use any tags you want. Markdown mode decodes the source in a fixed way (i.e., with the Markdown decoder). But markup mode lets you build any decoder you want.
Let's convert our Markdown example into Pollen markup. Marking up content is simple: insert the lozenge character (@tt{◊}) followed by the name of the tag (@tt{◊tag}), followed by the content of the tag in curly braces (@tt{◊tag{content}}). In DrRacket, create a new file called @tt{uptown.html.pm} as follows:
@racketmod[#:file "uptown.html.pm" pollen
◊headline{Pollen markup}
◊items{
◊item{You ◊strong{wanted} it — you ◊em{got} it.}
◊item{◊link["https://google.com/search?q=racket"]{search for Racket}}
}]
Go to the @link["http://localhost:8080/index.ptree"]{project dashboard} and click on @link["http://localhost:8080/uptown.html"]{@tt{uptown.html}}. You'll see something like this:
@nested[#:style 'code-inset]{
Pollen markup You @bold{wanted} it — you @italic{got} it. https://google.com/search?q=racketsearch for Racket}
That's not right. What happened?
We marked up the source using a combination of standard HTML tags (@tt{strong}, @tt{em}) and nonstandard ones (@tt{headline}, @tt{items}, @tt{item}, @tt{link}). This is valid Pollen markup. (In fact, if you look at @link["http://localhost:8080/out/markup.html"]{the generated source}, you'll see that they didn't disappear.) But since we're targeting HTML, we need to convert our custom tags into valid HTML tags.
For that, we'll make a special file called @tt{project-require.rkt}. This is a file in the standard Racket language that provides helper functions to decode the source. The definitions won't make sense yet. But this is the quick start, so all you need to do is copy, paste, and save:
@racketmod[#:file "project-require.rkt" racket/base
(require pollen/tag)
(provide (all-defined-out))
(define headline (make-tag-function 'h2))
(define items (make-tag-function 'ul))
(define item (make-tag-function 'li 'p))
(define (link url text) `(a [[href ,url]] ,text))
]
Return to the @link["http://localhost:8080/index.ptree"]{project dashboard} and click on @link["http://localhost:8080/uptown.html"]{@tt{uptown.html}}. Now you'll get the right result:
@nested[#:style 'code-inset]{
@bold{@larger{Pollen markup}}
@nested[#:style 'inset]{@itemlist[
@item{You @bold{wanted} it — you @italic{got} it.}
@item{@link["https://google.com/search?q=racket"]{search for Racket}}
]}}
Markup mode takes a little more effort to set up. But it also allows you more flexibility. If you want to do semantic markup, or convert your source into multiple output formats, or handle complex page layouts — it's the way to go.
@section{Templates}
The HTML pages we just made looked pretty dull. For the last stop on the quick tour, let's fix that.
Pollen source files that are written in Markdown or markup mode (i.e., @tt{.pmd} or @tt{.pm} files) are rendered with a @italic{template}. A template is not a standalone Pollen source file. It's a file of the output type — e.g., CSS, HTML, XML — where you put the stuff that needs to be consistent between output files. The template also contains @italic{template variables} that mark where values from the Pollen source file should be inserted.
When it needs a template, Pollen first looks for a file in the project directory named @tt{template.[output extension of source]}. For @tt{uptown.html.pm}, the output extension will be @tt{.html}, thus Pollen will look for @tt{template.html}.
So let's create @tt{template.html}. Make a new file that with the following lines and save it to the same directory as @tt{uptown.html.pm}:
@filebox["template.html"]{@verbatim{<html><head><meta charset="UTF-8"/></head>
<body style="background: #f6f6f6">
<div style="background: white; margin: 3em;
border:10px double gray; padding: 3em; font-size: 130%;">
This file is ◊here
<hr />
◊->html{◊doc}
</div></body></html>
}}
This is a simple HTML file that should look familiar, except for the two template variables. The first, @tt{here}, contains the name of the current source file. As before, the lozenge character marks it as a Pollen command rather than text, so you write it as @tt{◊here}. The other command, @tt{◊->html{◊doc}}, takes the content from the source file, which is contained in a variable called @tt{doc}, and converts it to HTML with a Pollen function called @tt{->html}.
Go back to your web browser and reload @link["http://localhost:8080/uptown.html"]{@tt{uptown.html}}. (Or @link["http://localhost:8080/downtown.html"]{@tt{downtown.html}} — both will work.) The page will be rendered with the new @tt{template.html}. As before, you can edit the template or the source and the project server will dynamically update the output file.
@section{PS for Scribble users}
Pollen can also be used as a dynamic preview server for Scribble files. From your terminal, do the following:
@verbatim{
> cd [directory containing your Scribble files]
> raco pollen start}
On the @link["http://localhost:8080/index.ptree"]{project dashboard}, you'll see your @tt{[filename].scrbl} files listed as @tt{[filename].html}. This may not represent the ultimate structure of your Scribble project — you may end up combining multiple Scribble source files into one HTML file, or making multiple HTML files from one Scribble source — but it's handy for checking your work as you go.
@section{The end of the beginning}
Now you've seen the key features of Pollen. What do you think?
@itemlist[
@item{@italic{``So it's like WordPress, but harder to use?''} I was a happy WordPress user for several years. If you need a blog, it's great. But the farther you get from blogs, the more it becomes like teaching an elephant to pirouette. And for those who like to solve problems with programming, PHP is, um, limited.}
@item{@italic{``What about pairing a Python template system and Python web server?''} Good idea. I even tried it. But Python template systems don't offer you Python — they offer you pidgin dialects that ain't very Pythonic. Also, Python's handing of markup-based data structures is cumbersome.}
@item{@italic{``Haven't you heard of Jekyll?''} Yes. If everything you need to write is expressible in Markdown, it's great. If you need more than that, you're stuck.}
@item{@italic{``Sounds a lot like LaTeX. Why not use that?''} Also a good idea. LaTeX gets a lot of things right. But it wasn't designed for web publishing.}
@item{@italic{``Eh, there are plenty of adequate options. Why should I learn a system written in Racket, which I've never used?''} A salient objection. It's also the question I asked myself before I committed to Racket. But publishing systems that are author- or designer-friendly tend to be programmer-hostile, and vice versa. Racket is the only language I found that could meet my requirements.}
]
But don't take my word for it. The rest of this documentation will show you the cool, useful, and sophisticated things you can do with Pollen. If there's another tool that suits you better, great. Keep in mind that I didn't make Pollen because I'm a programmer. I'm a writer who wants to make electronic books that are better than the ones we have now. And for that, I needed a better tool.

@ -0,0 +1,249 @@
/* See the beginning of "scribble.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk {
font-family: monospace;
white-space: inherit;
}
/* Serif: */
.inheritedlbl {
font-family: serif;
}
/* Sans-serif: */
.RBackgroundLabelInner {
font-family: sans-serif;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 100%;
margin-top: 0.5em;
text-align: left;
background-color: #ECF5F5;
}
.inherited td {
font-size: 82%;
padding-left: 1em;
text-indent: -0.8em;
padding-right: 0.2em;
}
.inheritedlbl {
font-style: italic;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eeeeee;
}
.RktInBG {
background-color: #eeeeee;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: black;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
}
.RktVar {
color: #262680;
font-style: italic;
}
.RktSym {
color: #262680;
}
.RktSymDef { /* used with RktSym at def site */
}
.RktValLink {
text-decoration: none;
color: blue;
}
.RktValDef { /* used with RktValLink at def site */
}
.RktModLink {
text-decoration: none;
color: blue;
}
.RktStxLink {
text-decoration: none;
color: black;
}
.RktStxDef { /* used with RktStxLink at def site */
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together {
width: 100%;
}
.prototype, .argcontract, .RBoxed {
white-space: nowrap;
}
.prototype td {
vertical-align: text-top;
}
.RktBlk {
white-space: inherit;
text-align: left;
}
.RktBlk tr {
white-space: inherit;
}
.RktBlk td {
vertical-align: baseline;
white-space: inherit;
}
.argcontract td {
vertical-align: text-top;
}
.highlighted {
background-color: #ddddff;
}
.defmodule {
width: 100%;
background-color: #F5F5DC;
}
.specgrammar {
float: right;
}
.RBibliography td {
vertical-align: text-top;
}
.leftindent {
margin-left: 1em;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.Rfilebox {
}
.Rfiletitle {
text-align: right;
margin: 0em 0em 0em 0em;
}
.Rfilename {
border-top: 1px solid #6C8585;
border-right: 1px solid #6C8585;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: #ECF5F5;
}
.Rfilecontent {
margin: 0em 0em 0em 0em;
}
.RpackageSpec {
padding-right: 0.5em;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0px;
text-align: right;
color: white;
z-index: 0;
font-weight: bold;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}
/* ---------------------------------------- */
/* History */
.SHistory {
font-size: 82%;
}

@ -0,0 +1,84 @@
#lang scribble/manual
@(require scribble/eval pollen/render pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/render web-server/templates pollen/file))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen))
@title{Render}
@defmodule[pollen/render]
@italic{Rendering} is how Pollen source files get converted into output.
@defproc[
(render
[source-path complete-path?]
[template-path (or/c #f complete-path?) #f])
bytes?]
Renders @racket[_source-path]. The rendering behavior depends on the type of source file:
A [pollen/pre] file is rendered without a template.
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.
For those panicked at the use of @racket[eval], please don't be. As the author of @racket[include-template] has already advised, ``If you insist on dynamicism'' — and yes, I do insist — ``@link["http://docs.racket-lang.org/web-server/faq.html#%28part._.How_do_.I_use_templates__dynamically__%29"]{there is always @racket[eval].}''
@defproc[
(render-to-file
[source-path complete-path?]
[template-path (or/c #f complete-path?) #f]
[output-path (or/c #f complete-path?) #f])
void?]
Like @racket[render], but saves the file to @racket[_output-path], overwriting whatever was already there. If no @racket[_output-path] is provided, it's derived from @racket[_source-path] using @racket[->output-path].
@defproc[
(render-to-file-if-needed
[source-path complete-path?]
[template-path (or/c #f complete-path?) #f]
[output-path (or/c #f complete-path?) #f]
[#:force force-render? boolean? #f])
void?]
Like @racket[render-to-file], but the render only happens if one of these conditions exist:
@itemlist[#:style 'ordered
@item{The @racket[_force-render?] flag — set with the @racket[#:force] keyword — is @racket[#t].}
@item{No file exists at @racket[_output-path]. (Thus, an easy way to force a render of a particular @racket[_output-path] is to delete it.)}
@item{Either @racket[_source-path] or @racket[_template-path] have changed since the last trip through @racket[render].}
@item{One or more of the project requires have changed.}]
If none of these conditions exist, @racket[_output-path] is deemed to be up to date, and the render is skipped.
@defproc[
(render-batch
[source-paths (listof pathish?)] ...)
void?]
Render multiple @racket[_source-paths] in one go. This can be faster than @racket[(for-each render _source-paths)] if your @racket[_source-paths] rely on a common set of templates. Templates may have their own source files that need to be compiled. If you use @racket[render], the templates will be repeatedly (and needlessly) re-compiled. Whereas if you use @racket[render-batch], each template will only be compiled once.
@defproc*[
(
[(render-pagetree [pagetree pagetree?]) void?]
[(render-pagetree [pagetree-source pathish?]) void?])]
Using @racket[_pagetree], or a pagetree loaded from @racket[_pagetree-source], render the pages in that pagetree using @racket[render-batch].
@defproc[
(get-template-for
[source-path complete-path?])
(or/c #f complete-path?)]
Find a template file for @racket[_source-path], with the following priority:
@itemlist[#:style 'ordered
@item{If the metas for @racket[_source-path] have a key for @code[(format "~a" world:template-meta-key)], then use the value of this key.}
@item{If this key doesn't exist, or if it points to a nonexistent file, look for a default template in the project directory with the name @code[(format "~a.[output extension].~a" world:default-template-prefix world:template-source-ext)]. Meaning, if @racket[_source-path] is @code[(format "intro.html.~a" world:markup-source-ext)], the output path would be @code["intro.html"], so the default template would be @code[(format "~a.html.~a" world:default-template-prefix world:template-source-ext)].}
@item{If this file doesn't exist, use the fallback template as a last resort.}]
This function is called when a template is needed, but a @racket[_template-path] argument is missing (for instance, in @racket[render] or @racket[render-to-file]).

@ -0,0 +1,40 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) txexpr pollen/tag pollen/render xml pollen/pagetree sugar/coerce/value))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/template xml))
@title{Tag}
@defmodule[pollen/tag]
Convenience functions for working with tags.
@defproc[
(make-tag-function
[id txexpr-tag?])
(-> txexpr?)]
Make a tag function for @racket[_id]. As arguments, a tag function takes an optional set of X-expression attributes (@racket[txexpr-attrs?]) followed by X-expression elements (@racket[txexpr-elements?]). From these, the tag function creates a tagged X-expression using @racket[_id] as the tag.
@examples[
(require pollen/tag)
(define beaucoup (make-tag-function 'em))
(beaucoup "Bonjour")
(beaucoup '((id "greeting")) "Bonjour")
]
Entering attributes this way can be cumbersome. So for convenience, a tag function provides an alternative: any symbol + string pairs at the front of your expression will be interpreted as attributes, if the symbols are followed by a colon. If you leave out the colon, the symbols will be interpreted as part of the content of the tag.
@examples[
(require pollen/tag)
(define beaucoup (make-tag-function 'em))
(beaucoup 'id: "greeting" 'class: "large" "Bonjour")
(code:comment @#,t{Don't forget the colons})
(beaucoup 'id "greeting" 'class "large" "Bonjour")
(code:comment @#,t{Don't forget to provide a value for each attribute})
(beaucoup 'id: 'class: "large" "Bonjour")
]
Pollen also uses this function to provide the default behavior for undefined tags. See @racket[#%top].

@ -0,0 +1,98 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/template pollen/render xml pollen/pagetree sugar/coerce/value))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/template xml))
@title{Template}
@defmodule[pollen/template]
Convenience functions for templates. These are automatically imported into the @racket[eval] environment when rendering with a template (see @racket[render]).
This module also provides everything from @racket[sugar/coerce/value].
@defproc[
(->html
[xexpr xexpr?])
string?]
Convert @racket[_xexpr] to an HTML string. Similar to @racket[xexpr->string], but consistent with the HTML spec, text that appears within @code{script} or @code{style} blocks will not be escaped.
@examples[#:eval my-eval
(define tx '(root (script "3 > 2") "Why is 3 > 2?"))
(xexpr->string tx)
(->html tx)
]
Be careful not to pass existing HTML strings into this function, because the angle brackets will be escaped. Fine if that's what you want, but you probably don't.
@examples[#:eval my-eval
(define tx '(p "You did" (em "what?")))
(->html tx)
(->html (->html tx))
]
@deftogether[(
@defproc[
(select
[key symbolish?]
[value-source (or/c hash? txexpr? pagenode? pathish?)])
(or/c #f txexpr-element?)]
@defproc[
(select*
[key symbolish?]
[value-source (or/c hash? txexpr? pagenode? pathish?)])
(or/c #f (listof txexpr-element?))]
)]
Find matches for @racket[_key] in @racket[_value-source], first by looking in its @code{metas} (using @racket[select-from-metas]) and then by looking in its @code{doc} (using @racket[select-from-doc]). With @racket[select], you get the first result; with @racket[select*], you get them all. In both cases, you get @racket[#f] if there are no matches.
@defproc[
(select-from-metas
[key symbolish?]
[meta-source (or/c hash? pagenodeish? pathish?)])
(or/c #f txexpr-element?)]
Look up the value of @racket[_key] in @racket[_meta-source]. The @racket[_meta-source] argument can be either a set of metas (i.e., a @racket[hash]) or a @racket[pagenode?], from which metas are pulled. If no value exists for @racket[_key], you get @racket[#f].
@examples[#:eval my-eval
(module ice-cream pollen/markup
'(div (question "Flavor?")
(answer "Chocolate chip") (answer "Maple walnut"))
'(meta ((template "sub.xml.pt")))
'(meta ((target "print"))))
(code:comment @#,t{Import doc & metas from 'ice-cream submodule})
(require 'ice-cream)
(select-from-metas 'template metas)
('target . select-from-metas . metas)
(select-from-metas 'nonexistent-key metas)
]
@defproc[
(select-from-doc
[key symbolish?]
[doc-source (or/c txexpr? pagenodeish? pathish?)])
(or/c #f txexpr-element?)]
Look up the value of @racket[_key] in @racket[_doc-source]. The @racket[_doc-source] argument can be either be a @code{doc} (i.e., a @racket[txexpr]) or a @racket[pagenode?], from which doc is pulled. If no value exists for @racket[_key], you get @racket[#f].
@examples[#:eval my-eval
(module gelato pollen/markup
'(div (question "Flavor?")
(answer "Nocciola") (answer "Pistachio"))
'(meta ((template "sub.xml.pt")))
'(meta ((target "print"))))
(code:comment @#,t{Import doc & metas from 'gelato submodule})
(require 'gelato)
(select-from-doc 'question doc)
('answer . select-from-doc . doc)
(select-from-doc 'nonexistent-key doc)
]

@ -0,0 +1,100 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/tag))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/world))
@title{Top}
@defmodule[pollen/top]
You'll probably never invoke this module directly. But it's implicitly imported into every Pollen markup file. And if you don't know what it does, you might end up surprised by some of the behavior you get.
@defform[(#%top . id)]{
In standard Racket, @racket[#%top] is the function of last resort, called when @racket[_id] is not bound to any value. As such, it typically reports a syntax error.
@examples[
(code:comment @#,t{Let's call em without defining it})
(em "Bonjour")
(code:comment @#,t{(em "Bonjour") is being converted to ((#%top . em) "Bonjour")})
(code:comment @#,t{So calling ((#%top . em) "Bonjour") will give the same result})
((#%top . em) "Bonjour")
]
In the Pollen markup environment, however, this behavior is annoying. Because when you're writing X-expressions, you don't necessarily want to define all your tags ahead of time.
So Pollen redefines @racket[#%top]. For convenience, Pollen's version of @racket[#%top] assumes that an undefined tag should just refer to an X-expression beginning with that tag (and uses @racket[make-tag-function] to provide this behavior):
@examples[
(code:comment @#,t{Again, let's call em without defining it, but using pollen/top})
(require pollen/top)
(em "Bonjour")
(code:comment @#,t{(em "Bonjour") is still being converted to ((#%top . em) "Bonjour")})
(code:comment @#,t{But now, ((#%top . em) "Bonjour") gives a different result})
((#%top . em) "Bonjour")
]
The good news is that this behavior means you use any tag you want in your markup without defining it in advance. You can still attach a function to the tag later, which will automatically supersede @racket[#%top].
@examples[
(define (em x) `(span ((style "font-size:100px")) ,x))
(em "Bonjour")
]
The bad news is that you'll never get an ``undefined identifier'' error. These undefined identifiers will happily sail through and be converted to tags.
@examples[
(require pollen/top)
(define (em . xs) `(span ((style "font-size:100px")) ,@xs))
(code:comment @#,t{There's a typo in my tag})
(erm "Bonjour")
]
This isn't a bug. It's just a natural consequence of how Pollen's @racket[#%top] works. It can, however, make debugging difficult sometimes. Let's suppose my markup depends on @racket[very-important-function], which I don't import correctly.
@examples[
(require pollen/top)
(module vif racket/base
(define (very-important-function . xs) `(secrets-of-universe ,@xs)))
(code:comment @#,t{Forgot to (require 'vif)})
(very-important-function "Bonjour")
]
So the undefined-function bug goes unreported. Again, that's not a bug in Pollen — there's just no way for it to tell the difference between an identifier that's deliberately undefined and one that's inadvertently undefined. If you want to guarantee that you're invoking a defined identifier, use @racket[def/c].}
@defform[(def/c id)]{Invoke @racket[_id] if it's a defined identifier, otherwise raise an error. This form reverses the behavior of @racket[#%top] (in other words, it restores default Racket behavior).
Recall this example from before. In standard Racket, you get an undefined-identifier error.
@examples[
(module vif racket/base
(define (very-important-function . xs) `(secrets-of-universe ,@xs)))
(code:comment @#,t{Forgot to (require 'vif)})
(very-important-function "Bonjour")
]
But with @racketmodname[pollen/top], the issue is not treated as an error.
@examples[
(require pollen/top)
(module vif racket/base
(define (very-important-function . xs) `(secrets-of-universe ,@xs)))
(code:comment @#,t{Forgot to (require 'vif)})
(very-important-function "Bonjour")
]
By adding @racket[def/c], we restore the usual behavior, guaranteeing that we get the defined version of @racket[very-important-function] or nothing.
@examples[
(require pollen/top)
(module vif racket/base
(define (very-important-function . xs) `(secrets-of-universe ,@xs)))
(code:comment @#,t{Forgot to (require 'vif)})
((def/c very-important-function) "Bonjour")
]
}

@ -0,0 +1,262 @@
#lang racket/base
(require scribble/core
scribble/html-properties
scribble/manual
(prefix-in racket: scribble/racket)
(prefix-in scribble: scribble/reader)
(prefix-in pollen: (submod pollen reader)))
(define-syntax bounce-for-label
(syntax-rules (all-except)
[(_ (all-except mod (id ...) (id2 ...)))
(begin (require (for-label (except-in mod id ...)))
(provide (for-label (except-out (all-from-out mod) id2 ...))))]
[(_ mod) (begin (require (for-label mod))
(provide (for-label (all-from-out mod))))]
[(_ mod ...) (begin (bounce-for-label mod) ...)]))
(bounce-for-label (all-except racket (abstract link) ())
scribble/core
scribble/base-render
scribble/decode
scribble/manual
scribble/racket
scribble/html-properties
scribble/latex-properties
scribble/eval
scribble/bnf)
(provide scribble-examples pollen-examples litchar/lines doc-render-examples)
(define (as-flow e)
(if (block? e) e (make-paragraph plain (list e))))
(define (litchar/lines . strs)
(let ([strs (regexp-split #rx"\n" (apply string-append strs))])
(if (= 1 (length strs))
(litchar (car strs))
(make-table
plain
(map (lambda (s) ; the nbsp is needed for IE
(list (as-flow (if (string=? s "") 'nbsp (litchar s)))))
strs)))))
(define spacer (hspace 2))
(define ((norm-spacing base) p)
(cond [(and (syntax->list p) (not (null? (syntax-e p))))
(let loop ([e (syntax->list p)]
[line (syntax-line (car (syntax-e p)))]
[pos base]
[second #f]
[accum null])
(if (null? e)
(datum->syntax
p (reverse accum)
(list (syntax-source p) (syntax-line p) base (add1 base)
(- pos base))
p)
(let* ([v ((norm-spacing (if (= line (syntax-line (car e)))
pos
(or second pos)))
(car e))]
[next-pos (+ (syntax-column v) (syntax-span v) 1)])
(loop (cdr e)
(syntax-line v)
next-pos
(or second next-pos)
(cons v accum)))))]
[else (datum->syntax
p (syntax-e p)
(list (syntax-source p) (syntax-line p) base (add1 base) 1)
p)]))
(define (pollen-examples . lines)
(define reads-as (make-paragraph plain (list spacer "reads as" spacer)))
(let* ([lines (apply string-append lines)]
[p (open-input-string lines)])
(port-count-lines! p)
(let loop ([r '()] [newlines? #f])
(regexp-match? #px#"^[[:space:]]*" p)
(let* ([p1 (file-position p)]
[stx (pollen:read-syntax #f p)]
[p2 (file-position p)])
(if (not (eof-object? stx))
(let ([str (substring lines p1 p2)])
(loop (cons (list str stx) r)
(or newlines? (regexp-match? #rx#"\n" str))))
(let* ([r (reverse r)]
[r (if newlines?
(cdr (apply append (map (lambda (x) (list #f x)) r)))
r)])
(make-table
plain
(map (lambda (x)
(let ([@expr (if x (litchar/lines (car x)) "")]
[sexpr (if x
(racket:to-paragraph
((norm-spacing 0) (cadr x)))
"")]
[reads-as (if x reads-as "")])
(map as-flow (list spacer @expr reads-as sexpr))))
r))))))))
(define (scribble-examples . lines)
(define reads-as (make-paragraph plain (list spacer "reads as" spacer)))
(let* ([lines (apply string-append lines)]
[p (open-input-string lines)])
(port-count-lines! p)
(let loop ([r '()] [newlines? #f])
(regexp-match? #px#"^[[:space:]]*" p)
(let* ([p1 (file-position p)]
[stx (scribble:read-syntax #f p)]
[p2 (file-position p)])
(if (not (eof-object? stx))
(let ([str (substring lines p1 p2)])
(loop (cons (list str stx) r)
(or newlines? (regexp-match? #rx#"\n" str))))
(let* ([r (reverse r)]
[r (if newlines?
(cdr (apply append (map (lambda (x) (list #f x)) r)))
r)])
(make-table
plain
(map (lambda (x)
(let ([@expr (if x (litchar/lines (car x)) "")]
[sexpr (if x
(racket:to-paragraph
((norm-spacing 0) (cadr x)))
"")]
[reads-as (if x reads-as "")])
(map as-flow (list spacer @expr reads-as sexpr))))
r))))))))
;; stuff for the scribble/text examples
(require racket/list (for-syntax racket/base racket/list))
(define max-textsample-width 45)
(define (textsample-verbatim-boxes line in-text out-text more)
(define (split str) (regexp-split #rx"\n" str))
(define strs1 (split in-text))
(define strs2 (split out-text))
(define strsm (map (compose split cdr) more))
(define (str->elts str)
(let ([spaces (regexp-match-positions #rx"(?:^| ) +" str)])
(if spaces
(list* (str->elts (substring str 0 (caar spaces)))
(smaller (hspace (- (cdar spaces) (caar spaces))))
(str->elts (substring str (cdar spaces))))
(list (smaller (make-element 'tt str))))))
(define (make-line str)
(list (as-flow (if (equal? str "")
(smaller (hspace 1))
(str->elts str)))))
(define (make-box strs [file #f])
(nested #:style 'code-inset
(let ([t (make-table plain (map make-line strs))])
(if file
(filebox file t)
t))))
(define filenames (map car more))
(define indent (let ([d (- max-textsample-width
(for*/fold ([m 0])
([s (in-list (cons strs1 strsm))]
[s (in-list s)])
(max m (string-length s))))])
(if (negative? d)
(error 'textsample-verbatim-boxes
"left box too wide for sample at line ~s" line)
(make-element 'tt (list (hspace d))))))
;; Note: the font-size property is reset for every table, so we need it
;; everywhere there's text, and they don't accumulate for nested tables
(values
(make-table
(make-style #f
(list (make-table-columns (list (make-style #f '(left top))))))
(cons (list (as-flow (make-box strs1)))
(map (lambda (file strs)
(list (as-flow (make-box strs file))))
filenames strsm)))
(make-box strs2)))
(define (textsample line in-text out-text more)
(define-values (box1 box2)
(textsample-verbatim-boxes line in-text out-text more))
(make-table
(make-style #f (list (make-table-columns (list (make-style #f '(left vcenter))
(make-style "Short" '(left vcenter))
(make-style #f '(left vcenter))))))
(list (map as-flow (list box1 (make-paragraph plain '(nbsp rarr nbsp)) box2)))))
(define-for-syntax tests-ids #f)
(provide initialize-tests)
(define-syntax (initialize-tests stx)
(set! tests-ids (map (lambda (x) (datum->syntax stx x stx))
'(tests add-to-tests)))
(with-syntax ([(tests add-to-tests) tests-ids])
#'(begin (provide tests)
(define-values (tests add-to-tests)
(let ([l '()])
(values (lambda () (reverse l))
(lambda (x) (set! l (cons x l)))))))))
(provide example)
(define-syntax (example stx)
(define sep-rx #px"^---[*]{3}---(?: +(.*))?$")
(define file-rx #rx"^[a-z0-9_.+-]+$")
(define-values (body hidden?)
(syntax-case stx ()
[(_ #:hidden x ...) (values #'(x ...) #t)]
[(_ x ...) (values #'(x ...) #f)]))
(let loop ([xs body] [text '(#f)] [texts '()])
(syntax-case xs ()
[("\n" sep "\n" . xs)
(and (string? (syntax-e #'sep)) (regexp-match? sep-rx (syntax-e #'sep)))
(let ([m (cond [(regexp-match sep-rx (syntax-e #'sep)) => cadr]
[else #f])])
(if (and m (not (regexp-match? file-rx m)))
(raise-syntax-error #f "bad filename specified" stx #'sep)
(loop #'xs
(list (and m (datum->syntax #'sep m #'sep #'sep)))
(cons (reverse text) texts))))]
[(x . xs) (loop #'xs (cons #'x text) texts)]
[() (let ([texts (reverse (cons (reverse text) texts))]
[line (syntax-line stx)])
(define-values (files i/o) (partition car texts))
(unless ((length i/o) . = . 2)
(raise-syntax-error
'example "need at least an input and an output block" stx))
(with-syntax ([line line]
[((in ...) (out ...)) (map cdr i/o)]
[((file text ...) ...) files]
[add-to-tests (cadr tests-ids)])
(quasisyntax/loc stx
(let* ([in-text (string-append in ...)]
[out-text (string-append out ...)]
[more (list (cons file (string-append text ...)) ...)])
(add-to-tests (list line in-text out-text more))
#,(if hidden? #'""
#'(textsample line in-text out-text more))))))]
[_ (raise-syntax-error #f "no separator found in example text")])))
(provide ltx ltxe ltxd)
(define (ltx s) (tt "\\" s)) ; command
(define (ltxe s) (tt s)) ; enviornment
(define (ltxd n s)
(make-element #f (cons (index (list s) (ltx s))
(for/list ([i (in-range n)]) (tt "{}")))))
;; Utility to render examples of scribble documentation forms
;; Note: it would be nice if this abstracted over the codeblock
;; that usually comes along with this too, but that's hard
;; because there's a read-time distinction between [...]
;; and |{...}|.
(define-syntax-rule (doc-render-examples e ...)
(nested "Renders like:\n"
(nested #:style 'inset (nested #:style 'inset e ...))))

@ -0,0 +1,55 @@
#lang scribble/manual
@title{Why I made Pollen}
The nerds have already raced ahead to the quick tutorial. That's okay. Because software isn't just data structures and functions. It's ideas, and choices, and policies. It's design.
I created Pollen to overcome certain tool limitations that surfaced repeatedly in my work. If you agree with my characterization of those problems, then you'll probably like the solution that Pollen offers.
If not, you probably won't.
@section{The web-development problem}
I made my first web page in 1994, shortly after the web was invented. I opened my text editor (at the time, @link["http://www.barebones.com/products/bbedit/"]{BBEdit}) and pecked out @code{<html><body>Hello world</body></html>}, then loaded it in @link["http://en.wikipedia.org/wiki/Mosaic_(web_browser)"]{Mosaic}. So did a million others.
If you weren't around then, you didn't miss much. Everything about the web was horrible: the web browsers, the computers running the browsers, the dial-up connections feeding the browsers, and of course HTML itself. At that point, the desktop-software experience was already slick and refined. By comparison, using the web felt like banging rocks together.
That's no longer true. The web is now 20 years old. During that time, most parts of the web have improved dramatically — the connections are faster, the browsers are more sophisticated, the screens have more pixels.
But one part has not: the way we make web pages. Over the years, tools promising to simplify HTML development have come and mostly gone — from PageMill to Dreamweaver. Meanwhile, true web jocks have remained loyal to the original HTML power tool: the humble text editor.
In one way, this makes sense. Web pages are mostly made of text — HTML, CSS, JavaScript, and so on — and thus the simplest way to mainpulate them is with a text editor. While HTML and CSS are not programming languages, they lend themselves to semantic and logical structure that's most easily expressed by editing them as text. Text-based editing also makes debugging and performance improvements easier.
But text-based editing is also limited. Though the underlying description of a web page is notionally human-readable, it's largely optimized to be readable by other software (namely, web browsers). HTML markup in particular is verbose and easily mistyped. And isn't it fatally dull to manage all the boilerplate, like surrounding every paragraph with @code{<p>...</p>}? Yes, it is.
For these reasons, much of web development should lend itself to automation. But in practice, tools that enable this automation have been slow to arrive, and most come hobbled with unacceptable deficiencies.
@subsection{Why not a content management system, like WordPress?}
I used WordPress to make the original version of @link["http://typographyforlawyers.com/"]{Typography for Lawyers} (the precursor to Butterick's Practical Typography). Even WordPress founder Matt Mullenweg @link["http://ma.tt/2010/04/typography-for-lawyers/"]{thought} it was “a cool use of WordPress for a mini-book.” Thanks, Matt. At the time, WordPress was the best tool for the job.
But at the risk of having my @link["http://gravatar.com"]{Gravatar} revoked, I'll tell you I became disenchanted with WordPress because:
It's a resource hog.
Performance is questionable.
There's always a new security problem.
No source control.
PHP.
@subsection{Why not a CSS preprocessor, like Sass or LESS?}
A CSS preprocessor automates the generation of CSS data. These preprocessors do save time & effort, so using one is better than not using one. My objection is that they ask you to incur much of the overhead of learning a programming language but without delivering the benefits. Because unlike a general-purpose programming language, Sass and LESS can only manipulate CSS. Better to learn a programming language that can manipulate anything.
@subsection{Why not a static blog generator, like Jekyll or Pelican?}
@subsection{Why not a dynamic templating system, like Bottle?}

@ -0,0 +1,93 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world pollen/render))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/world))
@title{World}
@defmodule[pollen/world]
A set of global values and parameters that are used throughout the Pollen system. If you don't like the defaults I've picked, change them.
All identifiers are exported with the prefix @racket[world:], and are so documented below.
@deftogether[(
@defthing[world:main-pollen-export symbol? #:value 'doc]
@defthing[world:meta-pollen-export symbol? #:value 'metas]
)]
The two exports from a compiled Pollen source file.
@(defthing world:project-require string? #:value "project-require.rkt")
File implicitly required into every Pollen source file from its directory.
@defparam[world:check-project-requires-in-render? check? boolean?
#:value #t]{
A parameter that determines whether the @racket[world:project-require] file is checked for changes on every pass through @racket[render]. (Can be faster to turn this off if you don't need it.) Initialized to @racket[#t].}
@defthing[world:server-extras-dir string? #:value "server-extras"]
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 project server. Initialized to @racket[#f], but set to a proper value when the server runs.}
@deftogether[(
@defthing[world:preproc-source-ext symbol? #:value 'pp]
@defthing[world:markup-source-ext symbol? #:value 'pm]
@defthing[world:markdown-source-ext symbol? #:value 'pmd]
@defthing[world:null-source-ext symbol? #:value 'p]
@defthing[world:pagetree-source-ext symbol? #:value 'ptree]
@defthing[world:template-source-ext symbol? #:value 'pt]
@defthing[world:scribble-source-ext symbol? #:value 'scrbl]
)]
File extensions for Pollen source files.
@defthing[world:decodable-extensions (listof symbol?) #:value (list world:markup-source-ext world:pagetree-source-ext)]
File extensions that are eligible for decoding.
@deftogether[(
@(defthing world:mode-auto symbol? #:value 'auto)
@(defthing world:mode-preproc symbol? #:value 'pre)
@(defthing world:mode-markup symbol? #:value 'markup)
@(defthing world:mode-markdown symbol? #:value 'markdown)
@(defthing world:mode-pagetree symbol? #:value 'ptree)
)]
Mode indicators for the Pollen reader and parser.
@defthing[world:default-pagetree string? #:value "index.ptree"]
Pagetree that Pollen dashboard loads by default in each directory.
@defthing[world:pagetree-root-node symbol? #:value 'pagetree-root]
Name of the root node in a decoded pagetree. It's ignored by the code, so its only role is to clue you in that you're looking at something that came out of the pagetree decoder.
@defthing[world:command-marker char? #:value #\◊]
The magic character that indicates a Pollen command, function, or variable.
@defthing[world:default-template-prefix string? #:value "template"]
Prefix of the default template.
@defthing[world:fallback-template string? #:value "fallback.html.pt"]
Name of the fallback template (i.e., the template used to render a Pollen markup file when no other template can be found).
@defthing[world:template-meta-key symbol? #:value 'template]
Meta key used to store a template name for that particular source file.
@deftogether[(
@(defthing world:newline string? #:value "\n")
@(defthing world:linebreak-separator string? #:value world:newline)
@(defthing world:paragraph-separator string? #:value "\n\n")
)]
Default separators used in decoding.
@(defthing world:dashboard-css string? #:value "poldash.css")
CSS file used for the dashboard.
@(defthing world:paths-excluded-from-dashboard (listof path?) #:value (map string->path (list "poldash.css" "compiled")))
Paths not shown in the Pollen dashboard.

@ -0,0 +1 @@
File not found. Sorry.

@ -0,0 +1,37 @@
* {
margin: 0;
padding: 0;
}
body {
font-family: "Source Code Pro";
padding: 1em;
}
div.title, p {
padding: 0.4em;
}
div.title {
border-top: 1px solid #ccc;
border-bottom: 1px solid #ccc;
}
pre {
background: #ffe;
padding: 0.8em;
line-height: 1.5;
font-size: 80%;
font-family: "Source Code Pro";
white-space: pre-wrap;
overflow: auto;
max-height: 240px;
}
.error {
font-weight: bolder;
color: red;
font-size: large;
}

@ -0,0 +1 @@
◊(->html (html (head (meta 'charset: "UTF-8")) (body doc)))

@ -0,0 +1,97 @@
* {
margin: 0;
padding: 0;
}
body {
padding: 1em;
font-family: "Source Code Pro";
}
div#pollen-logo {
display: none;
position: fixed;
right: 0;
bottom: 0;
width: 76;
height: 76;
background-size: 100%;
}
table {
border-collapse:collapse;
width: 100%;
max-width: 700px;
}
tr > td:first-child {
width: 0%;
}
th, tr > td:first-child {
font-family: "Source Code Pro";
background: #f6f6f6;
text-align: left;
}
th {
background: white;
font-weight: normal;
padding: 0.4em;
}
tr, tr + tr {
border-top: 1px solid #ccc;
}
td {
font-size: 16px;
line-height: 1.35;
text-align: center;
}
td.no-files {
padding: 0.4em;
}
a:hover {
background: #eee;
}
a {
text-decoration: none;
color: #6a6;
display: block;
padding: 0.4em;
}
th a {
font-weight: normal;
display: inline;
color: black;
padding-left: 0;
}
th a:hover {
background: inherit;
color: #6a6;
}
.file-ext {
color: #bbb;
}
a:active {
text-decoration: underline;
}
tt {
font-family: "Source Code Pro";
font-size: 100%;
white-space: pre-wrap;
}

@ -0,0 +1,32 @@
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg version="1.1" xmlns="http://www.w3.org/2000/svg"
width="19em" height="19em" viewBox="0 0 19 19">
<rect fill="#e6e6e6" width="19" height="19" />
<g>
<polyline fill="none" stroke="#BCBEC0" stroke-width="5" stroke-linecap="square" stroke-miterlimit="5" points="
3.5,9.5
3.5,15.5
9.5,15.5
9.5,9.5
15.5,9.5
15.5,3.5
3.5,3.5 "/>
<polyline fill="none" stroke="#000000" stroke-width="3" stroke-linecap="square" stroke-miterlimit="5" points="
3.5,9.5
3.5,15.5
9.5,15.5
9.5,9.5
15.5,9.5
15.5,3.5
3.5,3.5 "/>
<polyline fill="none" stroke="#D7Df23" stroke-width="1" stroke-linecap="square" stroke-miterlimit="5" points="
3.5,9.5
3.5,15.5
9.5,15.5
9.5,9.5
15.5,9.5
15.5,3.5
3.5,3.5 "/>
</g>
</svg>

After

Width:  |  Height:  |  Size: 891 B

@ -0,0 +1,236 @@
#lang racket/base
(require racket/list racket/contract racket/rerequire racket/file racket/format xml racket/match racket/set racket/string racket/promise racket/path)
(require web-server/http/xexpr web-server/dispatchers/dispatch)
(require net/url)
(require web-server/http/request-structs)
(require web-server/http/response-structs)
(require 2htdp/image)
(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagetree.rkt" "cache.rkt")
(module+ test (require rackunit))
;;; Routes for the server module
;;; separated out for ease of testing
;;; because it's tedious to start the server just to check a route.
(provide route-dashboard route-xexpr route-default route-404 route-in route-out)
(define (body-wrapper content-xexpr)
`(html
(head
(meta ([charset "UTF-8"]))
(link ([rel "stylesheet"]
[type "text/css"]
[href ,(format "/~a" world:dashboard-css)])))
(body
,content-xexpr (div ((id "pollen-logo"))))))
;; to make dummy requests for debugging
(define/contract (string->request u)
(string? . -> . request?)
(make-request #"GET" (string->url u) empty
(delay empty) #f "1.2.3.4" 80 "4.3.2.1"))
;; print message to console about a request
(define/contract (logger req)
(request? . -> . void?)
(define client (request-client-ip req))
(define localhost-client "::1")
(define url-string (url->string (request-uri req)))
(message "request:" (string-replace url-string world:default-pagetree " dashboard")
(if (not (equal? client localhost-client)) (format "from ~a" client) "")))
;; pass string args to route, then
;; package route into right format for web server
;; todo: fix inbound contrfact to be proc with (path? . -> . xexpr?)
;; todo: fix outbound contract to be proc with (request? #:rest args . -> . response?)
(define/contract (route-wrapper route-proc)
(procedure? . -> . procedure?)
(λ(req . string-args)
(logger req)
(define path (apply build-path (world:current-project-root) (flatten string-args)))
(response/xexpr (route-proc path))))
;; extract main xexpr from a path
(define/contract (file->xexpr path #:render [wants-render #t])
((complete-path?) (#:render boolean?) . ->* . txexpr?)
(when wants-render (render-from-source-or-output-path path))
(dynamic-rerequire path) ; stores module mod date; reloads if it's changed
(dynamic-require path world:main-pollen-export))
;; todo: rewrite this test, obsolete since filename convention changed
;;(module+ test
;; (check-equal? (file->xexpr (build-path (current-directory) "tests/server-routes/foo.p") #:render #f) '(root "\n" "foo")))
;; read contents of file to string
;; just file->string with a render option
(define/contract (slurp path #:render [wants-render #t])
((complete-path?) (#:render boolean?) . ->* . string?)
(when wants-render (render-from-source-or-output-path path))
(file->string path))
;; add a wrapper to txexpr that displays it as monospaced text
;; for "view source"ish functions
;; takes either a string or an xexpr
(define/contract (format-as-code x)
(xexpr? . -> . txexpr?)
(body-wrapper `(tt ,x)))
(define (handle-image-path p)
(pathish? . -> . xexpr?)
(define path (->complete-path p))
(define img (bitmap/file path))
(define relative-path (->string (find-relative-path (world:current-project-root) path)))
(define img-url (format "/~a" relative-path))
`(div
(p "filename =" ,(->string relative-path))
(p "size = " ,(bytecount->string (file-size path)))
,@(when/splice (not (equal? (get-ext path) "svg"))
`(p "width = " ,(->string (image-width img)) " "
"height = " ,(->string (image-height img))))
(a ((href ,img-url)) (img ((style "width:100%;border:1px solid #eee")(src ,img-url))))))
(require file/unzip)
(define (handle-zip-path p)
(pathish? . -> . xexpr?)
(define path (->path p))
(define relative-path (->string (find-relative-path (world:current-project-root) path)))
(define ziplist (zip-directory-entries (read-zip-directory path)))
`(div
(p "filename =" ,(->string relative-path))
(p "size = " ,(bytecount->string (file-size path)))
(ul ,@(map (λ(i) `(li ,(~a i))) ziplist))))
(define/contract (make-binary-info-page p)
(pathish? . -> . xexpr?)
(define path (->complete-path p))
(cond
[((get-ext path) . in? . '("gif" "jpg" "jpeg" "png" "svg"))
(handle-image-path path)]
[((get-ext path) . in? . '("zip")) (handle-zip-path path)]
[else '(p "We got some other kind of binary file.")]))
;; server routes
;; these all produce an xexpr, which is handled upstream by response/xexpr
;; server routes that show result, formatted as code
;; route-in just gets file from disk; route-out renders it first
(define/contract (in path)
(complete-path? . -> . xexpr?)
(format-as-code (slurp path #:render #f)))
(define route-in (route-wrapper in))
(define/contract (out path)
(complete-path? . -> . xexpr?)
(cond
[(or (has-binary-ext? path) (sourceish? path)) (make-binary-info-page path)]
[else (format-as-code (slurp path #:render #t))]))
(define route-out (route-wrapper out))
;; dashboard route
(define (dashboard dashboard-ptree)
(define dashboard-dir (get-enclosing-dir dashboard-ptree))
(define (in-project-root?)
(directories-equal? dashboard-dir (world:current-project-root)))
(define parent-dir (and (not (in-project-root?)) (get-enclosing-dir dashboard-dir)))
(define empty-cell (cons #f #f))
(define (make-link-cell href+text)
(match-define (cons href text) href+text)
(filter-not void? `(td ,(when text
(if href
`(a ((href ,href)) ,text)
text)))))
(define (make-parent-row)
(define title (string-append "Project root" (if (equal? (world:current-project-root) dashboard-dir) (format " = ~a" dashboard-dir) "")))
(define dirs (cons title (if (not (equal? (world:current-project-root) dashboard-dir))
(explode-path (find-relative-path (world:current-project-root) dashboard-dir))
null)))
(define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps)))
(for/list ([i (length (cdr dirs))])
(take (cdr dirs) (add1 i))))))
`(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink world:default-pagetree))) ,(->string dir))) dirs dirlinks) "/"))))
(define (make-path-row filename-path)
(define filename (->string filename-path))
(define possible-source (->source-path (build-path dashboard-dir filename-path)))
(define source (and possible-source (->string possible-source)))
`(tr ,@(map make-link-cell
(append (list
(cond ; main cell
[(directory-exists? (build-path dashboard-dir filename)) ; links subdir to its dashboard
(cons (format "~a/~a" filename world:default-pagetree) (format "~a/" filename))]
[(and source (equal? (get-ext source) "scrbl"))
(cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,(path->string (find-relative-path dashboard-dir source)) ")")))]
[source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))]
[else (cons filename filename)])
(cond ; in cell
[source (cons (format "in/~a" source) "in")]
[(or (pagetree-source? filename) (sourceish? filename)) (cons (format "in/~a" filename) "in")]
[else empty-cell])
(cond ; out cell
[(directory-exists? (build-path dashboard-dir filename)) (cons #f #f)]
[(pagetree-source? filename) empty-cell]
[else (cons (format "out/~a" filename) "out")]))))))
(define (ineligible-path? x) (member x world:paths-excluded-from-dashboard))
(define project-paths
(filter-not ineligible-path? (map ->path (pagetree->list
(if (file-exists? dashboard-ptree)
(cached-require (->path dashboard-ptree) world:main-pollen-export)
(directory->pagetree dashboard-dir))))))
(body-wrapper
`(table
,@(cons (make-parent-row)
(if (not (null? project-paths))
(map make-path-row project-paths)
(list '(tr (td ((class "no-files")) "No files yet in this directory") (td) (td))))))))
(define route-dashboard (route-wrapper dashboard))
(define (get-query-value url key)
; query is parsed as list of pairs, key is symbol, value is string
; '((key . "value") ... )
(let ([result (memf (λ(x) (equal? (car x) key)) (url-query url))])
(and result (cdar result))))
(define/contract (req->path req)
(request? . -> . path?)
(reroot-path (url->path (request-uri req)) (world:current-project-root)))
;; default route
(define (route-default req)
(logger req)
(define force (equal? (get-query-value (request-uri req) 'force) "true"))
(render-from-source-or-output-path (req->path req) #:force force)
(next-dispatcher))
;; 404 route
(define/contract (route-404 req)
(request? . -> . response?)
(define error-text (format "route-404: Can't find ~a" (->string (req->path req))))
(message error-text)
(response/xexpr `(html ,error-text)))
;; server route that returns xexpr (before conversion to html)
(define/contract (xexpr path)
(complete-path? . -> . xexpr?)
(format-as-code (~v (file->xexpr path))))
(define route-xexpr (route-wrapper xexpr))

@ -1,139 +1,44 @@
#! /Applications/Racket/bin/racket #lang web-server/base
#lang web-server
(require web-server/servlet-env) (require racket/list racket/contract
(require web-server/dispatch web-server/dispatchers/dispatch) web-server/servlet-env
(require racket/rerequire) web-server/dispatch)
(require (planet mb/pollen/tools)) (require "server-routes.rkt"
(require (planet mb/pollen/world)) "debug.rkt"
(require (planet mb/pollen/regenerate)) "world.rkt"
(require (planet mb/pollen/template)) "file.rkt"
(require xml) "cache.rkt")
(require xml/path)
(provide start-server)
(displayln "Pollen server starting...")
(define (start-server)
(define pollen-file-root (current-directory))
(define-values (pollen-servlet _)
(define-values (start url) (dispatch-rules
(dispatch-rules [((string-arg) ... (? pagetree-source?)) route-dashboard]
[("start") route-index] [((string-arg) ... "in" (string-arg)) route-in]
[("source" (string-arg)) route-source] [((string-arg) ... "out" (string-arg)) route-out]
[("xexpr" (string-arg)) route-xexpr] [((string-arg) ... "xexpr" (string-arg)) route-xexpr]
[("raw" (string-arg)) route-raw-html] [else route-default]))
[("html" (string-arg)) route-html]
[else route-preproc])) (message (format "Welcome to Pollen ~a" world:pollen-version) (format "(Racket ~a)" (version)))
(message (format "Project root is ~a" (world:current-project-root)))
(define (get-query-value url key) (define server-name (format "http://localhost:~a" (world:current-server-port)))
; query is parsed as list of pairs, key is symbol, value is string (message (format "Project server is ~a" server-name) "(Ctrl-C to exit)")
; '((key . "value") ... ) (message (format "Project dashboard is ~a/~a" server-name world:default-pagetree))
(let ([result (memf (ƒ(x) (=str (car x) key)) (url-query url))])
(if result (message "Ready to rock")
(cdar result) ; second value of first result
result))) (define module-root (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
(world:current-server-extras-path (build-path module-root world:server-extras-dir))
; default route w/preproc support
(define (route-preproc req) (parameterize ([error-print-width 1000]
; because it's the "else" route, can't use string-arg matcher [current-cache (make-cache)])
; so extract the path manually (serve/servlet pollen-servlet
(define path #:port (world:current-server-port)
(reroot-path (url->path (request-uri req)) pollen-file-root)) #:listen-ip #f
(define force-value (get-query-value (request-uri req) 'force)) #:servlet-regexp #rx"" ; respond to top level
(regenerate path #:force force-value) #:command-line? #t
; serve path #:file-not-found-responder route-404
(next-dispatcher)) #:extra-files-paths (list (world:current-server-extras-path) (world:current-project-root)))))
(define (slurp filename #:regenerate? [regenerate? #t])
(define path (build-path pollen-file-root filename))
(when regenerate?
(regenerate path))
(file->string path))
(define (file->xexpr filename)
(define path (build-path pollen-file-root filename))
(regenerate path)
(dynamic-rerequire path)
(define-from path body)
body)
(define (format-as-code data)
`(div ((style "white-space:pre-wrap;font-family:AlixFB,monospaced")) ,data))
(define (route-source req filename)
(response/xexpr (format-as-code (slurp filename #:regenerate? #f))))
(define (route-xexpr req filename)
(response/xexpr (format-as-code (~v (file->xexpr filename)))))
(define (route-raw-html req filename)
(response/xexpr (format-as-code (slurp filename))))
(define (route-html req filename)
(response/xexpr (file->xexpr filename)))
(define (route-index req)
; set up filter functions by mapping a function-maker for each file type
(define-values (pollen-file? preproc-file? pmap-file?)
(apply values (map (ƒ(ext)(ƒ(f)(has-ext? f ext))) (list POLLEN_SOURCE_EXT POLLEN_PREPROC_EXT POLLEN_MAP_EXT))))
(define (template-file? x)
(define-values (dir name ignore) (split-path x))
(=str (get (as-string name) 0) TEMPLATE_FILE_PREFIX))
; get lists of files by mapping a filter function for each file type
(define-values (pollen-files preproc-files pmap-files template-files)
(apply values (map (ƒ(test) (filter test (directory-list pollen-file-root))) (list pollen-file? preproc-file? pmap-file? template-file?))))
; the actual post-p files may not have been generated yet
(define post-preproc-files (map (ƒ(path) (remove-ext path)) preproc-files))
; make a combined list of p-files and post-p files
(define all-preproc-files (sort (append preproc-files post-preproc-files) #:key path->string string<?))
(define post-pollen-files (map (ƒ(path) (add-ext (remove-ext path) 'html)) pollen-files))
(define all-pollen-files (sort (append pollen-files post-pollen-files) #:key path->string string<?))
(define (make-file-row file routes)
(define (make-link-cell type)
(letrec ([source (add-ext (remove-ext file) POLLEN_SOURCE_EXT)]
[preproc-source (add-ext file POLLEN_PREPROC_EXT)]
[file-string (path->string file)]
[name (case type
['direct (str file-string)]
['preproc-source "source"]
[else (str type)])]
[target (case type
['direct name]
[(source xexpr) (format "/~a/~a" type source)]
['preproc-source (format "/~a/~a" 'raw preproc-source)]
['force (format "/~a?force=true" file-string)]
[else (format "/~a/~a" type file-string)])])
`(td (a ((href ,target)) ,name))))
`(tr ,(make-link-cell 'direct) ,@(map make-link-cell routes)))
(if (all empty? (list pmap-files all-pollen-files all-preproc-files template-files))
(response/xexpr '(body "No files yet. Get to work!"))
(response/xexpr
`(body
(style ((type "text/css")) "td a { display: block; width: 100%; height: 100%; padding: 8px; }"
"td:hover {background: #eee}")
(table ((style "font-family:Concourse T3;font-size:115%"))
; options for pmap files and template files
,@(map (ƒ(file) (make-file-row file '(raw))) (append pmap-files template-files))
; options for pollen files
,@(map (ƒ(file) (make-file-row file '(raw source xexpr force))) post-pollen-files)
; options for preproc files
; branching in ƒ is needed so these files can be interleaved on the list
,@(map (ƒ(file) (make-file-row file '(raw preproc-source))) post-preproc-files))))))
(displayln "Ready to rock")
(serve/servlet start
#:port 8080
#:listen-ip #f
#:servlet-regexp #rx"" ; respond to top level
#:command-line? #t
#:extra-files-paths (list (build-path (current-directory)))
; #:server-root-path (current-directory)
)

@ -1,23 +0,0 @@
#lang racket
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Macro that generates all the little xexpr functions
;; For each tag.
;;
(require (for-syntax racket/syntax))
(define-syntax (define-tags stx)
(syntax-case stx ()
[(_ name '(tags ...)) ; match pattern of the calling form
#`(begin ; start with quasiquoted begin block & splice into it
(define name '(tags ...)) ; assign the provided name to the tags as a group
#,@(for/list ([tag (syntax->list #'(tags ...))]) ; step through list of tags
(with-syntax ((tag-as-id (format-id stx "~a" tag))) ; convert tag into identifier
; todo: edit this to use tools:tagger
#`(define (tag-as-id . x) `(tag-as-id ,@x)))))])) ; write out the xexpr function
(provide (all-defined-out))

@ -0,0 +1,31 @@
#lang racket/base
(provide make-tag-function)
(define (make-tag-function . ids)
(define (make-one-tag id)
(λ x
(define reversed-pieces ; list of attribute pairs, and last element holds a list of everything else, then reversed
(reverse (let chomp ([x x])
(define result+regexp (and ((length x) . >= . 2)
(symbol? (car x))
;; accept strings only
;; numbers are difficult because they don't parse as cleanly.
;; string will read as a string even if there's no space to the left.
(or (string? (cadr x)))
;; Looking for symbol ending with a colon
(regexp-match #rx"^(.*?):$" (symbol->string (car x)))))
(if result+regexp
; reuse result value. cadr is first group in match.
(cons (list (string->symbol (cadr result+regexp))(cadr x)) (chomp (cddr x)))
(list x)))))
(define-values (body attrs) (if (equal? null reversed-pieces)
(values null null)
(values (car reversed-pieces) (cdr reversed-pieces))))
`(,id ,@(if (equal? attrs null) null (list (reverse attrs))) ,@body)))
(apply compose1 (map make-one-tag ids)))

@ -1,109 +1,88 @@
#lang racket/base #lang racket/base
(require (planet mb/pollen/tools) (planet mb/pollen/world)) (require (for-syntax racket/base))
(require xml xml/path racket/list racket/string) (require racket/string xml xml/path sugar/define sugar/container sugar/coerce/contract)
(require web-server/templates) (require "file.rkt" txexpr "world.rkt" "cache.rkt" "pagetree.rkt" "debug.rkt")
; get the values out of the file, or make them up
(define map-file (build-path START_DIR DEFAULT_MAP))
(define map-main empty)
(if (file-exists? map-file)
; load it, or ...
(set! map-main (dynamic-require map-file POLLEN_ROOT))
; ... synthesize it
(let ([files (directory-list START_DIR)])
(set! files (map remove-ext (filter (ƒ(x) (has-ext? x POLLEN_SOURCE_EXT)) files)))
(set! map-main `(map-main ,@(map path->string files)))))
(require sugar/coerce/value)
(provide (all-from-out sugar/coerce/value))
(define (add-parents x [parent null] [previous null]) (define/contract+provide (metas->here metas)
; disallow main as parent tag (hash? . -> . pagenode?)
(when (equal? parent 'map-main) (set! parent empty)) (path->pagenode (select-from-metas 'here-path metas)))
(cond
[(list? x)
(let ([new-parent (car x)])
; xexpr with topic as name, parent as attr, children as elements
`(,@(add-parents new-parent parent) ,@(map (ƒ(i) (add-parents i new-parent)) (cdr x))))]
[else `(,(as-symbol x) ((parent ,(as-string parent))))]))
(define (remove-parents x)
(cond
[(list? x) `(,(car x) ,@(map remove-parents (cddr x)))]
[else x]))
(define (main->tree main) (define (pagenode->path pagenode)
(add-parents main)) (build-path (world:current-project-root) (symbol->string pagenode)))
(define tree (main->tree map-main))
(define (get-parent x [xexpr tree]) (define+provide/contract (select key value-source)
(empty/else x (ƒ(x) (coerce/symbol? (or/c hash? txexpr? pagenode? pathish?) . -> . (or/c #f txexpr-element?))
(let ([result (se-path* `(,(as-symbol x) #:parent) xexpr)]) (define metas-result (and (not (txexpr? value-source)) (select-from-metas key value-source)))
(if (not result) ; se-path* returns #f if nothing found (or metas-result
empty ; but don't pass #f up through the chain. (let ([doc-result (select-from-doc key value-source)])
(as-string result)))))) (and doc-result (car doc-result)))))
; algorithm to find children
(define (get-children x [xexpr tree])
(empty/else x (ƒ(x)
; find contents of node.
(let ([node-contents (se-path*/list `(,(as-symbol x)) xexpr)])
; If there are sublists, just take first element
(map (ƒ(i) (as-string (if (list? i) (car i) i))) node-contents)))))
; find all siblings on current level: go up to parent and ask for children (define+provide/contract (select* key value-source)
(define (get-all-siblings x [xexpr tree]) (coerce/symbol? (or/c hash? txexpr?) . -> . (or/c #f (listof txexpr-element?)))
(get-children (get-parent x xexpr) xexpr)) (define metas-result (and (not (txexpr? value-source)) (select-from-metas key value-source)))
(define doc-result (select-from-doc key value-source))
(define result (append (or (and metas-result (list metas-result)) null) (or doc-result null)))
(and (not (null? result)) result))
(define (get-adjacent-siblings x [xexpr tree])
(define-values (left right)
(splitf-at (get-all-siblings x xexpr) (ƒ(y) (not (equal? (as-string x) (as-string y))))))
; use cdr because right piece includes x itself at front
(values left (empty/else right cdr)))
(define (get-left-siblings x [xexpr tree]) (define+provide/contract (select-from-metas key metas-source)
(define-values (left right) (get-adjacent-siblings x xexpr)) (coerce/symbol? (or/c hash? pagenode? pathish?) . -> . (or/c #f txexpr-element?))
left) (define metas (cond
[(hash? metas-source) metas-source]
[else (get-metas metas-source)]))
(and (hash-has-key? metas key) (hash-ref metas key)))
(define (get-right-siblings x [xexpr tree])
(define-values (left right) (get-adjacent-siblings x xexpr))
right)
(define (get-left x [xexpr tree]) (define+provide/contract (select-from-doc key doc-source)
(empty/else (get-left-siblings x xexpr) last)) (coerce/symbol? (or/c txexpr? pagenode? pathish?) . -> . (or/c #f (listof txexpr-element?)))
(define doc (cond
[(txexpr? doc-source) doc-source]
[else (get-doc doc-source)]))
(define result (se-path*/list (list key) doc))
(and (not (null? result)) result))
(define (get-right x [xexpr tree])
(empty/else (get-right-siblings x xexpr) first))
(define (get-metas pagenode-or-path)
; ((or/c pagenode? pathish?) . -> . hash?)
(define source-path (->source-path (cond
[(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)]
[else pagenode-or-path])))
(if source-path
(cached-require source-path world:meta-pollen-export)
(error (format "get-metas: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))
(define (make-page-sequence [xexpr tree])
; use cdr to get rid of body tag at front
; todo: calculate exclusions?
(map as-string (cdr (flatten (remove-parents xexpr)))))
(define (get-adjacent-pages x [xexpr tree]) (define (get-doc pagenode-or-path)
(define-values (left right) ; ((or/c pagenode? pathish?) . -> . (or/c txexpr? string?))
(splitf-at (make-page-sequence xexpr) (ƒ(y) (not (=str (as-string x) (as-string y)))))) (define source-path (->source-path (cond
; use cdr because right piece includes x itself at front [(pagenode? pagenode-or-path) (pagenode->path pagenode-or-path)]
(values left (empty/else right cdr))) [else pagenode-or-path])))
(if source-path
(cached-require source-path world:main-pollen-export)
(error (format "get-doc: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))
(define (get-previous-pages x [xexpr tree])
(define-values (left right) (get-adjacent-pages x xexpr))
left)
(define (get-next-pages x [xexpr tree])
(define-values (left right) (get-adjacent-pages x xexpr))
right)
(define (get-previous x [xexpr tree])
(empty/else (get-previous-pages x xexpr) last))
(define (get-next x [xexpr tree]) (define+provide/contract (->html x)
(empty/else (get-next-pages x xexpr) first)) (xexpr? . -> . string?)
(xexpr->html x))
(provide when/block)
(define-syntax (when/block stx)
(syntax-case stx ()
[(_ condition body ...)
#'(if condition (string-append*
(with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
(map ->string (list body ...))))
"")]))
(provide (all-defined-out) (all-from-out web-server/templates))

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

@ -0,0 +1,7 @@
#lang racket/base
(require pollen/main-base)
(define+provide-module-begin-in-mode world:mode-template)
(module reader racket/base
(require pollen/reader-base)
(define+provide-reader-in-mode world:mode-template))

@ -1,598 +0,0 @@
#lang racket/base
(require racket/list)
(require xml)
(require (only-in racket/function thunk))
(require racket/string)
(require racket/file)
(require xml/path)
(require (only-in racket/format ~a ~s ~v))
(require (prefix-in scribble: (only-in scribble/decode whitespace?)))
(require (only-in racket/path filename-extension))
(require (only-in (planet mb/pollen/library/html) inline-tags))
(require (planet mb/pollen/world))
(require (planet mb/pollen/readability))
;(require (planet mb/pollen/hyphenate))
(define nbsp " ") ; use this for readability in code
(define lozenge "") ; use this instead of escape syntax
(provide (all-defined-out)
describe whitespace? xexpr->string xexpr? filter-not flatten
(all-from-out (planet mb/pollen/readability)))
(define (hash-ref-or hash key [default #f])
(if (in? hash key)
(get hash key)
default))
(define (make-meta-hash x)
(define keys (se-path*/list '(meta #:name) x))
(define values (se-path*/list '(meta #:content) x))
(define meta-hash (make-hash))
;todo: convert this to for/list because map does not guarantee ordering
; probably want to keep it in sequence
(map (ƒ(key value) (change meta-hash (as-symbol key) (as-string value))) keys values)
meta-hash)
(define (magic-directory? path)
(and (directory-exists? path)
(or (ends-with? (path->string path) "requires")
(ends-with? (path->string path) "compiled")
)))
(define (filename-of path)
(let-values ([(dir filename ignored) (split-path path)])
filename))
(define (pollen-script? path)
(let ([path-string (path->string (filename-of path))])
(or (starts-with? path-string "pollen_") (starts-with? path-string "pollen-"))))
(define (racket-file? path)
(has-ext? path 'rkt))
(define (pmap-source? path)
(has-ext? path POLLEN_MAP_EXT))
(define (template-source? path)
(starts-with? (path->string (filename-of path)) (~a TEMPLATE_FILE_PREFIX)))
(define (preproc-source? path)
(has-ext? path POLLEN_PREPROC_EXT))
(define (make-preproc-in-path path)
(add-ext path POLLEN_PREPROC_EXT))
(define (make-preproc-out-path path)
(remove-ext path))
(define (has-preproc-source? path)
(file-exists? (make-preproc-in-path path)))
(define (pollen-source? path)
(has-ext? path POLLEN_SOURCE_EXT))
(define (make-pollen-source-path thing)
(add-ext (remove-ext (as-path thing)) POLLEN_SOURCE_EXT))
(define (has-pollen-source? path)
(file-exists? (make-pollen-source-path path)))
(define (insert-subdir path [subdir-in OUTPUT_SUBDIR])
(let-values ([(dir filename ignored) (split-path path)])
(when (equal? dir 'relative)
(set! dir (string->path ".")))
(letrec ([subdir-name (string->path (~a subdir-in))]
[subdir (build-path dir subdir-name)])
(when (not (directory-exists? subdir))
(make-directory subdir))
(build-path subdir filename))))
;;;;;;;;;;;;;;
; Moved from template.rkt
;;;;;;;;;;;;;;
; All from* functions should return a named-xexpr
(define (from x query)
; cache x
(let ([x (put x)])
; try finding it in metas, if not, find it in main, if not then return false
(or (from-metas x query) (from-main x query))))
(define (from-main x query) ; this used to be plain from
; check results first
(let* ([x (put x)]
[results (se-path*/list (list query) x)])
; if results exist, send back xexpr as output
(if (not (empty? results))
`(,query ,@results) ; todo: why use query as tag?
#f)))
(define (from-metas x key)
(let* ([x (put x)]
[meta-hash (make-meta-hash x)]
[key (as-symbol key)])
(if (in? meta-hash key)
`(value ,(get meta-hash key)) ;todo: why use value as tag?
#f)))
(define (put x)
; handles either xexpr or pollen file as input
(cond
; pass through xexpr as is
; put is optional for xexprs.
; it's only here to make the idiom smooth.
[(named-xexpr? x) x]
; todo: how to externalize pollen main tag into world name?
[(file-exists? (as-path x)) (dynamic-require x 'main)]
; also try adding pollen file extension
; this makes put compatible with map references
[(let ([x (make-pollen-source-path x)])
(when (file-exists? x)
(put x)))]
[else (error "put: need named xexpr or pollen file, but got" x)]))
(define (merge x)
(cond
[(named-xexpr? x)
; return content of xexpr.
; pollen language rules will splice these into the main flow.
(if (empty? x)
""
(let-values([(name attr content) (xexplode x)])
content))]
[(string? x) (list x)]))
#|(define (merge-strings x)
(when (empty? x) (error "merge-strings got empty x"))
;todo: filter metas?
; leaning toward no. Simplest behavior.
; function is not intended to be used with whole pollen body anyhow.
(let ([x (merge x)])
(string-join (filter string? (flatten x)) " ")))|#
(define (merge-strings x)
(string-join (filter string? (flatten x)) " "))
(define (make-html x)
(if (named-xexpr? x)
(xexpr->string x)
(let ([x (as-list x)])
(when (all xexpr? x)
(string-join (map xexpr->string x) "")))))
; generate *-as-html versions of functions
(define-values (put-as-html merge-as-html merge-strings-as-html)
(apply values (map (ƒ(proc) (ƒ(x) (make-html (proc x)))) (list put merge merge-strings))))
(define (as-literal x)
(set! x (flatten (list x))) ; coerce text or list to new list
(merge `(literal-thing ,@x)))
(define (make-url x)
(if (exists? x)
(str x ".html")
"#")) ; funny null url that means "stay here"
;;;;;;;;;;;;;;;;;;;;;;;;;
; make these independent of local includes
(define (map-topic topic . subtopics)
`(,(string->symbol topic) ,@(filter-not whitespace? subtopics)))
(define (meta key value)
`(meta ((name ,(as-string key))(content ,(as-string value)))))
; scribble's whitespace function misses trailing spaces wrapped in a list
(define (whitespace? x)
(cond
[(list? x) (all scribble:whitespace? x)]
[else (scribble:whitespace? x)]))
; remove empty elements
(define (remove-empty x)
(cond
[(list? x) (map remove-empty (filter-not empty? x))]
[else x]))
(define (remove-void x)
(cond
[(list? x) (map remove-void (filter-not void? x))]
[else x]))
; common idiom with lists:
; if list is empty, return empty
; otherwise do procedure
(define (empty/else thing proc)
(if (empty? thing)
empty
(proc thing)))
; common idiom with files:
; if the file exists, do procedure with it
(define (file-exists?/do path proc)
(if (file-exists? path)
(proc path)
#f))
; simple timer
(define-syntax-rule (time expr)
(begin
(define start-time (current-inexact-milliseconds))
(define result expr)
(define stop-time (current-inexact-milliseconds))
(message "Time for" 'expr "=" (- stop-time start-time))
result))
; utilities for working with file extensions
(define (.+ x) (format ".~a" x))
(define (get-ext path)
(bytes->string/utf-8 (filename-extension path)))
(define (has-ext? path ext)
(let ([path-ext (filename-extension path)])
; returns true if f-ext exists, and equals ext, otherwise false
(and path-ext (equal? (bytes->string/utf-8 path-ext) (~a ext)))))
(define (remove-ext path)
(path-replace-suffix path ""))
(define (add-ext path ext)
(string->path (string-append (path->string path) (.+ ext))))
; find all xexpr names within another xexpr
(define (gather-xexpr-names x)
(cond
[(named-xexpr? x)
(let-values([(name attr content) (xexplode x)])
(flatten (cons name (map gather-xexpr-names content))))]
[else empty]))
; shorthand for define + dynamic require
(define-syntax-rule (define-from module symbol)
(define symbol (dynamic-require module 'symbol)))
; dynamic require or return false if not found
; allows constructs like:
; (or (require-now module symbol) "default value")
(define (require-now module symbol)
(dynamic-require module symbol (thunk #f)))
; define & provide in one easy step
(define-syntax-rule (define/provide name expr ...)
(begin (define name expr ...)(provide name)))
; xexpr->html
(define (xexpr->html x)
; (string-join (map xexpr->string x)))
(xexpr->string x))
(define (html->xexpr . stuff)
(string->xexpr (string-join stuff "")))
; do a set of actions on same item
(define ((tee . procs) thing)
(apply values (map (ƒ(proc)(proc thing)) procs)))
; python-style try/except syntax
(define-syntax-rule (try body (except tests ...))
(with-handlers (tests ...) body))
; xexpr shortcut; map tag across items
(define (map-tag tag-name xs)
(map (ƒ(x) (list tag-name x)) xs))
; trim from beginning & end of list
(define (trim things test)
(dropf-right (dropf things test) test))
; trim whitespace from beginning & end of list
(define (trim-whitespace things)
(trim things whitespace?))
; ----------------------------
; DECODER
; ----------------------------
(define (splice-xexpr-content x [acc '()])
; takes a list and splices top-level sublists into main list
; used by merge function
(cond
[(empty? x) acc]
[(and (xexpr-content? (car x)) (not (named-xexpr? (car x)))) (splice-xexpr-content (cdr x) `(,@acc ,@(car x)))]
[else (splice-xexpr-content (cdr x) `(,@acc ,(car x)))]))
(define (named-xexpr? x)
; meets basic xexpr contract, and is also a list starting with a symbol
; todo: rewrite this using match?
; todo: rewrite this recurively so errors can be pinpointed (for debugging)
(and (xexpr? x) (list? x) (symbol? (car x))))
(define (xexpr-attr-list? x)
(define (attr-pair? x)
; list with two elements: first element is a symbol, second is a string
(and (list? x) (= (length x) 2) (symbol? (car x)) (string? (second x))))
; a list where elements are attr pairs
(and (list? x) (all attr-pair? x)))
(define (xexpr-content? x)
; it's a list whose elements meet xexpr contract
(and (list? x) (all xexpr? x)))
(define (xexpr-has-attrs? x)
(and (named-xexpr? x) (> (length x) 1) (xexpr-attr-list? (second x))))
(define (make-xexpr name (attr empty) (content empty))
(when (not (symbol? name)) (error "make-xexpr: need a name, dude"))
(when (not (xexpr-attr-list? attr))
(error "make-xexpr: attr must be list of attr pairs"))
; todo: fix xexpr-content? test so I can use it here
; (when (not (xexpr-content? content)) content)
(when (not (list? content)) (error "make-xexpr: content must be a list"))
(define xexpr `(,name))
(when (exists? attr) (set! xexpr `(,@xexpr ,attr)))
(when (exists? content) (set! xexpr `(,@xexpr ,@content)))
xexpr)
(define (xexplode x)
(when (not (named-xexpr? x)) (error (format "xexplode: ~v not a named-xexpr" x)))
(define-values (name attr content) (values (car x) empty empty))
(if (xexpr-has-attrs? x)
(set!-values (attr content) (values (second x) (cddr x))) ; attr comes back as a list of lists
(set! content (cdr x))) ; content always comes back as a list
(values name attr content))
; block is a named expression that's not on the inline list
; todo: bear in mind that browsers take the opposite view:
; that only elements on the block list are blocks
; and otherwise are treated as inline
(define (block-xexpr? x)
(and (named-xexpr? x) (not (in? inline-tags (car x)))))
(define (wrap-paragraph x) ; x is a list containing paragraph pieces
; if paragraph is just one block-level xexpr
(if (and (= (length x) 1) (block-xexpr? (car x)))
(car x) ; leave it
`(p ,@x))) ; otherwise wrap in p tag
; wrap initial quotes for hanging punctuation
; todo: improve this
; does not handle <p>“<em>thing</em> properly
(define (wrap-hanging-quotes x) ; x is one paragraph
(define-values (name attr content) (xexplode x))
(cond
[(and (not (empty? content))
(string? (car content))
(> (string-length (car content)) 1))
(let ([new-car
(letrec ([x (car content)]
[first (get x 0)]
[rest (get x 1 'end)])
(cond
[(member first '("\"" ""))
; this has to be span so that it's explicitly
; an inline element. If not,
; things like linebreak detection won't work.
`(span ((class "dquo")) ,(~a #\“) ,rest)]
[(member first '("\'" ""))
`(span ((class "squo")) ,(~a #\) ,rest)]
[else x]))])
(make-xexpr name attr (cons new-car (cdr content))))]
[(and (exists? content) (named-xexpr? (car content)))
(make-xexpr name attr (cons (wrap-hanging-quotes (car content)) (cdr content)))]
[else x]))
; how a list-item break is denoted: three or more newlines
(define (list-item-break? x)
(and (string? x) (regexp-match #rx"^\n\n\n+$" x)))
; how a paragraph break is denoted: two or more newlines
(define (paragraph-break? x)
; (equal? x PARAGRAPH_BREAK) ; obsolete: two newlines only
(and (string? x) (regexp-match #rx"^\n\n+$" x)))
; convert single newline to br tag
; only if neither adjacent tag is a block
; otherwise delete
(define (convert-linebreaks x) ; x is list
(remove-empty
(for/list ([i (len x)])
(cond
[(equal? (get x i) LINE_BREAK)
(if (none block-xexpr? (list (get x (sub1 i)) (get x (add1 i))))
'(br)
'())]
[else (get x i)]))))
; find two or more adjacent newlines and bring them together
; works on any number of newlines
(define (merge-newlines x)
(define (newline? x)
(and (string? x) (equal? "\n" x)))
(define (not-newline? x)
(not (newline? x)))
(define (merge-newlines-inner x [acc '()]) ; x is list
(if (empty? x)
acc
(let-values ([(leading-newlines remainder) (splitf-at x newline?)])
(if (not (empty? leading-newlines))
(merge-newlines-inner remainder `(,@acc ,(string-join leading-newlines "")))
(merge-newlines-inner (dropf remainder not-newline?) `(,@acc ,@(takef remainder not-newline?)))))))
(cond
((list? x) (merge-newlines-inner (map merge-newlines x)))
(else x)))
(define (typogrify string)
; make set of functions for replacers
(define (make-replacers query+subs)
(map (ƒ(q+s) (ƒ(str) (regexp-replace* (first q+s) str (second q+s)))) query+subs))
; just store the query strings + replacement strings
(define dashes
; fix em dashes first, else they'll be mistaken for en dashes
; [\\s ] is whitespace + nonbreaking space
'((#px"[\\s ]*(---|—)[\\s ]*" "") ; em dash
(#px"[\\s ]*(--|)[\\s ]*" ""))) ; en dash
(define smart-quotes
'((#px"(?<=\\w)'(?=\\w)" "") ; apostrophe
(#px"(?<!\\w)'(?=\\w)" "") ; single_at_beginning
(#px"(?<=\\S)'(?!\\w)" "") ; single_at_end
(#px"(?<!\\w)\"(?=\\w)" "") ; double_at_beginning
(#px"(?<=\\S)\"(?!\\w)" ""))) ; double_at_end
; todo: is this transformation obsolete due to css ligatures?
; maybe not, because soft hyphens mess up css ligature function.
; \u00AD is a soft hyphen, which might appear in between letters
(define ligatures
'((#px"f\u00AD?i" "")
(#px"f\u00AD?f" "")
(#px"f\u00AD?l" "")
(#px"f\u00AD?f\u00AD?i" "")
(#px"f\u00AD?f\u00AD?l" "")))
; put replacers in desired order here
(define replacers (make-replacers (append dashes smart-quotes)))
; compose goes from last to first, so reverse order
; ((apply compose1 hyphenate-text-soft (reverse replacers)) string))
((apply compose1 (reverse replacers)) string))
; find the last word space and replace it with a nonbreaking space
; doesn't work on weirdo cases that need backtracking, like:
; (define t4 '(p "hello from all the freaks" "at the " (em "factory.")))
; but cures enough problems to be worthwhile.
(define (nonbreaking-last-space x)
(define nbsp #\ ) ; use an Ø if you want to make the results visible
(define minimum-word-length (add1 5)) ; add1 to account for final punctuation
; todo: parameterize this, as it will be different for each project
(define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs
(define (replace-last-space str)
(if (in? str #\space)
(let ([reversed-str-list (reverse (string->list str))])
(define-values (last-word-chars other-chars)
(splitf-at reversed-str-list (λ(i) (not (eq? i #\space)))))
(list->string (reverse (append last-word-chars
; OK for long words to be on their own line.
(if (< (len last-word-chars) minimum-word-length)
; first char of other-chars will be the space, so use cdr
(cons nbsp (cdr other-chars))
other-chars)))))
str))
(define (find-last-word-space x) ; recursively traverse xexpr
(cond
[(string? x) (replace-last-space x)]
[(named-xexpr? x)
(let-values([(name attr content) (xexplode x)])
(if (> (length content) 0) ; content is list of xexprs
(let-values ([(all-but-last last) (split-at content (sub1 (length content)))])
(make-xexpr name attr `(,@all-but-last ,(find-last-word-space (car last)))))
x))]
[else x]))
(if (in? tags-to-pay-attention-to (car x))
(find-last-word-space x)
x))
(define (prep-paragraph-flow x)
(convert-linebreaks (merge-newlines (trim-whitespace x))))
(define (map-xexpr-content proc x #:only [only-proc (ƒ(x) x)])
; why map and not apply? Because map guarantees a list of the same length.
; whereas apply does not. So it works as an implied constraint.
(if (named-xexpr? x)
(let-values([(name attr content) (xexplode x)])
(make-xexpr name attr (map (ƒ(x) (if (only-proc x) (proc x) x)) content)))
(error "map-xexpr-content: Input is not a named xexpr and has no content:" x)))
; Main decode function
(define (decode x)
(define (&decode x)
(cond
[(named-xexpr? x)
(let-values([(name attr content) (xexplode x)])
(define decoded-x (make-xexpr name attr (&decode content)))
(if (block-xexpr? decoded-x)
; add nonbreaking-last-space to the next line when ready
(wrap-hanging-quotes (nonbreaking-last-space decoded-x)) ; do special processing for block xexprs
decoded-x))]
[(xexpr-content? x) ; a list of xexprs
(let ([x (prep-paragraph-flow x)])
(map &decode (if (any paragraph-break? x) ; need this condition to prevent infinite recursion
(map wrap-paragraph (splitf-at* x paragraph-break?)) ; split into ¶¶
x)))]
[(string? x) (typogrify x)]
[else x]))
(define (stringify x) ; convert numbers to strings
(cond
[(list? x) (map stringify x)]
[(number? x) (~a x)]
[else x]))
(let* ([x (stringify x)]
[x (trim-whitespace x)])
(if (named-xexpr? x)
(&decode x)
;todo: improve this error message, more specific location
; now, it just spits out the whole defective content
(error (format "decode: ~v not a full named-xexpr" x)))))
(define (splitf-at* pieces test)
; split list into list of sublists using test
(define (splitf-at*-inner pieces [acc '()]) ; use acc for tail recursion
(if (empty? pieces)
acc
(let-values ([(item rest)
(splitf-at (dropf pieces test) (compose1 not test))])
(splitf-at*-inner rest `(,@acc ,item)))))
(splitf-at*-inner (trim pieces test)))
(define (make-missing-source-files map-xexpr)
; use cdr to omit body tag
(define source-names (map (ƒ(x) (add-ext (string->path (as-string x)) POLLEN_SOURCE_EXT)) (flatten (cdr map-xexpr))))
(define (make-source-if-missing x)
(if (not (file-exists? x))
(begin
(display-to-file MISSING_FILE_BOILERPLATE x)
(format "Created file: ~a" x))
(format "Already exists: ~a" x)))
(display (string-join (map make-source-if-missing source-names) "\n")))

@ -0,0 +1,26 @@
#lang racket/base
;; Changes the default behavior of #%top.
;; Unbound identifiers are allowed, and treated as the
;; tag in a txexpr (with the rest of the expression treated as the body)
;; To suppress this behavior, use def/c to wrap any name.
;; If that name isn't already defined, you'll get the usual syntax error.
(require (for-syntax racket/base) pollen/tag)
(provide (except-out (all-defined-out) top~)
(rename-out (top~ #%top)))
;; Allow tag attributes to be specified as follows:
;; @foo['shape: "square" 'color: "red"]{hello}
(define-syntax (top~ stx)
(syntax-case stx ()
[(_ . id) #'(make-tag-function 'id)]))
(define-syntax (def/c stx)
(syntax-case stx ()
[(_ x)
(if (identifier-binding #'x )
#'x
#'(#%top . x))]))

@ -1,7 +0,0 @@
#lang racket
(define places '(home-dir pref-dir pref-file temp-dir init-dir init-file links-file addon-dir doc-dir desk-dir sys-dir exec-file run-file collects-dir orig-dir))
(displayln (string-join (map (λ(x) (format "~a: ~a" x (find-system-path x))) places) "\n") )
(displayln (format "current-directory: ~a" (current-directory)))

@ -1,44 +1,58 @@
#lang racket #lang racket/base
(define POLLEN_PREPROC_EXT 'pp) (provide (prefix-out world: (all-defined-out)))
(define POLLEN_SOURCE_EXT 'p)
(define POLLEN_MAP_EXT 'pmap)
(define TEMPLATE_FILE_PREFIX #\-)
(define POLLEN_EXPRESSION_DELIMITER #\◊)
(define TEMPLATE_FIELD_DELIMITER POLLEN_EXPRESSION_DELIMITER)
(define DEFAULT_TEMPLATE "-main.html") (define pollen-version "0.001")
(define TEMPLATE_META_KEY 'template)
(define DEFAULT_MAP "main.pmap") (define preproc-source-ext 'pp)
(define markup-source-ext 'pm)
(define markdown-source-ext 'pmd)
(define null-source-ext 'p)
(define pagetree-source-ext 'ptree)
(define template-source-ext 'pt)
(define scribble-source-ext 'scrbl)
(define MAIN_POLLEN_EXPORT 'body) (define mode-auto 'auto)
;(define META_POLLEN_TAG 'metas) (define mode-preproc 'pre)
;(define META_POLLEN_EXPORT 'metas) (define mode-markup 'markup)
(define mode-markdown 'markdown)
(define mode-pagetree 'ptree)
(define mode-template 'template)
(define EXTRAS_DIR (string->path "requires")) (define decodable-extensions (list markup-source-ext pagetree-source-ext))
(define MISSING_FILE_BOILERPLATE "#lang planet mb/pollen\n\n") (define default-pagetree "index.ptree")
(define pagetree-root-node 'pagetree-root)
(define LINE_BREAK "\n") (define command-marker #\◊)
(define PARAGRAPH_BREAK "\n\n") (define template-command-marker #\∂)
(define OUTPUT_SUBDIR 'public) (define default-template-prefix "template")
(define fallback-template "fallback.html")
(define template-meta-key "template")
(define RACKET_PATH "/Users/MB/git/racket/racket/bin/racket") (define main-pollen-export 'doc) ; don't forget to change fallback template too
(define meta-pollen-export 'metas)
(define POLLEN_ROOT 'main) (define project-require "project-require.rkt")
; todo: this doesn't work as hoped (define newline "\n")
;(define-syntax POLLEN_ROOT_TAG (define linebreak-separator newline)
; (λ(stx) (datum->syntax stx 'main))) (define paragraph-separator "\n\n")
; get the starting directory, which is the parent of 'run-file (define paths-excluded-from-dashboard
(define START_DIR (map string->path (list "poldash.css" "compiled")))
(let-values ([(dir ignored also-ignored)
(split-path (find-system-path 'run-file))])
(if (equal? dir 'relative)
(string->path ".")
dir)))
(provide (all-defined-out))
(define current-project-root (make-parameter (current-directory)))
(define current-server-port (make-parameter 8080))
(define dashboard-css "poldash.css")
(define server-extras-dir "server-extras")
(define current-server-extras-path (make-parameter #f))
(define check-project-requires-in-render? (make-parameter #t))
(define clone-directory-name "clone")

Loading…
Cancel
Save