#lang racket/base

(provide wrap-width wrap-line)

;; The default wrap width for `wrape-line'.
(define wrap-width (make-parameter 79))

;; `wrap-line' wraps the `line' string into a list of strings that fit `width'
;; characters.
;;
;; This is intended to be a building block for fancier wrappers -- for
;; examples, ones that have a prefix for all lines, that indent/outdent of the
  first line , that treat some prefix regexp as a known indentation , that
;; "squeeze" all whitespaces, that can be used as part of some other output and
;; use the starting column to set the width, or even ones that take a multiline
;; string and identify paragraphs to wrap individually.  For now, it's not
;; intended to be used directly so it's only documented here -- this is likely
;; to change if the interface is stable enough.
;;
;; `width' can be either a width or an improper list of widths, where the last
  element is used for the rest .   For example , ( cons 72 70 ) indicates a width
  of 72 characters for the first line , and 70 for the rest .
;;
;; `split-word' controls what happens when a word is split: it is invoked with
;; the word that is to be split, and an integer indicating how many characters
  could fit on the first line .   In most cases the string will be just a word ,
  but if it was the first / last word with only spaces before / after it , then the
  string will have these spaces too .   It is expected to return three values :
  the first two are a string to put on the current line and a string that goes
;; first on the next one.  Either of these can be `#f' to indicate nothing
;; (this is different from returning "", since that will keep the spaces next
  to it ) .   The third result is relevant when the second result is longer than
  the wrapping width : # t indicates that the second result is considered a word
;; and should not be rewrapped, and #f indicates that it can.  Spaces from the
  original string are preserved , even if there are more than one space between
;; words; spaces between a word that moves to the next line and the preceding
  word are usually dropped , but they can be preserved too if the first result
;; is "" rather than #f (and same for the space between a word that stays on
  the same line when the following word moves down ) .   If the first result is
;; `#f' and it was the only word on the line, then the line that would
;; otherwise be empty is dropped.  Note that depending on what `split-word'
;; chooses to do, the result may still have lines that are longer than `width'
;; characters.  The default `split-word' returns (values #f the-word #t).
;;
;; Side note: never returns an empty list.
;;
;; Caveats: considers only spaces as whitespace; not too efficient since it
  constructs intermediate strings for its processing ; the need for the third
;; boolean result from `split-word' is suspicious and might be dropped or
;; changed.
;;
(define (wrap-line line [width* (wrap-width)] [split-word #f])
  (define (loop str strs width*)
    (define width (if (pair? width*) (car width*) width*))
    (define strlen (string-length str))
    (define (do-word s1 w1 w2 s2) ; s1--spaces--w1--word--w2--spaces--s2
      (define w1* (if (eq? 0 s1) 0 w1))       ;\ w1*..w2* includes spaces
/ for first / last word
      (define word (substring str w1* w2*))
      (define-values [r1 r2 r3]
        (if split-word (split-word word (- width w1*)) (values #f word #t)))
      (let* ([1st (cond [r1 (string-append (substring str 0 w1*) r1)]
                        [(eq? w1* 0) #f]
                        [else (substring str 0 s1)])]
             [strs (if 1st (cons 1st strs) strs)]
             [width* (cond [(not r1) width*]
                           [(pair? width*) (cdr width*)]
                           [else width*])]
             [2nd (and r2 r3
                       (>= (string-length r2)
                           (if (pair? width*) (car width*) width*))
                       r2)]
             [strs (if 2nd (cons 2nd strs) strs)]
             [width* (cond [(not r2) width*]
                           [(pair? width*) (cdr width*)]
                           [else width*])]
             [rst (cond [(and (not 2nd) r2)
                         (string-append r2 (substring str w2*))]
                        [(eq? w2* strlen) #f]
                        [else (substring str s2)])])
        (if rst (loop rst strs width*) (reverse strs))))
    (cond
      [(strlen . <= . width) (reverse (cons str strs))]
      ;; wrapping point is inside a word
      [(regexp-match-positions #rx"^([^ ][^ ]+) *" str (sub1 width))
       => (λ (m2)
            (define m1 (regexp-match-positions #rx" *([^ ]+)$" str 0 width))
            (do-word (caar m1) (caadr m1) (cdadr m2) (cdar m2)))]
      ;; wrapping point is probably between words
      [(regexp-match-positions #rx" *([^ ]+) *$" str 0 width)
       => (λ (m1)
            (define m2 (regexp-match-positions #rx"[^ ]" str width))
            (if m2 ; there is a following word, so we are between words
              (loop (substring str (caar m2))
                    (cons (substring str 0 (cdadr m1)) strs)
                    (if (pair? width*) (cdr width*) width*))
              ;; no following word, so the following spaces are part of a word
              ;; that does need to be split
              (do-word (caar m1) (caadr m1) strlen strlen)))]
  all spaces in first line = > part of the following word
      [(regexp-match-positions #rx"([^ ]+) *" str width)
       => (λ (m) (do-word 0 (caar m) (cdadr m) (cdar m)))]
      ;; no word at all => split the whole "word" (which is all spaces)
      [else (do-word 0 0 strlen strlen)]))
  (loop line '() width*))

 The default wrap width for `wrape-line'.
 `wrap-line' wraps the `line' string into a list of strings that fit `width'
 characters.

 This is intended to be a building block for fancier wrappers -- for
 examples, ones that have a prefix for all lines, that indent/outdent of the
 "squeeze" all whitespaces, that can be used as part of some other output and
 use the starting column to set the width, or even ones that take a multiline
 string and identify paragraphs to wrap individually.  For now, it's not
 intended to be used directly so it's only documented here -- this is likely
 to change if the interface is stable enough.

 `width' can be either a width or an improper list of widths, where the last

 `split-word' controls what happens when a word is split: it is invoked with
 the word that is to be split, and an integer indicating how many characters
 first on the next one.  Either of these can be `#f' to indicate nothing
 (this is different from returning "", since that will keep the spaces next
 and should not be rewrapped, and #f indicates that it can.  Spaces from the
 words; spaces between a word that moves to the next line and the preceding
 is "" rather than #f (and same for the space between a word that stays on
 `#f' and it was the only word on the line, then the line that would
 otherwise be empty is dropped.  Note that depending on what `split-word'
 chooses to do, the result may still have lines that are longer than `width'
 characters.  The default `split-word' returns (values #f the-word #t).

 Side note: never returns an empty list.

 Caveats: considers only spaces as whitespace; not too efficient since it
 the need for the third
 boolean result from `split-word' is suspicious and might be dropped or
 changed.

 s1--spaces--w1--word--w2--spaces--s2
\ w1*..w2* includes spaces
 wrapping point is inside a word
 wrapping point is probably between words
 there is a following word, so we are between words
 no following word, so the following spaces are part of a word
 that does need to be split
 no word at all => split the whole "word" (which is all spaces)
#lang racket/base

(provide wrap-width wrap-line)

(define wrap-width (make-parameter 79))

  first line , that treat some prefix regexp as a known indentation , that
  element is used for the rest .   For example , ( cons 72 70 ) indicates a width
  of 72 characters for the first line , and 70 for the rest .
  could fit on the first line .   In most cases the string will be just a word ,
  but if it was the first / last word with only spaces before / after it , then the
  string will have these spaces too .   It is expected to return three values :
  the first two are a string to put on the current line and a string that goes
  to it ) .   The third result is relevant when the second result is longer than
  the wrapping width : # t indicates that the second result is considered a word
  original string are preserved , even if there are more than one space between
  word are usually dropped , but they can be preserved too if the first result
  the same line when the following word moves down ) .   If the first result is
(define (wrap-line line [width* (wrap-width)] [split-word #f])
  (define (loop str strs width*)
    (define width (if (pair? width*) (car width*) width*))
    (define strlen (string-length str))
/ for first / last word
      (define word (substring str w1* w2*))
      (define-values [r1 r2 r3]
        (if split-word (split-word word (- width w1*)) (values #f word #t)))
      (let* ([1st (cond [r1 (string-append (substring str 0 w1*) r1)]
                        [(eq? w1* 0) #f]
                        [else (substring str 0 s1)])]
             [strs (if 1st (cons 1st strs) strs)]
             [width* (cond [(not r1) width*]
                           [(pair? width*) (cdr width*)]
                           [else width*])]
             [2nd (and r2 r3
                       (>= (string-length r2)
                           (if (pair? width*) (car width*) width*))
                       r2)]
             [strs (if 2nd (cons 2nd strs) strs)]
             [width* (cond [(not r2) width*]
                           [(pair? width*) (cdr width*)]
                           [else width*])]
             [rst (cond [(and (not 2nd) r2)
                         (string-append r2 (substring str w2*))]
                        [(eq? w2* strlen) #f]
                        [else (substring str s2)])])
        (if rst (loop rst strs width*) (reverse strs))))
    (cond
      [(strlen . <= . width) (reverse (cons str strs))]
      [(regexp-match-positions #rx"^([^ ][^ ]+) *" str (sub1 width))
       => (λ (m2)
            (define m1 (regexp-match-positions #rx" *([^ ]+)$" str 0 width))
            (do-word (caar m1) (caadr m1) (cdadr m2) (cdar m2)))]
      [(regexp-match-positions #rx" *([^ ]+) *$" str 0 width)
       => (λ (m1)
            (define m2 (regexp-match-positions #rx"[^ ]" str width))
              (loop (substring str (caar m2))
                    (cons (substring str 0 (cdadr m1)) strs)
                    (if (pair? width*) (cdr width*) width*))
              (do-word (caar m1) (caadr m1) strlen strlen)))]
  all spaces in first line = > part of the following word
      [(regexp-match-positions #rx"([^ ]+) *" str width)
       => (λ (m) (do-word 0 (caar m) (cdadr m) (cdar m)))]
      [else (do-word 0 0 strlen strlen)]))
  (loop line '() width*))
