start query

quad/quad/qexpr.rkt

@@ -40,7 +40,7 @@
   (check-true (qexpr? '(quad "Hello world")))
   (check-true (qexpr? `(quad "Hello " ,(q "world")))))
 
-(define (quad-name q) (string->symbol (string-trim (symbol->string (object-name q)) "$")))
+(define (quad-qexpr-name q) (string->symbol (string-trim (symbol->string (object-name q)) "$")))
 
 (define (qexpr #:clean-attrs? [clean-attrs? #f]
                #:name [name 'q]
@@ -67,7 +67,7 @@
 (define (quad->qexpr q)
   (let loop ([x q])
     (cond
-      [(quad? x) (apply qexpr #:name (quad-name x) #:clean-attrs? #t (hash->qattrs (quad-attrs x)) (map loop (quad-elems x)))]
+      [(quad? x) (apply qexpr #:name (quad-qexpr-name x) #:clean-attrs? #t (hash->qattrs (quad-attrs x)) (map loop (quad-elems x)))]
       [else x])))
 
 (define (qexpr->quad x)

quad/quad/quad.rkt

@@ -74,6 +74,7 @@
               draw-start ; func called at the beginning of every draw event (for setup ops)
               draw ; func called in the middle of every daw event
               draw-end ; func called at the end of every draw event (for teardown ops)
+              name ; for anchor resolution
               tag) ; from q-expr, maybe
   #:mutable
   #:transparent
@@ -166,6 +167,7 @@
          #:draw-start [draw-start void]
          #:draw [draw default-draw]
          #:draw-end [draw-end void]
+         #:name [name #f]
          . args)
   (unless (andmap (λ (x) (not (pair? x))) elems)
     (raise-argument-error 'make-quad "elements that are not lists" elems))
@@ -188,7 +190,8 @@
                         printable
                         draw-start
                         draw
-                        draw-end))
+                        draw-end
+                        name))
           (apply type (append args
                               (list (or tag (string->symbol (~r (eq-hash-code args) #:base 36))))))]))
 

quad/quadwriter/debug.rkt

@@ -26,7 +26,7 @@
                        (define debug-column-gap (make-parameter 36)))]
                    [else
                     '(begin
-                       (define draw-debug? (make-parameter #false))
+                       (define draw-debug? (make-parameter #true))
                        (define draw-debug-line? (make-parameter #true))
                        (define draw-debug-block? (make-parameter #true))
                        (define draw-debug-string? (make-parameter #true))

quad/quadwriter/render.rkt

@@ -57,7 +57,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 +66,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)
+    (cons (match (first kv)
-                    [(? string? k) (string->bytes/utf-8 k)]
+            [(? string? k) (string->bytes/utf-8 k)]
-                    [k (raise-argument-error 'string->feature-list "string" k)])
+            [k (raise-argument-error 'string->feature-list "string" k)])
-                  (match (string->number (second kv))
+          (match (string->number (second kv))
-                    [(? number? num) num]
+            [(? number? num) num]
-                    [v (raise-argument-error 'string->feature-list "number string" v)]))))
+            [v (raise-argument-error 'string->feature-list "number string" v)]))))
 
 (define (parse-font-features! attrs)
   ;; `font-features` are OpenType font feature specifiers.
@@ -106,7 +106,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 +114,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
+    (hash-update! attrs k (λ (val) (match val
-                                        [(? string? str) (string-downcase str)]
+                                     [(? string? str) (string-downcase str)]
-                                        [_ val]))))
+                                     [_ val]))))
   attrs)
 
 (define (complete-every-path! attrs)
@@ -125,7 +125,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 +138,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.
@@ -160,11 +160,11 @@
     [else (convert-string-quad q)]))
 
 #;(define (extract-defined-quads qs)
-  (define (get-define-val q) (quad-ref q 'define))
+    (define (get-define-val q) (quad-ref q 'define))
-  (define-values (dqs not-dqs) (partition get-define-val qs))
+    (define-values (dqs not-dqs) (partition get-define-val qs))
-  (for ([dq-group (in-list (group-by get-define-val dqs))])
+    (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)
+    not-dqs)
 
 (define default-line-height-multiplier 1.42)
 (define (setup-qs qx-arg base-dir)
@@ -256,9 +256,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 +292,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
+    (define repeaters-for-this-page
-         (for/list ([repeater (in-list repeaters)]
+      (for/list ([repeater (in-list repeaters)]
-                    #:when (let* ([val (quad-ref repeater :page-repeat)]
+                 #:when (let* ([val (quad-ref repeater :page-repeat)]
-                                  [sym (string->symbol val)])
+                               [sym (string->symbol val)])
-                             (or (eq? sym 'all)
+                          (or (eq? sym 'all)
-                                 (eq? sym page-side)
+                              (eq? sym page-side)
-                                 (eq? sym (if (= page-num 1) 'first 'rest)))))
+                              (eq? sym (if (= page-num 1) 'first 'rest)))))
-                   repeater))
+        repeater))
-       (when (pair? repeaters-for-this-page)
+    (when (pair? repeaters-for-this-page)
-         (set-quad-elems! page (append repeaters-for-this-page (quad-elems page)))))
+      (set-quad-elems! page (append repeaters-for-this-page (quad-elems page)))))
   secs)
 
 (define (make-sections all-qs)
@@ -355,20 +355,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
+        (define section-repeaters-for-this-page
-                  (for/list ([repeater (in-list section-repeaters)]
+          (for/list ([repeater (in-list section-repeaters)]
-                             #:when (let* ([val (quad-ref repeater :page-repeat)]
+                     #:when (let* ([val (quad-ref repeater :page-repeat)]
-                                           [sym (string->symbol (string-trim val #px"section\\s"))])
+                                   [sym (string->symbol (string-trim val #px"section\\s"))])
-                                      (or (eq? sym 'section)
+                              (or (eq? sym 'section)
-                                          (eq? sym 'all)
+                                  (eq? sym 'all)
-                                          (eq? sym page-side)
+                                  (eq? sym page-side)
-                                          (eq? sym (if (= page-num 1) 'first 'rest)))))
+                                  (eq? sym (if (= page-num 1) 'first 'rest)))))
-                            repeater))
+            repeater))
-                (cond
+        (cond
-                  [(null? section-repeaters-for-this-page) page]
+          [(null? section-repeaters-for-this-page) page]
-                  [else
+          [else
-                   (quad-copy page-quad page
+           (quad-copy page-quad page
-                              [elems (append section-repeaters-for-this-page (quad-elems page))])])))
+                      [elems (append section-repeaters-for-this-page (quad-elems page))])])))
         
     (begin0
       (cond
@@ -400,6 +400,28 @@
               (cons new-section sections-acc)])
       (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))]))))            
+  doc)
+
 (define (correct-line-alignment doc)
   ;; correct lines with inner / outer alignment
   ;; all inner / outer lines are initially filled as if they were right-aligned
@@ -407,16 +429,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 right-side? (odd? (add1 page-idx)))
-        (define zero-filler-side (if right-side? "inner" "outer"))
+    (define zero-filler-side (if right-side? "inner" "outer"))
-        (let loop ([x page])
+    (let loop ([x page])
-          (cond
+      (cond
-            [(and (line-quad? x)
+        [(and (line-quad? x)
-                  (equal? zero-filler-side (quad-ref x :line-align))
+              (equal? zero-filler-side (quad-ref x :line-align))
-                  (filler-quad? (car (quad-elems x))))
+              (filler-quad? (car (quad-elems x))))
-             ;; collapse the filler quad by setting size to 0
+         ;; collapse the filler quad by setting size to 0
-             (set-quad-size! (car (quad-elems x)) (pt 0 0))]
+         (set-quad-size! (car (quad-elems x)) (pt 0 0))]
-            [(quad? x) (for-each loop (quad-elems x))])))
+        [(quad? x) (for-each loop (quad-elems x))])))
   doc)
 
 (define/contract (render-pdf qx-arg
@@ -474,7 +496,10 @@
     (setup-pdf-metadata! qs (current-pdf))
     ;; all the heavy lifting happens inside `make-sections`
     ;; which calls out to `make-pages`, `make-columns`, and so on.
-    (define doc (correct-line-alignment (quad-update! q:doc [elems (make-sections qs)])))
+    (define doc (let* ([doc (quad-update! q:doc [elems (make-sections qs)])]
+                       [doc (correct-line-alignment doc)]
+                       [doc (resolve-parents doc)])
+                  doc))
     ;; call `position` and `draw` separately so we can print a timer for each
     (define positioned-doc (time-log position (position doc)))
     ;; drawing implies that a PDF is written to disk