codepad

Language:

; 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)

Private [?]

Run code