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

Patches applied:

 * lcourtes@laas.fr--2005-libre/skribilo--engine-classes--1.2  (patch 5, 11)

   - `slide' package: use the native APIs.
   - evaluator: Made safer with respect to module excursions.

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

   - Merge from skribilo@sv.gnu.org--2006/skribilo--devo--1.2
   - evaluator: Made safer with respect to module excursions.
   - `slide' package: use the native APIs.
   - evaluator: Slight module-related cleanups.
   - skribe-load: Better modulogy.
   - `base' engine: Use the native Skribilo APIs.

 * lcourtes@laas.fr--2005-mobile/skribilo--engine-classes--1.2  (patch 7)

   - evaluator: Made safer with respect to module excursions.

 * skribilo@sv.gnu.org--2006/skribilo--devo--1.2  (patch 34-59)

   - lout & latex engines: Fixed the output of `&prog-line'.
   - eq/lout: Properly handle `div-style' and `mul-style'.
   - Fixed `publisher' in default biblio entry style.
   - lout engine: Fixed automatic `url-ref' breaking wrt. spacing.
   - LaTeX engine: Added support for classes without `chapter'.
   - Updated the LaTeX engine doc, mention `class-has-chapters?'.
   - `lncs' package: Use the native APIs.
   - `lncs' package: Fixed `abstract' for LaTeX.
   - `lncs' package: Use a native LaTeX/BibTeX bibliography.
   - `latex' engine: Removed stupid uses of `bold'.
   - `lncs' package: Changed the default bibliography sort, udpated the doc.
   - `latex' engine: Support `a' with grave accent.
   - `lncs' package: Tiny fix.
   - `latex' engine: Fixed `ref' with both `:handle' and `:text'.
   - Added basic GNU Gettext support.
   - Fixed biblio template output.
   - Rewrote the bib entry template evaluator, added support for `if'.
   - Cleaned up the default bibliography template.
   - biblio: Use SRFI-3[45] conditions instead of `skribe-error'.
   - Internationalized `(skribilo condition)'.
   - Updated (French) translation.
   - evaluator: Made safer with respect to module excursions.
   - `slide' package: use the native APIs.
   - evaluator: Slight module-related cleanups.
   - skribe-load: Better modulogy.
   - `base' engine: Use the native Skribilo APIs.

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

4 files changed, 102 insertions, 68 deletions

diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm
index 711c179..f339a40 100644
--- a/src/guile/skribilo/engine/base.scm
+++ b/src/guile/skribilo/engine/base.scm
@@ -19,11 +19,23 @@
 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
 ;;; USA.
 
-(define-skribe-module (skribilo engine base)
-  :autoload (skribilo biblio template) (make-bib-entry-template/default
-                                        output-bib-entry-template)
-  :use-module (srfi srfi-13))
+(define-module (skribilo engine base)
+  :use-module (skribilo ast)
+  :use-module (skribilo engine)
+  :use-module (skribilo writer)
+  :autoload   (skribilo output) (output)
+  :use-module (skribilo evaluator)
+  :autoload   (skribilo package base) (color)
+  :autoload   (skribilo utils keywords) (list-split)
+  :autoload   (skribilo biblio template) (make-bib-entry-template/default
+                                          output-bib-entry-template)
+  ;; syntactic sugar
+  :use-module (skribilo reader)
+  :use-module (skribilo utils syntax))
 
+(fluid-set! current-reader (make-reader 'skribe))
+
+
 ;*---------------------------------------------------------------------*/
 ;*    base-engine ...                                                  */
 ;*---------------------------------------------------------------------*/
@@ -170,7 +182,7 @@
 			    (format #f "?~a " k))))
 		     (msg (list f (markup-body n)))
 		     (n (list "[" (color :fg "red" (bold msg)) "]")))
-		 (skribe-eval n e))))
+		 (evaluate-document n e))))
 
 ;*---------------------------------------------------------------------*/
 ;*    &the-bibliography ...                                            */
@@ -234,7 +246,7 @@
 (markup-writer '&bib-entry-url
                :action (lambda (n e)
                          (let ((url (markup-body n)))
-                           (skribe-eval
+                           (evaluate-document
                             (ref :text (it url) :url url) e))))
 
 ;*---------------------------------------------------------------------*/
@@ -258,7 +270,7 @@
 ;*---------------------------------------------------------------------*/
 (markup-writer '&bib-entry-title
    :action (lambda (n e)
-	      (skribe-eval (markup-body n)) e))
+	      (evaluate-document (markup-body n) e)))
 
 ;*---------------------------------------------------------------------*/
 ;*    &bib-entry-booktitle ...                                         */
@@ -266,21 +278,21 @@
 (markup-writer '&bib-entry-booktitle
                :action (lambda (n e)
                          (let ((title (markup-body n)))
-                           (skribe-eval (it title) e))))
+                           (evaluate-document (it title) e))))
 
 ;*---------------------------------------------------------------------*/
 ;*    &bib-entry-journal ...                                           */
 ;*---------------------------------------------------------------------*/
 (markup-writer '&bib-entry-journal
                :action (lambda (n e)
-                         (skribe-eval (it (markup-body n)) e)))
+                         (evaluate-document (it (markup-body n)) e)))
 
 ;*---------------------------------------------------------------------*/
 ;*    &bib-entry-publisher ...                                         */
 ;*---------------------------------------------------------------------*/
 (markup-writer '&bib-entry-publisher
    :action (lambda (n e)
-	      (skribe-eval (markup-body n) e)))
+	      (evaluate-document (markup-body n) e)))
 
 ;*---------------------------------------------------------------------*/
 ;*    &the-index ...  @label the-index@                                */
@@ -400,7 +412,7 @@
 			       ;;:&skribe-eval-location loc
 			       :class "index-table"
 			       (make-sub-tables ie nc pref))))))
-		 (output (skribe-eval t e) e))))
+		 (output (evaluate-document t e) e))))
 
 ;*---------------------------------------------------------------------*/
 ;*    &the-index-header ...                                            */
@@ -418,7 +430,7 @@
    :before (lambda (n e)
              (let ((num (markup-option n :number)))
                (if (number? num)
-                   (skribe-eval
+                   (evaluate-document
                     (it (string-append (string-pad (number->string num) 3)
                                        ": "))
                     e))))
@@ -432,11 +444,5 @@
    :action (lambda (n e)
 	      (let ((o (markup-option n :offset))
 		    (n (markup-ident (handle-body (markup-body n)))))
-		 (skribe-eval (it (if (integer? o) (+ o n) n)) e))))
-
-
+		 (evaluate-document (it (if (integer? o) (+ o n) n)) e))))
 
-;;;; A VIRER (mais handle-body n'est pas défini)
-(markup-writer 'line-ref
-   :options '(:offset)
-   :action #f)
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index 8502d51..5067b59 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -57,19 +57,18 @@
 ;;;
 ;;; %EVALUATE
 ;;;
-(define (%evaluate expr)
-  ;; Evaluate EXPR, an arbitrary S-expression that may contain calls to the
-  ;; markup functions defined in a markup package such as
-  ;; `(skribilo package base)', e.g., `(bold "hello")'.
-  (let ((result (eval expr (*skribilo-user-module*))))
-
+(define (%evaluate expr module)
+  ;; Evaluate EXPR in the current module.  EXPR is an arbitrary S-expression
+  ;; that may contain calls to the markup functions defined in a markup
+  ;; package such as `(skribilo package base)', e.g., `(bold "hello")'.
+  (let ((result (eval expr module)))
     (if (ast? result)
-	(let ((file (source-property expr 'filename))
-	      (line (source-property expr 'line))
-	      (column (source-property expr 'column)))
-	  (slot-set! result 'loc
-		     (make <location>
-		       :file file :line line :pos column))))
+        (let ((file (source-property expr 'filename))
+              (line (source-property expr 'line))
+              (column (source-property expr 'column)))
+          (slot-set! result 'loc
+                     (make <location>
+                       :file file :line line :pos column))))
 
     result))
 
@@ -94,7 +93,8 @@
 ;;;
 (define* (evaluate-document-from-port port engine
 				      :key (env '())
-				           (reader (*document-reader*)))
+				           (reader (*document-reader*))
+                                           (module (*skribilo-user-module*)))
   (with-debug 2 'evaluate-document-from-port
      (debug-item "engine=" engine)
      (debug-item "reader=" reader)
@@ -103,12 +103,21 @@
        (debug-item "e=" e)
        (if (not (engine? e))
 	   (skribe-error 'evaluate-document-from-port "cannot find engine" engine)
-	   (let loop ((exp (reader port)))
-	     (with-debug 10 'evaluate-document-from-port
-		(debug-item "exp=" exp))
-	     (unless (eof-object? exp)
-	       (evaluate-document (%evaluate exp) e :env env)
-	       (loop (reader port))))))))
+           (save-module-excursion
+            (lambda ()
+              (with-debug 10 'evaluate-document-from-port
+                          (debug-item "exp=" exp))
+              (set-current-module (*skribilo-user-module*))
+
+              (let loop ((exp (reader port)))
+                (if (eof-object? exp)
+                    (evaluate-document (%evaluate exp module)
+                                       e :env env)
+                    (begin
+                      (evaluate-document (%evaluate exp module)
+                                         e :env env)
+                      (loop (reader port)))))))))))
+
 
 
 ;;;
@@ -121,9 +130,14 @@
 ;; List of the names of files already loaded.
 (define *loaded-files* (make-parameter '()))
 
-(define* (load-document file :key (engine #f) (path #f) :allow-other-keys
+
+(define* (load-document file
+                        :key engine path
+                             (module (*skribilo-user-module*))
+                             (reader (*document-reader*))
+                        :allow-other-keys
 			:rest opt)
-  (with-debug 4 'skribe-load
+  (with-debug 4 'load-document
      (debug-item "  engine=" engine)
      (debug-item "  path=" path)
      (debug-item "  opt=" opt)
@@ -138,15 +152,7 @@
 					       (argument  path)))))
 			   (else path))
 			  %load-path))
-            (filep (or (search-path path file)
-		       (search-path (append path %load-path) file)
-		       (search-path (append path %load-path)
-				    (let ((dot (string-rindex file #\.)))
-				      (if dot
-					  (string-append
-					   (string-take file dot)
-					   ".scm")
-					  file))))))
+            (filep  (search-path path file)))
 
        (unless (and (string? filep) (file-exists? filep))
 	 (raise (condition (&file-search-error
@@ -169,7 +175,9 @@
 	   ;; Load it
 	   (with-input-from-file filep
 	     (lambda ()
-	       (evaluate-document-from-port (current-input-port) ei)))
+	       (evaluate-document-from-port (current-input-port) ei
+                                            :module module
+                                            :reader reader)))
 
 	   (*loaded-files* (cons filep (*loaded-files*))))))))
 
@@ -177,7 +185,8 @@
 ;;; INCLUDE-DOCUMENT
 ;;;
 (define* (include-document file :key (path (*document-path*))
-			             (reader (*document-reader*)))
+			             (reader (*document-reader*))
+                                     (module (*skribilo-user-module*)))
   (unless (every string? path)
     (raise (condition (&invalid-argument-error (proc-name 'include-document)
 					       (argument  path)))))
@@ -193,11 +202,15 @@
 
     (with-input-from-file full-path
       (lambda ()
-	(let Loop ((exp (reader (current-input-port)))
-		   (res '()))
-	  (if (eof-object? exp)
-	      (if (and (pair? res) (null? (cdr res)))
-		    (car res)
-		    (reverse! res))
-	      (Loop (reader (current-input-port))
-		    (cons (%evaluate exp) res))))))))
+        (save-module-excursion
+          (lambda ()
+            (set-current-module module)
+
+            (let Loop ((exp (reader (current-input-port)))
+                       (res '()))
+              (if (eof-object? exp)
+                  (if (and (pair? res) (null? (cdr res)))
+                      (car res)
+                      (reverse! res))
+                  (Loop (reader (current-input-port))
+                        (cons (%evaluate exp module) res))))))))))
diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
index 898f105..cbcae0b 100644
--- a/src/guile/skribilo/package/slide.scm
+++ b/src/guile/skribilo/package/slide.scm
@@ -20,13 +20,29 @@
 ;;; USA.
 
 
-(define-skribe-module (skribilo package slide))
+(define-module (skribilo package slide)
+  :use-module (skribilo reader)
+  :use-module (skribilo utils syntax)
 
+  :use-module (skribilo lib)
+  :use-module (skribilo ast)
+  :use-module (skribilo engine)
+  :use-module (skribilo evaluator) ;; `*load-options*'
+  :use-module (skribilo package base)
 
+  :autoload   (skribilo utils keywords) (the-options the-body)
+
+  :use-module (srfi srfi-1)
+  :use-module (ice-9 optargs))
+
+(fluid-set! current-reader (make-reader 'skribe))
+
+
+
 ;*---------------------------------------------------------------------*/
 ;*    slide-options                                                    */
 ;*---------------------------------------------------------------------*/
-(define-public &slide-load-options (skribe-load-options))
+(define-public &slide-load-options (*load-options*))
 
 
 ;*---------------------------------------------------------------------*/
@@ -49,7 +65,7 @@
    (let ((s (new container
 	       (markup 'slide)
 	       (ident (if (not ident)
-			  (symbol->string (gensym 'slide))
+			  (symbol->string (gensym "slide"))
 			  ident))
 	       (class class)
 	       (required-options '(:title :number :toc))
@@ -232,7 +248,7 @@
    (new container
       (markup 'slide-topic)
       (required-options '(:title :outline?))
-      (ident (or ident (symbol->string (gensym 'slide-topic))))
+      (ident (or ident (symbol->string (gensym "slide-topic"))))
       (class class)
       (options `((:outline? ,outline?)
                  ,@(the-options opt :outline? :class)))
@@ -247,7 +263,7 @@
    (new container
       (markup 'slide-subtopic)
       (required-options '(:title :outline?))
-      (ident (or ident (symbol->string (gensym 'slide-subtopic))))
+      (ident (or ident (symbol->string (gensym "slide-subtopic"))))
       (class class)
       (options `((:outline? ,outline?)
                  ,@(the-options opt :outline? :class)))
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index 4905cef..9f85658 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -153,13 +153,12 @@
 				 "  skribe-load: `~a' -> `~a'~%"
 				 file mod-name))
 		     (let ((mod (false-if-exception
-				 (resolve-module mod-name))))
+				 (resolve-interface mod-name))))
 		       (if (not mod)
 			   (raise c)
 			   (begin
-			     (set-module-uses!
-			      (current-module)
-			      (cons mod (module-uses (current-module))))
+			     (module-use-interfaces! (current-module)
+                                                     (list mod))
 			     #t))))
 		   (raise c)))))