mbutterick
/
pollen-tfl
Archived
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

ready for action

Browse Source
dev-lp
Matthew Butterick 8 years ago
parent 1852471612
commit 6e8442054d
3 changed files with 211 additions and 167 deletions
Show Stats Download Patch File Download Diff File

40
pollen-lp-test.rkt
Unescape Escape View File

@ -167,4 +167,42 @@ will be combined into a single submodule.
(check-txexprs-equal? ◊section{foo} (check-txexprs-equal? ◊section{foo}
'(h2 ((class "section")) "foo")) '(h2 ((class "section")) "foo"))
(check-txexprs-equal? ◊chapter{foo} (check-txexprs-equal? ◊chapter{foo}
'(h1 ((class "chapter")) "foo"))) '(h1 ((class "chapter")) "foo")))
(module+ test
(let ([my-fake-metas (hash 'title "Fake Title" 'white "noise")])
(check-txexprs-equal? ◊topic-from-metas[my-fake-metas]
'(h3 ((class "topic")) "Fake Title"))
(check-txexprs-equal? ◊section-from-metas[my-fake-metas]
'(h2 ((class "section")) "Fake Title"))
(check-txexprs-equal? ◊chapter-from-metas[my-fake-metas]
'(h1 ((class "chapter")) "Fake Title"))))
(module+ test
(check-txexprs-equal? ◊hanging-topic["Topic name"]{One-line explanation}
`(div ((class "hanging-topic") ,no-hyphens-attr) "Topic name"
(p (,no-hyphens-attr) "One-line explanation"))))
(module+ test
(check-txexprs-equal?
◊(quick-table "heading-one | heading-two" "\n"
" three | four" "\n"
"five | six ")
'(table (tr (th "heading-one") (th "heading-two"))
(tr (td "three") (td "four"))
(tr (td "five") (td "six")))))
(module+ test
(check-txexprs-equal? (hyphenate-block `(div "snowman" (span (,no-hyphens-attr) "snowman")))
`(div "snow\u00ADman" (span (,no-hyphens-attr) "snowman"))))
(module+ test
(check-txexprs-equal? (make-quotes-hangable "“Who is it?”")
'(quo "" (dquo-push) (dquo-pull "“") "Who is it?”")))
(module+ test
(check-equal? (fix-em-dashes "Hey — you!") "Hey—you!")
(check-equal? (fix-em-dashes "Hey—you!") "Hey—you!"))
(module+ test
(check-equal? (capitalize-first-letter "foo dog") "Foo dog"))

300
pollen-lp.scrbl
Unescape Escape View File

@ -21,33 +21,7 @@ file and see how they affect the output.
We could avoid the next @racket[require] if we were using @|lang| @racketmodname[racket], because these libraries would We could avoid the next @racket[require] if we were using @|lang| @racketmodname[racket], because these libraries would
already be available. already be available.
@chunk[<*>
<req>
<req2>
<provides>
<dev-mode>
<values>
<link>
<buy-book-link>
<image>
<div-scale>
<font-scale>
<home-image>
<home-overlay>
<glyph>
<image-wrapped>
<detect-list-items>
<make-list-function>
<bullet-list>
<numbered-list>
<btw>
<xref>
<target->url>
<xref-font>
<define-heading>
<headings>
<define-heading-from-metas>
]
@chunk[<req> @chunk[<req>
(require (require
@ -670,40 +644,40 @@ Macro for defining a function that makes a heading by relying on data in the met
#'(define (heading-from-metas metas) #'(define (heading-from-metas metas)
(heading-name (hash-ref metas meta-key-for-page-title))))]))] (heading-name (hash-ref metas meta-key-for-page-title))))]))]
@;|{
@deftogether[(
(define-heading-from-metas topic) @defproc[
(topic-from-metas [metas hash?])
txexpr?]
@defproc[
(section-from-metas [metas hash?])
txexpr?]
@defproc[
(chapter-from-metas [metas hash?])
txexpr?])]
@chunk[<headings-from-metas>
(define-heading-from-metas topic)
(define-heading-from-metas section) (define-heading-from-metas section)
(define-heading-from-metas chapter) (define-heading-from-metas chapter)]
(module+ test @defproc[
(let ([my-fake-metas (hash 'title "Fake Title" 'white "noise")]) (hanging-topic
(check-txexprs-equal? ◊topic-from-metas[my-fake-metas] [topic-xexpr xexpr?]
'(h3 ((class "topic")) "Fake Title")) [pollen-args (listof xexpr?)] ...)
(check-txexprs-equal? ◊section-from-metas[my-fake-metas] txexpr?]
'(h2 ((class "section")) "Fake Title")) Convert a topic + subhead into one HTML markup unit
(check-txexprs-equal? ◊chapter-from-metas[my-fake-metas]
'(h1 ((class "chapter")) "Fake Title"))))
#|
@racket[hanging-topic]: convert a topic + subhead into one HTML markup unit
◊hanging-topic["Topic name"]{One-line explanation}
|# @chunk[<hanging-topic>
(define (hanging-topic topic-xexpr . text-args) (define (hanging-topic topic-xexpr . pollen-args)
(txexpr 'div (list '(class "hanging-topic") no-hyphens-attr) (txexpr 'div (list '(class "hanging-topic") no-hyphens-attr)
(list topic-xexpr (list* 'p (list no-hyphens-attr) text-args)))) (list topic-xexpr (list* 'p (list no-hyphens-attr) pollen-args))))]
(module+ test @defproc[
(check-txexprs-equal? ◊hanging-topic["Topic name"]{One-line explanation} (quick-table
`(div ((class "hanging-topic") ,no-hyphens-attr) "Topic name" [table-rows (listof xexpr?)] ...)
(p (,no-hyphens-attr) "One-line explanation")))) txexpr?]
Make an HTML table using simplified notation
#|
@racket[quick-table]: make little HTML tables with simplified notation
◊quick-table{heading left | heading center | heading right ◊quick-table{heading left | heading center | heading right
upper left | upper center | upper right upper left | upper center | upper right
@ -719,9 +693,9 @@ Macro for defining a function that makes a heading by relying on data in the met
This function assumes that each row has the same number of columns. This function assumes that each row has the same number of columns.
You could improve it to fill in blank cells in rows that need them. You could improve it to fill in blank cells in rows that need them.
|#
@chunk[<quick-table>
(define (quick-table . text-args) (define (quick-table . text-args)
;; In Pollen, a multiline text-args block arrives as a list of lines and linebreak characters. ;; In Pollen, a multiline text-args block arrives as a list of lines and linebreak characters.
@ -757,20 +731,14 @@ Macro for defining a function that makes a heading by relying on data in the met
;; Converts an expression of the form @racket[(apply func (list arg1 arg2 ...))] ;; Converts an expression of the form @racket[(apply func (list arg1 arg2 ...))]
;; Into @racket[(func arg1 arg2 ...)] ;; Into @racket[(func arg1 arg2 ...)]
(cons 'table (for/list ([html-row (in-list html-rows)]) (cons 'table (for/list ([html-row (in-list html-rows)])
(apply tr-tag html-row)))) (apply tr-tag html-row))))]
(module+ test @defproc[
(check-txexprs-equal? (pdf-thumbnail
◊(quick-table "heading-one | heading-two" "\n" [pdf-path path-string?])
" three | four" "\n" txexpr?]
"five | six ") Create a thumbnail of a PDF that links to the PDF.
'(table (tr (th "heading-one") (th "heading-two"))
(tr (td "three") (td "four"))
(tr (td "five") (td "six")))))
#|
@racket[pdf-thumbnail-link]: create a thumbnail of a PDF that links to the PDF
This function will only work properly if you have @racket[sips] on your system This function will only work properly if you have @racket[sips] on your system
(command-line image-processing program, included with OS X). (command-line image-processing program, included with OS X).
@ -780,24 +748,37 @@ Macro for defining a function that makes a heading by relying on data in the met
One disadvantage of this approach is that the thumbnail will *always* be generated on recompile, One disadvantage of this approach is that the thumbnail will *always* be generated on recompile,
though you could put in some logic to avoid this (e.g., check the modification date of the PDF). though you could put in some logic to avoid this (e.g., check the modification date of the PDF).
In this case, @racket[sips] is fast enough that it's not bothersome. In this case, @racket[sips] is fast enough that it's not bothersome.
|# @chunk[<pdf-thumbnail>
(define (pdf-thumbnail-link pdf-pathstring) (define (pdf-thumbnail-link pdf-pathstring)
(define img-extension "gif") (define img-extension "gif")
(define img-pathstring (->string (add-ext (remove-ext pdf-pathstring) img-extension))) (define img-pathstring (->string (add-ext (remove-ext pdf-pathstring) img-extension)))
(define sips-command (define sips-command
(format "sips -Z 2000 -s format ~a --out '~a' '~a' > /dev/null" (format "sips -Z 2000 -s format ~a --out '~a' '~a' > /dev/null"
img-extension img-pathstring pdf-pathstring)) img-extension img-pathstring pdf-pathstring))
◊link[pdf-pathstring]{◊(if (system sips-command) (link pdf-pathstring (if (system sips-command)
`(img ((src ,img-pathstring))) `(img ((src ,img-pathstring)))
;; usually one would raise an error on the next line, ;; usually one would raise an error on the next line,
;; but for instructional purposes, we'll have a graceful fail ;; but for instructional purposes, we'll have a graceful fail
"sips not available")}) "sips not available")))]
@deftogether[(
#| @defproc[
A few convenience variants of @racket[pdf-thumbnail-link] (pdf-thumbnail-link-from-metas
|# [metas hash?])
txexpr?]
@defproc[
(before-and-after-pdfs
[base-name string?])
txexpr?]
@defproc[
(alternate-after-pdf
[base-name string?])
txexpr?]
)]
A few convenience variants of @racket[pdf-thumbnail-link]
@chunk[<pdf-thumbnail-variants>
(define (pdf-thumbnail-link-from-metas metas) (define (pdf-thumbnail-link-from-metas metas)
(define-values (dir fn _) (split-path (add-ext (remove-ext* (hash-ref metas 'here-path)) "pdf"))) (define-values (dir fn _) (split-path (add-ext (remove-ext* (hash-ref metas 'here-path)) "pdf")))
(pdf-thumbnail-link (->string fn))) (pdf-thumbnail-link (->string fn)))
@ -814,11 +795,13 @@ Macro for defining a function that makes a heading by relying on data in the met
(define (alternate-after-pdf base-name) (define (alternate-after-pdf base-name)
`(div ((class "pdf-thumbnail")) `(div ((class "pdf-thumbnail"))
"after (alternate)" (br) "after (alternate)" (br)
,(pdf-thumbnail-link (format "pdf/sample-doc-~a-after-alternate.pdf" base-name)))) ,(pdf-thumbnail-link (format "pdf/sample-doc-~a-after-alternate.pdf" base-name))))]
@defproc[
#| (root
@racket[root]: decode page content [pollen-args (listof txexpr?)] ...)
txexpr?]
Decode page content
In a Pollen markup source, the output is a tagged X-expression that starts with @racket[root]: In a Pollen markup source, the output is a tagged X-expression that starts with @racket[root]:
@ -833,8 +816,8 @@ Macro for defining a function that makes a heading by relying on data in the met
Often, you'll want to use a @racket[decode] function, which can recursively perform different kinds of Often, you'll want to use a @racket[decode] function, which can recursively perform different kinds of
processing on different types of page elements. processing on different types of page elements.
|# @chunk[<root>
(define (root . elems) (define (root . elems)
;; We will do the decoding in two steps. ;; We will do the decoding in two steps.
;; Detect paragraphs first so that they're treated as block-txexprs in next phase. ;; Detect paragraphs first so that they're treated as block-txexprs in next phase.
@ -846,11 +829,15 @@ Macro for defining a function that makes a heading by relying on data in the met
#:string-proc (compose1 make-quotes-hangable #:string-proc (compose1 make-quotes-hangable
fix-em-dashes fix-em-dashes
smart-quotes) smart-quotes)
#:exclude-tags '(style script)))) #:exclude-tags '(style script))))]
#| @defproc[
@racket[hyphenate-block]: helper function for root decoder (hyphenate-block
|# [block-tx txexpr?])
txexpr?]
Helper function for root decoder
@chunk[<hyphenate-block>
(define (hyphenate-block block-tx) (define (hyphenate-block block-tx)
;; The basic @racket[hyphenate] function comes from the @racket[hyphenate] module. ;; The basic @racket[hyphenate] function comes from the @racket[hyphenate] module.
;; We could attach @racket[hyphenate] to our decoder as a string processor rather than block processor. ;; We could attach @racket[hyphenate] to our decoder as a string processor rather than block processor.
@ -862,21 +849,21 @@ Macro for defining a function that makes a heading by relying on data in the met
(hyphenate block-tx (hyphenate block-tx
#:min-left-length 3 #:min-left-length 3
#:min-right-length 3 #:min-right-length 3
#:omit-txexpr no-hyphens?)) #:omit-txexpr no-hyphens?))]
(module+ test @defproc[
(check-txexprs-equal? (hyphenate-block `(div "snowman" (span (,no-hyphens-attr) "snowman"))) (make-quotes-hangable
`(div "snow\u00ADman" (span (,no-hyphens-attr) "snowman")))) [str string?])
txexpr?]
#| Perform tricky processing on quotation marks.
@racket[make-quotes-hangable]: perform tricky processing on quotation marks.
Because I'm a typography snob I like to push quotation marks into the margin a little bit Because I'm a typography snob I like to push quotation marks into the margin a little bit
when they appear at the left edge of a line (aka "hanging quotes"). when they appear at the left edge of a line (aka "hanging quotes").
This function just wraps left-hand quote marks in two little tags ("push" and "pull") This function just wraps left-hand quote marks in two little tags ("push" and "pull")
that I can then manipulate in CSS to get the effect. that I can then manipulate in CSS to get the effect.
|#
@chunk[<make-quotes-hangable>
(define (make-quotes-hangable str) (define (make-quotes-hangable str)
;; using @racket[regexp-match*] with #:gap-select? makes it act like a funny kind of string splitter ;; using @racket[regexp-match*] with #:gap-select? makes it act like a funny kind of string splitter
(define substrs (regexp-match* #px"\\s?[“‘]" str #:gap-select? #t)) (define substrs (regexp-match* #px"\\s?[“‘]" str #:gap-select? #t))
@ -889,41 +876,39 @@ Macro for defining a function that makes a heading by relying on data in the met
[("‘") (list '(squo-push) `(squo-pull ,str))] [("‘") (list '(squo-push) `(squo-pull ,str))]
[("“") (list '(dquo-push) `(dquo-pull ,str))] [("“") (list '(dquo-push) `(dquo-pull ,str))]
[else (list str)]) [else (list str)])
(list str)))) substrs)))) (list str)))) substrs))))]
(module+ test @defproc[
(check-txexprs-equal? (make-quotes-hangable "“Who is it?”") (fix-em-dashes
'(quo "" (dquo-push) (dquo-pull "“") "Who is it?”"))) [str string?])
txexpr?]
#| Helper function for root decoder
@racket[fix-em-dashes]: helper function for root decoder
When I type an em dash in my sources, I will often leave a space around it, When I type an em dash in my sources, I will often leave a space around it,
but I don't want spaces in the output, so this function removes them. but I don't want spaces in the output, so this function removes them.
|#
(define (fix-em-dashes str) @chunk[<fix-em-dashes>
(define (fix-em-dashes str)
;; \u00A0 = nbsp, \u2009 = thinsp (neither included in \s) ;; \u00A0 = nbsp, \u2009 = thinsp (neither included in \s)
(let* ([str (regexp-replace* #px"(?<=\\w)[\u00A0\u2009\\s]—" str "—")] (let* ([str (regexp-replace* #px"(?<=\\w)[\u00A0\u2009\\s]—" str "—")]
[str (regexp-replace* #px"—[\u00A0\u2009\\s](?=\\w)" str "—")]) [str (regexp-replace* #px"—[\u00A0\u2009\\s](?=\\w)" str "—")])
str)) str))]
(module+ test @defproc[
(check-equal? (fix-em-dashes "Hey — you!") "Hey—you!") (capitalize-first-letter
(check-equal? (fix-em-dashes "Hey—you!") "Hey—you!")) [str string?])
string?]
#| utility function for use in HTML templates.
@racket[capitalize-first-letter]: utility function for use in HTML templates.
|# @chunk[<capitalize-first-letter>
(define (capitalize-first-letter str) (define (capitalize-first-letter str)
(regexp-replace #rx"^." str string-upcase)) (regexp-replace #rx"^." str string-upcase))]
(module+ test @subsubsection{Miscellaneous tag functions}
(check-equal? (capitalize-first-letter "foo dog") "Foo dog"))
Presented without docs or comment, as it should be obvious at this point what they do.
#| @chunk[<misc-functions>
Miscellaneous tag functions. Obvious at this point what they do.
|#
(define omission (make-default-tag-function 'div #:class "omission")) (define omission (make-default-tag-function 'div #:class "omission"))
(define mono (make-default-tag-function 'span #:class "mono")) (define mono (make-default-tag-function 'span #:class "mono"))
@ -953,6 +938,51 @@ Macro for defining a function that makes a heading by relying on data in the met
(define (captioned name . xs) (define (captioned name . xs)
`(table ((class "captioned indented")) `(table ((class "captioned indented"))
(tr (td ((style "text-align:left")) ,@xs) (td ,(caption name))))) (tr (td ((style "text-align:left")) ,@xs) (td ,(caption name)))))]
@;|{
#|
|#
}| }|
@chunk[<*>
<req>
<req2>
<provides>
<dev-mode>
<values>
<link>
<buy-book-link>
<image>
<div-scale>
<font-scale>
<home-image>
<home-overlay>
<glyph>
<image-wrapped>
<detect-list-items>
<make-list-function>
<bullet-list>
<numbered-list>
<btw>
<xref>
<target->url>
<xref-font>
<define-heading>
<headings>
<define-heading-from-metas>
<headings-from-metas>
<hanging-topic>
<quick-table>
<pdf-thumbnail>
<pdf-thumbnail-variants>
<root>
<hyphenate-block>
<make-quotes-hangable>
<fix-em-dashes>
<capitalize-first-letter>
<misc-functions>
]

38
pollen.rkt
Unescape Escape View File

@ -623,14 +623,7 @@ For fun, I used Pollen notation inside the macro just to show you that it will w
(define-heading-from-metas section) (define-heading-from-metas section)
(define-heading-from-metas chapter) (define-heading-from-metas chapter)
(module+ test
(let ([my-fake-metas (hash 'title "Fake Title" 'white "noise")])
(check-txexprs-equal? ◊topic-from-metas[my-fake-metas]
'(h3 ((class "topic")) "Fake Title"))
(check-txexprs-equal? ◊section-from-metas[my-fake-metas]
'(h2 ((class "section")) "Fake Title"))
(check-txexprs-equal? ◊chapter-from-metas[my-fake-metas]
'(h1 ((class "chapter")) "Fake Title"))))
#| #|
`hanging-topic`: convert a topic + subhead into one HTML markup unit `hanging-topic`: convert a topic + subhead into one HTML markup unit
@ -642,10 +635,7 @@ For fun, I used Pollen notation inside the macro just to show you that it will w
(make-txexpr 'div (list '(class "hanging-topic") no-hyphens-attr) (make-txexpr 'div (list '(class "hanging-topic") no-hyphens-attr)
(list topic-xexpr (list* 'p (list no-hyphens-attr) text-args)))) (list topic-xexpr (list* 'p (list no-hyphens-attr) text-args))))
(module+ test
(check-txexprs-equal? ◊hanging-topic["Topic name"]{One-line explanation}
`(div ((class "hanging-topic") ,no-hyphens-attr) "Topic name"
(p (,no-hyphens-attr) "One-line explanation"))))
#| #|
@ -705,14 +695,7 @@ You could improve it to fill in blank cells in rows that need them.
(cons 'table (for/list ([html-row (in-list html-rows)]) (cons 'table (for/list ([html-row (in-list html-rows)])
(apply tr-tag html-row)))) (apply tr-tag html-row))))
(module+ test
(check-txexprs-equal?
◊(quick-table "heading-one | heading-two" "\n"
" three | four" "\n"
"five | six ")
'(table (tr (th "heading-one") (th "heading-two"))
(tr (td "three") (td "four"))
(tr (td "five") (td "six")))))
#| #|
`pdf-thumbnail-link`: create a thumbnail of a PDF that links to the PDF `pdf-thumbnail-link`: create a thumbnail of a PDF that links to the PDF
@ -810,9 +793,7 @@ processing on different types of page elements.
#:min-right-length 3 #:min-right-length 3
#:omit-txexpr no-hyphens?)) #:omit-txexpr no-hyphens?))
(module+ test
(check-txexprs-equal? (hyphenate-block `(div "snowman" (span (,no-hyphens-attr) "snowman")))
`(div "snow\u00ADman" (span (,no-hyphens-attr) "snowman"))))
#| #|
`make-quotes-hangable`: perform tricky processing on quotation marks. `make-quotes-hangable`: perform tricky processing on quotation marks.
@ -837,9 +818,7 @@ that I can then manipulate in CSS to get the effect.
[else (list str)]) [else (list str)])
(list str)))) substrs)))) (list str)))) substrs))))
(module+ test
(check-txexprs-equal? (make-quotes-hangable "“Who is it?”")
'(quo "" (dquo-push) (dquo-pull "“") "Who is it?”")))
#| #|
`fix-em-dashes`: helper function for root decoder `fix-em-dashes`: helper function for root decoder
@ -853,9 +832,7 @@ but I don't want spaces in the output, so this function removes them.
[str (regexp-replace* #px"—[\u00A0\u2009\\s](?=\\w)" str "—")]) [str (regexp-replace* #px"—[\u00A0\u2009\\s](?=\\w)" str "—")])
str)) str))
(module+ test
(check-equal? (fix-em-dashes "Hey — you!") "Hey—you!")
(check-equal? (fix-em-dashes "Hey—you!") "Hey—you!"))
#| #|
`capitalize-first-letter`: utility function for use in HTML templates. `capitalize-first-letter`: utility function for use in HTML templates.
@ -863,8 +840,7 @@ but I don't want spaces in the output, so this function removes them.
(define (capitalize-first-letter str) (define (capitalize-first-letter str)
(regexp-replace #rx"^." str string-upcase)) (regexp-replace #rx"^." str string-upcase))
(module+ test
(check-equal? (capitalize-first-letter "foo dog") "Foo dog"))
#| #|