Initial import of Skribe 1.2d.

Initial import of Skribe 1.2d.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0

1 files changed, 186 insertions, 0 deletions

diff --git a/skribe/src/bigloo/parseargs.scm b/skribe/src/bigloo/parseargs.scm
new file mode 100644
index 0000000..4ce58c4
--- /dev/null
+++ b/skribe/src/bigloo/parseargs.scm
@@ -0,0 +1,186 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/bigloo/parseargs.scm             */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Tue Jul 22 16:52:53 2003                          */
+;*    Last change :  Wed Nov 10 10:57:40 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    Argument parsing                                                 */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    The module                                                       */
+;*---------------------------------------------------------------------*/
+(module skribe_parse-args
+   
+   (include "debug.sch")
+
+   (import  skribe_configure
+	    skribe_param
+	    skribe_read
+	    skribe_types
+	    skribe_eval)
+   
+   (export  (parse-env-variables)
+	    (parse-args ::pair)
+	    (load-rc)))
+
+;*---------------------------------------------------------------------*/
+;*    parse-env-variables ...                                          */
+;*---------------------------------------------------------------------*/
+(define (parse-env-variables)
+   (let ((e (getenv "SKRIBEPATH")))
+      (if (string? e)
+	  (skribe-path-set! (append (unix-path->list e) (skribe-path))))))
+
+;*---------------------------------------------------------------------*/
+;*    parse-args ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (parse-args args)
+   (define (usage args-parse-usage)
+      (print "usage: skribe [options] [input]")
+      (newline)
+      (args-parse-usage #f)
+      (newline)
+      (print "Rc file:")
+      (newline)
+      (print "   *skribe-rc* (searched in \".\" then $HOME)")
+      (newline)
+      (print "Target formats:")
+      (for-each (lambda (f) (print "   - " (car f))) *skribe-auto-mode-alist*)
+      (newline)
+      (print "Shell Variables:")
+      (newline)
+      (for-each (lambda (var)
+		   (print "   - " (car var) " " (cdr var)))
+		'(("SKRIBEPATH" . "Skribe input path (all files)"))))
+   (define (version)
+      (print "skribe v" (skribe-release)))
+   (define (query)
+      (version)
+      (newline)
+      (for-each (lambda (x)
+		   (let ((s (keyword->string (car x))))
+		      (printf "  ~a: ~a\n"
+			      (substring s 1 (string-length s))
+			      (cadr x))))
+		(skribe-configure)))
+   (let ((np  '())
+	 (engine #f))
+      (args-parse (cdr args)
+	 ((("-h" "--help") (help "This message"))
+	  (usage args-parse-usage)
+	  (exit 0))
+	 (("--options" (help "Display the skribe options and exit"))
+	  (args-parse-usage #t)
+	  (exit 0))
+	 (("--version" (help "The version of Skribe"))
+	  (version)
+	  (exit 0))
+	 ((("-q" "--query") (help "Display informations about the Skribe configuration"))
+	  (query)
+	  (exit 0))
+	 ((("-c" "--custom") ?key=val (synopsis "Preset custom value"))
+	  (let ((l (string-length key=val)))
+	     (let loop ((i 0))
+		(cond
+		   ((= i l)
+		    (skribe-error 'skribe "Illegal option" key=val))
+		   ((char=? (string-ref key=val i) #\=)
+		    (let ((key (substring key=val 0 i))
+			  (val (substring key=val (+ i 1) l)))
+		       (set! *skribe-precustom*
+			     (cons (cons (string->symbol key) val)
+				   *skribe-precustom*))))
+		   (else
+		    (loop (+ i 1)))))))
+	 (("-v?level" (help "Increase or set verbosity level (-v0 for crystal silence)"))
+	  (if (string=? level "")
+	      (set! *skribe-verbose* (+fx 1 *skribe-verbose*))
+	      (set! *skribe-verbose* (string->integer level))))
+	 (("-w?level" (help "Increase or set warning level (-w0 for crystal silence)"))
+	  (if (string=? level "")
+	      (set! *skribe-warning* (+fx 1 *skribe-warning*))
+	      (set! *skribe-warning* (string->integer level))))
+	 (("-g?level" (help "Increase or set debug level"))
+	  (if (string=? level "")
+	      (set! *skribe-debug* (+fx 1 *skribe-debug*))
+	      (let ((l (string->integer level)))
+		 (if (= l 0)
+		     (begin
+			(set! *skribe-debug* 1)
+			(set! *skribe-debug-symbols*
+			      (cons (string->symbol level)
+				    *skribe-debug-symbols*)))
+		     (set! *skribe-debug* l)))))
+	 (("--no-color" (help "Disable coloring for debug"))
+	  (set! *skribe-debug-color* #f))
+	 ((("-t" "--target") ?e (help "The output target format"))
+	  (set! engine (string->symbol e)))
+	 (("-I" ?path (help "Add <path> to skribe path"))
+	  (set! np (cons path np)))
+	 (("-B" ?path (help "Add <path> to skribe bibliography path"))
+	  (skribe-bib-path-set! (cons path (skribe-bib-path))))
+	 (("-S" ?path (help "Add <path> to skribe source path"))
+	  (skribe-source-path-set! (cons path (skribe-source-path))))
+	 (("-P" ?path (help "Add <path> to skribe image path"))
+	  (skribe-image-path-set! (cons path (skribe-image-path))))
+	 ((("-C" "--split-chapter") ?chapter (help "Emit chapter's sections in separate files"))
+	  (set! *skribe-chapter-split* (cons chapter *skribe-chapter-split*)))
+	 (("--eval" ?expr (help "Evaluate expression"))
+	  (with-input-from-string expr
+	     (lambda ()
+		(eval (skribe-read)))))
+	 (("--no-init-file" (help "Dont load rc Skribe file"))
+	  (set! *load-rc* #f))
+	 ((("-p" "--preload") ?file (help "Preload file"))
+	  (set! *skribe-preload* (cons file *skribe-preload*)))
+	 ((("-u" "--use-variant") ?variant (help "use <variant> output format"))
+	  (set! *skribe-variants* (cons variant *skribe-variants*)))
+	 ((("-o" "--output") ?o (help "The output target name"))
+	  (set! *skribe-dest* o)
+	  (let* ((s (suffix o))
+		 (c (assoc s *skribe-auto-mode-alist*)))
+	     (if (and (pair? c) (symbol? (cdr c)))
+		 (set! *skribe-engine* (cdr c)))))
+	 ((("-b" "--base") ?base (help "The base prefix to be removed from hyperlinks"))
+	  (set! *skribe-ref-base* base))
+	 ;; skribe rc directory
+	 ((("-d" "--rc-dir") ?dir (synopsis "Set the skribe RC directory"))
+	  (set! *skribe-rc-directory* dir))
+	 (else
+	  (set! *skribe-src* (cons else *skribe-src*))))
+      ;; we have to configure according to the environment variables
+      (if engine (set! *skribe-engine* engine))
+      (set! *skribe-src* (reverse! *skribe-src*))
+      (skribe-path-set! (append (build-path-from-shell-variable "SKRIBEPATH")
+				(reverse! np)
+				(skribe-path)))))
+
+;*---------------------------------------------------------------------*/
+;*    build-path-from-shell-variable ...                               */
+;*---------------------------------------------------------------------*/
+(define (build-path-from-shell-variable var)
+   (let ((val (getenv var)))
+      (if (string? val)
+	  (string-case val
+	     ((+ (out #\:))
+	      (let* ((str (the-string))
+		     (res (ignore)))
+		 (cons str res)))
+	     (#\:
+	      (ignore))
+	     (else
+	      '()))
+	  '())))
+
+;*---------------------------------------------------------------------*/
+;*    load-rc ...                                                      */
+;*---------------------------------------------------------------------*/
+(define (load-rc)
+   (if *load-rc*
+       (let ((file (make-file-name *skribe-rc-directory* *skribe-rc-file*)))
+	  (if (and (string? file) (file-exists? file))
+	      (loadq file)))))
+