Merge from lcourtes@laas.fr--2004-libre

Patches applied:

 * lcourtes@laas.fr--2004-libre/skribilo--devel--1.2  (patch 25-30)

   - Removed the Bigloo/STkLos in the `legacy' directory.
   - Cleaned up the Arch inventory and removed old useless makefiles.
   - Introduced SRFI-3[45] conditions; cleaned up `evaluator.scm'.
   - More SRFI-3[45] enhancements; first stab at the user documentation.
   - Towards a self-hosted user manual.
   - Various fixes: HTML engine, resolution, compatibility.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-27

5 files changed, 64 insertions, 48 deletions

diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index a376713..1f3466f 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -17,6 +17,7 @@
 ;*=====================================================================*/
 
 (define-skribe-module (skribilo engine html)
+  :autoload   (skribilo parameters) (*destination-file*)
   :use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)))
 
 
@@ -60,17 +61,17 @@
 			(engine-custom e 'subsection-file))
 		   (and (is-markup? node 'subsubsection)
 			(engine-custom e 'subsubsection-file)))
-	       (let* ((b (or (and (string? *skribe-dest*)
-				  (prefix *skribe-dest*))
+	       (let* ((b (or (and (string? (*destination-file*))
+				  (prefix (*destination-file*)))
 			     ""))
-		      (s (or (and (string? *skribe-dest*)
-				  (suffix *skribe-dest*))
+		      (s (or (and (string? (*destination-file*))
+				  (suffix (*destination-file*)))
 			     "html"))
 		      (nm (get-file-name b s)))
 		  (markup-option-add! node filename nm)
 		  nm))
 	      ((document? node)
-	       *skribe-dest*)
+	       (*destination-file*))
 	      (else
 	       (let ((p (ast-parent node)))
 		  (if (container? p)
@@ -986,8 +987,8 @@
       (sui-blocks 'subsection n e)
       (sui-blocks 'subsubsection n e)
       (display "  )\n"))
-   (if (string? *skribe-dest*)
-       (let ((f (format #f "~a.sui" (prefix *skribe-dest*))))
+   (if (string? (*destination-file*))
+       (let ((f (format #f "~a.sui" (prefix (*destination-file*)))))
 	  (with-output-to-file f sui))
        (sui)))
 
@@ -1132,22 +1133,17 @@
 		    (printf "<td colspan=\"~a\" width=\"100%\">"
 			    (- 4 level))
 		    (printf "<a href=\"~a#~a\">"
-			    (if (and *skribe-dest*
-				     (string=? f *skribe-dest*))
+			    (if (and (*destination-file*)
+				     (string=? f (*destination-file*)))
 				""
-				(strip-ref-base (or f *skribe-dest* "")))
+				(strip-ref-base (or f (*destination-file*) "")))
 			    (string-canonicalize id))
 		    (output (markup-option c :title) e)
 		    (display "</a></td>")
 		    (display "</tr>\n")
 		    ;; the children
 		    (for-each (lambda (n) (toc-entry n (+ 1 level))) ch)))
-	      (define (symbol->keyword s)
-		 (cond-expand
-		    (stklos
-		     (make-keyword s))
-		    (bigloo
-		     (string->keyword (string-append ":" (symbol->string s))))))
+
 	      (let* ((c (markup-option n :chapter))
 		     (s (markup-option n :section))
 		     (ss (markup-option n :subsection))
@@ -1925,9 +1921,10 @@
 				(markup-class n)
 				"inbound")))
 		 (printf "<a href=\"~a#~a\" class=\"~a\""
-			 (if (and *skribe-dest* (string=? f *skribe-dest*))
+			 (if (and (*destination-file*)
+				  (string=? f (*destination-file*)))
 			     ""
-			     (strip-ref-base (or f *skribe-dest* "")))
+			     (strip-ref-base (or f (*destination-file*) "")))
 			 (string-canonicalize id)
 			 class)
 		 (display ">")))
diff --git a/src/guile/skribilo/parameters.scm b/src/guile/skribilo/parameters.scm
index b464667..04517e7 100644
--- a/src/guile/skribilo/parameters.scm
+++ b/src/guile/skribilo/parameters.scm
@@ -76,8 +76,7 @@
 (define-public *destination-file* (make-parameter "output.html"))
 (define-public *source-file*      (make-parameter "default-input-file.skb"))
 
-;; FIXME: I don't understand exactly what this is.  See, for instance, the
-;; HTML and Context engines.
+;; Base prefix to remove from hyperlinks.
 (define-public *ref-base*         (make-parameter ""))
 
 ;;; TODO: Skribe used to have other parameters as global variables.  See
diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm
index 7c83270..020a275 100644
--- a/src/guile/skribilo/prog.scm
+++ b/src/guile/skribilo/prog.scm
@@ -89,7 +89,7 @@
        (values #f line))
       ((string? line)
        (extract-string-mark line mark regexp))
-      ((pair? line)
+      ((list? line)
        (let loop ((ls line)
 		  (res '()))
 	  (if (null? ls)
@@ -135,7 +135,7 @@
 		 (loop r1
 		       (+ r2 1)
 		       res))))))
-      ((pair? line)
+      ((list? line)
        (let loop ((ls line)
 		  (res '()))
 	  (if (null? ls)
diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
index c100b62..cbb939d 100644
--- a/src/guile/skribilo/resolve.scm
+++ b/src/guile/skribilo/resolve.scm
@@ -72,13 +72,16 @@
 (define-method (do-resolve! (ast <pair>) engine env)
   (let Loop ((n* ast))
     (cond
-      ((pair? n*)
+      ((null? n*)
+       ast)
+      ((list? n*)
        (set-car! n* (do-resolve! (car n*) engine env))
        (Loop (cdr n*)))
-      ((not (null? n*))
-       (error 'do-resolve "illegal argument" n*))
+      ((pair? n*)
+       (set-car! n* (do-resolve! (car n*) engine env))
+       (set-cdr! n* (do-resolve! (cdr n*) engine env)))
       (else
-       ast))))
+       (error 'do-resolve "illegal argument" n*)))))
 
 
 (define-method (do-resolve! (node <node>) engine env)
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index c187975..c6e95bf 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -24,6 +24,7 @@
   :use-module (skribilo parameters)
   :use-module (skribilo evaluator)
   :use-module (srfi srfi-1)
+  :autoload   (srfi srfi-13) (string-rindex)
   :use-module (srfi srfi-34)
   :use-module (srfi srfi-35)
   :use-module (ice-9 optargs)
@@ -63,6 +64,9 @@
 ;;; Global variables that have been replaced by parameter objects
 ;;; in `(skribilo parameters)'.
 ;;;
+;;; FIXME: There's not much we can do about these variables (as opposed to
+;;; the _accessors_ below).  Perhaps we should just not define them?
+;;;
 
 ;;; Switches
 (define-public *skribe-verbose*	0)
@@ -86,7 +90,7 @@
 (define-public *skribe-dest*		#f)
 
 ;;; Engine
-(define-public *skribe-engine*	'html)	;; Use HTML by default
+(define-public *skribe-engine*  	'html)	;; Use HTML by default
 
 ;;; Misc
 (define-public *skribe-chapter-split*	'())
@@ -112,7 +116,16 @@
 
 (define %skribe-known-files
   ;; Like of Skribe package files and their equivalent Skribilo module.
-  '(("web-book.skr" . (skribilo packages web-book))))
+  '(("web-book.skr"     . (skribilo package web-book))
+    ("web-article.skr"  . (skribilo package web-article))
+    ("slide.skr"        . (skribilo package slide))
+    ("sigplan.skr"      . (skribilo package sigplan))
+    ("scribe.skr"       . (skribilo package scribe))
+    ("lncs.skr"         . (skribilo package lncs))
+    ("letter.skr"       . (skribilo package letter))
+    ("jfp.skr"          . (skribilo package jfp))
+    ("french.skr"       . (skribilo package french))
+    ("acmproc.skr"      . (skribilo package acmproc))))
 
 (define*-public (skribe-load file :rest args)
   (call/cc
@@ -121,15 +134,20 @@
 		;; Regular file loading failed.  Try built-ins.
 		(let ((mod-name (assoc-ref %skribe-known-files file)))
 		  (if mod-name
-		      (let ((mod (false-if-exception
-				  (resolve-module mod-name))))
-			(if (not mod)
-			    (raise c)
-			    (begin
-			      (set-module-uses!
-			       (current-module)
-			       (cons mod (module-uses (current-module))))
-			      (return #t))))
+		      (begin
+			(if (> (*verbose*) 1)
+			    (format (current-error-port)
+				    "  skribe-load: `~a' -> `~a'~%"
+				    file mod-name))
+			(let ((mod (false-if-exception
+				    (resolve-module mod-name))))
+			  (if (not mod)
+			      (raise c)
+			      (begin
+				(set-module-uses!
+				 (current-module)
+				 (cons mod (module-uses (current-module))))
+				(return #t)))))
 		      (raise c)))))
 
 	    ;; Try a regular `load-document'.
@@ -175,19 +193,18 @@
 
 (define-public (file-prefix fn)
   (if fn
-      (let ((match (regexp-match "(.*)\\.([^/]*$)" fn)))
-	(if match
-	    (cadr match)
-	    fn))
+      (let ((dot (string-rindex fn #\.)))
+	(if dot (substring fn 0 dot) fn))
       "./SKRIBILO-OUTPUT"))
 
-(define-public (file-suffix s)
-  ;; Not completely correct, but sufficient here
-  (let* ((basename (regexp-replace "^(.*)/(.*)$" s "\\2"))
-	 (split    (string-split basename ".")))
-    (if (> (length split) 1)
-	(car (reverse! split))
-	"")))
+(define-public (file-suffix fn)
+  (if fn
+      (let ((dot (string-rindex fn #\.)))
+	(if dot
+	    (substring fn (+ dot 1) (string-length fn))
+	    ""))
+      #f))
+
 
 (define-public prefix			file-prefix)
 (define-public suffix			file-suffix)