evaluator: Made safer with respect to module excursions.

Patches applied:

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

   - evaluator: Made safer with respect to module excursions.

git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-55

1 files changed, 39 insertions, 36 deletions

diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index 8502d51..a397f29 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -58,18 +58,17 @@
 ;;; %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*))))
-
+  ;; 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 (current-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))
 
@@ -103,12 +102,19 @@
        (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) e :env env)
+                    (begin
+                      (evaluate-document (%evaluate exp) e :env env)
+                      (loop (reader port)))))))))))
+
 
 
 ;;;
@@ -123,7 +129,7 @@
 
 (define* (load-document file :key (engine #f) (path #f) :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 +144,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
@@ -177,7 +175,8 @@
 ;;; INCLUDE-DOCUMENT
 ;;;
 (define* (include-document file :key (path (*document-path*))
-			             (reader (*document-reader*)))
+			             (reader (*document-reader*))
+                                     (module (current-module)))
   (unless (every string? path)
     (raise (condition (&invalid-argument-error (proc-name 'include-document)
 					       (argument  path)))))
@@ -193,11 +192,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) res))))))))))