From ea87fc231d9eb30ac3dc5bb1d6933ae7862ed1ac Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Mon, 20 Aug 2007 16:01:30 +0000
Subject: Allow for user-specified section numbers.

* src/guile/skribilo/ast.scm: Use `srfi-13'.
  (markup-number-string): Made tail-recursive.  Allow for non-number
  `:number' options.

* src/guile/skribilo/package/base.scm (section-number): Allow non-number
  `:number' options to pass through.
  (chapter): Use `section-number'.

git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-86
---
 src/guile/skribilo/ast.scm          | 36 +++++++++++++++++++++++++-----------
 src/guile/skribilo/package/base.scm | 33 +++++++++++++++++----------------
 2 files changed, 42 insertions(+), 27 deletions(-)

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
@@ -173,6 +173,22 @@
 		  (else
 		   (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 ... ...                                                  */
 ;*    -------------------------------------------------------------    */
@@ -193,28 +209,13 @@
       (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 '())
 		 (list 'footnote-counter 0) (list 'footnote-env '())
                  (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 ...                                                      */
 ;*    -------------------------------------------------------------    */
-- 
cgit v1.2.3