summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Court`es2007-08-20 16:01:30 +0000
committerLudovic Court`es2007-08-20 16:01:30 +0000
commitea87fc231d9eb30ac3dc5bb1d6933ae7862ed1ac (patch)
tree3ff725cbfd42cab7f112e7a30a4eb859366a8686
parent6e53232aaf3f3ec31678911643c1e1a9f04d6619 (diff)
downloadskribilo-ea87fc231d9eb30ac3dc5bb1d6933ae7862ed1ac.tar.gz
skribilo-ea87fc231d9eb30ac3dc5bb1d6933ae7862ed1ac.tar.lz
skribilo-ea87fc231d9eb30ac3dc5bb1d6933ae7862ed1ac.zip
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
-rw-r--r--src/guile/skribilo/ast.scm36
-rw-r--r--src/guile/skribilo/package/base.scm33
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
@@ -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: */