Merge from lcourtes@laas.fr--2005-mobile

Patches applied:

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2  (patch 27-28)

   - Merge from lcourtes@laas.fr--2004-libre
   - More fixes in the hope to get the manual compiled.

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

3 files changed, 73 insertions, 63 deletions

diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index b9805b3..43885ee 100644
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -87,7 +87,7 @@ specifications."
    (set! paths (cons path paths)))
   (("bib-path" :alternate "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")
+  (("source-path" :alternate "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))))
@@ -388,6 +388,7 @@ Processes a Skribilo/Skribe source file and produces its output.
 	 (warning-level     (option-ref options 'warning "2"))
 	 (load-path         (option-ref options 'load-path "."))
 	 (bib-path          (option-ref options 'bib-path "."))
+	 (source-path       (option-ref options 'source-path "."))
 	 (preload           '())
 	 (variants          '())
 
@@ -414,6 +415,9 @@ Processes a Skribilo/Skribe source file and produces its output.
     (parameterize ((*current-engine* engine)
 		   (*document-path*  (cons load-path (*document-path*)))
 		   (*bib-path*       (cons bib-path (*bib-path*)))
+		   (*source-path*    (cons source-path
+					   (append %load-path
+						   (*source-path*))))
 		   (*warning*        (string->number warning-level))
 		   (*verbose*        (let ((v (option-ref options
 							  'verbose 0)))
diff --git a/src/guile/skribilo/coloring/lisp.scm b/src/guile/skribilo/coloring/lisp.scm
index 589e70a..33ecc48 100644
--- a/src/guile/skribilo/coloring/lisp.scm
+++ b/src/guile/skribilo/coloring/lisp.scm
@@ -30,6 +30,7 @@
   :use-module (skribilo source)
   :use-module (skribilo lib)
   :use-module (skribilo runtime)
+  :use-module (ice-9 match)
   :autoload   (skribilo reader)  (make-reader)
   :export (skribe scheme stklos bigloo lisp))
 
@@ -48,14 +49,16 @@
 ;;;
 ;;; DEFINITION-SEARCH
 ;;;
-(define (definition-search inp tab test)
-  (let Loop ((exp (%read inp)))
+(define (definition-search inp read tab def?)
+  (let Loop ((exp (read inp)))
     (unless (eof-object? exp)
-      (if (test exp)
-	  (let ((start (and (%epair? exp) (%epair-line exp)))
-		(stop  (port-current-line inp)))
-	    (source-read-lines (port-file-name inp) start stop tab))
-	  (Loop (%read inp))))))
+      (if (def? exp)
+	  (let ((start (and (pair? exp) (source-property exp 'line)))
+		(stop  (port-line inp)))
+	    (format (current-error-port) "READ-LINES: `~a' ~a->~a~%"
+		    exp start stop)
+	    (source-read-lines (port-filename inp) start stop tab))
+	  (Loop (read inp))))))
 
 
 (define (lisp-family-fontifier s read)
@@ -75,15 +78,15 @@
 (define (lisp-extractor iport def tab)
   (definition-search
     iport
+    read
     tab
     (lambda (exp)
-      (match-case exp
-	 (((or defun defmacro) ?fun ?- . ?-)
-		(and (eq? def fun) exp))
-	 ((defvar ?var . ?-)
-		(and (eq? var def) exp))
-	 (else
-		#f)))))
+      (match exp
+	 (((or 'defun 'defmacro) fun _ . _)
+	  (and (eq? def fun) exp))
+	 (('defvar var . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
 
 (define (init-lisp-keys)
   (unless *lisp-keys*
@@ -117,15 +120,15 @@
 (define (scheme-extractor iport def tab)
   (definition-search
     iport
+    %skribilo-module-reader
     tab
     (lambda (exp)
-      (match-case exp
-	 (((or define define-macro) (?fun . ?-) . ?-)
-	     (and (eq? def fun) exp))
-	 ((define (and (? symbol?) ?var) . ?-)
-	     (and (eq? var def) exp))
-	 (else
-	     #f)))))
+      (match exp
+	 (((or 'define 'define-macro) (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (('define (? symbol? var) . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
 
 
 (define (init-scheme-keys)
@@ -161,14 +164,15 @@
 (define (stklos-extractor iport def tab)
   (definition-search
     iport
+    %skribilo-module-reader
     tab
     (lambda (exp)
-      (match-case exp
-	 (((or define define-generic define-method define-macro)
-	   (?fun . ?-) . ?-)
-		(and (eq? def fun) exp))
-	 (((or define define-module) (and (? symbol?) ?var) . ?-)
-		(and (eq? var def) exp))
+      (match exp
+	 (((or 'define 'define-generic 'define-method 'define-macro)
+	   (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (((or 'define 'define-module) (? symbol? var) . _)
+	  (and (eq? var def) exp))
 	 (else
 		#f)))))
 
@@ -214,17 +218,18 @@
 (define (skribe-extractor iport def tab)
   (definition-search
     iport
+    (make-reader 'skribe)
     tab
     (lambda (exp)
-      (match-case exp
-	(((or define define-macro define-markup) (?fun . ?-) . ?-)
-	   (and (eq? def fun) exp))
-	((define (and (? symbol?) ?var) . ?-)
-	   (and (eq? var def) exp))
-	((markup-output (quote ?mk) . ?-)
-	   (and (eq? mk def) exp))
-	(else
-	   #f)))))
+      (match exp
+	(((or 'define 'define-macro 'define-markup 'define-public)
+	  (fun . _) . _)
+	 (and (eq? def fun) exp))
+	(('define (? symbol? var) . _)
+	 (and (eq? var def) exp))
+	(('markup-output (quote mk) . _)
+	 (and (eq? mk def) exp))
+	(else #f)))))
 
 
 (define (init-skribe-keys)
@@ -275,17 +280,18 @@
 (define (bigloo-extractor iport def tab)
   (definition-search
     iport
+    %skribilo-module-reader
     tab
     (lambda (exp)
-      (match-case exp
-	 (((or define define-inline define-generic
-	       define-method define-macro define-expander)
-	   (?fun . ?-) . ?-)
-		(and (eq? def fun) exp))
-	 (((or define define-struct define-library) (and (? symbol?) ?var) . ?-)
-		(and (eq? var def) exp))
-	 (else
-		#f)))))
+      (match exp
+	 (((or 'define 'define-inline 'define-generic
+	       'define-method 'define-macro 'define-expander)
+	   (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (((or 'define 'define-struct 'define-library)
+	   (? symbol? var) . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
 
 (define bigloo
   (new language
diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/skribe/api.scm
index bf99868..c9606a0 100644
--- a/src/guile/skribilo/skribe/api.scm
+++ b/src/guile/skribilo/skribe/api.scm
@@ -1,7 +1,7 @@
-;;; api.scm
+;;; api.scm -- The markup API of Skribe/Skribilo.
 ;;;
 ;;; Copyright 2003, 2004  Manuel Serrano
-;;; Copyright 2005  Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
 ;;;
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
@@ -19,7 +19,8 @@
 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
 ;;; USA.
 
-(define-skribe-module (skribilo skribe api))
+(define-skribe-module (skribilo skribe api)
+  :replace (symbol))
 
 ;;; Author:  Manuel Serrano
 ;;; Commentary:
@@ -824,20 +825,19 @@
 ;*---------------------------------------------------------------------*/
 ;*    symbol ...                                                       */
 ;*---------------------------------------------------------------------*/
-(set! symbol
-      (lambda (symbol)
-	(let ((v (cond
-		  ((symbol? symbol)
-		   (symbol->string symbol))
-		  ((string? symbol)
-		   symbol)
-		  (else
-		   (skribe-error 'symbol
-				 "Illegal argument (symbol expected)"
-				 symbol)))))
-	  (new markup
-	       (markup 'symbol)
-	       (body v)))))
+(define-markup (symbol symbol)
+  (let ((v (cond
+	    ((symbol? symbol)
+	     (symbol->string symbol))
+	    ((string? symbol)
+	     symbol)
+	    (else
+	     (skribe-error 'symbol
+			   "Illegal argument (symbol expected)"
+			   symbol)))))
+    (new markup
+	 (markup 'symbol)
+	 (body v))))
 
 ;*---------------------------------------------------------------------*/
 ;*    ! ...                                                            */