propagate

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

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

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