diff options
| -rw-r--r-- | ChangeLog | 19 | ||||
| -rw-r--r-- | src/guile/skribilo/biblio/author.scm | 33 |
2 files changed, 48 insertions, 4 deletions
@@ -2,6 +2,25 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-08-29 13:20:34 GMT Ludovic Court`es <ludovic.courtes@laas.fr> patch-154 + + Summary: + biblio: Improved `bib-sort/first-author-last-name'. + Revision: + skribilo--devo--1.2--patch-154 + + * 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. + + modified files: + ChangeLog src/guile/skribilo/biblio/author.scm + + new patches: + lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-96 + + 2007-08-28 14:40:42 GMT Ludovic Court`es <ludovic.courtes@laas.fr> patch-153 Summary: 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 |