diff options
| -rw-r--r-- | src/guile/skribilo/ast.scm | 6 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/info.scm | 58 | ||||
| -rw-r--r-- | tests/Makefile.am | 6 | ||||
| -rw-r--r-- | tests/engines/info.test | 97 |
4 files changed, 138 insertions, 29 deletions
diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm index 747c364..671a90e 100644 --- a/src/guile/skribilo/ast.scm +++ b/src/guile/skribilo/ast.scm @@ -2,7 +2,7 @@ ;;; ;;; Copyright 2003, 2004, 2009 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;; Copyright 2003, 2004 Manuel Serrano -;;; Copyright 2005, 2006, 2007 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2005, 2006, 2007, 2012 Ludovic Courtès <ludo@gnu.org> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -544,8 +544,8 @@ ;;; (define (ast-fold proc init ast) - ;; Apply PROC to each node in AST (per `node?'), in a way similar to `fold' - ;; (in SRFI-1). + ;; Do a depth-first traversal of AST, applying PROC to each node in AST + ;; (per `node?'), in a way similar to SRFI-1 `fold'. (let loop ((ast ast) (result init)) (cond ((pair? ast) diff --git a/src/guile/skribilo/engine/info.scm b/src/guile/skribilo/engine/info.scm index 0e0db02..0ca7e97 100644 --- a/src/guile/skribilo/engine/info.scm +++ b/src/guile/skribilo/engine/info.scm @@ -34,7 +34,11 @@ :autoload (skribilo utils text-table) (table->ascii) :autoload (srfi srfi-1) (fold) :use-module (srfi srfi-8) + :use-module (srfi srfi-11) :use-module (srfi srfi-13) + :use-module (srfi srfi-26) + :use-module (ice-9 match) + :use-module (ice-9 format) :export (info-engine)) @@ -79,17 +83,35 @@ ;*---------------------------------------------------------------------*/ (define (info-node node next prev up) (print "\n ") - (print "File: " (info-dest) - ", Node: " node - ", Next: " next - ", Prev: " prev - ", Up: " up) - (newline)) + (format #t "File: ~a, Node: ~a, ~:[~*~;Next: ~a, ~]~:[~*~;Prev: ~a, ~]Up: ~a~%" + (info-dest) node next next prev prev up)) ;*---------------------------------------------------------------------*/ ;* node-next+prev+top ... */ ;*---------------------------------------------------------------------*/ (define (node-next+prev+top section e) + ;; Return the next, previous, and up node of SECTION. + + (define (ast-prev+next n) + ;; Return the nodes around N at its level. + (define p + (ast-parent n)) + + (let loop ((nodes (filter %block? (node-children p))) + (prev (and (eq? p (ast-document n)) p))) + (match nodes + (((? (cut eq? n <>))) + (values prev #f)) + (((? (cut eq? n <>)) next _ ...) + (values prev next)) + ((prev rest ...) + (loop rest prev))))) + + (define (title n) + (if (document? n) + "Top" + (block-title n e))) + (if (document? section) (let loop ((c (markup-body section))) (cond @@ -100,25 +122,11 @@ (values (block-title (car c) e) "(dir)" "(dir)")) (else (loop (cdr c))))) - (let ((parent (ast-parent section))) - (let ((top (if (document? parent) - "Top" - (block-title parent e)))) - (let loop ((els (filter %block? (markup-body parent))) - (prev #f)) - (cond - ((null? els) - (values top top top)) - ((eq? (car els) section) - (let ((p (if prev - (block-title prev e) - top)) - (n (if (null? (cdr els)) - top - (block-title (cadr els) e)))) - (values n p top))) - (else - (loop (cdr els) (car els))))))))) + (let-values (((parent) (ast-parent section)) + ((prev next) (ast-prev+next section))) + (values (and=> next title) + (and=> prev title) + (title parent))))) ;*---------------------------------------------------------------------*/ ;* node-menu ... */ diff --git a/tests/Makefile.am b/tests/Makefile.am index 280875a..84cb0c9 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -3,7 +3,11 @@ TESTS_ENVIRONMENT = \ GUILE_LOAD_COMPILED_PATH="$(top_builddir)/src/guile:$$GUILE_LOAD_COMPILED_PATH" \ $(GUILE) -L $(top_srcdir)/src/guile -L $(top_builddir)/src/guile -TESTS = ast.test readers/rss-2.test resolve.test +TESTS = \ + ast.test \ + resolve.test \ + readers/rss-2.test \ + engines/info.test EXTRA_DIST = $(TESTS) diff --git a/tests/engines/info.test b/tests/engines/info.test new file mode 100644 index 0000000..2c6eb8f --- /dev/null +++ b/tests/engines/info.test @@ -0,0 +1,97 @@ +;;; Test the Info engine. -*- Scheme -*- +;;; +;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of Skribilo. +;;; +;;; Skribilo is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Skribilo is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(define-module (tests engines info) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo resolve) + :use-module (skribilo package base) + :use-module (srfi srfi-1) + :use-module (srfi srfi-11) + :use-module (srfi srfi-64)) + +(define %info + (find-engine 'info)) + +(define node-next+prev+up + (@@ (skribilo engine info) node-next+prev+top)) + + +(test-begin "info") + +(test-assert "empty document" + (let*-values (((doc) (document #:title "t")) + ((next prev up) (node-next+prev+up doc %info))) + (and (equal? next "Top") + (equal? prev "(dir)") + (equal? up "(dir)")))) + +(test-assert "two chapters" + (let ((doc (document #:title "t" + (chapter #:title "c" "body") + (chapter #:title "d" "body")))) + (resolve! doc %info '()) + (let-values (((next prev up) (node-next+prev+up doc %info))) + (and (equal? up "(dir)") + (equal? prev "(dir)") + (equal? next "c") + (let*-values (((ch) (car (markup-body doc))) + ((next prev up) (node-next+prev+up ch %info))) + (and (equal? up "Top") + (equal? prev "Top") + (equal? next "d"))) + (let*-values (((ch) (cadr (markup-body doc))) + ((next prev up) (node-next+prev+up ch %info))) + (and (equal? up "Top") + (equal? prev "c") + (not next))))))) + +(test-assert "nest" + (let ((doc (document #:title "t" + "hello" + (chapter #:ident "c" #:title "c" + (p "body") + (section #:ident "s" #:title "s" "body")) + (chapter #:ident "d" #:title "d" "body")))) + (resolve! doc %info '()) + (and (let*-values (((ch) (document-lookup-node doc "c")) + ((next prev up) (node-next+prev+up ch %info))) + (and (equal? up "Top") + (equal? prev "Top") + (equal? next "d"))) + (let*-values (((sec) (document-lookup-node doc "s")) + ((next prev up) (node-next+prev+up sec %info))) + (and (equal? up "c") + (not prev) + (not next))) + (let*-values (((sec) (document-lookup-node doc "d")) + ((next prev up) (node-next+prev+up sec %info))) + (and (equal? up "Top") + (equal? prev "c") + (not next)))))) + +(test-end "info") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;; Local Variables: +;; coding: utf-8 +;; eval: (put 'test-assert 'scheme-indent-function 1) +;; End: |