refactoring & commentary

dev-lp
Matthew Butterick 8 years ago
parent fc34339ae9
commit ab1d3fd5e3

@ -23,6 +23,7 @@ be available.
racket/string
racket/function
racket/contract
racket/match
racket/system
txexpr
pollen/decode
@ -538,8 +539,8 @@ Now we can define `bullet-list` and `numbered-list` using our helper function.
(define numbered-list (make-list-function 'ol))
(module+ test
(check-txexprs-equal? (bullet-list "foo") '(ul (li (p "foo"))))
(check-txexprs-equal? (numbered-list "foo") '(ol (li (p "foo")))))
(check-txexprs-equal? ◊bullet-list{foo} '(ul (li (p "foo"))))
(check-txexprs-equal? ◊numbered-list{foo} '(ol (li (p "foo")))))
#|
@ -561,7 +562,10 @@ The `btw` tag expands to an HTML list, which we will then crack open and add a h
(get-elements btw-list)))
(module+ test
(check-txexprs-equal? (btw "foo" "\n" "\n" "\n" "bar")
(check-txexprs-equal? ◊btw{foo
bar}
'(ul ((class "btw"))
(div ((id "btw-title")) "by the way")
(li (p "foo"))
@ -587,43 +591,83 @@ But to be safe, we'll raise an arity error if we get too many arguments.
;; one argument: must be a target. Note the Rackety recursive technique here:
;; we'll create a second argument and then call `xref` again.
[(target) (xref (target->url target) target)]
;; two arguments: must be a url followed by a target.
[(url target) (apply attr-set* (link url target) 'class "xref" no-hyphens-attr)]
;; more than two arguments: raise an arity error.
[more-than-two-args (apply raise-arity-error 'xref (list 1 2) more-than-two-args)]))
(module+ test
(check-txexprs-equal? (xref "target")
(check-txexprs-equal? ◊xref{target}
'(a ((class "xref") (href "target.html") (hyphens "none")) "target"))
(check-txexprs-equal? (xref "url" "target")
(check-txexprs-equal? ◊xref["url"]{target}
'(a ((class "xref") (href "url") (hyphens "none")) "target"))
(check-exn exn:fail:contract:arity? (λ _ (xref "url" "target" "spurious-third-argument"))))
#|
`target->url`: convert the target text of an xref into a url.
This function depends on my commitment to name my source files in a logical, predictable way,
e.g., "Why Does Typography Matter?" becomes "why-does-typography-matter.html".
If you needed to associate targets with URLs arbitrarily, you could store the targets and URLs
in an association list or hashtable.
I do it this way so that it's easy to add new pages and xrefs, without the extra housekeeping step
The name of the source file for a page is determined by its title.
|#
(define (target->url target)
(define nonbreaking-space (~a #\u00A0))
(let* ([xn target]
[xn (string-trim xn "?")]
[xn (string-downcase xn)]
[xn (regexp-replace* #rx"é" xn "e")]
[xn (if (regexp-match #rx"^foreword" xn) "foreword" xn)]
[xn (if (regexp-match #rx"^table of contents" xn) "toc" xn)]
[xn (string-replace xn nonbreaking-space "-")]
[xn (string-replace xn " " "-")])
[xn (string-trim xn "?")] ; delete a question mark at the end
[xn (string-downcase xn)] ; put string in all lowercase
[xn (regexp-replace* #rx"é" xn "e")] ; remove accented é
[xn (if (regexp-match #rx"^foreword" xn) "foreword" xn)] ; special rule for foreword
[xn (if (regexp-match #rx"^table of contents" xn) "toc" xn)] ; special rule for toc
[xn (string-replace xn nonbreaking-space "-")] ; replace nbsp with hyphen
[xn (string-replace xn " " "-")]) ; replace word space with hyphen
(format "~a.html" xn)))
(module+ test
(check-equal? (target->url "foo?") "foo.html")
(check-equal? (target->url "FOO") "foo.html")
(check-equal? (target->url "foé") "foe.html")
(check-equal? (target->url "Foreword Lengthy Title") "foreword.html")
(check-equal? (target->url "Table of Contents and Other Nonsense") "toc.html")
(check-equal? (target->url "Nonbreaking Space and Spaces") "nonbreaking-space-and-spaces.html"))
#|
`xref-font`: special version of `xref` for the fontrec directory
|#
(define (xref-font font-name)
(xref (format "fontrec/~a" (target->url font-name)) font-name))
#|
`no-hyphens-attr`: an attribute we'll use to signal that some X-expression should not be hyphenated.
|#
(define no-hyphens-attr '(hyphens "none"))
(define-syntax-rule (define-heading name tag)
(define (name #:class [class-string ""] . xs)
`(,tag ((class ,(string-trim (format "~a ~a" 'name class-string))) ,no-hyphens-attr) ,@xs)))
#|
`define-heading`: macro for defining a function that makes a heading.
This could also be done with `make-default-tag-function`. And as a rule of thumb, it's wise to reserve
macros for the times you can't avoid using them. Otherwise, use a function.
We'll bend that rule here because this is a quick & easy example macro. What makes it suitable to be
handled as a macro is that we want to use the name of the identifier (for instance 'topic') as an
argument to the function. Ordinarily we can't do that, but with a macro, we can.
`define-syntax-rule` is the easiest macro form: essentially you're writing a code template
with arguments that will be filled in when you invoke the macro.
|#
(define-syntax-rule (define-heading heading-name tag)
; first, heading-name is used as an identifier
(define (heading-name . text-args)
; 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)))
(define-heading topic 'h3)
(define-heading subhead 'h3)
@ -631,25 +675,184 @@ But to be safe, we'll raise an arity error if we get too many arguments.
(define-heading section 'h2)
(define-heading chapter 'h1)
(define title-key 'title)
(module+ test
(check-txexprs-equal? ◊topic{foo}
'(h3 ((class "topic") (hyphens "none")) "foo"))
(check-txexprs-equal? ◊subhead{foo}
'(h3 ((class "subhead") (hyphens "none")) "foo"))
(check-txexprs-equal? ◊font-headline{foo}
'(h3 ((class "font-headline") (hyphens "none")) "foo"))
(check-txexprs-equal? ◊section{foo}
'(h2 ((class "section") (hyphens "none")) "foo"))
(check-txexprs-equal? ◊chapter{foo}
'(h1 ((class "chapter") (hyphens "none")) "foo")))
#|
`define-heading-from-metas`: macro for defining a function that makes a heading
by relying on data in the metas.
This macro relies on `syntax-case` rather than `define-syntax-rule`.
It's a little more complicated, but also more flexible (and more idiomatic in Racket).
`define-syntax-rule` is actually a special simplified version of `syntax-case`.
The best advice on learning macros is to start with `syntax-case`, because you can't live without it.
Good tutorial: http://www.greghendershott.com/fear-of-macros/pattern-matching.html
Otherwise this macro is similar to `define-heading`, except that we want to introduce a new identifier
based on the name given to the macro. So if we pass `topic` to the macro, it will define
an identifier called `topic-from-metas`. You can't do that with `define-syntax-rule`.
For fun, I used Pollen notation inside the macro just to show you that it will work.
(define-syntax (define-thing-from-metas stx)
|#
(define meta-key-for-page-title 'title)
(define-syntax (define-heading-from-metas stx)
(syntax-case stx ()
[(_ thing)
(with-syntax ([thing-from-metas (format-id stx "~a-from-metas" #'thing)])
#'(define (thing-from-metas metas)
(thing (hash-ref metas title-key))))]))
[(_ heading-name)
(with-syntax ([heading-from-metas (format-id stx "~a-from-metas" #'heading-name)])
#'(define (heading-from-metas metas)
◊heading-name{(hash-ref metas meta-key-for-page-title)}))]))
(define-thing-from-metas topic)
(define-thing-from-metas section)
(define-thing-from-metas chapter)
(define-heading-from-metas topic)
(define-heading-from-metas section)
(define-heading-from-metas chapter)
(define (hanging-topic topic-xexpr . xs)
`(div ((class "hanging-topic") ,no-hyphens-attr) ,topic-xexpr (p (,no-hyphens-attr) ,@xs)))
(module+ test
(let ([my-fake-metas (hash 'title "Fake Title" 'white "noise")])
(check-txexprs-equal? ◊topic-from-metas[my-fake-metas]
'(h3 ((class "topic") (hyphens "none")) "Fake Title"))
(check-txexprs-equal? ◊section-from-metas[my-fake-metas]
'(h2 ((class "section") (hyphens "none")) "Fake Title"))
(check-txexprs-equal? ◊chapter-from-metas[my-fake-metas]
'(h1 ((class "chapter") (hyphens "none")) "Fake Title"))))
#|
`hanging-topic`: convert a topic + subhead into one HTML markup unit
◊hanging-topic["Topic name"]{One-line explanation}
|#
(define (hanging-topic topic-xexpr . text-args)
(make-txexpr 'div (list '(class "hanging-topic") no-hyphens-attr)
(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") (hyphens "none")) "Topic name"
(p ((hyphens "none")) "One-line explanation"))))
#|
`quick-table`: make little HTML tables with simplified notation
◊quick-table{heading left | heading center | heading right
upper left | upper center | upper right
lower left | lower center | lower right}
In HTML, wrapping every paragraph in <p> tags is a terrible and dull task.
But formatting tables is even worse.
This function lets you make simple tables using "|" to signify columns,
and line breaks to signify rows.
Let's uncork a few more whizzy Racket commands while we're at it.
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.
|#
(define (quick-table . text-args)
;; In Pollen, a multiline text-args block arrives as a list of lines and linebreak characters.
;; (A situation we already encountered in `detect-list-items`.)
(define rows-of-text-cells
(let ([text-rows (filter-not whitespace? text-args)]) ; throw out the linebreak characters
;; `for/list` is very handy: a `for` loop that gathers the results into a list.
;; Think of it as a more flexible version of `map`.
(for/list ([text-row (in-list text-rows)])
;; the cells are delimited within a row by "|", so split on this char
(for/list ([text-cell (in-list (string-split text-row "|"))])
(string-trim text-cell))))) ; trim remaining whitespace from cell text
;; Racket's `match` functions are very useful.
;; Among other things, they can be used for Python-style data unpacking.
;; The expression on the right will produce three tag functions;
;; the `match-define` assigns them to three new identifiers.
(match-define (list tr-tag td-tag th-tag) (map make-default-tag-function '(tr td th)))
;; now we'll take our rows of text cells and apply cell-level HTML tags.
;; the first row will get 'th tags; the other rows get 'td tags.
(define html-rows
;; another use of `match`. Notice how this `cons` is used to separate a list into parts ...
(match-let ([(cons header-row other-rows) rows-of-text-cells])
;; ... whereas this `cons` is used to combine parts into a list
(cons (map th-tag header-row)
(for/list ([row (in-list other-rows)])
(map td-tag row)))))
;; With the cells tagged up, add the row tags and finally the table tag.
;; Notice that we use `apply` with `tr-tag` to unpack the list of cells in each html-row.
;; Remember that `apply` does something very simple:
;; Converts an expression of the form `(apply func (list arg1 arg2 ...))`
;; Into `(func arg1 arg2 ...)`
(cons 'table (for/list ([html-row (in-list html-rows)])
(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")))))
(define (pdf-thumbnail-link pdf-pathstring)
(define img-extension "gif")
(define img-pathstring (->string (add-ext (remove-ext pdf-pathstring) img-extension)))
(define sips-command
(format "sips -Z 2000 -s format ~a --out '~a' '~a' > /dev/null"
img-extension img-pathstring pdf-pathstring))
(let ([result (system sips-command)])
(if result
(link pdf-pathstring `(img ((src ,img-pathstring))))
(error 'pdf-thumbnail-link "sips failed"))))
(define (pdf-thumbnail-link-from-metas metas)
(define-values (dir fn _) (split-path (add-ext (remove-ext* (hash-ref metas 'here-path)) "pdf")))
(pdf-thumbnail-link (->string fn)))
(define (before-and-after-pdfs base-name)
`(div
(div ((class "pdf-thumbnail"))
"before" (br)
,(pdf-thumbnail-link (format "pdf/sample-doc-~a-before.pdf" base-name)))
(div ((class "pdf-thumbnail"))
"after" (br)
,(pdf-thumbnail-link (format "pdf/sample-doc-~a-after.pdf" base-name)))))
(define (alternate-after-pdf base-name)
`(div ((class "pdf-thumbnail"))
"after (alternate)" (br)
,(pdf-thumbnail-link (format "pdf/sample-doc-~a-after-alternate.pdf" base-name))))
(define omission (make-default-tag-function 'div #:class "omission"))
(define no-hyphens-attr '(hyphens "none"))
(define (root . xs)
;; process paragraphs first so that they're treated as block-txexprs in next phase.
(define elements-with-paragraphs (decode-elements xs #:txexpr-elements-proc detect-paragraphs))
`(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))))
(define (hyphenate-block block-tx)
;; attach hyphenate as a block processor rather than string processor
@ -662,6 +865,7 @@ But to be safe, we'll raise an arity error if we get too many arguments.
#:min-right-length 3
#:omit-txexpr no-hyphens?))
(define (hangable-quotes str)
(define strs (regexp-match* #px"\\s?[“‘]" str #:gap-select? #t))
(if (= (length strs) 1) ; no submatches
@ -685,44 +889,40 @@ But to be safe, we'll raise an arity error if we get too many arguments.
[str (regexp-replace* #px"—[\u00A0\u2009\\s](?=\\w)" str "")])
str))
(define (root . xs)
;; process paragraphs first so that they're treated as block-txexprs in next phase.
(define elements-with-paragraphs (decode-elements xs #:txexpr-elements-proc detect-paragraphs))
`(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))))
#|
`capitalize-first-letter`: utility function for use in HTML templates.
|#
(define (capitalize-first-letter str)
(regexp-replace #rx"^." str string-upcase))
(module+ test
(check-equal? (capitalize-first-letter "foo dog") "Foo dog"))
#|
Miscellaneous tag functions. Obvious at this point what they do.
|#
(define omission (make-default-tag-function 'div #:class "omission"))
(define mono (make-default-tag-function 'span #:class "mono"))
(define font-details (make-default-tag-function 'div #:class "font-details"))
(define mb-font-specimen
(make-default-tag-function 'div #:class "mb-font-specimen" #:contenteditable "true"))
(define (margin-note . xs)
`(div ((class "margin-note") ,no-hyphens-attr) ,@xs))
(define os (make-default-tag-function 'span #:class "os"))
(define (gap [size 1.5])
`(div ((style ,(format "height: ~arem" size)))))
(define (center . xs)
`(div ((style "text-align:center")) ,@xs))
(define (map-tag tag-name elems)
(map (curry list tag-name) elems))
(define (map-splicing-tag tag-name elems)
(map (curry cons tag-name) elems))
(define (tabulate celled-rows)
(define header-row (car celled-rows))
(define other-rows (cdr celled-rows))
`(table ,@(map-splicing-tag 'tr
(cons
(map-tag 'th header-row)
(for/list ([celled-row (in-list other-rows)])
(map-tag 'td celled-row))))))
(define (quick-table . xs)
(define rows (filter-not whitespace? xs))
(define celled-rows
(for/list ([row (in-list rows)])
(map (λ(cell) (string-trim cell)) (string-split row "|"))))
(tabulate celled-rows))
(define (indented #:hyphenate [hyphenate #t] . xs)
`(p ((class "indented"),@(if (not hyphenate) (list no-hyphens-attr) null)) ,@xs))
@ -736,53 +936,6 @@ But to be safe, we'll raise an arity error if we get too many arguments.
(tr (td ((style "text-align:left")) ,@xs) (td ,(caption name)))))
(define mono (make-default-tag-function 'span #:class "mono"))
(define/contract (pdf-thumbnail-link pdf-pathstring)
(path-string? . -> . any/c)
(define img-extension "gif")
(define img-pathstring (->string (add-ext (remove-ext pdf-pathstring) img-extension)))
(define sips-command
(format "sips -Z 2000 -s format ~a --out '~a' '~a' > /dev/null"
img-extension img-pathstring pdf-pathstring))
(let ([result (system sips-command)])
(if result
(link pdf-pathstring `(img ((src ,img-pathstring))))
(error 'pdf-thumbnail-link "sips failed"))))
(define (pdf-thumbnail-link-from-metas metas)
(define-values (dir fn _) (split-path (add-ext (remove-ext* (hash-ref metas 'here-path)) "pdf")))
(pdf-thumbnail-link (->string fn)))
(define (before-and-after-pdfs base-name)
`(div
(div ((class "pdf-thumbnail"))
"before" (br)
,(pdf-thumbnail-link (format "pdf/sample-doc-~a-before.pdf" base-name)))
(div ((class "pdf-thumbnail"))
"after" (br)
,(pdf-thumbnail-link (format "pdf/sample-doc-~a-after.pdf" base-name)))))
(define (alternate-after-pdf base-name)
`(div ((class "pdf-thumbnail"))
"after (alternate)" (br)
,(pdf-thumbnail-link (format "pdf/sample-doc-~a-after-alternate.pdf" base-name))))
(define (random-select . xs)
(list-ref xs (random (length xs))))
(define font-details (make-default-tag-function 'div #:class "font-details"))
(define mb-font-specimen
(make-default-tag-function 'div #:class "mb-font-specimen" #:contenteditable "true"))
(define (margin-note . xs)
`(div ((class "margin-note") ,no-hyphens-attr) ,@xs))
(define os (make-default-tag-function 'span #:class "os"))
(define (capitalize-first-letter str)
(regexp-replace #rx"^." str string-upcase))