aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
authorLudovic Court`es2007-08-29 09:12:33 +0000
committerLudovic Court`es2007-08-29 09:12:33 +0000
commit5d9b0e84c21a4d87e204b0f28a3e60d3f297d4ab (patch)
tree8662aaba7ceef97d1802a3ce4a8090bedf8b312e /src/guile
parentf0c79b60862138deb10286e8fe3edece3755dcdf (diff)
downloadskribilo-5d9b0e84c21a4d87e204b0f28a3e60d3f297d4ab.tar.gz
skribilo-5d9b0e84c21a4d87e204b0f28a3e60d3f297d4ab.tar.lz
skribilo-5d9b0e84c21a4d87e204b0f28a3e60d3f297d4ab.zip
biblio: Improved `bib-sort/first-author-last-name'.
* src/guile/skribilo/biblio/author.scm (bib-sort/first-author-last-name)[entry-field, <=?]: New. Use them such that ordering also takes `year' and `title' into account. git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-96
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/biblio/author.scm33
1 files changed, 29 insertions, 4 deletions
diff --git a/src/guile/skribilo/biblio/author.scm b/src/guile/skribilo/biblio/author.scm
index e842780..fe4e0e6 100644
--- a/src/guile/skribilo/biblio/author.scm
+++ b/src/guile/skribilo/biblio/author.scm
@@ -129,11 +129,30 @@
(define (bib-sort/first-author-last-name entries)
- ;; May be passed as the `:sort' argument of `the-bibliography'.
+ ;; May be passed as the `:sort' argument of `the-bibliography'.
+
+ (define (entry-field entry name)
+ (let ((o (markup-option entry name)))
+ (and o (markup-body o))))
+
+ (define (<=? e1 e2 field fail)
+ (let ((f1 (entry-field e1 field))
+ (f2 (entry-field e2 field)))
+ (cond ((and (string? f1) (string? f2))
+ (if (string-ci=? f1 f2)
+ (fail)
+ (string-ci<=? f1 f2)))
+ ((and (number? f1) (number? f2))
+ (if (= f1 f2)
+ (fail)
+ (<= f1 f2)))
+ (else
+ (fail)))))
+
(let ((check-author (lambda (e)
(if (not (markup-option e 'author))
- (skribe-error 'web
- "No author for this bib entry"
+ (skribe-error 'bib-sort/first-author-last-name
+ "no author for this bib entry"
(markup-ident e))
#t))))
(sort entries
@@ -144,7 +163,13 @@
(markup-body (markup-option e1 'author))))
(a2 (first-author-last-name
(markup-body (markup-option e2 'author)))))
- (string-ci<=? a1 a2)))))))
+ (if (string-ci=? a1 a2)
+ (<=? e1 e2 'year
+ (lambda ()
+ (<=? e1 e2 'title
+ (lambda ()
+ #f))))
+ (string-ci<=? a1 a2))))))))
;;; arch-tag: c9a1ef10-a2cd-4a06-bd35-fbdee1abf09a