aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLudovic Court`es2007-08-20 16:29:46 +0000
committerLudovic Court`es2007-08-20 16:29:46 +0000
commit78b603a076be86ffeb1861fc16bf355fa3c4562f (patch)
tree1aeb42cbcc3885b53a1fd89aa24b42bdfb2f7411 /src
parent655e83cceddc28f7a1b25106e9cafae005530ca5 (diff)
parentea87fc231d9eb30ac3dc5bb1d6933ae7862ed1ac (diff)
downloadskribilo-78b603a076be86ffeb1861fc16bf355fa3c4562f.tar.gz
skribilo-78b603a076be86ffeb1861fc16bf355fa3c4562f.tar.lz
skribilo-78b603a076be86ffeb1861fc16bf355fa3c4562f.zip
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
Diffstat (limited to 'src')
-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: */