summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès2008-04-23 22:33:23 +0200
committerLudovic Courtès2008-04-23 22:33:23 +0200
commit5add78aba082524aee7350432f9ac0c0e983b33d (patch)
treea52315356a45e189a0253fa853f81d3c9cc666b2
parent087306a64cc34ea2b5415e3c1cd8505faedf4f14 (diff)
downloadskribilo-5add78aba082524aee7350432f9ac0c0e983b33d.tar.gz
skribilo-5add78aba082524aee7350432f9ac0c0e983b33d.tar.lz
skribilo-5add78aba082524aee7350432f9ac0c0e983b33d.zip
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.
-rw-r--r--NEWS1
-rw-r--r--src/guile/skribilo/package/base.scm4
-rw-r--r--src/guile/skribilo/sui.scm25
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 ... */