; text formatting
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
(char=? (peek-char p) c))
(read-char p)))
(let ((p (if (null? port) (current-input-port) (car port))))
(let loop ((c (read-char p)) (line '()))
(cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
(else (loop (read-char p) (cons c line)))))))
(define (string-split sep str)
(define (f cs xs) (cons (list->string (reverse cs)) xs))
(let loop ((ss (string->list str)) (cs '()) (xs '()))
(cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
(else (loop (cdr ss) (cons (car ss) cs) xs)))))
(define (print-line line)
(when (positive? (string-length line))
(display (substring line 1 (string-length line)))
(newline)))
(define (format file-name . args)
(let ((width (if (null? args) 60 (car args))))
(with-input-from-file file-name (lambda ()
(let loop ((words (list)) (line ""))
(cond ((null? words)
(let ((in-line (read-line)))
(cond ((eof-object? in-line)
(print-line line))
((string=? in-line "")
(print-line line)
(newline)
(loop words ""))
(else (loop (string-split #\space in-line) line)))))
((string=? (car words) "") (loop (cdr words) line))
((< width (string-length (car words)))
(print-line (car words))
(display (car words)) (newline)
(loop (cdr words) ""))
((< (+ (string-length line) (string-length (car words))) width)
(loop (cdr words) (string-append line " " (car words))))
(else (print-line line) (loop words ""))))))))
(format "gettysburg.txt" 30)