You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
48 lines
1.9 KiB
Racket
48 lines
1.9 KiB
Racket
5 years ago
|
#lang debug racket
|
||
|
|
(require quad/quad
|
||
|
|
quad/util
|
||
|
|
"attrs.rkt"
|
||
|
|
"struct.rkt")
|
||
|
|
(provide (all-defined-out))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(define (make-nobreak! q) (quad-set! q :no-colbr #true)) ; scooperates with col-wrap
|
||
|
|
|
||
|
|
(define (do-keep-with-next! reversed-lines)
|
||
|
|
;; paints nobreak onto the kwn line itself,
|
||
|
|
;; and any line spacers that follow (could be one or more)
|
||
|
|
;; (we are iterating backward, so the geometrically previous ln follows the spacer)
|
||
|
|
(define (is-kwn-line? ln) (quad-ref ln :keep-with-next))
|
||
|
|
(let loop ([lines (reverse reversed-lines)])
|
||
|
|
(unless (null? lines)
|
||
|
|
(match lines
|
||
|
|
[(list* (? is-kwn-line? kwn) (? line-spacer-quad? lsqs) ..1 rest)
|
||
|
|
(for-each make-nobreak! (cons kwn lsqs))
|
||
|
|
(loop rest)]
|
||
|
|
[(cons ln rest) (loop rest)]))))
|
||
|
|
|
||
|
|
(define (apply-keeps lines)
|
||
|
|
(define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines))
|
||
|
|
(for*/fold ([reversed-lines null]
|
||
|
|
#:result (begin
|
||
|
|
(do-keep-with-next! reversed-lines)
|
||
|
|
(reverse reversed-lines)))
|
||
|
|
([group (in-list groups-of-lines)]
|
||
|
|
[group-len (in-value (length group))]
|
||
|
|
[(ln idx0) (in-indexed group)])
|
||
|
|
(define idx (add1 idx0))
|
||
|
|
;; always catch last line of block in this case
|
||
|
|
;; so later cases are guaranteed to have earlier lines.
|
||
|
|
(define keep-first (quad-ref ln :keep-first-lines))
|
||
|
|
(define keep-last (quad-ref ln :keep-last-lines))
|
||
|
|
(unless (eq? idx group-len)
|
||
|
|
(when (or
|
||
|
|
;; if we have keep all we can skip :keep-first and :keep-last cases
|
||
|
|
(or (equal? keep-first "all") (equal? keep-last "all"))
|
||
|
|
;; to keep n lines, we only paint the first n - 1
|
||
|
|
;; (because each nobr line sticks to the next)
|
||
|
|
(and (number? keep-first) (< idx keep-first))
|
||
|
|
(and (number? keep-last) (< (- group-len keep-last) idx)))
|
||
|
|
(make-nobreak! ln)))
|
||
|
|
(cons ln reversed-lines)))
|