|
|
|
@ -87,13 +87,10 @@
|
|
|
|
|
soft-break?
|
|
|
|
|
finish-wrap-proc)
|
|
|
|
|
(define start-signal (gensym))
|
|
|
|
|
(define last-soft-break-k #f)
|
|
|
|
|
(define (capture-soft-break-k!)
|
|
|
|
|
(when debug (report 'capturing-break))
|
|
|
|
|
(let/cc k (set! last-soft-break-k k) #f))
|
|
|
|
|
(let loop ([wraps null][wrap-pieces null][dist-so-far start-signal][xs xs])
|
|
|
|
|
(match xs
|
|
|
|
|
[(== empty)
|
|
|
|
|
(when debug (report x 'end-of-the-line))
|
|
|
|
|
;; combine the segments into a flat list, and drop any trailing breaks
|
|
|
|
|
;; (on the idea that breaks should separate things, and there's nothing left to separate)
|
|
|
|
|
;; wraps alternate with breaks
|
|
|
|
@ -105,8 +102,13 @@
|
|
|
|
|
[(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
|
|
|
|
|
(finish-wrap-proc (reverse rest))]))]
|
|
|
|
|
[(cons x _)
|
|
|
|
|
(when debug (report x 'one-x))
|
|
|
|
|
(define at-start? (eq? dist-so-far start-signal))
|
|
|
|
|
(define underflow? (and (not at-start?) (<= (+ dist-so-far (if (and (quad? x) (printable? x 'end)) (distance x) 0)) target-size)))
|
|
|
|
|
(define underflow?
|
|
|
|
|
(and (not at-start?)
|
|
|
|
|
(<= (+ dist-so-far (if (and (quad? x) (printable? x 'end))
|
|
|
|
|
(distance x)
|
|
|
|
|
0)) target-size)))
|
|
|
|
|
(define (values-for-insert-break [before? #f])
|
|
|
|
|
;; a break can be inserted before or after the current quad.
|
|
|
|
|
;; At an ordinary break (hard or soft) it goes after the wrap point.
|
|
|
|
@ -116,18 +118,19 @@
|
|
|
|
|
;; The wrap signal will not consume the quad (rather, it will become the first quad in the next wrap)
|
|
|
|
|
;; (we do this by resetting next-xs to the whole xs list)
|
|
|
|
|
;; In both cases, the `finish-wrap` proc will strip off any trailing white breaks from the new segment.
|
|
|
|
|
(set! last-soft-break-k #f) ;; prevents continuation loop
|
|
|
|
|
(if before?
|
|
|
|
|
(values wrap-pieces xs)
|
|
|
|
|
; omit nonprinting quad
|
|
|
|
|
(values (if (and (quad? x) (nonprinting-at-end? x)) wrap-pieces (cons x wrap-pieces)) (cdr xs))))
|
|
|
|
|
(values (if (and (quad? x) (nonprinting-at-end? x))
|
|
|
|
|
wrap-pieces
|
|
|
|
|
(cons x wrap-pieces)) (cdr xs))))
|
|
|
|
|
(cond
|
|
|
|
|
[(and at-start? (soft-break? x) (nonprinting-at-start? x))
|
|
|
|
|
(when debug (report x 'skipping-soft-break-at-beginning))
|
|
|
|
|
;; skip it
|
|
|
|
|
(loop wraps null dist-so-far (cdr xs))]
|
|
|
|
|
[(and underflow? (soft-break? x) (capture-soft-break-k!))
|
|
|
|
|
(when debug (report x 'resuming-break-from-continuation))
|
|
|
|
|
[(and underflow? (soft-break? x))
|
|
|
|
|
(when debug (report x 'underflow-soft-break))
|
|
|
|
|
(define-values (pieces-for-this-wrap next-xs) (values-for-insert-break))
|
|
|
|
|
(loop (list* (list break-val) pieces-for-this-wrap wraps)
|
|
|
|
|
null
|
|
|
|
@ -151,11 +154,7 @@
|
|
|
|
|
(cdr xs))]
|
|
|
|
|
;; the previous branch will catch all `underflow?` cases
|
|
|
|
|
;; therefore, in these last two cases, we have overflow
|
|
|
|
|
[last-soft-break-k ;; overflow implied
|
|
|
|
|
;; if we have an soft break stored, we jump back and use it
|
|
|
|
|
;; now that we know we need it.
|
|
|
|
|
(when debug (report x 'invoking-last-breakpoint))
|
|
|
|
|
(last-soft-break-k #t)]
|
|
|
|
|
|
|
|
|
|
[else ;; overflow implied
|
|
|
|
|
;; if we don't have an soft break stored, we need to just end the wrap and move on
|
|
|
|
|
;; we insert the break `before` so that the current quad is moved to the next wrap
|
|
|
|
@ -192,10 +191,14 @@
|
|
|
|
|
#:hard-break-proc (λ (q) (and (quad? q) (memv (car (elems q)) '(#\newline))))
|
|
|
|
|
#:soft-break-proc soft-break?))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(check-equal? (linewrap (list a sp b) 3 #true) (list a sp b)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(require rackunit)
|
|
|
|
|
(require rackunit))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"chars"
|
|
|
|
|
(check-equal? (linewrap (list) 1) null)
|
|
|
|
@ -206,25 +209,27 @@
|
|
|
|
|
(check-equal? (linewrap (list x x x x) 2) (list x x 'lb x x))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 3) (list x x x 'lb x x))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 1) (list x 'lb x 'lb x 'lb x 'lb x))
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 10) (list x x x x x)))
|
|
|
|
|
|
|
|
|
|
(check-equal? (linewrap (list x x x x x) 10) (list x x x x x))))
|
|
|
|
|
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"chars and spaces"
|
|
|
|
|
(check-equal? (linewrap (list x sp x) 1) (list x 'lb x))
|
|
|
|
|
(check-equal? (linewrap (list x x sp x) 2) (list x x 'lb x))
|
|
|
|
|
(check-equal? (linewrap (list a sp b) 3) (list a sp b))
|
|
|
|
|
(check-equal? (linewrap (list x sp x x) 3) (list x 'lb x x)))
|
|
|
|
|
(check-equal? (linewrap (list x sp x x) 3) (list x 'lb x x))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"leading & trailing spaces"
|
|
|
|
|
(check-equal? (linewrap (list sp x) 2) (list x))
|
|
|
|
|
(check-equal? (linewrap (list x sp) 2) (list x))
|
|
|
|
|
(check-equal? (linewrap (list sp x sp) 2) (list x))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x sp sp) 2) (list x))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x sp sp x sp) 1) (list x 'lb x)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp x sp sp x sp) 1) (list x 'lb x))))
|
|
|
|
|
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard hyphens"
|
|
|
|
|
(check-equal? (linewrap (list hyph) 1) (list hyph))
|
|
|
|
@ -236,8 +241,9 @@
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 2) (list x x 'lb hyph x 'lb x))
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 3) (list x x hyph 'lb x x))
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 4) (list x x hyph 'lb x x))
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 5) (list x x hyph x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x hyph x x) 5) (list x x hyph x x))))
|
|
|
|
|
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"soft hyphens"
|
|
|
|
|
(check-equal? (linewrap (list shy) 1) (list))
|
|
|
|
@ -250,16 +256,18 @@
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 3) (list x x shy 'lb x x))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 4) (list x x x x))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x x) 5) (list x x x x))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x sp x) 4) (list x x x 'lb x)))
|
|
|
|
|
(check-equal? (linewrap (list x x shy x sp x) 4) (list x x x 'lb x))))
|
|
|
|
|
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"zero width nonbreakers"
|
|
|
|
|
(check-equal? (linewrap (list sp zwx) 2) (list zwx))
|
|
|
|
|
(check-equal? (linewrap (list zwx sp) 2) (list zwx))
|
|
|
|
|
(check-equal? (linewrap (list sp zwx sp) 2) (list zwx))
|
|
|
|
|
(check-equal? (linewrap (list sp sp zwx sp sp) 2) (list zwx))
|
|
|
|
|
(check-equal? (linewrap (list sp sp zwx sp sp zwx sp) 2) (list zwx sp sp zwx)))
|
|
|
|
|
(check-equal? (linewrap (list sp sp zwx sp sp zwx sp) 2) (list zwx sp sp zwx))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks"
|
|
|
|
|
(check-equal? (linewrap (list br) 2) (list)) ;; only insert a break if it's between things
|
|
|
|
@ -270,8 +278,9 @@
|
|
|
|
|
(check-equal? (linewrap (list x x br x) 3) (list x x 'lb x))
|
|
|
|
|
(check-equal? (linewrap (list x x x x) 3) (list x x x 'lb x))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 2) (list x x 'lb x 'lb x x))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x)))
|
|
|
|
|
(check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))))
|
|
|
|
|
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks and spurious spaces"
|
|
|
|
|
(check-equal? (linewrap (list a sp sp sp br b) 2) (list a 'lb b))
|
|
|
|
@ -289,7 +298,7 @@
|
|
|
|
|
(cond
|
|
|
|
|
[(quad? b) (car (elems b))]
|
|
|
|
|
[else #\|]))))
|
|
|
|
|
(module+ test
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"visual breaks"
|
|
|
|
|
(check-equal? (visual-wrap "My dog has fleas" 1) "M|y|d|o|g|h|a|s|f|l|e|a|s")
|
|
|
|
@ -328,16 +337,18 @@
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 2) (list 'pb x x 'pb x))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 3) (list 'pb x x x))
|
|
|
|
|
(check-equal? (pagewrap (list x x x) 4) (list 'pb x x x))
|
|
|
|
|
(check-equal? (pagewrap (list x 'lb x x) 2) (list 'pb x 'pb x x)))
|
|
|
|
|
(check-equal? (pagewrap (list x 'lb x x) 2) (list 'pb x 'pb x x))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard page breaks"
|
|
|
|
|
(check-equal? (pagewrap (list x pbr x x) 2) (list 'pb x 'pb x x))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr x x) 1) (list 'pb x 'pb x 'pb x))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr pbr x x) 1) (list 'pb x 'pb 'pb x 'pb x))
|
|
|
|
|
(check-equal? (pagewrap (list x pbr pbr x x) 2) (list 'pb x 'pb 'pb x x))
|
|
|
|
|
(check-equal? (pagewrap (list 'lb x 'lb 'lb pbr 'lb x x 'lb) 2) (list 'pb x 'pb x x)))
|
|
|
|
|
(check-equal? (pagewrap (list 'lb x 'lb 'lb pbr 'lb x x 'lb) 2) (list 'pb x 'pb x x))))
|
|
|
|
|
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"composed line breaks and page breaks"
|
|
|
|
|
(check-equal? (pagewrap (linewrap null 1) 2) '(pb) )
|
|
|
|
@ -355,7 +366,7 @@
|
|
|
|
|
#:soft-break-proc soft-break?
|
|
|
|
|
#:finish-wrap-proc (λ (pcs) (list ($slug #f pcs)))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
#;(module+ test
|
|
|
|
|
(test-case
|
|
|
|
|
"hard breaks and spurious spaces with slugs"
|
|
|
|
|
(check-equal? (linewrap2 (list a sp sp sp br b) 2) (list (slug a) 'lb (slug b)))
|
|
|
|
@ -364,4 +375,4 @@
|
|
|
|
|
(check-equal? (linewrap2 (list a sp b sp sp br sp c) 3) (list (slug a sp b) 'lb (slug c)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x x) 3) (list (slug x x x) 'lb (slug x)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x sp x x) 2) (list (slug x x) 'lb (slug x) 'lb (slug x x)))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x sp x x) 3) (list (slug x x x) 'lb (slug x x)))))
|
|
|
|
|
(check-equal? (linewrap2 (list x x x sp x x) 3) (list (slug x x x) 'lb (slug x x)))))
|
|
|
|
|