;;;; ;;;; skribe.stk -- Skribe Main ;;;; ;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI ;;;; ;;;; ;;;; 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 ") (set! engine (string->symbol target))) (("I" :arg path :help "adds to Skribe path") (set! paths (cons path paths))) (("B" :arg path :help "adds to bibliography path") (skribe-bib-path-set! (cons path (skribe-bib-path)))) (("S" :arg path :help "adds to source path") (skribe-source-path-set! (cons path (skribe-source-path)))) (("P" :arg path :help "adds 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 ") (set! *skribe-preload* (cons file *skribe-preload*))) (("use-variant" :alternate "u" :arg variant :help "use 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 ") (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 ") (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 . 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 . 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 ") (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 ") (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)