From 3aaf0dfae4fdea885a054b701ac41c9166c0daa8 Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Fri, 3 Nov 2006 14:10:34 +0000
Subject: evaluator: Made safer with respect to module excursions.

* src/guile/skribilo/evaluator.scm (%evaluate): Evaluate EXPR in
  `current-module' rather than `*skribilo-user-module*'.
  (evaluate-document-from-port): Use `save-module-excursion' and place
  ourselves in `*skribilo-user-module*' before invoking `%evaluate'.
  (load-document): Only search FILE in PATH, not in %LOAD-PATH.
  (include-document): Added a `:module' argument.  Use
  `save-module-excursion' and place ourselves in MODULE.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--engine-classes--1.2--patch-7
---
 src/guile/skribilo/evaluator.scm | 75 +++++++++++++++++++++-------------------
 1 file changed, 39 insertions(+), 36 deletions(-)

diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index 4450298..3297cc7 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -59,18 +59,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))
 
@@ -106,12 +105,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)))))))))))
+
 
 
 ;;;
@@ -126,7 +132,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)
@@ -141,15 +147,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
@@ -180,7 +178,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)))))
@@ -196,11 +195,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))))))))))
-- 
cgit v1.2.3