closer

quad/quadwriter/query.rkt

@@ -3,7 +3,9 @@
 (provide (all-defined-out))
 
 (define (make-linear-index q)
-  (cons q (append-map make-linear-index (quad-elems q))))
+  (if (quad? q)
+      (cons q (append-map make-linear-index (quad-elems q)))
+      null))
 
 (define (string->pred str)
   (match str
@@ -16,13 +18,13 @@
 
 (define (parse-query str)
   (for/list ([piece (in-list (string-split str ":"))])
-    (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
-      [#false (cons (string->pred piece) #false)]
-      [(list all name arg) (cons (string->pred name) (or (string->number arg)
-                                                         (string->symbol arg)))])))
+            (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
+              [#false (cons (string->pred piece) #false)]
+              [(list all name arg) (cons (string->pred name) (or (string->number arg)
+                                                                 (string->symbol arg)))])))
 
-(define (query q query-str)
-  (for/fold ([qs (make-linear-index q)]
+(define (query qs query-str)
+  (for/fold ([qs qs]
              #:result (and qs (car qs)))
             ([query-piece (in-list (parse-query query-str))])
     (match-define (cons pred count) query-piece)
@@ -41,12 +43,12 @@
   (define-syntax-rule (factory type proc)
     (make-quad #:type type
                #:elems (for/list ([i (in-range 3)])
-                         (set! counter (add1 counter))
-                         (define new-q (proc))
-                         (quad-update! new-q
-                                       [tag (format "~a[~a]-~a" 'proc counter (gensym))])
-                         (hash-set! (quad-attrs new-q) 'count counter)
-                         new-q)))
+                                 (set! counter (add1 counter))
+                                 (define new-q (proc))
+                                 (quad-update! new-q
+                                               [tag (format "~a[~a]-~a" 'proc counter (gensym))])
+                                 (hash-set! (quad-attrs new-q) 'count counter)
+                                 new-q)))
 
   (define (line) (make-quad #:type line-quad))
   (define (block) (factory block-quad line))

quad/quadwriter/render.rkt

@@ -28,7 +28,8 @@
          "doc.rkt"
          "column.rkt"
          "keep.rkt"
-         "debug.rkt")
+         "debug.rkt"
+         "query.rkt")
 (provide (all-defined-out))
 
 
@@ -57,7 +58,7 @@
                                             #: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)]))]
+                (struct-copy quad q [elems (list substr)]))]
     [else (list q)]))
 
 
@@ -66,12 +67,12 @@
   (unless (even? (length pcs))
     (raise-argument-error 'string->feature-list "even number of tags and values" pcs))
   (for/list ([kv (in-slice 2 pcs)])
-    (cons (match (first kv)
-            [(? string? k) (string->bytes/utf-8 k)]
-            [k (raise-argument-error 'string->feature-list "string" k)])
-          (match (string->number (second kv))
-            [(? number? num) num]
-            [v (raise-argument-error 'string->feature-list "number string" v)]))))
+            (cons (match (first kv)
+                    [(? string? k) (string->bytes/utf-8 k)]
+                    [k (raise-argument-error 'string->feature-list "string" k)])
+                  (match (string->number (second kv))
+                    [(? number? num) num]
+                    [v (raise-argument-error 'string->feature-list "number string" v)]))))
 
 (define (parse-font-features! attrs)
   ;; `font-features` are OpenType font feature specifiers.
@@ -106,7 +107,7 @@
   ;; we parse them into the equivalent measurement in points.
   (for ([k (in-hash-keys attrs)]
         #:when (takes-dimension-string? k))
-    (hash-update! attrs k (λ (val) (parse-dimension val attrs))))
+       (hash-update! attrs k (λ (val) (parse-dimension val attrs))))
   attrs)
 
 (define (downcase-values! attrs)
@@ -114,9 +115,9 @@
   ;; so we can check them more easily later.
   (for ([k (in-hash-keys attrs)]
         #:unless (has-case-sensitive-value? k))
-    (hash-update! attrs k (λ (val) (match val
-                                     [(? string? str) (string-downcase str)]
-                                     [_ val]))))
+       (hash-update! attrs k (λ (val) (match val
+                                        [(? string? str) (string-downcase str)]
+                                        [_ val]))))
   attrs)
 
 (define (complete-every-path! attrs)
@@ -125,7 +126,7 @@
   ;; relies on `current-directory` being parameterized to source file's dir
   (for ([k (in-hash-keys attrs)]
         #:when (takes-path? k))
-    (hash-update! attrs k (compose1 path->string path->complete-path)))
+       (hash-update! attrs k (compose1 path->string path->complete-path)))
   attrs)
 
 (define (handle-cascading-attrs attrs)
@@ -138,7 +139,7 @@
                              ;; because they can be denoted relative to em size
                              parse-dimension-strings!
                              parse-font-features!))])
-    (proc attrs)))
+       (proc attrs)))
 
 (define (drop-leading-breaks qs)
   ;; any leading breaks are pointless at the start of the doc, so drop them.
@@ -163,7 +164,7 @@
     (define (get-define-val q) (quad-ref q 'define))
     (define-values (dqs not-dqs) (partition get-define-val qs))
     (for ([dq-group (in-list (group-by get-define-val dqs))])
-      (hash-set! (current-named-quads) (get-define-val (car dq-group)) dq-group))
+         (hash-set! (current-named-quads) (get-define-val (car dq-group)) dq-group))
     not-dqs)
 
 (define default-line-height-multiplier 1.42)
@@ -256,9 +257,9 @@
                                            (cons :pdf-keywords 'Keywords)))]
                  [str (in-value (and (pair? qs) (quad-ref (car qs) k)))]
                  #:when str)
-       (cons pdf-k str))))
+                (cons pdf-k str))))
   (for ([(k v) (in-dict kv-dict)])
-    (hash-set! (pdf-info pdf) k v)))
+       (hash-set! (pdf-info pdf) k v)))
 
 (define (footnote-flow? q) (equal? (quad-ref q 'flow) "footnote"))
 
@@ -292,19 +293,19 @@
   (for ([page (in-list (for*/list ([sec (in-list secs)]
                                    [elem (in-list (quad-elems sec))]
                                    #:when (page-quad? elem))
-                         elem))]
+                                  elem))]
         [page-num (in-naturals 1)]
         [page-side (in-cycle '(right left))])
-    (define repeaters-for-this-page
-      (for/list ([repeater (in-list repeaters)]
-                 #:when (let* ([val (quad-ref repeater :page-repeat)]
-                               [sym (string->symbol val)])
-                          (or (eq? sym 'all)
-                              (eq? sym page-side)
-                              (eq? sym (if (= page-num 1) 'first 'rest)))))
-        repeater))
-    (when (pair? repeaters-for-this-page)
-      (set-quad-elems! page (append repeaters-for-this-page (quad-elems page)))))
+       (define repeaters-for-this-page
+         (for/list ([repeater (in-list repeaters)]
+                    #:when (let* ([val (quad-ref repeater :page-repeat)]
+                                  [sym (string->symbol val)])
+                             (or (eq? sym 'all)
+                                 (eq? sym page-side)
+                                 (eq? sym (if (= page-num 1) 'first 'rest)))))
+                   repeater))
+       (when (pair? repeaters-for-this-page)
+         (set-quad-elems! page (append repeaters-for-this-page (quad-elems page)))))
   secs)
 
 (define (make-sections all-qs)
@@ -355,20 +356,20 @@
       (for/list ([page (in-list section-pages-without-repeaters)]
                  [page-num (in-naturals 1)]
                  [page-side (in-cycle ((if (eq? section-starting-side 'right) values reverse) '(right left)))])
-        (define section-repeaters-for-this-page
-          (for/list ([repeater (in-list section-repeaters)]
-                     #:when (let* ([val (quad-ref repeater :page-repeat)]
-                                   [sym (string->symbol (string-trim val #px"section\\s"))])
-                              (or (eq? sym 'section)
-                                  (eq? sym 'all)
-                                  (eq? sym page-side)
-                                  (eq? sym (if (= page-num 1) 'first 'rest)))))
-            repeater))
-        (cond
-          [(null? section-repeaters-for-this-page) page]
-          [else
-           (quad-copy page-quad page
-                      [elems (append section-repeaters-for-this-page (quad-elems page))])])))
+                (define section-repeaters-for-this-page
+                  (for/list ([repeater (in-list section-repeaters)]
+                             #:when (let* ([val (quad-ref repeater :page-repeat)]
+                                           [sym (string->symbol (string-trim val #px"section\\s"))])
+                                      (or (eq? sym 'section)
+                                          (eq? sym 'all)
+                                          (eq? sym page-side)
+                                          (eq? sym (if (= page-num 1) 'first 'rest)))))
+                            repeater))
+                (cond
+                  [(null? section-repeaters-for-this-page) page]
+                  [else
+                   (quad-copy page-quad page
+                              [elems (append section-repeaters-for-this-page (quad-elems page))])])))
         
     (begin0
       (cond
@@ -401,25 +402,13 @@
       (section-pages-used (+ (section-pages-used) (length section-pages))))))
 
 (define (resolve-parents doc)
-  ;; resolve location of any quad with a dynamic anchor-parent attribute like @line:1
-  (for* ([section (in-list (quad-elems doc))]
-         [(page page-idx) (in-indexed (quad-elems section))]
-         #:when (page-quad? page))
-    (define unresolved-qs
-      (let loop ([x page])
-        (match x
-          [(? quad?) ((if (quad-ref x :anchor-parent)
-                          (λ (tail) (cons x tail))
-                          values) (append-map loop (quad-elems x)))]
-          [_ null])))
-    (for ([line (in-list (quad-elems page))]
-          [line-num (in-naturals 1)]
-          #:when (line-quad? line))
-      (define line-key (format "@line:~a" line-num))
-      #R line-key
-      (for ([uq (in-list unresolved-qs)]
-            #:when (equal? (quad-ref uq :anchor-parent) line-key))
-        (quad-update! line [elems (append (quad-elems line) (list uq))]))))            
+  (define linearized-qs (make-linear-index doc))
+  (for* ([q (in-list linearized-qs)]
+         [query-str (in-value (quad-ref q :anchor-parent))]
+         #:when query-str
+         [parent (in-value (query linearized-qs query-str))]
+         #:when parent)
+        (quad-update! parent [elems (append (quad-elems parent) (list q))]))
   doc)
 
 (define (correct-line-alignment doc)
@@ -429,16 +418,16 @@
   (for* ([section (in-list (quad-elems doc))]
          [(page page-idx) (in-indexed (quad-elems section))]
          #:when (page-quad? page))
-    (define right-side? (odd? (add1 page-idx)))
-    (define zero-filler-side (if right-side? "inner" "outer"))
-    (let loop ([x page])
-      (cond
-        [(and (line-quad? x)
-              (equal? zero-filler-side (quad-ref x :line-align))
-              (filler-quad? (car (quad-elems x))))
-         ;; collapse the filler quad by setting size to 0
-         (set-quad-size! (car (quad-elems x)) (pt 0 0))]
-        [(quad? x) (for-each loop (quad-elems x))])))
+        (define right-side? (odd? (add1 page-idx)))
+        (define zero-filler-side (if right-side? "inner" "outer"))
+        (let loop ([x page])
+          (cond
+            [(and (line-quad? x)
+                  (equal? zero-filler-side (quad-ref x :line-align))
+                  (filler-quad? (car (quad-elems x))))
+             ;; collapse the filler quad by setting size to 0
+             (set-quad-size! (car (quad-elems x)) (pt 0 0))]
+            [(quad? x) (for-each loop (quad-elems x))])))
   doc)
 
 (define/contract (render-pdf qx-arg