From 9a8581b9b056efed763fb6beff15f9d36cf07ee0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Tue, 26 May 2009 18:28:11 +0200
Subject: resolve: Clarify node bindings in nested documents.

* src/guile/skribilo/ast.scm (document-bind-nodes!): Bind nodes in the
  innermost document, which may or may not be the root document.

* tests/resolve.test ("root document has no parent", "nested document
  has a parent", "nested document is its own `ast-document'", "nested
  document bindings"): New tests.
---
 src/guile/skribilo/ast.scm | 25 ++++++++++++++++++-----
 tests/resolve.test         | 49 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 69 insertions(+), 5 deletions(-)

diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm
index 3de6947..86fa781 100644
--- a/src/guile/skribilo/ast.scm
+++ b/src/guile/skribilo/ast.scm
@@ -496,11 +496,26 @@
   (if (document-nodes-bound? doc)
       #t
       (begin
-	(ast-fold (lambda (node result)
-		    (if (markup? node) (document-bind-node! doc node))
-		    #t)
-		  #t ;; unused
-		  doc)
+        (let loop ((node doc)
+                   (doc  doc))
+          (cond ((document? node)
+                 ;; Bind NODE in its parent's document.  This is so
+                 ;; that (i) a sub-document is bound in its parent
+                 ;; document, and (ii) a node within a sub-document
+                 ;; is bound in this sub-document.
+                 (document-bind-node! doc node)
+                 (loop (markup-body node) node))
+
+                ((markup? node)
+                 (document-bind-node! doc node)
+                 (loop (markup-body node) doc))
+
+                ((pair? node)
+                 (for-each (lambda (n) (loop n doc)) node))
+
+                ((command? node)
+                 (loop (command-body node) doc))))
+
 	(slot-set! doc 'nodes-bound? #t))))
 
 
diff --git a/tests/resolve.test b/tests/resolve.test
index 0e29614..bfbdd27 100644
--- a/tests/resolve.test
+++ b/tests/resolve.test
@@ -46,6 +46,36 @@
                 (eq? (ast-parent sec) ch)
                 (eq? (ast-parent par) sec))))))
 
+(test-assert "root document has no parent"
+  (let ((doc (document #:title "Doc")))
+    (resolve! doc %engine '())
+    (and (not (ast-parent doc))
+         (eq? doc (ast-document doc)))))
+
+(test-assert "nested document has a parent"
+  ;; Nested documents are sometimes used in the manual.
+  (let* ((doc (document #:title "Doc"
+                (document #:title "Nested Doc"
+                  (chapter #:title "C"))))
+         (sub (car (markup-body doc)))
+         (ch  (car (markup-body sub))))
+    (resolve! doc %engine '())
+    (and (not (ast-parent doc))
+         (document? sub)
+         (eq? doc (ast-document doc))
+         (eq? doc (ast-parent sub)))))
+
+(test-assert "nested document is its own `ast-document'"
+  (let* ((doc (document #:title "Doc"
+                (document #:title "Nested Doc"
+                  (chapter #:title "C"))))
+         (sub (car (markup-body doc)))
+         (ch  (car (markup-body sub))))
+    (resolve! doc %engine '())
+    (and (document? sub)
+         (eq? sub (ast-document sub))
+         (eq? sub (ast-document ch)))))
+
 (test-assert "unresolved node in body"
   (let* ((resolved? #f)
          (doc (document #:title "Doc"
@@ -125,6 +155,25 @@
            (and (is-markup? (document-lookup-node doc "c") 'chapter)
                 (is-markup? (document-lookup-node doc "s") 'section))))))
 
+(test-assert "nested document bindings"
+  ;; Bindings in nested documents are scoped.  This was not the case prior
+  ;; to 0.9.2.
+  (let* ((doc (document #:title "Doc"
+                (chapter #:ident "outer")
+                (document #:title "Nested Doc"
+                  (chapter #:ident "inner"))))
+         (out (car  (markup-body doc)))
+         (sub (cadr (markup-body doc)))
+         (in  (car  (markup-body sub))))
+    (resolve! doc %engine '())
+    (and (let ((x (document-lookup-node doc "outer")))
+           (and (is-markup? x 'chapter)
+                (eq? (ast-document x) doc)))
+         (not (document-lookup-node doc "inner"))
+         (let ((x (document-lookup-node sub "inner")))
+           (and (is-markup? x 'chapter)
+                (eq? (ast-document x) sub))))))
+
 (test-end "resolve")
 
 
-- 
cgit v1.2.3