;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; schematic-markdown.scm
;;;
;;; This script converts Scheme source to markdown text.
;;;
;;; It should run in any R7RS-compatible Scheme, so long as this
;;; project's "src" and "lib/*/src" directories are added to the include
;;; path. In Chibi Scheme, for example, that's done with the -I flag.
;;;
;;; See this project's README for more information.
;;;
;;; Copyright (c) 2013-2016, Evan Hanson <evhan@foldling.org>
;;; See LICENSE for details.
;;;

(import (schematic process)
        (schematic read)
        (scheme base)
        (scheme file)
        (scheme process-context)
        (scheme write))

(define comment-prefixes '(";;" ";;;"))

;; This should probably be replaced by the host's implementation.
(define (string-split str char)
  (let ((len (string-length str)))
    (let lp ((c 0)
             (a '()))
      (if (> c len)
          (reverse a)
          (do ((i c (+ i 1)))
              ((or (= i len)
                   (char=? (string-ref str i) char))
               (lp (+ i 1)
                   (cons (substring str c i) a))))))))

(define (string-null? s) (string=? s ""))

(define (process-input comment-strings port)
  (port-fold-source-sections
   (lambda (docs code _)
     (unless (string-null? docs)
       (display docs)
       (newline)
       (newline))
     (unless (string-null? code)
       (for-each
        (lambda (line)
          (display "    ")
          (display line)
          (newline))
        (string-split code #\newline))
       (newline)))
   #f ; Ignored.
   comment-strings
   port))

;; Parse the command line and process input.
(for-each
 (lambda (option)
   (case (car option)
     ((-h --help)
      (display "Usage: ")
      (display (car (command-line)))
      (display " [-c <string>]")
      (newline)
      (exit))
     ((-v --version)
      (display version)
      (newline)
      (exit))
     ((-c --comment-prefix)
      (set! comment-prefixes (cdr option)))
     ((--)
      (with-exception-handler error-exit
       (lambda ()
         (if (null? (cdr option))
             (process-input comment-prefixes (current-input-port))
             (error "Unrecognized command line argument" (cadr option))))))))
 (command-line-options
  '(((-c --comment-prefix) string))))