One step further with the Guile port.

* src/guile/skribilo.scm:  Use `getopt-long'; include all the necessary
  modules that user-visible macros depend on.
  Use `read-hash-extend' to allow for DSSSL-style keywords, as needed by
  Skribe modules.

* src/guile/skribe/debug.scm:  Export `with-debug' and `%with-debug'.

* src/guile/skribe/lib.scm (new):  Fixed.
  (define-markup):  Fixed (more the `rest' argument to the end).

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

3 files changed, 237 insertions, 68 deletions

diff --git a/src/guile/skribe/debug.scm b/src/guile/skribe/debug.scm
index 01f88c2..e2bff27 100644
--- a/src/guile/skribe/debug.scm
+++ b/src/guile/skribe/debug.scm
@@ -25,7 +25,8 @@
 
 
 (define-module (skribe debug)
-   :export (debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol
+   :export (with-debug %with-debug
+	    debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol
 	    no-debug-color))
 
 (define *skribe-debug* 			0)
@@ -138,7 +139,7 @@
       r)))
 
 (define-macro (with-debug  level label . body)
-  `((in-module SKRIBE-DEBUG-MODULE %with-debug) ,level ,label (lambda () ,@body)))
+  `(%with-debug ,level ,label (lambda () ,@body)))
 
 ;;(define-macro (with-debug  level label . body)
 ;;  `(begin ,@body))
diff --git a/src/guile/skribe/lib.scm b/src/guile/skribe/lib.scm
index 4a9b471..fa5e962 100644
--- a/src/guile/skribe/lib.scm
+++ b/src/guile/skribe/lib.scm
@@ -29,23 +29,34 @@
 ;;;
 ;;; NEW
 ;;;
-(define (maybe-copy obj)
-  (if (pair-mutable? obj)
-      obj
-      (copy-tree obj)))
-
 (define-macro (new class . parameters)
-  `(make ,(string->symbol (format "<~a>" class))
+  `(make ,(string->symbol (format #f "<~a>" class))
      ,@(apply append (map (lambda (x)
-			    `(,(make-keyword (car x)) (maybe-copy ,(cadr x))))
+			    `(,(symbol->keyword (car x)) ,(cadr x)))
 			  parameters))))
 
 ;;;
 ;;; DEFINE-MARKUP
 ;;;
 (define-macro (define-markup bindings . body)
-  ;; This is just a STklos extended lambda. Nothing to do
-  `(define ,bindings ,@body))
+  ;; This is just an `(ice-9 optargs)' kind of `lambda*', with DSSSL
+  ;; keyword-style conversion enabled.  However, using `(ice-9 optargs)', the
+  ;; `#:rest' argument can only appear last which not what Skribe/DSSSL
+  ;; expect, hence `fix-rest-arg'.
+  (define (fix-rest-arg args)
+    (let loop ((args args)
+	       (result '())
+	       (rest-arg #f))
+      (if (null? args)
+	  (if rest-arg (append (reverse result) rest-arg) (reverse result))
+	  (let ((is-rest-arg? (eq? (car args) #:rest)))
+	    (loop (if is-rest-arg? (cddr args) (cdr args))
+		  (if is-rest-arg? result (cons (car args) result))
+		  (if is-rest-arg? (list (car args) (cadr args)) rest-arg))))))
+
+  (let ((name (car bindings))
+	(opts (cdr bindings)))
+    `(define* ,(cons name (fix-rest-arg opts)) ,@body)))
 
 
 ;;;
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index 77e9618..e766830 100755
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -42,6 +42,28 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
 ;; Allow for this `:style' of keywords.
 (read-set! keywords 'prefix)
 
+;; Allow for DSSSL-style keywords (i.e. `#!key', etc.).
+;; See http://lists.gnu.org/archive/html/guile-devel/2005-06/msg00060.html
+;; for details.
+(read-hash-extend #\! (lambda (chr port)
+			(symbol->keyword (read port))))
+
+(let ((gensym-orig gensym))
+  ;; In Skribe, `gensym' expects a symbol as its (optional) argument, while
+  ;; Guile's `gensym' expect a string.  XXX
+  (set! gensym
+	(lambda (. args)
+	  (if (null? args)
+	      (gensym-orig)
+	      (let ((the-arg (car args)))
+		(cond ((symbol? the-arg)
+		       (gensym-orig (symbol->string the-arg)))
+		      ((string? the-arg)
+		       (gensym-orig the-arg))
+		      (else
+		       (skribe-error 'gensym "Invalid argument type"
+				     the-arg))))))))
+
 ; (use-modules (skribe eval)
 ; 	     (skribe configure)
 ; 	     (skribe runtime)
@@ -63,45 +85,169 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
 	     (skribe configure)
 	     (skribe eval)
 	     (skribe engine)
+	     (skribe types) ;; because `new' is a macro and refers to classes
 
-	     (ice-9 optargs))
+	     (oop goops)  ;; because `new' is a macro
+	     (ice-9 optargs)
+
+	     (ice-9 getopt-long))
 
 
 (load "skribe/lib.scm")
 
 (load "../common/configure.scm")
 (load "../common/param.scm")
-
-; (include "vars.stk")
-; (include "reader.stk")
-; (include "configure.stk")
-; (include "types.stk")
-; (include "debug.stk")
-; (include "lib.stk")
 (load "../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")
 (load "../common/sui.scm")
-
 (load "../common/index.scm")
+
+;; Markup definitions...
 (load "../common/api.scm")
 
 
-;;; KLUDGE for allowing redefinition of Skribe INCLUDE
-;(remove-expander! 'include)
+
+(define* (process-option-specs longname #:key (alternate #f)
+			       (arg #f) (help #f)
+			       #:rest thunk)
+  "Process STkLos-like option specifications and return getopt-long option
+specifications."
+  `(,(string->symbol longname)
+    ,@(if alternate
+	  `((single-char ,(string-ref alternate 0)))
+	  '())
+    (value #f)))
+
+(define (raw-options->getopt-long options)
+  "Converts @var{options} to a getopt-long-compatible representation."
+  (map (lambda (option-specs)
+	 (apply process-option-specs (car option-specs)))
+       options))
+
+(define-macro (define-options binding . options)
+  `(define ,binding (quote ,(raw-options->getopt-long options))))
+
+(define-options skribilo-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*)))
+     (if (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)))
+     (if (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)))
+     (if (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))))))
+
+; (define skribilo-options
+;   ;; Skribilo options in getopt-long's format, as computed by
+;   ;; `raw-options->getopt-long'.
+;   `((target (single-char #\t) (value #f))
+;     (I (value #f))
+;     (B (value #f))
+;     (S (value #f))
+;     (P (value #f))
+;     (split-chapters (single-char #\C) (value #f))
+;     (preload (value #f))
+;     (use-variant (single-char #\u) (value #f))
+;     (base (single-char #\b) (value #f))
+;     (rc-dir (single-char #\d) (value #f))
+;     (no-init-file (value #f))
+;     (output (single-char #\o) (value #f))
+;     (help (single-char #\h) (value #f))
+;     (options (value #f))
+;     (version (single-char #\V) (value #f))
+;     (query (single-char #\q) (value #f))
+;     (verbose (single-char #\v) (value #f))
+;     (warning (single-char #\w) (value #f))
+;     (debug (single-char #\g) (value #f))
+;     (no-color (value #f))
+;     (custom (single-char #\c) (value #f))
+;     (eval (single-char #\e) (value #f))))
+
 
+(define (skribilo-show-help)
+  (format #t "Usage: skribilo [OPTIONS] [INPUT]
+
+Processes a Skribilo/Skribe source file and produces its output.
+
+  --target=ENGINE  Use ENGINE as the underlying engine
+
+  --help           Give this help list
+  --version        Print program version
+"))
+
+(define (skribilo-show-version)
+  (format #t "skribilo ~a~%" (skribe-release)))
 
 ;;;; ======================================================================
 ;;;;
@@ -160,7 +306,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
 	   (set! *skribe-dest* file)
 	   (let* ((s (file-suffix file))
 		  (c (assoc s *skribe-auto-mode-alist*)))
-	     (when (and (pair? c) (symbol? (cdr c)))
+	     (if (and (pair? c) (symbol? (cdr c)))
 	       (set! *skribe-engine* (cdr c)))))
 
       "Misc:"
@@ -180,12 +326,12 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
 	(("verbose" :alternate "v" :arg level
 	  :help "sets the verbosity to <level>. Use -v0 for crystal silence")
 	   (let ((val (string->number level)))
-	     (when (integer? val)
+	     (if (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)
+	     (if (integer? val)
 	       (set! *skribe-warning* val))))
 	(("debug" :alternate "g" :arg level :help "sets the debug <level>")
 	   (let ((val (string->number level)))
@@ -219,7 +365,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
 			      (reverse! paths)
 			      (skribe-default-path)))
     ;; Final initializations
-    (when engine
+    (if engine
       (set! *skribe-engine* engine))))
 
 ;;;; ======================================================================
@@ -227,13 +373,14 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
 ;;;;				   L O A D - R C
 ;;;;
 ;;;; ======================================================================
+(define *load-rc* #f)  ;; FIXME:  This should go somewhere else.
+
 (define (load-rc)
-  (when *load-rc*
+  (if *load-rc*
     (let ((file (make-path *skribe-rc-directory* *skribe-rc-file*)))
-      (when (and file (file-exists? file))
+      (if (and file (file-exists? file))
 	(load file)))))
 
-      
 
 ;;;; ======================================================================
 ;;;;
@@ -254,35 +401,45 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
 
 ;;;; ======================================================================
 ;;;;
-;;;;				      M A I N 
+;;;;				      M A I N
 ;;;;
 ;;;; ======================================================================
 (define (skribilo . 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))
+  (let* ((options           (getopt-long (cons "skribilo" args) skribilo-options))
+	 (target            (option-ref options 'target #f))
+	 (help-wanted       (option-ref options 'help #f))
+	 (version-wanted    (option-ref options 'version #f)))
+
+    (cond (help-wanted    (begin (skribilo-show-help) (exit 1)))
+	  (version-wanted (begin (skribilo-show-version) (exit 1)))
+	  (target         (format #t "target set to `~a'~%" target)))
+
+    ;; Load the user rc file
+    (load-rc)
+
+    ;; 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 #f "~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))))
 
+(display "skribilo loaded\n")
 
 (define main skribilo)