From 0006c02a10ebe6826bed52d7bf4fabc1752912ac Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 4 Jun 2019 14:11:11 -0700 Subject: [PATCH] fix breakage --- quad/quadwriter/core.rkt | 1 + quad/quadwriter/markdown.rkt | 6 ++-- quad/quadwriter/render.rkt | 69 ++++++++++++++++++++++-------------- quad/quadwriter/tags.rkt | 3 +- 4 files changed, 48 insertions(+), 31 deletions(-) diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index 11cb2bb1..f1d57292 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -7,6 +7,7 @@ line-break page-break column-break + hr-break q:para-break q:line-break q:page-break diff --git a/quad/quadwriter/markdown.rkt b/quad/quadwriter/markdown.rkt index 9530d4be..c610aff6 100644 --- a/quad/quadwriter/markdown.rkt +++ b/quad/quadwriter/markdown.rkt @@ -23,9 +23,9 @@ ;; markdown parser returns list of paragraphs (root null (match strs [(list str) strs] - [_ (add-between strs (list q:para-break) - #:before-first (list q:para-break) - #:after-last (list q:para-break) + [_ (add-between strs (list para-break) + #:before-first (list para-break) + #:after-last (list para-break) #:splice? #true)]))) (make-module-begin doc-proc) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index a53f70d7..4ae7425f 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -1,5 +1,6 @@ #lang debug racket/base -(require racket/match +(require (for-syntax racket/base racket/syntax) + racket/match txexpr/base racket/contract racket/file @@ -21,35 +22,51 @@ (define (setup-pdf-path pdf-path-arg) (define fallback-path (build-path (find-system-path 'temp-dir) "quadwriter-temp.pdf")) (path->complete-path (simplify-path (expand-user-path (->path (or pdf-path-arg fallback-path)))))) - +#| (define para-break '(q ((break "para")))) (define line-break '(q ((break "line")))) (define page-break '(q ((break "page")))) (define column-break '(q ((break "column")))) +(define hr-break '(q ((break "hr")))) +|# + + +(define-syntax (define-break-types stx) + (syntax-case stx () + [(_ ALL-BREAKS-ID . TYPES) + (with-syntax ([((TYPE-BREAK TYPE-STR Q:TYPE-BREAK) ...) + (for/list ([type (in-list (syntax->list #'TYPES))]) + (list + (format-id #'TYPES "~a-break" type) + (symbol->string (syntax->datum type)) + (format-id #'TYPES "q:~a-break" type)))]) + #'(begin + (define TYPE-BREAK '(q ((break TYPE-STR)))) ... + (define ALL-BREAKS-ID (list (cons TYPE-BREAK Q:TYPE-BREAK) ...))))])) + +(define-break-types all-breaks para line page column hr) (define (replace-breaks x) (map-elements (λ (el) - (match el - [(== para-break) q:para-break] - [(== line-break) q:line-break] - [(== column-break) q:column-break] - [(== page-break) q:page-break] - [_ el])) x)) + (cond + [(assoc el all-breaks) => cdr] + [else el])) x)) + (define (handle-hyphenate qs) ;; find quads that want hyphenation and split them into smaller pieces ;; do this before ->string-quad so that it can handle the sizing promises (apply append (for/list ([q (in-list qs)]) - (match (quad-ref q :hyphenate) - [#false (list q)] - [_ (for*/list ([str (in-list (quad-elems q))] - [hyphen-char (in-value #\u00AD)] - [hstr (in-value (hyphenate str hyphen-char - #:min-left-length 3 - #:min-right-length 3))] - [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) - (struct-copy quad q [elems (list substr)]))])))) + (match (quad-ref q :hyphenate) + [#false (list q)] + [_ (for*/list ([str (in-list (quad-elems q))] + [hyphen-char (in-value #\u00AD)] + [hstr (in-value (hyphenate str hyphen-char + #:min-left-length 3 + #:min-right-length 3))] + [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) + (struct-copy quad q [elems (list substr)]))])))) (define (handle-cascading-attrs attrs) (resolve-font-path attrs) @@ -66,12 +83,12 @@ (setup-font-path-table! pdf-path) [define atomized-qs (time-log atomize (atomize the-quad - #:attrs-proc handle-cascading-attrs - #:missing-glyph-action 'fallback - #:fallback "fallback" - #:emoji "emoji" - #:math "math" - #:font-path-resolver resolve-font-path))] + #:attrs-proc handle-cascading-attrs + #:missing-glyph-action 'fallback + #:fallback "fallback" + #:emoji "emoji" + #:math "math" + #:font-path-resolver resolve-font-path))] [define hyphenated-qs (time-log hyphenate (handle-hyphenate atomized-qs))] [define stringified-qs (map ->string-quad hyphenated-qs)] [define indented-qs (insert-first-line-indents stringified-qs)] @@ -81,9 +98,9 @@ ;; page size can be specified by name, or measurements. ;; explicit measurements from page-height and page-width supersede those from page-size. (match-define (list page-width page-height) (for/list ([k (list :page-width :page-height)]) - (match (quad-ref (car qs) k) - [#false #false] - [val (parse-dimension val 'round)]))) + (match (quad-ref (car qs) k) + [#false #false] + [val (parse-dimension val 'round)]))) ;; `make-pdf` will sort out conflicts among page dimensions (make-pdf #:compress compress? #:auto-first-page #false diff --git a/quad/quadwriter/tags.rkt b/quad/quadwriter/tags.rkt index b422d98e..9855ee20 100644 --- a/quad/quadwriter/tags.rkt +++ b/quad/quadwriter/tags.rkt @@ -26,8 +26,7 @@ :display (symbol->string (gensym))) attrs) exprs)) -(define-tag-function (hr attrs exprs) - q:hr-break) +(define-tag-function (hr attrs exprs) hr-break) (define-tag-function (blockquote attrs exprs) (qexpr (append (list->attrs