From 5add78aba082524aee7350432f9ac0c0e983b33d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Wed, 23 Apr 2008 22:33:23 +0200
Subject: Fix SUI `:ident' references.

* src/guile/skribilo/package/base.scm (skribe-ref): Pass the result of
  `dirname' as the DIR argument of `sui-ref->url'.  Don't pass ":ident
  ident" to `ref'.

* src/guile/skribilo/sui.scm (sui-find-ref): Fix invocation of
  `sui-search-all-refs'.
  (sui-search-all-refs): Actually implemented.

* NEWS: Update.
---
 NEWS                                |  1 +
 src/guile/skribilo/package/base.scm |  4 ++--
 src/guile/skribilo/sui.scm          | 25 ++++++++++++++++++++++---
 3 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index 5eb9d29..1b92ac3 100644
--- a/NEWS
+++ b/NEWS
@@ -32,6 +32,7 @@ Namely, `slide-outline-title' and
 ** The `:toc' option of `slide' determines whether to include it in the outline
 ** New option `:rulecolor' for `table'
 ** New `--sui-path' command-line option, new `*sui-path*' parameter
+** Fix SUI `:ident' references
 ** Use more SRFI-34/35 exception handling instead of `skribe-error'
 ** Lesser reliance on recursive make
 
diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm
index fc6abca..c8aac4a 100644
--- a/src/guile/skribilo/package/base.scm
+++ b/src/guile/skribilo/package/base.scm
@@ -1089,11 +1089,11 @@
    (define (skribe-ref skribe)
      (let* ((sui (load-sui skribe))
             (os  (the-options opts :skribe :class :text))
-            (u   (sui-ref->url (search-path (*sui-path*) skribe)
+            (u   (sui-ref->url (dirname (search-path (*sui-path*) skribe))
                                sui ident os)))
        (if (not u)
            (unref #f os 'sui-ref)
-           (ref :url u :text text :ident ident :class class))))
+           (ref :url u :text text :class class))))
    (define (handle-ref text)
       (new markup
 	 (markup 'ref)
diff --git a/src/guile/skribilo/sui.scm b/src/guile/skribilo/sui.scm
index effc263..e60a324 100644
--- a/src/guile/skribilo/sui.scm
+++ b/src/guile/skribilo/sui.scm
@@ -192,7 +192,7 @@
 	     (section (sui-search-ref 'sections refs (cadr section) class))
 	     (subsection (sui-search-ref 'subsections refs (cadr subsection) class))
 	     (subsubsection (sui-search-ref 'subsubsections refs (cadr subsubsection) class))
-	     (ident (sui-search-all-refs sui ident class))
+	     (ident (sui-search-all-refs refs (cadr ident) class))
 	     (else '())))
 	 (else
           (raise (condition (&invalid-sui-error
@@ -201,8 +201,27 @@
 ;*---------------------------------------------------------------------*/
 ;*    sui-search-all-refs ...                                          */
 ;*---------------------------------------------------------------------*/
-(define (sui-search-all-refs sui id refs)
-   '())
+(define (sui-search-all-refs refs id class)
+  ;; Search any kind of object with ident ID among REFS.
+  (define (find-mark full-ref)
+    (let loop ((ref full-ref))
+      (and (not (null? ref))
+           (or (and (eq? (car ref) :mark)
+                    (string=? (cadr ref) id)
+                    (let ((f (memq :file full-ref))
+                          (c (memq :mark full-ref)))
+                      (list (cons (and (pair? f) (cadr f))
+                                  (and (pair? c) (cadr c))))))
+               (loop (cdr ref))))))
+
+  (let loop ((ref-kind refs))
+    (and (not (null? ref-kind))
+         (or (and (pair? (car ref-kind))
+                  (let liip ((refs (cdar ref-kind)))
+                    (and (not (null? refs))
+                         (or (find-mark (car refs))
+                             (liip (cdr refs))))))
+             (loop (cdr ref-kind))))))
 
 ;*---------------------------------------------------------------------*/
 ;*    sui-search-ref ...                                               */
-- 
cgit v1.2.3