; file bundles

(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 (write-header)
  (for-each (lambda (x) (display x) (newline))
    '("#! /usr/bin/petite --script"
      "(define (do-file f)"
      "  (define (write-line x) (display x) (newline))"
      "  (with-output-to-file (car f) (lambda ()"
      "    (for-each write-line (cdr f)))))"
      "(for-each do-file '(")))

(define (do-file f)
  (display "(") (write f) (newline)
  (with-input-from-file f (lambda ()
    (do ((x (read-line) (read-line)))
        ((eof-object? x))
      (write x) (newline))))
  (display ")") (newline))

(define (bundle out-file . in-files)
  (with-output-to-file out-file (lambda ()
    (write-header)
    (for-each do-file in-files)
    (display "))") (newline))))