From eade6fe5808b53cbc621dda86130c64a94be0045 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 26 May 2019 10:45:38 -0700 Subject: [PATCH] propagate attrs correctly; make footer hideable --- quad/quadwriter/attrs.rkt | 12 ++++++++++++ quad/quadwriter/core.rkt | 32 ++++++++++++++++---------------- quad/quadwriter/tags.rkt | 9 +++++++-- 3 files changed, 35 insertions(+), 18 deletions(-) diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt index 5c14d0ee..2869e254 100644 --- a/quad/quadwriter/attrs.rkt +++ b/quad/quadwriter/attrs.rkt @@ -30,6 +30,16 @@ Naming guidelines [(regexp #rx"mm") (compose1 in->pts cm->in mm->cm)]) (string->number num-string))])])) (if round? (inexact->exact (floor val)) val)) +(define (copy-block-attrs source-hash dest-hash) + (define new-hash (make-hasheq)) + (for ([(k v) (in-hash dest-hash)]) + (hash-set! new-hash k v)) + (for* ([k (in-list block-attrs)] + [v (in-value (hash-ref source-hash k #f))] + #:when v) + (hash-set! new-hash k v)) + new-hash) + (define block-attrs '(display ;; inset values increase the layout size of the quad. ;; they are relative to the natural layout box. @@ -88,4 +98,6 @@ Naming guidelines page-margin-bottom page-margin-left page-margin-right + + footer-display )) \ No newline at end of file diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index 7117d798..7f704545 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -186,13 +186,6 @@ (check-true (q:line-break? (second (quad-elems (q "foo" pbr "bar"))))) (check-true (q:line-break? (second (atomize (q "foo" pbr "bar")))))) -(define (copy-block-attrs source-hash dest-hash) - (for* ([k (in-list block-attrs)] - [v (in-value (hash-ref source-hash k #f))] - #:when v) - (hash-set! dest-hash k v)) - dest-hash) - (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 @@ -328,7 +321,7 @@ (list (struct-copy quad line-q - ;; move block attrs up, so they are visible in page wrap + ;; move block attrs up, so they are visible in col wrap [attrs (copy-block-attrs (quad-attrs elem) (hash-copy (quad-attrs line-q)))] ;; line width is static @@ -567,6 +560,9 @@ (define ((col-finish-wrap col-quad) lns . _) (list (struct-copy quad col-quad + ;; move block attrs up, so they are visible in page wrap + [attrs (copy-block-attrs (quad-attrs (car lns)) + (hash-copy (quad-attrs col-quad)))] [elems (from-parent (insert-blocks lns) 'nw)]))) (define (col-wrap qs vertical-height col-gap [col-quad q:column]) @@ -593,14 +589,18 @@ col-spacer)) (define ((page-finish-wrap page-quad path) cols q0 q page-idx) - (define-values (dir name _) (split-path (path-replace-extension path #""))) - (define footer (struct-copy quad q:footer - [attrs (let ([h (hash-copy (quad-attrs q:footer))]) - (hash-set! h 'page-number page-idx) - (hash-set! h 'doc-title (string-titlecase (path->string name))) - h)])) - (list (struct-copy quad page-quad - [elems (cons footer (from-parent cols 'nw))]))) + (define elems + (match (quad-ref (car cols) 'footer-display "true") + [(or "false" "none") (from-parent cols 'nw)] + [_ + (define-values (dir name _) (split-path (path-replace-extension path #""))) + (define footer (struct-copy quad q:footer + [attrs (let ([h (hash-copy (quad-attrs q:footer))]) + (hash-set! h 'page-number page-idx) + (hash-set! h 'doc-title (string-titlecase (path->string name))) + h)])) + (cons footer (from-parent cols 'nw))])) + (list (struct-copy quad page-quad [elems elems]))) (define (page-wrap qs width [page-quad q:page]) (unless (positive? width) diff --git a/quad/quadwriter/tags.rkt b/quad/quadwriter/tags.rkt index f35fa5db..4caf2723 100644 --- a/quad/quadwriter/tags.rkt +++ b/quad/quadwriter/tags.rkt @@ -7,7 +7,8 @@ racket/dict racket/match txexpr/base - "font.rkt") + "font.rkt" + "attrs.rkt") (provide (all-defined-out)) (define (root attrs exprs) @@ -101,6 +102,10 @@ (define new-bullet-quad (match exprs [(cons (txexpr _ attrs _) _) (match bullet-quad - [(txexpr tag battrs elems) (txexpr tag (append attrs battrs) elems)])] + [(txexpr tag battrs elems) + (define new-attrs + (hash->attrs + (copy-block-attrs (attrs->hash attrs) (attrs->hash battrs)))) + (txexpr tag new-attrs elems)])] [_ bullet-quad])) (qexpr attrs (cons new-bullet-quad exprs))) \ No newline at end of file