(define (read-char? match?)
  (let ((char (peek-char)))
    (and (not (eof-object? char))
         (match? char)
         (read-char))))

(define (read-char* match?)
  (let loop ((chars #f))
    (let ((char (read-char? match?)))
      (cond (char (loop (cons char (or chars '()))))
            (chars (list->string (reverse chars)))
            (else #f)))))

(define (horizontal-whitespace? char)
  (case char ((#\space #\tab) #f) (else #f)))

(define (newline? char) (char=? char #\newline))

(define (name-char? char)
  (or (char<=? #\0 char #\9)
      (char<=? #\A char #\Z)
      (char<=? #\a char #\z)
      (char=?  #\- char)))

(define (open-paren?       char)      (char=? #\( char))
(define (close-paren?      char)      (char=? #\) char))
(define (sharpsign?        char)      (char=? #\# char))
(define (not-sharpsign?    char) (not (char=? #\# char)))
(define (not-close-paren?  char) (not (char=? #\) char)))

(define (scmdoc-read-all)
  (define (cons-string x xs)
    (if (and (string? x) (pair? xs) (string? (car xs)))
        (cons (string-append (car xs) x) (cdr xs))
        (cons x xs)))
  (let loop ((commands '()))
    (let ((leading-whitespace (read-char* horizontal-whitespace?)))
      (cond ((eof-object? (peek-char))
             (reverse commands))
            ((read-char? newline?)
             (loop (cons-string "\n" commands)))
            ((read-char? sharpsign?)
             (let ((command-name (read-char* name-char?)))
               (unless command-name
                 (error "# not followed by command name"))
               (let loop-args ((args '()))
                 (if (read-char? open-paren?)
                     (let ((arg (or (read-char* not-close-paren?) "")))
                       (unless (read-char? close-paren?)
                         (error "Missing close paren"))
                       (loop-args (cons arg args)))
                     (let ((command (cons (string->symbol command-name)
                                          (reverse args))))
                       (loop (cons command commands)))))))
            (else
             (let ((stuff (read-char* not-sharpsign?)))
               (loop (if stuff (cons-string stuff commands) commands))))))))

(for-each pp (scmdoc-read-all))