;;;;
;;;; skribe.stk	-- Skribe Main
;;;; 
;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; 
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;; 
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
;;;; USA.
;;;; 
;;;;           Author: Erick Gallesio [eg@essi.fr]
;;;;    Creation date: 24-Jul-2003 20:33 (eg)
;;;; Last file update:  6-Mar-2004 16:13 (eg)
;;;;

;; FIXME: These are horrible hacks
;(DESCRIBE 1 (current-error-port))	      ; to make compiler happy 
(set! *compiler-options* '()) ;HORREUR pour �viter les warnings du compilo


(include "../common/configure.scm")
(include "../common/param.scm")

(include "vars.stk")
(include "reader.stk")
(include "configure.stk")
(include "types.stk")
(include "debug.stk")
(include "lib.stk")
(include "../common/lib.scm")
(include "resolve.stk")
(include "writer.stk")
(include "verify.stk")
(include "output.stk")
(include "prog.stk")
(include "eval.stk")
(include "runtime.stk")
(include "engine.stk")
(include "biblio.stk")
(include "source.stk")
(include "lisp.stk")
(include "xml.stk")
(include "c.stk")
(include "color.stk")
(include "../common/sui.scm")

(import SKRIBE-EVAL-MODULE
	SKRIBE-CONFIGURE-MODULE
	SKRIBE-RUNTIME-MODULE
	SKRIBE-ENGINE-MODULE
	SKRIBE-EVAL-MODULE
	SKRIBE-WRITER-MODULE
	SKRIBE-VERIFY-MODULE
	SKRIBE-OUTPUT-MODULE
	SKRIBE-BIBLIO-MODULE
	SKRIBE-PROG-MODULE
	SKRIBE-RESOLVE-MODULE
	SKRIBE-SOURCE-MODULE
	SKRIBE-LISP-MODULE
	SKRIBE-XML-MODULE
	SKRIBE-C-MODULE
	SKRIBE-DEBUG-MODULE
	SKRIBE-COLOR-MODULE)

(include "../common/index.scm")
(include "../common/api.scm")


;;; KLUDGE for allowing redefinition of Skribe INCLUDE
(remove-expander! 'include)


;;;; ======================================================================
;;;;
;;;;				P A R S E - A R G S
;;;;
;;;; ======================================================================
(define (parse-args args)

  (define (version)
    (format #t "skribe v~A\n" (skribe-release)))

  (define (query)
    (version)
    (for-each (lambda (x)
		(let ((s (keyword->string (car x))))
		  (printf "  ~a: ~a\n" s (cadr x))))
	      (skribe-configure)))
  
  ;;
  ;; parse-args starts here
  ;;
  (let ((paths '())
	(engine #f))
    (parse-arguments args
      "Usage: skribe [options] [input]"
      "General options:"
	(("target" :alternate "t" :arg target
		   :help "sets the output format to <target>")
	   (set! engine (string->symbol target)))
	(("I" :arg path :help "adds <path> to Skribe path")
	   (set! paths (cons path paths)))
	(("B" :arg path :help "adds <path> to bibliography path")
	   (skribe-bib-path-set! (cons path (skribe-bib-path))))
	(("S" :arg path :help "adds <path> to source path")
	   (skribe-source-path-set! (cons path (skribe-source-path))))
	(("P" :arg path :help "adds <path> to image path")
	   (skribe-image-path-set! (cons path (skribe-image-path))))
	(("split-chapters" :alternate "C" :arg chapter
	  		   :help "emit chapter's sections in separate files")
	   (set! *skribe-chapter-split* (cons chapter *skribe-chapter-split*)))
	(("preload" :arg file :help "preload <file>")
	 (set! *skribe-preload* (cons file *skribe-preload*)))
	(("use-variant" :alternate "u" :arg variant
	  		:help "use <variant> output format")
	  (set! *skribe-variants* (cons variant *skribe-variants*)))
	(("base" :alternate "b" :arg base
	         :help "base prefix to remove from hyperlinks")
	   (set! *skribe-ref-base* base))
	(("rc-dir" :arg dir :alternate "d" :help "set the RC directory to <dir>")
	   (set! *skribe-rc-directory* dir))
	
      "File options:"
        (("no-init-file" :help "Dont load rc Skribe file")
	   (set! *load-rc* #f))
	(("output" :alternate "o" :arg file :help "set the output to <file>")
	   (set! *skribe-dest* file)
	   (let* ((s (file-suffix file))
		  (c (assoc s *skribe-auto-mode-alist*)))
	     (when (and (pair? c) (symbol? (cdr c)))
	       (set! *skribe-engine* (cdr c)))))

      "Misc:"
        (("help" :alternate "h" :help "provides help for the command")
	   (arg-usage (current-error-port))
	   (exit 0))
	(("options" :help "display the skribe options and exit")
	   (arg-usage (current-output-port) #t)
	   (exit 0))
	(("version" :alternate "V" :help "displays the version of Skribe")
	   (version)
	   (exit 0))
	(("query" :alternate "q"
	  	  :help "displays informations about Skribe conf.")
	   (query)
	   (exit 0))
	(("verbose" :alternate "v" :arg level
	  :help "sets the verbosity to <level>. Use -v0 for crystal silence")
	   (let ((val (string->number level)))
	     (when (integer? val)
	       (set! *skribe-verbose* val))))
	(("warning" :alternate "w" :arg level
	  :help "sets the verbosity to <level>. Use -w0 for crystal silence")
	   (let ((val (string->number level)))
	     (when (integer? val)
	       (set! *skribe-warning* val))))
	(("debug" :alternate "g" :arg level :help "sets the debug <level>")
	   (let ((val (string->number level)))
	     (if (integer? val)
		 (set-skribe-debug! val)
		 (begin
		   ;; Use the symbol for debug
		   (set-skribe-debug! 	    1)
		   (add-skribe-debug-symbol (string->symbol level))))))
	(("no-color" :help "disable coloring for output")
	 (no-debug-color))
	(("custom" :alternate "c" :arg key=val :help "Preset custom value")
	   (let ((args (string-split key=val "=")))
	     (if (and (list args) (= (length args) 2))
		 (let ((key (car args))
		       (val (cadr args)))
		   (set! *skribe-precustom* (cons (cons (string->symbol key) val)
						  *skribe-precustom*)))
		 (error 'parse-arguments "Bad custom ~S" key=val))))
	(("eval" :alternate "e" :arg expr :help "evaluate expression <expr>")
	   (with-input-from-string expr
	     (lambda () (eval (read)))))
	(else
	 (set! *skribe-src* other-arguments)))
    
    ;; we have to configure Skribe path according to the environment variable
    (skribe-path-set! (append (let ((path (getenv "SKRIBEPATH")))
				(if path 
				    (string-split path ":")
				    '()))
			      (reverse! paths)
			      (skribe-default-path)))
    ;; Final initializations
    (when engine
      (set! *skribe-engine* engine))))

;;;; ======================================================================
;;;;
;;;;				   L O A D - R C
;;;;
;;;; ======================================================================
(define (load-rc)
  (when *load-rc*
    (let ((file (make-path *skribe-rc-directory* *skribe-rc-file*)))
      (when (and file (file-exists? file))
	(load file)))))

      

;;;; ======================================================================
;;;;
;;;;				      S K R I B E
;;;;
;;;; ======================================================================
(define (doskribe)
   (let ((e (find-engine *skribe-engine*)))
     (if (and (engine? e) (pair? *skribe-precustom*))
	 (for-each (lambda (cv)
		     (engine-custom-set! e (car cv) (cdr cv)))
		   *skribe-precustom*))
     (if (pair? *skribe-src*)
	 (for-each (lambda (f) (skribe-load f :engine *skribe-engine*))
		   *skribe-src*)
	 (skribe-eval-port (current-input-port) *skribe-engine*))))


;;;; ======================================================================
;;;;
;;;;				      M A I N 
;;;;
;;;; ======================================================================
(define (main args)
  ;; Load the user rc file
  (load-rc)

  ;; Parse command line
  (parse-args args)

  ;; Load the base file to bootstrap the system as well as the files
  ;; that are in the *skribe-preload* variable
  (skribe-load "base.skr" :engine 'base)
  (for-each (lambda (f) (skribe-load f :engine *skribe-engine*)) *skribe-preload*)

  ;; Load the specified variants
  (for-each (lambda (x) (skribe-load (format "~a.skr" x) :engine *skribe-engine*))
	    (reverse! *skribe-variants*))

;;  (if (string? *skribe-dest*)
;;      (with-handler (lambda (kind loc msg)
;;		      (remove-file *skribe-dest*)
;;		      (error loc msg))
;;	 (with-output-to-file *skribe-dest* doskribe))
;;      (doskribe))
(if (string? *skribe-dest*)
    (with-output-to-file *skribe-dest* doskribe)
    (doskribe))
  
  0)