From 4c3a84d4fd923cefc663d314d5659253101b70f9 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Fri, 24 Nov 2006 12:53:47 +0000
Subject: `base' package: Added `numref'.

* src/guile/skribilo/package/base.scm (numref): New.

git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-77
---
 src/guile/skribilo/package/base.scm | 43 +++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)

(limited to 'src')

diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm
index bbb2a62..4c9e84c 100644
--- a/src/guile/skribilo/package/base.scm
+++ b/src/guile/skribilo/package/base.scm
@@ -1187,6 +1187,49 @@
 	 (line (line-ref line))
 	 (else (skribe-error 'ref "illegal reference" opts)))))
 
+
+;*---------------------------------------------------------------------*/
+;*    numref ...                                                       */
+;*---------------------------------------------------------------------*/
+(define-markup (numref #!rest opts
+                       #!key (ident #f) (text "") (page #f)
+                             (separator ".") (class #f))
+  ;; Produce a numbered reference to `ident'.
+  (new unresolved
+       (proc (lambda (n e env)
+	       (let* ((parent (ast-parent n))
+                      (doc (ast-document n))
+		      (target (document-lookup-node doc ident))
+		      (number (and target
+                                   (markup-option target :number))))
+                 (cond
+                  ((not target)
+                   (skribe-warning/ast 1 n 'numref
+                                       (format #f "can't find `ident': ")
+                                       ident)
+                   (new markup
+                        (markup 'unref)
+                        (ident (symbol->string (gensym "unref")))
+                        (class class)
+                        (required-options '(:text))
+                        (options `((kind numref)
+                                   ,@(the-options opts :ident :class)))
+                        (body (list ident ": " (ast->file-location n)))))
+                  ((unresolved? number)
+                   ;; Loop until `number' is resolved.
+                   n)
+                  (else
+                   (let ((xref
+                          (ref :text
+                               (list (if text text "") " "
+                                     (if (number? number)
+                                         (markup-number-string target
+                                                               separator)
+                                         ""))
+                               :page page
+                               :handle (handle target))))
+                     (resolve! xref e env)))))))))
+
 ;*---------------------------------------------------------------------*/
 ;*    resolve ...                                                      */
 ;*---------------------------------------------------------------------*/
-- 
cgit v1.2.3