Fixed `find-up'.

* src/guile/skribilo/ast.scm (find-up): Don't cons OBJ when it doesn't
  match PRED.

git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-145

3 files changed, 60 insertions, 27 deletions

diff --git a/ChangeLog b/ChangeLog
index b0d53de..ac73bfe 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,24 @@
 # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2
 #
 
+2007-08-20 16:29:46 GMT	Ludovic Court`es <ludovic.courtes@laas.fr>	patch-145
+
+    Summary:
+      Fixed `find-up'.
+    Revision:
+      skribilo--devo--1.2--patch-145
+
+    * src/guile/skribilo/ast.scm (find-up): Don't cons OBJ when it doesn't
+      match PRED.
+
+    modified files:
+     ChangeLog src/guile/skribilo/ast.scm
+     src/guile/skribilo/package/base.scm
+
+    new patches:
+     lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-86
+
+
 2007-08-20 16:28:40 GMT	Ludovic Court`es <ludovic.courtes@laas.fr>	patch-144
 
     Summary:
diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm
index 1b37a0b..f515009 100644
--- a/src/guile/skribilo/ast.scm
+++ b/src/guile/skribilo/ast.scm
@@ -23,6 +23,7 @@
 (define-module (skribilo ast)
   :use-module (oop goops)
 
+  :use-module (srfi srfi-13)
   :use-module (srfi srfi-34)
   :use-module (srfi srfi-35)
   :use-module (skribilo condition)
@@ -610,20 +611,33 @@
   ;; Return a structure number string such as "1.2".
   (cond ((is-markup? markup 'figure)
          ;; Figure numbering is assumed to be document-wide.
-         (number->string (markup-option markup :number)))
+         (let ((num (markup-option markup :number)))
+           (if (number? num)
+               (number->string num)
+               num)))
         (else
          ;; Use a hierarchical numbering scheme.
-         (let loop ((markup markup))
+         (let loop ((markup markup)
+                    (result '()))
            (if (document? markup)
-               ""
-               (let ((parent-num (loop (ast-parent markup)))
-                     (num (markup-option markup :number)))
-                 (string-append parent-num
-                                (if (string=? "" parent-num) "" sep)
-                                (if (number? num)
-                                    (number->string num)
-                                    ""))))))))
-
+               (string-join result sep)
+               (let ((num (markup-option markup :number)))
+                 (loop (ast-parent markup)
+                       (cond ((number? num)
+                              (cons (number->string num)
+                                    result))
+                             ((ast? num)
+                              (cons (ast->string num)
+                                    result))
+                             ((string? num)
+                              (cons num result))
+                             (else
+                              result)))))))))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
 
 ;;; arch-tag: e2489bd6-1b6d-4b03-bdfb-83cffd2f7ce7
 
diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm
index 872c1e2..9616080 100644
--- a/src/guile/skribilo/package/base.scm
+++ b/src/guile/skribilo/package/base.scm
@@ -174,6 +174,22 @@
 		   (skribe-error 'toc "Illegal argument" body)))))))
 
 ;*---------------------------------------------------------------------*/
+;*    section-number ...                                               */
+;*---------------------------------------------------------------------*/
+(define (section-number number markup)
+  (cond ((not number)
+         ;; number-less
+         #f)
+        ((or (string? number) (list? number) (ast? number))
+         ;; user-specified number
+         number)
+        (else
+         ;; automatic numbering
+         (new unresolved
+              (proc (lambda (n e env)
+                      (resolve-counter n env markup number)))))))
+
+;*---------------------------------------------------------------------*/
 ;*    chapter ... ...                                                  */
 ;*    -------------------------------------------------------------    */
 ;*    doc:                                                             */
@@ -193,13 +209,7 @@
       (loc   &invocation-location)
       (required-options '(:title :file :toc :number))
       (options `((:toc ,toc)
-		 (:number ,(and number
-				(new unresolved
-				   (proc (lambda (n e env)
-					    (resolve-counter n
-							     env
-							     'chapter
-							     number))))))
+		 (:number ,(section-number number 'chapter))
 		 ,@(the-options opts :ident :class)))
       (body (the-body opts))
       (env (list (list 'section-counter 0) (list 'section-env '())
@@ -207,15 +217,6 @@
                  (list 'equation-counter 0) (list 'equation-env '())))))
 
 ;*---------------------------------------------------------------------*/
-;*    section-number ...                                               */
-;*---------------------------------------------------------------------*/
-(define (section-number number markup)
-   (and number
-	(new unresolved
-	   (proc (lambda (n e env)
-		    (resolve-counter n env markup number))))))
-
-;*---------------------------------------------------------------------*/
 ;*    section ...                                                      */
 ;*    -------------------------------------------------------------    */
 ;*    doc:                                                             */