propagate attrs correctly; make footer hideable

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
                       ))

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)

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)))