From e47dcdb8340d6c24a7f20107b3f199a8f70020a8 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Mon, 14 May 2012 00:46:59 +0200
Subject: ast: Add `node-children'.

* src/guile/skribilo/ast.scm (node-children): New procedure.

* tests/ast.test ("node-children"): New test.
---
 src/guile/skribilo/ast.scm | 17 +++++++++++++++++
 tests/ast.test             | 13 ++++++++++++-
 2 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm
index 140f861..747c364 100644
--- a/src/guile/skribilo/ast.scm
+++ b/src/guile/skribilo/ast.scm
@@ -32,6 +32,7 @@
 
   :autoload (skribilo location) (location?)
 
+  :use-module (ice-9 match)
   :use-module (ice-9 optargs)
 
   :export (<ast> ast? ast-loc ast-loc-set!
@@ -42,6 +43,7 @@
 	   <unresolved> unresolved? unresolved-proc
 	   <handle> handle? handle-ast handle-body
 	   <node> node? node-options node-loc node-body
+                  node-children
 	   <processor> processor? processor-combinator processor-engine
 
 	   <markup> markup? markup-options is-markup?
@@ -274,6 +276,21 @@
        (equal? (node-body a)
                (node-body b))))
 
+(define (node-children n)
+  ;; Return the children of N, even those found in sub-lists of N's body.
+  (reverse
+   (let loop ((body   (node-body n))
+              (result '()))
+     (match body
+       (()
+        result)
+       (((? node? n) rest ...)
+        (loop rest (cons n result)))
+       (((sub-list ...) rest ...)
+        (loop rest (loop sub-list result)))
+       ((_ rest ...)
+        (loop rest result))))))
+
 (define node-loc	   ast-loc)
 
 (define-method (ast->string (ast <node>))
diff --git a/tests/ast.test b/tests/ast.test
index cb18e3f..596d9d3 100644
--- a/tests/ast.test
+++ b/tests/ast.test
@@ -1,6 +1,6 @@
 ;;; Excercise the AST routines.                  -*- Scheme -*-
 ;;;
-;;; Copyright (C) 2009  Ludovic Courtès <ludo@gnu.org>
+;;; Copyright (C) 2009, 2012  Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of Skribilo.
 ;;;
@@ -99,6 +99,17 @@
          (equal? (map markup-ident lst)
                  (map number->string (iota 2))))))
 
+(test-assert "node-children"
+  (let* ((doc (document
+               (chapter #:ident "0" (section #:ident "s"))
+               (list (chapter #:ident "1"))
+               "hey"
+               (list "foo"
+                     (chapter #:ident "2"))))
+         (lst (node-children doc)))
+    (equal? (map markup-ident lst)
+            '("0" "1" "2"))))
+
 (test-end "ast")
 
 
-- 
cgit v1.2.3