Syntax highlighting and `image'-related fixes.

* src/guile/skribilo/coloring/lisp.scm: Use `(skribilo reader)'.
  (lisp-family-fontifier): Take a READ argument.
  (skribe-fontifier): Pass `(make-reader 'skribe)' as the reader.

* src/guile/skribilo/module.scm (%skribilo-user-autoloads): Added
  `(skribilo prog)'.

* src/guile/skribilo/parameters.scm (*ref-base*): New.

* src/guile/skribilo/prog.scm: Guilified.

* src/guile/skribilo/reader/skribe.scm: Nothing changed.

* src/guile/skribilo/runtime.scm (suffix): New.
  (string-ref-base): Don't use `file-separator'.  Use `string-contains'
  instead of Bigloo/STkLos' `substring=?'.
  (convert-image): Use `*image-path*' instead of `skribe-image-path'.
  Don't use `make-path'.

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

7 files changed, 87 insertions, 42 deletions

diff --git a/ChangeLog b/ChangeLog
index 435ae41..be46ac3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,40 @@
 # arch-tag: automatic-ChangeLog--lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2
 #
 
+2006-01-10 23:40:38 GMT	Ludovic Courtes <ludovic.courtes@laas.fr>	patch-20
+
+    Summary:
+      Syntax highlighting and `image'-related fixes.
+    Revision:
+      skribilo--devel--1.2--patch-20
+
+    * src/guile/skribilo/coloring/lisp.scm: Use `(skribilo reader)'.
+      (lisp-family-fontifier): Take a READ argument.
+      (skribe-fontifier): Pass `(make-reader 'skribe)' as the reader.
+    
+    * src/guile/skribilo/module.scm (%skribilo-user-autoloads): Added
+      `(skribilo prog)'.
+    
+    * src/guile/skribilo/parameters.scm (*ref-base*): New.
+    
+    * src/guile/skribilo/prog.scm: Guilified.
+    
+    * src/guile/skribilo/reader/skribe.scm: Nothing changed.
+    
+    * src/guile/skribilo/runtime.scm (suffix): New.
+      (string-ref-base): Don't use `file-separator'.  Use `string-contains'
+      instead of Bigloo/STkLos' `substring=?'.
+      (convert-image): Use `*image-path*' instead of `skribe-image-path'.
+      Don't use `make-path'.
+
+    modified files:
+     ChangeLog src/guile/skribilo/coloring/lisp.scm
+     src/guile/skribilo/module.scm
+     src/guile/skribilo/parameters.scm src/guile/skribilo/prog.scm
+     src/guile/skribilo/reader/skribe.scm
+     src/guile/skribilo/runtime.scm
+
+
 2006-01-08 17:13:42 GMT	Ludovic Courtes <ludovic.courtes@laas.fr>	patch-19
 
     Summary:
diff --git a/src/guile/skribilo/coloring/lisp.scm b/src/guile/skribilo/coloring/lisp.scm
index 55fb7d6..589e70a 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)
+  :autoload   (skribilo reader)  (make-reader)
   :export (skribe scheme stklos bigloo lisp))
 
 
@@ -57,7 +58,7 @@
 	  (Loop (%read inp))))))
 
 
-(define (lisp-family-fontifier s)
+(define (lisp-family-fontifier s read)
   (let ((lisp-input (open-input-string s)))
     (let loop ((token (read lisp-input))
 	       (res   '()))
@@ -99,7 +100,7 @@
   (with-fluids ((*the-keys*	   (init-lisp-keys))
 		(*bracket-highlight* #f)
 		(*class-highlight*   #f))
-    (lisp-family-fontifier s)))
+    (lisp-family-fontifier s read)))
 
 
 (define lisp
@@ -143,7 +144,7 @@
   (with-fluids ((*the-keys*	   (init-scheme-keys))
 		(*bracket-highlight* #f)
 		(*class-highlight*   #f))
-    (lisp-family-fontifier s)))
+    (lisp-family-fontifier s read)))
 
 
 (define scheme
@@ -196,7 +197,7 @@
   (with-fluids ((*the-keys*	   (init-stklos-keys))
 		(*bracket-highlight* #t)
 		(*class-highlight*   #t))
-    (lisp-family-fontifier s)))
+    (lisp-family-fontifier s read)))
 
 
 (define stklos
@@ -257,7 +258,7 @@
   (with-fluids ((*the-keys*	   (init-skribe-keys))
 		(*bracket-highlight* #t)
 		(*class-highlight*   #t))
-    (lisp-family-fontifier s)))
+    (lisp-family-fontifier s (make-reader 'skribe))))
 
 
 (define skribe
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index c9b7034..34641c9 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -73,6 +73,7 @@
 				 language-fontifier source-fontify))
     ((skribilo coloring lisp) . (skribe scheme lisp))
     ((skribilo coloring xml)  . (xml))
+    ((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/parameters.scm b/src/guile/skribilo/parameters.scm
index baab5ba..b464667 100644
--- a/src/guile/skribilo/parameters.scm
+++ b/src/guile/skribilo/parameters.scm
@@ -76,6 +76,9 @@
 (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.
+(define-public *ref-base*         (make-parameter ""))
 
 ;;; TODO: Skribe used to have other parameters as global variables.  See
 ;;; which ones need to be kept.
diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm
index eb0b3db..7c83270 100644
--- a/src/guile/skribilo/prog.scm
+++ b/src/guile/skribilo/prog.scm
@@ -1,39 +1,40 @@
-;;;;
-;;;; prog.stk	-- All the stuff for the prog markup
-;;;; 
-;;;; Copyright © 2003 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
-;;;; USA.
-;;;; 
-;;;;           Author: Erick Gallesio [eg@essi.fr]
-;;;;    Creation date: 31-Aug-2003 23:42 (eg)
-;;;; Last file update: 22-Oct-2003 19:35 (eg)
-;;;;
+;;; 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>
+;;;
+;;;
+;;; 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
 
-(define-module SKRIBE-PROG-MODULE
-  (export make-prog-body resolve-line)
+(define-module (skribilo prog)
+  :use-module (ice-9 regex)
+  :autoload   (ice-9 receive) (receive)
+  :use-module (skribilo lib)  ;; `new'
+  :autoload   (skribilo ast) (node?)
+  :export (make-prog-body resolve-line))
 
 ;;; ======================================================================
 ;;;
 ;;; COMPATIBILITY
 ;;;
 ;;; ======================================================================
-(define pregexp-match 	regexp-match)
-(define pregexp-replace regexp-replace)
+(define pregexp-match 	string-match)
+(define pregexp-replace (lambda (rx str what)
+			  (regexp-substitute/global #f rx str
+						    'pre what 'post)))
 (define pregexp-quote   regexp-quote)
 
 
@@ -188,7 +189,7 @@
 	     (string-append (make-string (- rl l) #\space) s))))
  
    (let* ((regexp (and mark
-		       (format "~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))
diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm
index 410ef01..f24c2f7 100644
--- a/src/guile/skribilo/reader/skribe.scm
+++ b/src/guile/skribilo/reader/skribe.scm
@@ -50,8 +50,8 @@ the Skribe syntax."
   ;; The reader for what comes after a `#' character.
   (let* ((dsssl-keyword-reader  ;; keywords à la `#!key'
           (r:make-token-reader #\!
-			       (r:token-reader-procedure
-				(r:standard-token-reader 'keyword)))))
+ 			       (r:token-reader-procedure
+ 				(r:standard-token-reader 'keyword)))))
       (r:make-reader (cons dsssl-keyword-reader
 			   (map r:standard-token-reader
 				'(character srfi-4 vector
diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm
index d4be2e9..b129652 100644
--- a/src/guile/skribilo/runtime.scm
+++ b/src/guile/skribilo/runtime.scm
@@ -36,6 +36,11 @@
   :use-module (srfi srfi-13))
 
 
+(define (suffix path)
+  (let ((dot (string-rindex path #\.)))
+    (if (not dot)
+	path
+	(substring path (+ dot 1) (string-length path)))))
 
 ;;; ======================================================================
 ;;;
@@ -52,9 +57,9 @@
 	(cond
 	  ((not (> (string-length file) (+ l 2)))
 	   file)
-	  ((not (substring=? file (*ref-base*) l))
+	  ((not (string-contains file (*ref-base*) 0 l))
 	   file)
-	  ((not (char=? (string-ref file l) (file-separator)))
+	  ((not (char=? (string-ref file l) #\/))
 	   file)
 	  (else
 	   (substring file (+ l 1) (string-length file)))))))
@@ -121,11 +126,11 @@
 	      to))))))
 
 (define (convert-image file formats)
-  (let ((path (search-path (skribe-image-path) file)))
+  (let ((path (search-path (*image-path*) file)))
     (if (not path)
 	(skribe-error 'convert-image
 		      (format #f "can't find `~a' image file in path: " file)
-		      (skribe-image-path))
+		      (*image-path*))
 	(let ((suf (suffix file)))
 	  (if (member suf formats)
 	      (let* ((dir (if (string? (*destination-file*))
@@ -133,7 +138,7 @@
 			      #f)))
 		(if dir
 		    (let ((dest (basename path)))
-		      (copy-file path (make-path dir dest))
+		      (copy-file path (string-append dir "/" dest))
 		      dest)
 		    path))
 	      (let loop ((fmts formats))