From 3f1236d7d85509269f2c3040cef589658e2e3d44 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Wed, 30 Jan 2008 18:00:13 +0100
Subject: Fix option resolution for <node> and <container>.

* src/guile/skribilo/resolve.scm (do-resolve<node>): Don't resolve
  OPTIONS only when PARENT is `unspecified', otherwise nodes returned by
  `do-resolve<unresolved>' would always have their options unresolved.
  (do-resolve<container>): Likewise.  In addition, make proper use of
  `*unresolved*' and set the `resolved?' slot accordingly.
  (do-resolve<unresolved>): Don't set the `parent' slot of RES at this
  point since we have to go for another resolution run anyway.
---
 src/guile/skribilo/resolve.scm | 81 +++++++++++++++++++++++++-----------------
 1 file changed, 48 insertions(+), 33 deletions(-)

(limited to 'src')

diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
index 54bf112..6405ebd 100644
--- a/src/guile/skribilo/resolve.scm
+++ b/src/guile/skribilo/resolve.scm
@@ -121,14 +121,16 @@
 	     (when (eq? parent 'unspecified)
 	       (let ((p (assq 'parent env)))
 		 (slot-set! node 'parent
-			    (and (pair? p) (pair? (cdr p)) (cadr p)))
-		 (when (pair? options)
-		   (debug-item "unresolved options=" options)
-		   (for-each (lambda (o)
-			       (set-car! (cdr o)
-					 (do-resolve! (cadr o) engine env)))
-			     options)
-		   (debug-item "resolved options=" options))))
+			    (and (pair? p) (pair? (cdr p)) (cadr p)))))
+
+             (when (pair? options)
+               (debug-item "unresolved options=" options)
+               (for-each (lambda (o)
+                           (set-car! (cdr o)
+                                     (do-resolve! (cadr o) engine env)))
+                         options)
+               (debug-item "resolved options=" options))
+
 	     (slot-set! node 'body (do-resolve! body engine env))
 	     (slot-set! node 'resolved? (not (*unresolved*))))
 
@@ -137,29 +139,43 @@
 
 
 (define-method (do-resolve! (node <container>) engine env0)
-  (let ((body     (slot-ref node 'body))
-	(options  (slot-ref node 'options))
-	(env      (slot-ref node 'env))
-	(parent   (slot-ref node 'parent)))
-    (with-debug 5 'do-resolve<container>
-       (debug-item "markup=" (markup-markup node))
-       (debug-item "body=" body)
-       (debug-item "env0=" env0)
-       (debug-item "env=" env)
-       (when (eq? parent 'unspecified)
-	 (let ((p (assq 'parent env0)))
-	   (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p)))
-	   (when (pair? options)
-	     (let ((e (append `((parent ,node)) env0)))
-	       (debug-item "unresolved options=" options)
-	       (for-each (lambda (o)
-			   (set-car! (cdr o)
-				     (do-resolve! (cadr o) engine e)))
-			 options)
-	       (debug-item "resolved options=" options)))))
-       (let ((e `((parent ,node) ,@env ,@env0)))
-	 (slot-set! node 'body (do-resolve! body engine e)))
-       node)))
+  ;; Similar to the NODE method, except that (i) children will get NODE as
+  ;; their parent, and (ii) NODE may extend its environment, through its
+  ;; `env' slot.
+  (if (ast-resolved? node)
+      node
+      (let ((body     (slot-ref node 'body))
+            (options  (slot-ref node 'options))
+            (env      (slot-ref node 'env))
+            (parent   (slot-ref node 'parent))
+            (unresolved? (*unresolved*)))
+        (with-debug 5 'do-resolve<container>
+           (debug-item "markup=" (markup-markup node))
+           (debug-item "body=" body)
+           (debug-item "env0=" env0)
+           (debug-item "env=" env)
+           (parameterize ((*unresolved* #f))
+             (when (eq? parent 'unspecified)
+               (let ((p (assq 'parent env0)))
+                 (slot-set! node 'parent
+                            (and (pair? p) (pair? (cdr p)) (cadr p)))))
+
+             (when (pair? options)
+               (let ((e (append `((parent ,node)) env0)))
+                 (debug-item "unresolved options=" options)
+                 (for-each (lambda (o)
+                             (set-car! (cdr o)
+                                       (do-resolve! (cadr o)
+                                                    engine e)))
+                           options)
+                 (debug-item "resolved options=" options)))
+
+             (let ((e `((parent ,node) ,@env ,@env0)))
+               (slot-set! node 'body (do-resolve! body engine e)))
+             (slot-set! node 'resolved? (not (*unresolved*))))
+
+           (*unresolved* (or unresolved? (not (ast-resolved? node))))
+           node))))
 
 
 (define-method (do-resolve! (node <document>) engine env0)
@@ -188,8 +204,7 @@
               (res  (proc node engine env))
               (loc  (ast-loc node)))
          (when (ast? res)
-           (ast-loc-set! res loc)
-           (slot-set! res 'parent parent))
+           (ast-loc-set! res loc))
          (debug-item "res=" res)
          (*unresolved* #t)
          res))))
-- 
cgit v1.2.3