;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; schematic-wiki.scm
;;;
;;; This script converts commented Scheme definitions into svnwiki markup.
;;;
;;; See this project's README for more information.
;;;
;;; Copyright (c) 2013-2015, Evan Hanson <evhan@foldling.org>
;;; See LICENSE for details.
;;;

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

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

(define wiki-tags
  '(constant parameter procedure record string syntax))

(define (write-wiki-tag type form)
  (display "<")
  (display type)
  (display ">")
  (write form)
  (display "</")
  (display type)
  (display ">\n"))

(define (write-wiki-doc doc)
  (display "\n")
  (display doc)
  (display "\n\n"))

(define (process-source input)
  (call-with-port
   (open-output-string)
   (lambda (output)
     (extract-definitions comment-prefixes input output)
     (call-with-port
      (open-input-string (get-output-string output))
      (lambda (specs)
        (do ((spec (read specs)
                   (read specs)))
            ((eof-object? spec))
          (for-each (lambda (tag)
                      (let ((type (car tag)))
                        (when (memq type wiki-tags)
                          (write-wiki-tag type (cdr tag)))))
                    (cdr spec))
          (write-wiki-doc (car spec))))))))

(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-source (current-input-port))
             (error "Unrecognized command line argument" (cadr option))))))))
 (command-line-options
  '(((-c --comment-prefix) string))))