From ab1d3fd5e3f2afefd1bdcd61ee6a8018b2a8e741 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 14 Dec 2015 16:11:59 -0800 Subject: [PATCH] refactoring & commentary --- pollen.rkt | 373 +++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 263 insertions(+), 110 deletions(-) diff --git a/pollen.rkt b/pollen.rkt index b8a39bb..243cd63 100644 --- a/pollen.rkt +++ b/pollen.rkt @@ -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

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)) \ No newline at end of file