aboutsummaryrefslogtreecommitdiff
path: root/src/stklos/main.stk
diff options
context:
space:
mode:
Diffstat (limited to 'src/stklos/main.stk')
-rw-r--r--src/stklos/main.stk264
1 files changed, 264 insertions, 0 deletions
diff --git a/src/stklos/main.stk b/src/stklos/main.stk
new file mode 100644
index 0000000..4905423
--- /dev/null
+++ b/src/stklos/main.stk
@@ -0,0 +1,264 @@
+;;;;
+;;;; 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)
generated by cgit v1.2.3 (git 2.45.0) at 2024-06-28 06:42:07 +0000