Merge from skribilo@sv.gnu.org--2006

Patches applied:

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

   - Merge from skribilo@sv.gnu.org--2006/skribilo--devo--1.2
   - Fixed (or almost so) the C lexer.
   - Autoload `(skribilo coloring c)' in the default module.
   - `lout' engine: Fixed argument passing for `lout-illustration'.
   - `base' package: Honor `:line #f' in `prog'.
   - Tiny doc fix.
   - Removed global hash tables for marks and program lines.
   - Fixed and simplified `(ref :line ...)', aka. `line-ref'.

 * skribilo@sv.gnu.org--2006/skribilo--devo--1.2  (patch 122-133)

   - `diff' package: Small bug fix.
   - Updated `TODO'.
   - Factorized `bib-ref+', add a `:sort-bib-refs' options to `ref'.
   - Updated documentation of `ref'.
   - `lncs' package: Honor `:sort-bib-refs'.
   - Fixed (or almost so) the C lexer.
   - Autoload `(skribilo coloring c)' in the default module.
   - `lout' engine: Fixed argument passing for `lout-illustration'.
   - `base' package: Honor `:line #f' in `prog'.
   - Tiny doc fix.
   - Removed global hash tables for marks and program lines.
   - Fixed and simplified `(ref :line ...)', aka. `line-ref'.

git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-83

12 files changed, 168 insertions, 205 deletions

diff --git a/src/guile/skribilo/coloring/Makefile.am b/src/guile/skribilo/coloring/Makefile.am
index 9a3e043..5073575 100644
--- a/src/guile/skribilo/coloring/Makefile.am
+++ b/src/guile/skribilo/coloring/Makefile.am
@@ -18,6 +18,7 @@ EXTRA_DIST = lisp-lex.l xml-lex.l c-lex.l
 	echo '  :use-module (skribilo lib)' >> "$@" &&			\
 	echo '  :use-module (skribilo coloring parameters)'		\
 		>> "$@" &&						\
+	echo '  :use-module (srfi srfi-1)' >> "$@" &&			\
 	echo '  :export (lexer-init lexer' >> "$@" &&			\
 	echo '           lexer-get-func-column' >> "$@" &&		\
 	echo '           lexer-get-func-offset' >> "$@" &&		\
diff --git a/src/guile/skribilo/coloring/c-lex.l b/src/guile/skribilo/coloring/c-lex.l
index 7d7b1ce..b28a91a 100644
--- a/src/guile/skribilo/coloring/c-lex.l
+++ b/src/guile/skribilo/coloring/c-lex.l
@@ -1,28 +1,22 @@
-;;;;
-;;;; c-lex.l			-- C fontifier for Skribe
-;;;; 
-;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 
-;;;; USA.
-;;;; 
-;;;;           Author: Erick Gallesio [eg@essi.fr]
-;;;;    Creation date:  6-Mar-2004 15:35 (eg)
-;;;; Last file update:  7-Mar-2004 00:10 (eg)
-;;;;
+;;; c-lex.l  --  C fontifier for Skribilo.
+;;;
+;;; Copyright 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2007  Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
 
 space	 [ \n\9]
 letter   [_a-zA-Z]
@@ -34,34 +28,46 @@ alphanum [_a-zA-Z0-9]
 \"[^\"]*\"		(new markup
 			     (markup '&source-string)
 			     (body yytext))
-;;Comments
-/\*.*\*/		(new markup
-			     (markup '&source-line-comment)
-			     (body   yytext))
+;; Comments
+;; FIXME: We shouldn't exclude `/' from comments but we do so to match the
+;; shortest multi-line comment.
+/\*(\n|[^/])*\*/	(let* ((not-line (char-set-complement (char-set #\newline)))
+                               (lines    (string-tokenize yytext not-line)))
+                          (reverse!
+                           (pair-fold (lambda (line* result)
+                                        (let* ((line  (car line*))
+                                               (last? (null? (cdr line*)))
+                                               (markup
+                                                (new markup
+                                                   (markup '&source-line-comment)
+                                                   (body   line))))
+                                          (if last?
+                                              (cons markup result)
+                                              (cons* (string #\newline)
+                                                     markup result))))
+                                      '()
+                                      lines)))
+
 //.*			(new markup
 			     (markup '&source-line-comment)
 			     (body   yytext))
 
 ;; Identifiers (only letters since we are interested in keywords only)
 [_a-zA-Z]+		(let* ((ident (string->symbol yytext))
-			       (tmp   (memq  ident *the-keys*)))
+			       (tmp   (memq ident (*the-keys*))))
 			  (if tmp
 			      (new markup
 				   (markup '&source-module)
 				   (body yytext))
 			      yytext))
 
-;; Regular text
-[^\"a-zA-Z]+		(begin yytext)
+;; Regular text (excluding `/' and `*')
+[^\"a-zA-Z/*]+		(begin yytext)
 
+;; `/' and `*' alone.
+/[^\*]                  (begin yytext)
+\*[^/]                  (begin yytext)
 
 
 <<EOF>>			'eof
-<<ERROR>>		(skribe-error 'lisp-fontifier "Parse error" yytext)
-
-				   
-			    
-			      
-			      
-
-			  
\ No newline at end of file
+<<ERROR>>		(skribe-error 'c-fontifier "Parse error" yytext)
diff --git a/src/guile/skribilo/coloring/c-lex.scm b/src/guile/skribilo/coloring/c-lex.scm
index 8ed6160..162c0c2 100644
--- a/src/guile/skribilo/coloring/c-lex.scm
+++ b/src/guile/skribilo/coloring/c-lex.scm
@@ -1,6 +1,7 @@
 (define-module (skribilo coloring c-lex)
   :use-module (skribilo lib)
   :use-module (skribilo coloring parameters)
+  :use-module (srfi srfi-1)
   :export (lexer-init lexer
            lexer-get-func-column
            lexer-get-func-offset
@@ -1152,7 +1153,7 @@
        ))
    (lambda (yycontinue yygetc yyungetc)
      (lambda (yytext yyline)
-         		(skribe-error 'lisp-fontifier "Parse error" yytext)
+         		(skribe-error 'c-fontifier "Parse error" yytext)
        ))
    (vector
     #t
@@ -1161,14 +1162,29 @@
           		(new markup
 			     (markup '&source-string)
 			     (body yytext))
-;;Comments
+;; Comments
+;; FIXME: We shouldn't exclude `/' from comments but we do so to match the
+;; shortest multi-line comment.
         ))
     #t
     (lambda (yycontinue yygetc yyungetc)
       (lambda (yytext yyline)
-        		(new markup
-			     (markup '&source-line-comment)
-			     (body   yytext))
+                	(let* ((not-line (char-set-complement (char-set #\newline)))
+                               (lines    (string-tokenize yytext not-line)))
+                          (reverse!
+                           (pair-fold (lambda (line* result)
+                                        (let* ((line  (car line*))
+                                               (last? (null? (cdr line*)))
+                                               (markup
+                                                (new markup
+                                                   (markup '&source-line-comment)
+                                                   (body   line))))
+                                          (if last?
+                                              (cons markup result)
+                                              (cons* (string #\newline)
+                                                     markup result))))
+                                      '()
+                                      lines)))
         ))
     #t
     (lambda (yycontinue yygetc yyungetc)
@@ -1183,36 +1199,44 @@
     (lambda (yycontinue yygetc yyungetc)
       (lambda (yytext yyline)
           		(let* ((ident (string->symbol yytext))
-			       (tmp   (memq  ident *the-keys*)))
+			       (tmp   (memq ident (*the-keys*))))
 			  (if tmp
 			      (new markup
 				   (markup '&source-module)
 				   (body yytext))
 			      yytext))
 
-;; Regular text
+;; Regular text (excluding `/' and `*')
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+              		(begin yytext)
+
+;; `/' and `*' alone.
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+                        (begin yytext)
         ))
     #t
     (lambda (yycontinue yygetc yyungetc)
       (lambda (yytext yyline)
-            		(begin yytext)
+                        (begin yytext)
         )))
    'decision-trees
    0
    0
-   '#((65 (35 (34 1 5) (= 47 4 1)) (96 (91 3 (95 1 2)) (97 1 (123 3 1))))
-    (65 (= 34 err 1) (97 (91 err 1) (123 err 1))) (91 (35 (34 1 err) (65 1
-    3)) (96 (95 1 2) (97 1 (123 3 1)))) (95 (65 err (91 3 err)) (97 (96 3
-    err) (123 3 err))) (47 (35 (34 1 err) (= 42 7 1)) (91 (48 6 (65 1 err))
-    (97 1 (123 err 1)))) (= 34 8 5) (35 (11 (10 6 1) (34 6 9)) (91 (65 6 9)
-    (97 6 (123 9 6)))) (42 (11 (10 7 1) (= 34 10 7)) (91 (43 11 (65 7 10))
-    (97 7 (123 10 7)))) err (= 10 err 9) (11 (10 10 err) (= 42 12 10)) (43
-    (34 (= 10 1 7) (35 10 (42 7 11))) (65 (= 47 13 7) (97 (91 10 7) (123 10
-    7)))) (42 (= 10 err 10) (47 (43 12 10) (48 14 10))) (42 (11 (10 7 1) (=
-    34 10 7)) (91 (43 11 (65 7 10)) (97 7 (123 10 7)))) (11 (10 10 err) (=
-    42 12 10)))
-   '#((#f . #f) (4 . 4) (3 . 3) (3 . 3) (4 . 4) (#f . #f) (2 . 2) (4 . 4)
-    (0 . 0) (2 . 2) (#f . #f) (4 . 4) (#f . #f) (1 . 1) (1 . 1))))
+   '#((48 (42 (= 34 6 2) (43 1 (47 2 5))) (95 (65 2 (91 4 2)) (97 (96 3 2)
+    (123 4 2)))) (= 47 err 7) (47 (35 (34 2 err) (= 42 err 2)) (91 (48 err
+    (65 2 err)) (97 2 (123 err 2)))) (48 (42 (= 34 err 2) (43 err (47 2
+    err))) (95 (65 2 (91 4 2)) (97 (96 3 2) (123 4 2)))) (95 (65 err (91 4
+    err)) (97 (96 4 err) (123 4 err))) (43 (42 8 10) (= 47 9 8)) (= 34 11
+    6) err err (= 10 err 12) (43 (42 10 13) (= 47 err 10)) err (= 10 err
+    12) (43 (42 10 13) (= 47 14 10)) err)
+   '#((#f . #f) (#f . #f) (4 . 4) (3 . 3) (3 . 3) (#f . #f) (#f . #f) (6 .
+    6) (5 . 5) (2 . 2) (#f . #f) (0 . 0) (2 . 2) (#f . #f) (1 . 1))))
 
 ;
 ; User functions
diff --git a/src/guile/skribilo/coloring/c.scm b/src/guile/skribilo/coloring/c.scm
index 28533b4..0d94307 100644
--- a/src/guile/skribilo/coloring/c.scm
+++ b/src/guile/skribilo/coloring/c.scm
@@ -19,13 +19,13 @@
 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
 ;;; USA.
 
-(define-module (skribilo c)
+(define-module (skribilo coloring c)
   :use-module (skribilo lib)
   :use-module (skribilo utils syntax)
   :use-module (skribilo coloring c-lex)		;; SILex generated
   :use-module (skribilo coloring parameters)
   :use-module (srfi srfi-39)
-  :export (c java))
+  :export (c c-language java))
 
 (fluid-set! current-reader %skribilo-module-reader)
 
@@ -62,6 +62,10 @@
        (fontifier c-fontifier)
        (extractor #f)))
 
+(define c-language
+  ;; This alias is defined for the user's convenience.
+  c)
+
 
 ;;;
 ;;; Java.
diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm
index 9e9445e..344146e 100644
--- a/src/guile/skribilo/engine/base.scm
+++ b/src/guile/skribilo/engine/base.scm
@@ -498,7 +498,8 @@
 (markup-writer 'line-ref
    :options '(:offset)
    :action (lambda (n e)
-	      (let ((o (markup-option n :offset))
-		    (n (markup-ident (handle-body (markup-body n)))))
-		 (evaluate-document (it (if (integer? o) (+ o n) n)) e))))
+             (let ((o (markup-option n :offset))
+                   (n (markup-option (handle-ast (markup-body n)) :number)))
+               (if (integer? n)
+                   (display (if (integer? o) (+ o n) n))))))
 
diff --git a/src/guile/skribilo/engine/context.scm b/src/guile/skribilo/engine/context.scm
index 1b4301b..98069a3 100644
--- a/src/guile/skribilo/engine/context.scm
+++ b/src/guile/skribilo/engine/context.scm
@@ -1060,22 +1060,6 @@
    :action (lambda (n e)
 	     (context-url (markup-option n :url) (markup-option n :text) e)))
 
-;;//;*---------------------------------------------------------------------*/
-;;//;*    line-ref ...                                                     */
-;;//;*---------------------------------------------------------------------*/
-;;//(markup-writer 'line-ref
-;;//   :options '(:offset)
-;;//   :before "{\\textit{"
-;;//   :action (lambda (n e)
-;;//	      (let ((o (markup-option n :offset))
-;;//		    (v (string->number (markup-option n :text))))
-;;//		 (cond
-;;//		    ((and (number? o) (number? v))
-;;//		     (display (+ o v)))
-;;//		    (else
-;;//		     (display v)))))
-;;//   :after "}}")
-
 
 ;;; ======================================================================
 ;;;	&the-bibliography ...
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index 688d33d..a16f01f 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -2069,6 +2069,21 @@
 		 (output (or v (markup-option n :url)) e)))
    :after "</a>")
 
+
+;*---------------------------------------------------------------------*/
+;*    &prog-line ...                                                   */
+;*---------------------------------------------------------------------*/
+(markup-writer '&prog-line
+   :before (lambda (n e)
+             (let ((before (writer-before
+                            (markup-writer-get '&prog-line base-engine))))
+               (format #t "<a name=\"~a\""
+                       (string-canonicalize (markup-ident n)))
+               (html-class n)
+               (display ">")
+               (before n e)))
+   :after "</a>\n")
+
 ;*---------------------------------------------------------------------*/
 ;*    line-ref ...                                                     */
 ;*---------------------------------------------------------------------*/
@@ -2077,12 +2092,14 @@
    :before (html-markup-class "i")
    :action (lambda (n e)
 	      (let ((o (markup-option n :offset))
-		    (v (string->number (markup-option n :text))))
-		 (if (and (number? o) (number? v))
-		     (markup-option-add! n :text (+ o v)))
+		    (v (markup-option (handle-ast (markup-body n)) :number)))
+		 (cond ((and (number? o) (number? v))
+                        (markup-option-set! n :text (+ o v)))
+                       ((number? v)
+                        (markup-option-set! n :text v)))
 		 (output n e (markup-writer-get 'ref e))
 		 (if (and (number? o) (number? v))
-		     (markup-option-add! n :text v))))
+		     (markup-option-set! n :text v))))
    :after "</i>")
 
 ;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm
index 9b49545..8523c9a 100644
--- a/src/guile/skribilo/engine/latex.scm
+++ b/src/guile/skribilo/engine/latex.scm
@@ -1579,22 +1579,6 @@
 			(format #t "}{~a}" url))))))
 
 ;*---------------------------------------------------------------------*/
-;*    line-ref ...                                                     */
-;*---------------------------------------------------------------------*/
-(markup-writer 'line-ref
-   :options '(:offset)
-   :before "{\\textit{"
-   :action (lambda (n e)
-	      (let ((o (markup-option n :offset))
-		    (v (string->number (markup-option n :text))))
-		 (cond
-		    ((and (number? o) (number? v))
-		     (display (+ o v)))
-		    (else
-		     (display v)))))
-   :after "}}")
-
-;*---------------------------------------------------------------------*/
 ;*    &the-bibliography ...                                            */
 ;*---------------------------------------------------------------------*/
 (markup-writer '&the-bibliography
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index bc796bd..a93cde7 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -2472,22 +2472,6 @@
 		     (output (transform n) e))))))
 
 ;*---------------------------------------------------------------------*/
-;*    line-ref ...                                                     */
-;*---------------------------------------------------------------------*/
-(markup-writer 'line-ref
-   :options '(:offset)
-   :before "{ @I {" ;; FIXME: Not tested
-   :action (lambda (n e)
-	      (let ((o (markup-option n :offset))
-		    (v (string->number (markup-option n :text))))
-		 (cond
-		    ((and (number? o) (number? v))
-		     (display (+ o v)))
-		    (else
-		     (display v)))))
-   :after "} }")
-
-;*---------------------------------------------------------------------*/
 ;*    &the-bibliography ...                                            */
 ;*---------------------------------------------------------------------*/
 (markup-writer '&the-bibliography
@@ -2811,13 +2795,14 @@
 					     (gensym "lout-illustration")))
 					".eps"))
 		 (port (open-output-pipe
-			(apply string-append
-                               (or (engine-custom lout 'lout-program-name)
-                                   "lout")
-                               " -o " output
-                               " -EPS "
-                               (engine-custom lout
-                                              'lout-program-arguments)))))
+			(string-append
+                         (or (engine-custom lout 'lout-program-name)
+                             "lout")
+                         " -o " output
+                         " -EPS "
+                         (string-join
+                          (engine-custom lout
+                                         'lout-program-arguments))))))
 
 	    ;; send the illustration to Lout's standard input
 	    (display (illustration-header) port)
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index ccded17..81d2a16 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -65,11 +65,7 @@
 
 (define %skribilo-user-autoloads
   ;; List of auxiliary modules that may be lazily autoloaded.
-  '(((skribilo engine lout)   . (!lout
-				 lout-illustration
-				 ;; FIXME: The following should eventually be
-				 ;;        removed from here.
-				 lout-structure-number-string))
+  '(((skribilo engine lout)   . (!lout lout-illustration))
     ((skribilo engine latex)  . (!latex LaTeX TeX))
     ((skribilo engine html)   . (html-markup-class html-class
 				 html-width))
@@ -81,6 +77,7 @@
 				 language-fontifier source-fontify))
     ((skribilo coloring lisp) . (skribe scheme lisp))
     ((skribilo coloring xml)  . (xml))
+    ((skribilo coloring c)    . (c java))
     ((skribilo prog)          . (make-prog-body resolve-line))
     ((skribilo color) .
      (skribe-color->rgb skribe-get-used-colors skribe-use-color!))
diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm
index 9f6de43..872c1e2 100644
--- a/src/guile/skribilo/package/base.scm
+++ b/src/guile/skribilo/package/base.scm
@@ -1001,11 +1001,6 @@
       (body (the-body opts))))
 
 ;*---------------------------------------------------------------------*/
-;*    *mark-table* ...                                                 */
-;*---------------------------------------------------------------------*/
-(define *mark-table* (make-hash-table))
-
-;*---------------------------------------------------------------------*/
 ;*    mark ...                                                         */
 ;*    -------------------------------------------------------------    */
 ;*    doc:                                                             */
@@ -1028,12 +1023,11 @@
 	  (let* ((bs (ast->string bd))
 		 (n (new markup
 		       (markup 'mark)
-		       (ident (symbol->string (gensym bs)))
+		       (ident bs)
 		       (class class)
                        (loc   &invocation-location)
 		       (options (the-options opts :ident :class :text))
 		       (body text))))
-	     (hash-set! *mark-table* bs n)
 	     n)))))
 
 ;*---------------------------------------------------------------------*/
@@ -1154,25 +1148,7 @@
 					 (ast s))))
 			     (unref n text (or kind 'ident)))))))))
    (define (mark-ref mark)
-      (if (not (string? mark))
-	  (skribe-type-error 'mark "Illegal mark, " mark "string")
-	  (new unresolved
-             (loc  &invocation-location)
-	     (proc (lambda (n e env)
-		      (let ((s (hash-ref *mark-table* mark)))
-			 (if s
-			     (new markup
-				(markup 'ref)
-				(ident (symbol->string (gensym "mark-ref")))
-				(class class)
-                                (loc   &invocation-location)
-				(required-options '(:text))
-				(options `((kind mark)
-					   (mark ,mark)
-					   ,@(the-options opts :ident :class)))
-				(body (new handle
-					 (ast s))))
-			     (unref n mark 'mark))))))))
+     (do-ident-ref mark 'mark))
    (define (make-bib-ref v)
       (let ((s (resolve-bib bib-table v)))
 	 (if s
@@ -1214,17 +1190,17 @@
       (new unresolved
          (loc   &invocation-location)
 	 (proc  (lambda (n e env)
-		   (let ((l (resolve-line line)))
-		      (if (pair? l)
+		   (let ((l (resolve-line (ast-document n) line)))
+		      (if l
 			  (new markup
 			     (markup 'line-ref)
 			     (ident (symbol->string (gensym "line-ref")))
 			     (class class)
                              (loc   &invocation-location)
-			     (options `((:text ,(markup-ident (car l)))
+			     (options `((:text ,(markup-ident l))
 					,@(the-options opts :ident :class)))
 			     (body (new handle
-				      (ast (car l)))))
+				      (ast l))))
 			  (unref n line 'line)))))))
    (let ((b (the-body opts)))
       (if (not (null? b))
diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm
index 0113db6..87321da 100644
--- a/src/guile/skribilo/prog.scm
+++ b/src/guile/skribilo/prog.scm
@@ -1,7 +1,7 @@
 ;;; prog.scm  --  All the stuff for the prog markup
 ;;;
-;;; Copyright 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;; Copyright 2006 Ludovic Courtès  <ludovic.courtes@laas.fr>
+;;; Copyright 2003  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2006, 2007  Ludovic Courtès  <ludovic.courtes@laas.fr>
 ;;;
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
@@ -21,22 +21,22 @@
 
 (define-module (skribilo prog)
   :use-module (ice-9 regex)
-  :autoload   (ice-9 receive) (receive)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-11)
+
   :use-module (skribilo lib)  ;; `new'
   :use-module (skribilo ast)
   :use-module (skribilo utils syntax)
-  :autoload   (skribilo package base) (mark)
 
   :export (make-prog-body resolve-line))
 
 (fluid-set! current-reader %skribilo-module-reader)
 
 
-;;; ======================================================================
 ;;;
-;;; COMPATIBILITY
+;;; Bigloo compatibility.
 ;;;
-;;; ======================================================================
+
 (define pregexp-match 	string-match)
 (define pregexp-replace (lambda (rx str what)
 			  (regexp-substitute/global #f rx str
@@ -52,37 +52,21 @@
 
 
 ;*---------------------------------------------------------------------*/
-;*    *lines* ...                                                      */
-;*---------------------------------------------------------------------*/
-;; FIXME: Removed that global.  Rework the thing.
-(define *lines* (make-hash-table))
-
-;*---------------------------------------------------------------------*/
-;*    make-line-mark ...                                               */
-;*---------------------------------------------------------------------*/
-(define (make-line-mark m line-ident b)
-   (let* ((n (list (mark line-ident) b)))
-      (hash-set! *lines* m n)
-      n))
-
-;*---------------------------------------------------------------------*/
 ;*    resolve-line ...                                                 */
 ;*---------------------------------------------------------------------*/
-(define (resolve-line id)
-   (hash-ref *lines* id))
+(define (resolve-line doc id)
+  (document-lookup-node doc id))
 
 ;*---------------------------------------------------------------------*/
 ;*    extract-string-mark ...                                          */
 ;*---------------------------------------------------------------------*/
 (define (extract-string-mark line mark regexp)
-   (let ((m (pregexp-match regexp line)))
-      (if (pair? m)
-	  (values (substring (car m)
-			     (string-length mark)
-			     (string-length (car m)))
-		  (pregexp-replace regexp line ""))
-	  (values #f line))))
-   
+  (let ((match (pregexp-match regexp line)))
+    (if match
+        (values (match:substring match 1)
+                (pregexp-replace regexp line ""))
+        (values #f line))))
+
 ;*---------------------------------------------------------------------*/
 ;*    extract-mark ...                                                 */
 ;*    -------------------------------------------------------------    */
@@ -99,14 +83,14 @@
 		  (res '()))
 	  (if (null? ls)
 	      (values #f line)
-	      (receive (m l)
-		 (extract-mark (car ls) mark regexp)
+	      (let-values (((m l)
+                            (extract-mark (car ls) mark regexp)))
 		 (if (not m)
 		     (loop (cdr ls) (cons l res))
 		     (values m (append (reverse! res) (cons l (cdr ls)))))))))
       ((node? line)
-       (receive (m l)
-	  (extract-mark (node-body line) mark regexp)
+       (let-values (((m l)
+                     (extract-mark (node-body line) mark regexp)))
 	  (if (not m)
 	      (values #f line)
 	      (begin
@@ -153,7 +137,7 @@
 ;*    flat-lines ...                                                   */
 ;*---------------------------------------------------------------------*/
 (define (flat-lines lines)
-   (apply append (map split-line lines)))
+   (concatenate (map split-line lines)))
 
 ;*---------------------------------------------------------------------*/
 ;*    collect-lines ...                                                */
@@ -181,13 +165,13 @@
 	  (loop (cdr lines)
 		res
 		(cons (car lines) tmp))))))
-      
+
 ;*---------------------------------------------------------------------*/
 ;*    make-prog-body ...                                               */
 ;*---------------------------------------------------------------------*/
 (define (make-prog-body src lnum-init ldigit mark)
    (let* ((regexp (and mark
-		       (format #f "~a[-a-zA-Z_][-0-9a-zA-Z_]+"
+		       (format #f "~a([-a-zA-Z_][-0-9a-zA-Z_]+)"
 			       (pregexp-quote mark))))
 	  (src (cond
 		  ((not (pair? src)) (list src))
@@ -200,18 +184,18 @@
 				    lnum)
 				(length lines)))))
      (let loop ((lines lines)
-		 (lnum lnum)
-		 (res '()))
+                (lnum lnum)
+                (res '()))
 	 (if (null? lines)
 	     (reverse! res)
-	     (receive (m l)
-		      (extract-mark (car lines) mark regexp)
+             (let-values (((m l)
+                           (extract-mark (car lines) mark regexp)))
 		(let* ((line-ident (symbol->string (gensym "&prog-line")))
 		       (n (new markup
 			     (markup  '&prog-line)
-			     (ident   line-ident)
-                             (options `((:number ,lnum)))
-			     (body (if m (make-line-mark m line-ident l) l)))))
+			     (ident   (or m line-ident))
+                             (options `((:number ,(and lnum-init lnum))))
+			     (body    l))))
  		   (loop (cdr lines)
  			 (+ lnum 1)
  			 (cons n res))))))))