undisturbed

quad/quadwriter/debug.rkt

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

quad/quadwriter/param.rkt

@@ -1,6 +1,12 @@
 #lang debug racket
 (provide (all-defined-out))
 (define current-doc (make-parameter #false))
+(define current-section (make-parameter #false))
+(define current-page (make-parameter #false))
+(define current-column (make-parameter #false))
+(define current-block (make-parameter #false))
+(define current-line (make-parameter #false))
+
 (define current-pdf (make-parameter #false))
 (define current-line-wrap (make-parameter #f)) ; because kp is slow and maybe we want to disable for "draft" mode
 (define section-pages-used (make-parameter 0))

quad/quadwriter/query.rkt

@@ -1,27 +1,43 @@
 #lang debug racket
-(require quad/base "struct.rkt")
+(require quad/base "struct.rkt" "param.rkt")
 (provide (all-defined-out))
 
 (define (make-linear-index q)
   (cons q (append* (for/list ([elem (in-list (quad-elems q))]
-                                   #:when (quad? elem))
+                              #:when (quad? elem))
-                          (make-linear-index elem)))))
+                             (make-linear-index elem)))))
 
-(define (string->pred str)
+(define (string->key str #:this [this? #false])
   (match str
-    ["doc" doc-quad?]
+    ["doc" 'doc]
-    [(or "section" "sec" "s") section-quad?]
+    [(or "section" "sec" "s") 'section]
-    [(or "page" "pg" "p") page-quad?]
+    [(or "page" "pg" "p") 'page]
-    [(or "column" "col" "c") column-quad?]
+    [(or "column" "col" "c") 'column]
-    [(or "block" "b") block-quad?]
+    [(or "block" "b") 'block]
-    [(or "line" "ln" "l") line-quad?]))
+    [(or "line" "ln" "l") 'line]))
+
+(define preds (hasheq 'doc doc-quad?
+                      'section section-quad?
+                      'page page-quad?
+                      'column column-quad?
+                      'block block-quad?
+                      'line line-quad?))
+
+(define quad-params (hasheq 'doc current-doc
+                      'section current-section
+                      'page current-page
+                      'column current-column
+                      'block current-block
+                      'line current-line))
 
 (define (parse-query str)
   (for/list ([piece (in-list (string-split str ":"))])
-    (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
+            (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
-      [#false (cons (string->pred piece) #false)]
+              [#false (cons (string->key piece) #false)]
-      [(list all name arg) (cons (string->pred name) (or (string->number arg)
+              [(list _ name "this") (cons (let ([quad-param-val ((hash-ref quad-params (string->key name)))])
-                                                         (string->symbol arg)))])))
+                                            (λ (q) (eq? q quad-param-val))) 1)]
+              [(list _ name arg) (cons (hash-ref preds (string->key name)) (or (string->number arg)
+                                                                               (string->symbol arg)))])))
 
 (define (query quad-or-index query-str)
   (for/fold ([qs (match quad-or-index
@@ -45,12 +61,12 @@
   (define-syntax-rule (factory type proc)
     (make-quad #:type type
                #:elems (for/list ([i (in-range 3)])
-                         (set! counter (add1 counter))
+                                 (set! counter (add1 counter))
-                         (define new-q (proc))
+                                 (define new-q (proc))
-                         (quad-update! new-q
+                                 (quad-update! new-q
-                                       [tag (format "~a[~a]-~a" 'proc counter (gensym))])
+                                               [tag (format "~a[~a]-~a" 'proc counter (gensym))])
-                         (hash-set! (quad-attrs new-q) 'count counter)
+                                 (hash-set! (quad-attrs new-q) 'count counter)
-                         new-q)))
+                                 new-q)))
 
   (define (line) (make-quad #:type line-quad))
   (define (block) (factory block-quad line))

quad/quadwriter/render.rkt

@@ -403,6 +403,7 @@
 
 (define (resolve-parents doc)
   (define (wants-parent? x) (and (quad? x) (quad-ref x :anchor-parent)))
+  ;; extract the quads that want parents
   (define parent-wanter-acc null)
   (let loop ([x doc])
     (match x
@@ -413,6 +414,7 @@
                    (quad-update! x [elems others]))
                  (map loop others)]
       [_ x]))
+  ;; then put them where they want to go
   (define linearized-qs (make-linear-index doc))
   (for* ([wp (in-list parent-wanter-acc)]
          [query-str (in-value (quad-ref wp :anchor-parent))]