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

finish "pollen.rkt" comments

Browse Source
dev-lp
Matthew Butterick 9 years ago
parent dccc9f737b
commit 57641ecc53
1 changed files with 102 additions and 48 deletions
Show Stats Download Patch File Download Diff File

150
pollen.rkt
Unescape Escape View File

@ -641,9 +641,9 @@ But to be safe, we'll raise an arity error if we get too many arguments.
(module+ test (module+ test
(check-txexprs-equal? ◊xref{target} (check-txexprs-equal? ◊xref{target}
'(a ((class "xref") (href "target.html") (hyphens "none")) "target")) `(a ((class "xref") (href "target.html") ,no-hyphens-attr) "target"))
(check-txexprs-equal? ◊xref["url"]{target} (check-txexprs-equal? ◊xref["url"]{target}
'(a ((class "xref") (href "url") (hyphens "none")) "target")) `(a ((class "xref") (href "url") ,no-hyphens-attr) "target"))
(check-exn exn:fail:contract:arity? (λ _ (xref "url" "target" "spurious-third-argument")))) (check-exn exn:fail:contract:arity? (λ _ (xref "url" "target" "spurious-third-argument"))))
@ -705,9 +705,9 @@ with arguments that will be filled in when you invoke the macro.
|# |#
(define-syntax-rule (define-heading heading-name tag) (define-syntax-rule (define-heading heading-name tag)
; first, heading-name is used as an identifier ; first, heading-name is used as an identifier
(define (heading-name . text-args) (define heading-name
; then it's used as a symbol that is converted to a string. ; then it's used as a symbol that is converted to a string.
(list* tag (list `(class ,(~a 'heading-name)) no-hyphens-attr) text-args))) (make-default-tag-function tag #:class (symbol->string 'heading-name))))
(define-heading topic 'h3) (define-heading topic 'h3)
(define-heading subhead 'h3) (define-heading subhead 'h3)
@ -717,15 +717,15 @@ with arguments that will be filled in when you invoke the macro.
(module+ test (module+ test
(check-txexprs-equal? ◊topic{foo} (check-txexprs-equal? ◊topic{foo}
'(h3 ((class "topic") (hyphens "none")) "foo")) '(h3 ((class "topic")) "foo"))
(check-txexprs-equal? ◊subhead{foo} (check-txexprs-equal? ◊subhead{foo}
'(h3 ((class "subhead") (hyphens "none")) "foo")) '(h3 ((class "subhead")) "foo"))
(check-txexprs-equal? ◊font-headline{foo} (check-txexprs-equal? ◊font-headline{foo}
'(h3 ((class "font-headline") (hyphens "none")) "foo")) '(h3 ((class "font-headline")) "foo"))
(check-txexprs-equal? ◊section{foo} (check-txexprs-equal? ◊section{foo}
'(h2 ((class "section") (hyphens "none")) "foo")) '(h2 ((class "section")) "foo"))
(check-txexprs-equal? ◊chapter{foo} (check-txexprs-equal? ◊chapter{foo}
'(h1 ((class "chapter") (hyphens "none")) "foo"))) '(h1 ((class "chapter")) "foo")))
#| #|
`define-heading-from-metas`: macro for defining a function that makes a heading `define-heading-from-metas`: macro for defining a function that makes a heading
@ -759,11 +759,11 @@ For fun, I used Pollen notation inside the macro just to show you that it will w
(module+ test (module+ test
(let ([my-fake-metas (hash 'title "Fake Title" 'white "noise")]) (let ([my-fake-metas (hash 'title "Fake Title" 'white "noise")])
(check-txexprs-equal? ◊topic-from-metas[my-fake-metas] (check-txexprs-equal? ◊topic-from-metas[my-fake-metas]
'(h3 ((class "topic") (hyphens "none")) "Fake Title")) '(h3 ((class "topic")) "Fake Title"))
(check-txexprs-equal? ◊section-from-metas[my-fake-metas] (check-txexprs-equal? ◊section-from-metas[my-fake-metas]
'(h2 ((class "section") (hyphens "none")) "Fake Title")) '(h2 ((class "section")) "Fake Title"))
(check-txexprs-equal? ◊chapter-from-metas[my-fake-metas] (check-txexprs-equal? ◊chapter-from-metas[my-fake-metas]
'(h1 ((class "chapter") (hyphens "none")) "Fake Title")))) '(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
@ -777,8 +777,8 @@ For fun, I used Pollen notation inside the macro just to show you that it will w
(module+ test (module+ test
(check-txexprs-equal? ◊hanging-topic["Topic name"]{One-line explanation} (check-txexprs-equal? ◊hanging-topic["Topic name"]{One-line explanation}
'(div ((class "hanging-topic") (hyphens "none")) "Topic name" `(div ((class "hanging-topic") ,no-hyphens-attr) "Topic name"
(p ((hyphens "none")) "One-line explanation")))) (p (,no-hyphens-attr) "One-line explanation"))))
#| #|
@ -848,6 +848,17 @@ You could improve it to fill in blank cells in rows that need them.
(tr (td "five") (td "six"))))) (tr (td "five") (td "six")))))
#| #|
`pdf-thumbnail-link`: create a thumbnail of a PDF that links to the PDF
This function will only work properly if you have `sips` on your system
(command-line image-processing program, included with OS X).
This shows how you can fold other kinds of project housekeeping into Pollen commands.
Here, the function generates the thumbnail it needs when the page is compiled.
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).
In this case, `sips` is fast enough that it's not bothersome.
|# |#
(define (pdf-thumbnail-link pdf-pathstring) (define (pdf-thumbnail-link pdf-pathstring)
@ -856,12 +867,16 @@ You could improve it to fill in blank cells in rows that need them.
(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))
(if (system sips-command) ◊link[pdf-pathstring]{◊(if (system sips-command)
(link pdf-pathstring `(img ((src ,img-pathstring)))) `(img ((src ,img-pathstring)))
(error 'pdf-thumbnail-link "sips failed"))) ;; usually one would raise an error on the next line,
;; but for instructional purposes, we'll have a graceful fail
"sips not available")})
#|
A few convenience variants of `pdf-thumbnail-link`
|#
(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)))
@ -881,35 +896,71 @@ You could improve it to fill in blank cells in rows that need them.
,(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))))
#|
`root`: decode page content
In a Pollen markup source, the output is a tagged X-expression that starts with `root`:
(root (div ((class "headline")) "Page title") ...)
Recall that every Pollen tag calls a function with the same name (if it exists, otherwise it just
becomes a tag). This is also true of `root`.
(define (root . xs) `root` has slightly special status inasmuch as it is the top tag of the X-expression,
;; process paragraphs first so that they're treated as block-txexprs in next phase. and thus the last tag function that will get called. Therefore, `root` is a good place to put any
(define elements-with-paragraphs (decode-elements xs #:txexpr-elements-proc detect-paragraphs)) processing that should happen once all the page content has been filled in.
`(div ((id "doc")) ,@(decode-elements elements-with-paragraphs
#:block-txexpr-proc hyphenate-block
;; `hangable-quotes` doesn't return a string, so do it last
#:string-proc (compose1 hangable-quotes
fix-em-dashes
smart-quotes)
#:exclude-tags '(style script))))
Often, you'll want to use a `decode` function, which can recursively perform different kinds of
processing on different types of page elements.
|#
(define (root . elems)
;; We will do the decoding in two steps.
;; Detect paragraphs first so that they're treated as block-txexprs in next phase.
(define elements-with-paragraphs (decode-elements elems #:txexpr-elements-proc detect-paragraphs))
;; Then do the rest of the decoding normally.
(list* 'div '((id "doc"))
(decode-elements elements-with-paragraphs
#:block-txexpr-proc hyphenate-block
#:string-proc (compose1 make-quotes-hangable
fix-em-dashes
smart-quotes)
#:exclude-tags '(style script))))
#|
`hyphenate-block`: helper function for root decoder
|#
(define (hyphenate-block block-tx) (define (hyphenate-block block-tx)
;; attach hyphenate as a block processor rather than string processor ;; The basic `hyphenate` function comes from the `hyphenate` module.
;; so that attrs can be inspected for "no-hyphens" flag. ;; We could attach `hyphenate` to our decoder as a string processor rather than block processor.
;; But we want to be able to handle our "no-hyphens" flag (aka `no-hyphens-attr`).
;; So we want to look at blocks, not strings.
(define (no-hyphens? tx) (define (no-hyphens? tx)
(or (member (get-tag tx) '(th h1 h2 h3 h4 style script)) (or (member (get-tag tx) '(th h1 h2 h3 h4 style script)) ; don't hyphenate these, no matter what
(member no-hyphens-attr (get-attrs tx)))) (member no-hyphens-attr (get-attrs tx)))) ; also don't hyphenate blocks with `no-hyphens-attr`
(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
(check-txexprs-equal? (hyphenate-block `(div "snowman" (span (,no-hyphens-attr) "snowman")))
`(div "snow\u00ADman" (span (,no-hyphens-attr) "snowman"))))
(define (hangable-quotes str) #|
(define strs (regexp-match* #px"\\s?[“‘]" str #:gap-select? #t)) `make-quotes-hangable`: perform tricky processing on quotation marks.
(if (= (length strs) 1) ; no submatches
(car strs) 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").
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.
|#
(define (make-quotes-hangable str)
;; using `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))
(if (= (length substrs) 1) ; no submatches
(car substrs)
(cons 'quo (append-map (λ(str) (cons 'quo (append-map (λ(str)
(let ([strlen (string-length str)]) (let ([strlen (string-length str)])
(if (> strlen 0) (if (> strlen 0)
@ -917,19 +968,27 @@ You could improve it to fill in blank cells in rows that need them.
[("‘") (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)))) strs)))) (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
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.
|#
(define (fix-em-dashes str) (define (fix-em-dashes str)
;; remove word spaces around em dashes where necessary. ;; \u00A0 = nbsp, \u2009 = thinsp (neither included in \s)
;; replace with thin spaces.
;; \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
(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.
@ -973,9 +1032,4 @@ You could improve it to fill in blank cells in rows that need them.
(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)))))