diff --git a/quad/quadwriter/debug.rkt b/quad/quadwriter/debug.rkt index 258bf1e3..962202fd 100644 --- a/quad/quadwriter/debug.rkt +++ b/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)) diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt index ff1b91fd..9c572f4d 100644 --- a/quad/quadwriter/param.rkt +++ b/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)) diff --git a/quad/quadwriter/query.rkt b/quad/quadwriter/query.rkt index 63a7acd5..4e6628cc 100644 --- a/quad/quadwriter/query.rkt +++ b/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)) - (make-linear-index elem))))) + #:when (quad? elem)) + (make-linear-index elem))))) -(define (string->pred str) +(define (string->key str #:this [this? #false]) (match str - ["doc" doc-quad?] - [(or "section" "sec" "s") section-quad?] - [(or "page" "pg" "p") page-quad?] - [(or "column" "col" "c") column-quad?] - [(or "block" "b") block-quad?] - [(or "line" "ln" "l") line-quad?])) + ["doc" 'doc] + [(or "section" "sec" "s") 'section] + [(or "page" "pg" "p") 'page] + [(or "column" "col" "c") 'column] + [(or "block" "b") 'block] + [(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) - [#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->key piece) #false)] + [(list _ name "this") (cons (let ([quad-param-val ((hash-ref quad-params (string->key name)))]) + (λ (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)) - (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)) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index f7ce4374..11dc0f01 100644 --- a/quad/quadwriter/render.rkt +++ b/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))]