From d836e3b9587740ea873410a03545a384578fae18 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sun, 11 Feb 2018 10:13:56 -0600
Subject: [PATCH] hold

---
 quad/quad/break.rkt | 44 +++++++++++++++++++++++---------------------
 1 file changed, 23 insertions(+), 21 deletions(-)

diff --git a/quad/quad/break.rkt b/quad/quad/break.rkt
index 3ebf1611..b1972ab7 100644
--- a/quad/quad/break.rkt
+++ b/quad/quad/break.rkt
@@ -9,15 +9,17 @@
                                 ;; todo: generalize these procs so they're not particular to quads
                                 #:mandatory-break-proc [mandatory-break? (const #f)]
                                 #:optional-break-proc [optional-break? (const #f)]
-                                #:size-proc [size-proc (const 1)])
+                                #:size-proc [size-proc (const 1)]
+                                #:group-proc [group-proc values])
   ((any/c) (integer? any/c
                      #:break-val any/c
                      #:mandatory-break-proc procedure?
                      #:optional-break-proc procedure?
-                     #:size-proc procedure?) . ->* . (listof any/c))
+                     #:size-proc procedure?
+                     #:group-proc procedure?) . ->* . (listof any/c))
   (define start-signal (gensym))
-  (define last-breakpoint-k #f)
-  (define (capture-k!) (let/cc k (set! last-breakpoint-k k) #f))
+  (define last-optional-break-k #f)
+  (define (capture-optional-break-k!) (let/cc k (set! last-optional-break-k k) #f))
   (for/fold ([vals null]
              [size-so-far start-signal]
              #:result (reverse (dropf vals optional-break?)))
@@ -38,15 +40,15 @@
       [(optional-break? x)
        (cond
          [at-start? (when debug (report x 'skipping-opt-break-at-beginning)) (values vals size-so-far)]
-         [(and underflow? (capture-k!)) (when debug (report x 'resuming-breakpoint))
-                                        (set! last-breakpoint-k #f) ;; prevents continuation loop
-                                        (insert-break)]
+         [(and underflow? (capture-optional-break-k!)) (when debug (report x 'resuming-breakpoint))
+                                                       (set! last-optional-break-k #f) ;; prevents continuation loop
+                                                       (insert-break)]
          [else (when debug (report x 'add-optional-break))
                (add-to-segment)])]
       [(or at-start? underflow?) (when debug (report x 'add-ordinary-char))
                                  (add-to-segment)]
-      [last-breakpoint-k (when debug (report x 'invoking-last-breakpoint))
-                         (last-breakpoint-k #t)]
+      [last-optional-break-k (when debug (report x 'invoking-last-breakpoint))
+                             (last-optional-break-k #t)]
       [else (when debug (report x 'falling-back))
             (values (list* x break-val vals) size-start)]))) ;; fallback if no last-breakpoint-k exists
 
@@ -60,21 +62,20 @@
 (define sp (q (hasheq 'size (delay (values 0 1 0))) #\space))
 (define br (q (hasheq 'size (delay (values 0 0 0))) #\newline))
 
+(define (lbs xs size [debug #f])
+  (insert-breaks xs size debug
+                 #:break-val 'lb
+                 #:mandatory-break-proc (λ (q) (and (quad? q) (memv (car (qe q)) '(#\newline))))
+                 #:optional-break-proc (λ (q) (and (quad? q) (memv (car (qe q)) '(#\space))))
+                 #:size-proc (λ (q) (let ([val (hash-ref (qa q) 'size (λ ()
+                                                                        (if (memv (car (qe q)) '(#\space))
+                                                                            (delay (values 0 1 0))
+                                                                            (delay (values 1 1 1)))))])
+                                      (if (promise? val) (force val) (val))))))
 
 (module+ test
   (require rackunit)
 
-  (define (lbs xs size [debug #f])
-    (insert-breaks xs size debug
-                   #:break-val 'lb
-                   #:mandatory-break-proc (λ (q) (and (quad? q) (memv (car (qe q)) '(#\newline))))
-                   #:optional-break-proc (λ (q) (and (quad? q) (memv (car (qe q)) '(#\space))))
-                   #:size-proc (λ (q) (let ([val (hash-ref (qa q) 'size (λ ()
-                                                                          (if (memv (car (qe q)) '(#\space))
-                                                                              (delay (values 0 1 0))
-                                                                              (delay (values 1 1 1)))))])
-                                        (if (promise? val) (force val) (val))))))
-
   (test-case
    "chars"
    (check-equal? (lbs (list) 1) null)  
@@ -192,4 +193,5 @@
    (check-equal? (pbs (lbs null 1) 2) null)
    (check-equal? (pbs (lbs (list x) 1) 2) (list x))
    (check-equal? (pbs (lbs (list x x x) 1) 2) (list x 'lb x 'pb x))
-   (check-equal? (pbs (lbs (list x x x) 2) 2) (list x x 'pb x))))
\ No newline at end of file
+   (check-equal? (pbs (lbs (list x x x) 2) 2) (list x x 'pb x))
+   (check-equal? (pbs (lbs (list x x x) 2) 1) (list x 'pb x 'pb x))))
\ No newline at end of file