diff --git a/quad/quad/atomize.rkt b/quad/quad/atomize.rkt index d6bf6bce..3e62b07c 100644 --- a/quad/quad/atomize.rkt +++ b/quad/quad/atomize.rkt @@ -18,14 +18,16 @@ ;; also drop leading & trailing whitespaces ;; (same behavior as web browsers) (define (white-aq? aq) (char-whitespace? (car (qe aq)))) - (let loop ([acc null][aqs aqs]) - (if (null? aqs) - (trimf (flatten acc) white-aq?) - (let*-values ([(ws rest) (splitf-at aqs white-aq?)] - [(bs rest) (splitf-at rest (negate white-aq?))]) - (loop (list acc (match ws - [(list ($quad attrs elems) rest ...) (break attrs #\space)] - [else null]) bs) rest))))) + (let loop ([acc null][aqs aqs]) + (if (null? aqs) + (flatten acc) + (let*-values ([(bs rest) (splitf-at aqs (negate white-aq?))] + [(ws rest) (splitf-at rest white-aq?)]) + (loop (list acc bs (if (and (pair? rest) ;; we precede bs (only #t if rest starts with bs, because we took the ws) + (pair? bs) ;; we follow bs + (pair? ws)) ;; we have ws + (break (qa (car ws)) #\space) + null)) rest))))) (module+ test (check-equal? (merge-whitespace (list (q #\space) (q #\newline) (q #\H) (q #\space) (q #\newline) (q #\space) (q #\i) (q #\newline))) diff --git a/quad/quad/break.rkt b/quad/quad/break.rkt index d48f1287..b460a357 100644 --- a/quad/quad/break.rkt +++ b/quad/quad/break.rkt @@ -1,10 +1,10 @@ -#lang sugar/debug racket/base +#lang debug racket/base (require racket/contract racket/list txexpr sugar/debug racket/promise - "param.rkt" "qexpr.rkt" "atomize.rkt") + "param.rkt" "qexpr.rkt" "atomize.rkt" "quad.rkt") (module+ test (require rackunit)) -(define/contract (break xs-in [target-size (current-line-width)]) - (((listof (or/c promise? procedure?))) (integer?) . ->* . (listof any/c)) +(define/contract (breaks xs-in [target-size (current-line-width)]) + (((listof atomic-quad?)) (integer?) . ->* . (listof any/c)) (define last-breakpoint-k #f) (define (capture-k!) (let/cc k (set! last-breakpoint-k k) #f)) (for/fold ([xs null] @@ -12,7 +12,8 @@ [size-so-far 0] #:result (reverse xs)) ([(x idx) (in-indexed xs-in)]) - (define-values (size-start size-mid size-end breakability) (if (promise? x) (force x) (x))) + (define-values (size-start size-mid size-end breakability) (let ([x (hash-ref (qa x) 'size)]) + (if (promise? x) (force x) (x)))) (cond [(not break-open?) (values (cons #f xs) #t (+ size-so-far size-start))] [(<= (+ size-so-far size-end) target-size) ;; check condition based on size-end (as if x were breakpoint) ... @@ -31,35 +32,35 @@ [else (values (cons #t xs) #t size-start)]))) ;; fallback if no last-breakpoint-k exists ;; todo bug: constrain breaking to certain junctures -(define ch (delay (values 1 1 1 #f))) -(define sp (delay (values 0 1 0 'can))) -(define br (delay (values 0 0 0 'must))) +(define ch (q (hasheq 'size (delay (values 1 1 1 #f))) #\c)) +(define sp (break (hasheq 'size (delay (values 0 1 0 'can))) #\space)) +(define br (break (hasheq 'size (delay (values 0 0 0 'must))) #\newline)) (module+ test - (check-equal? (break (list) 1) null) - (check-equal? (break (list ch) 1) '(#f)) - (check-equal? (break (list ch ch) 1) '(#f #t)) - (check-equal? (break (list ch ch ch) 1) '(#f #t #t)) - (check-equal? (break (list ch ch ch) 2) '(#f #f #t)) - (check-equal? (break (list ch ch ch ch) 2) '(#f #f #t #f)) - (check-equal? (break (list ch ch ch ch ch) 3) '(#f #f #f #t #f)) - (check-equal? (break (list ch ch ch ch ch) 1) '(#f #t #t #t #t)) - (check-equal? (break (list ch ch ch ch ch) 10) '(#f #f #f #f #f)) + (check-equal? (breaks (list) 1) null) + (check-equal? (breaks (list ch) 1) '(#f)) + (check-equal? (breaks (list ch ch) 1) '(#f #t)) + (check-equal? (breaks (list ch ch ch) 1) '(#f #t #t)) + (check-equal? (breaks (list ch ch ch) 2) '(#f #f #t)) + (check-equal? (breaks (list ch ch ch ch) 2) '(#f #f #t #f)) + (check-equal? (breaks (list ch ch ch ch ch) 3) '(#f #f #f #t #f)) + (check-equal? (breaks (list ch ch ch ch ch) 1) '(#f #t #t #t #t)) + (check-equal? (breaks (list ch ch ch ch ch) 10) '(#f #f #f #f #f)) - (check-equal? (break (list sp) 1) '(#f)) - (check-equal? (break (list sp sp) 1) '(#f #f)) - (check-equal? (break (list sp sp) 2) '(#f #f)) - (check-equal? (break (list sp sp) 3) '(#f #f)) - (check-equal? (break (list sp sp sp) 1) '(#f #f #f)) - (check-equal? (break (list sp sp sp) 2) '(#f #f #f)) - (check-equal? (break (list sp sp sp) 3) '(#f #f #f)) + (check-equal? (breaks (list sp) 1) '(#f)) + (check-equal? (breaks (list sp sp) 1) '(#f #f)) + (check-equal? (breaks (list sp sp) 2) '(#f #f)) + (check-equal? (breaks (list sp sp) 3) '(#f #f)) + (check-equal? (breaks (list sp sp sp) 1) '(#f #f #f)) + (check-equal? (breaks (list sp sp sp) 2) '(#f #f #f)) + (check-equal? (breaks (list sp sp sp) 3) '(#f #f #f)) ;; now it gets weird - (check-equal? (break (list ch sp) 1) '(#f #f)) - (check-equal? (break (list sp ch) 1) '(#f #f)) - (check-equal? (break (list sp ch ch) 1) '(#f #f #t)) - (check-equal? (break (list ch sp ch) 1) '(#f #f #t)) + (check-equal? (breaks (list ch sp) 1) '(#f #f)) + (check-equal? (breaks (list sp ch) 1) '(#f #f)) + (check-equal? (breaks (list sp ch ch) 1) '(#f #f #t)) + (check-equal? (breaks (list ch sp ch) 1) '(#f #f #t)) #| (check-equal? (break (list ch sp sp ch) 1) '(#f #f #t #f)) (check-equal? (break (list ch sp ch sp) 1) '(#f #f #t #f)) diff --git a/quad/quad/quad.rkt b/quad/quad/quad.rkt index 0802a28c..9c1145ef 100644 --- a/quad/quad/quad.rkt +++ b/quad/quad/quad.rkt @@ -18,7 +18,7 @@ (define (atomic-quad? x) (and (quad? x) (match (qe x) [(list (? char?)) #t] [else #f]))) -(define (atomic-quads? xs) (and (pair? xs) (andmap atomic-quad? xs))) +(define (atomic-quads? xs) (andmap atomic-quad? xs)) (module+ test (check-true (atomic-quad? ($quad '#hasheq() '(#\H)))) (check-true (atomic-quads? (list ($quad '#hasheq() '(#\H))))))