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

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