Merged the two bibliography modules.

* src/guile/skribilo/biblio.scm: Use `srfi-1', `ast', `goops'; don't use
  `module' and `skribe bib'.
  Merged the `(skribilo skribe bib)'.

* src/guile/skribilo/module.scm (%skribe-core-modules): Removed `bib'.

* src/guile/skribilo/skribe/Makefile.am (dist_guilemodule_DATA): Removed
  `bib.scm'.

git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-12

4 files changed, 218 insertions, 224 deletions

diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm
index 2d5f1ea..04a8bfd 100644
--- a/src/guile/skribilo/biblio.scm
+++ b/src/guile/skribilo/biblio.scm
@@ -1,7 +1,7 @@
 ;;; biblio.scm  --  Bibliography functions.
 ;;;
-;;; Copyright 2003-2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;; Copyright 2005  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2005, 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -23,20 +23,38 @@
 (define-module (skribilo biblio)
   :use-module (skribilo runtime)
   :use-module (skribilo utils syntax) ;; `when', `unless'
-  :use-module (skribilo module)
-  :use-module (skribilo skribe bib) ;; `make-bib-entry'
 
-  :autoload   (srfi srfi-34) (raise)
+  :autoload   (srfi srfi-34)         (raise)
   :use-module (srfi srfi-35)
-  :autoload   (skribilo condition) (&file-search-error)
+  :use-module (srfi srfi-1)
+  :autoload   (skribilo condition)   (&file-search-error)
 
   :autoload   (skribilo reader)      (%default-reader)
   :autoload   (skribilo parameters)  (*bib-path*)
+  :autoload   (skribilo ast)         (<markup> <handle>)
+
   :use-module (ice-9 optargs)
+  :use-module (oop goops)
 
   :export (bib-table? make-bib-table default-bib-table
 	   bib-add! bib-duplicate bib-for-each bib-map
-	   skribe-open-bib-file parse-bib))
+	   skribe-open-bib-file parse-bib
+
+           bib-load! resolve-bib resolve-the-bib make-bib-entry
+
+           ;; sorting entries
+           bib-sort/authors bib-sort/idents bib-sort/dates))
+
+;;; Author: Erick Gallesio, Manuel Serrano, Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; Provides the bibliography data type and basic bibliography handling,
+;;; including simple procedures to sort bibliography entries.
+;;;
+;;; FIXME: This module need cleanup!
+;;;
+;;; Code:
 
 (fluid-set! current-reader %skribilo-module-reader)
 
@@ -171,3 +189,194 @@
 			      path)))
        (raise (condition (&file-search-error (file-name file)
 					     (path (*bib-path*))))))))
+
+
+;;;
+;;; High-level API.
+;;;
+;;; The contents of the file below are unchanged compared to Skribe 1.2d's
+;;; `bib.scm' file found in the `common' directory.  The copyright notice for
+;;; this file was:
+;;;
+;;;  Copyright 2001, 2002, 2003, 2004  Manuel Serrano
+;;;
+
+
+;*---------------------------------------------------------------------*/
+;*    bib-load! ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (bib-load! table filename command)
+   (if (not (bib-table? table))
+       (skribe-error 'bib-load "Illegal bibliography table" table)
+       ;; read the file
+       (let ((p (skribe-open-bib-file filename command)))
+	  (if (not (input-port? p))
+	      (skribe-error 'bib-load "Can't open data base" filename)
+	      (unwind-protect
+		 (parse-bib table p)
+		 (close-input-port p))))))
+
+;*---------------------------------------------------------------------*/
+;*    resolve-bib ...                                                  */
+;*---------------------------------------------------------------------*/
+(define (resolve-bib table ident)
+   (if (not (bib-table? table))
+       (skribe-error 'resolve-bib "Illegal bibliography table" table)
+       (let* ((i (cond
+		    ((string? ident) ident)
+		    ((symbol? ident) (symbol->string ident))
+		    (else (skribe-error 'resolve-bib "Illegal ident" ident))))
+	      (en (hash-ref table i)))
+	  (if (is-markup? en '&bib-entry)
+	      en
+	      #f))))
+
+;*---------------------------------------------------------------------*/
+;*    make-bib-entry ...                                               */
+;*---------------------------------------------------------------------*/
+(define (make-bib-entry kind ident fields from)
+   (let* ((m (make <markup>
+		:markup '&bib-entry
+		:ident ident
+		:options `((kind ,kind) (from ,from))))
+	  (h (make <handle> :ast m)))
+      (for-each (lambda (f)
+		   (if (and (pair? f)
+			    (pair? (cdr f))
+			    (null? (cddr f))
+			    (symbol? (car f)))
+		       (markup-option-add! m 
+					   (car f)
+					   (make <markup>
+					      :markup (symbol-append
+						       '&bib-entry-
+						       (car f))
+					      :parent h
+					      :body (cadr f)))
+		       (bib-parse-error f)))
+		fields)
+      m))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/authors ...                                             */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/authors l)
+   (define (cmp i1 i2 def)
+      (cond
+	 ((and (markup? i1) (markup? i2))
+	  (cmp (markup-body i1) (markup-body i2) def))
+	 ((markup? i1)
+	  (cmp (markup-body i1) i2 def))
+	 ((markup? i2)
+	  (cmp i1 (markup-body i2) def))
+	 ((and (string? i1) (string? i2))
+	  (if (string=? i1 i2)
+	      (def)
+	      (string<? i1 i2)))
+	 ((string? i1)
+	  #f)
+	 ((string? i2)
+	  #t)
+	 (else
+	  (def))))
+   (sort l (lambda (e1 e2)
+	      (cmp (markup-option e1 'author)
+		   (markup-option e2 'author)
+		   (lambda ()
+		      (cmp (markup-option e1 'year)
+			   (markup-option e2 'year)
+			   (lambda ()
+			      (cmp (markup-option e1 'title)
+				   (markup-option e2 'title)
+				   (lambda ()
+				      (cmp (markup-ident e1)
+					   (markup-ident e2)
+					   (lambda ()
+					      #t)))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/idents ...                                              */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/idents l)
+   (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f)))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/dates ...                                               */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/dates l)
+   (sort l (lambda (p1 p2)
+	      (define (month-num m)
+		 (let ((body (markup-body m)))
+		    (if (not (string? body))
+			13
+			(let* ((s (if (> (string-length body) 3)
+				      (substring body 0 3)
+				      body))
+			       (sy (string->symbol (string-downcase body)))
+			       (c (assq sy '((jan . 1)
+					     (feb . 2)
+					     (mar . 3)
+					     (apr . 4)
+					     (may . 5)
+					     (jun . 6)
+					     (jul . 7)
+					     (aug . 8)
+					     (sep . 9)
+					     (oct . 10)
+					     (nov . 11)
+					     (dec . 12)))))
+			   (if (pair? c) (cdr c) 13)))))
+	      (let ((d1 (markup-option p1 'year))
+		    (d2 (markup-option p2 'year)))
+		 (cond
+		    ((not (markup? d1)) #f)
+		    ((not (markup? d2)) #t)
+		    (else
+		     (let ((y1 (markup-body d1))
+			   (y2 (markup-body d2)))
+			(cond
+			   ((string>? y1 y2) #t)
+			   ((string<? y1 y2) #f)
+			   (else
+			    (let ((d1 (markup-option p1 'month))
+				  (d2 (markup-option p2 'month)))
+			       (cond
+				  ((not (markup? d1)) #f)
+				  ((not (markup? d2)) #t)
+				  (else
+				   (let ((m1 (month-num d1))
+					 (m2 (month-num d2)))
+				      (> m1 m2))))))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    resolve-the-bib ...                                              */
+;*---------------------------------------------------------------------*/
+(define (resolve-the-bib table n sort pred count opts)
+   (define (count! entries)
+      (let loop ((es entries)
+		 (i 1))
+	 (if (pair? es)
+	     (begin
+		(markup-option-add! (car es)
+				    :title
+				    (make <markup>
+				       :markup '&bib-entry-ident
+				       :parent (car es)
+				       :options `((number ,i))
+				       :body (make <handle> :ast (car es))))
+		(loop (cdr es) (+ i 1))))))
+   (if (not (bib-table? table))
+       (skribe-error 'resolve-the-bib "Illegal bibliography table" table)
+       (let* ((es (sort (hash-map->list (lambda (key val) val) table)))
+	      (fes (filter (if (procedure? pred)
+			       (lambda (m) (pred m n))
+			       (lambda (m) (pair? (markup-option m 'used))))
+			   es)))
+	  (count! (if (eq? count 'full) es fes))
+	  (make <markup>
+	     :markup '&the-bibliography
+	     :options opts
+	     :body fes))))
+
+
+;;; biblio.scm ends here
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index 753aca8..1d716be 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -86,7 +86,7 @@
     ((ice-9 receive)          . (receive))))
 
 (define %skribe-core-modules
-  '("utils" "api" "bib" "index" "param" "sui"))
+  '("utils" "api" "index" "param" "sui"))
 
 
 
diff --git a/src/guile/skribilo/skribe/Makefile.am b/src/guile/skribilo/skribe/Makefile.am
index e005313..5b329b4 100644
--- a/src/guile/skribilo/skribe/Makefile.am
+++ b/src/guile/skribilo/skribe/Makefile.am
@@ -1,2 +1,2 @@
 guilemoduledir = $(GUILE_SITE)/skribilo/skribe
-dist_guilemodule_DATA = api.scm bib.scm index.scm param.scm sui.scm utils.scm
+dist_guilemodule_DATA = api.scm index.scm param.scm sui.scm utils.scm
diff --git a/src/guile/skribilo/skribe/bib.scm b/src/guile/skribilo/skribe/bib.scm
deleted file mode 100644
index 2bc2238..0000000
--- a/src/guile/skribilo/skribe/bib.scm
+++ /dev/null
@@ -1,215 +0,0 @@
-;;; lib.scm
-;;;
-;;; Copyright 2001, 2002, 2003, 2004  Manuel Serrano
-;;; Copyright 2005  Ludovic Courtès  <ludovic.courtes@laas.fr>
-;;;
-;;;
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-;;; USA.
-
-(define-skribe-module (skribilo skribe bib)
-  :use-module (skribilo biblio))
-
-;;; Author:  Manuel Serrano
-;;; Commentary:
-;;;
-;;; A library of bibliography-related functions.
-;;;
-;;; Code:
-
-
-;;; The contents of the file below are unchanged compared to Skribe 1.2d's
-;;; `bib.scm' file found in the `common' directory.
-
-;*---------------------------------------------------------------------*/
-;*    bib-load! ...                                                    */
-;*---------------------------------------------------------------------*/
-(define-public (bib-load! table filename command)
-   (if (not (bib-table? table))
-       (skribe-error 'bib-load "Illegal bibliography table" table)
-       ;; read the file
-       (let ((p (skribe-open-bib-file filename command)))
-	  (if (not (input-port? p))
-	      (skribe-error 'bib-load "Can't open data base" filename)
-	      (unwind-protect
-		 (parse-bib table p)
-		 (close-input-port p))))))
-
-;*---------------------------------------------------------------------*/
-;*    resolve-bib ...                                                  */
-;*---------------------------------------------------------------------*/
-(define-public (resolve-bib table ident)
-   (if (not (bib-table? table))
-       (skribe-error 'resolve-bib "Illegal bibliography table" table)
-       (let* ((i (cond
-		    ((string? ident) ident)
-		    ((symbol? ident) (symbol->string ident))
-		    (else (skribe-error 'resolve-bib "Illegal ident" ident))))
-	      (en (hashtable-get table i)))
-	  (if (is-markup? en '&bib-entry)
-	      en
-	      #f))))
-
-;*---------------------------------------------------------------------*/
-;*    make-bib-entry ...                                               */
-;*---------------------------------------------------------------------*/
-(define-public (make-bib-entry kind ident fields from)
-   (let* ((m (new markup
-		(markup '&bib-entry)
-		(ident ident)
-		(options `((kind ,kind) (from ,from)))))
-	  (h (new handle
-		(ast m))))
-      (for-each (lambda (f)
-		   (if (and (pair? f)
-			    (pair? (cdr f))
-			    (null? (cddr f))
-			    (symbol? (car f)))
-		       (markup-option-add! m 
-					   (car f)
-					   (new markup
-					      (markup (symbol-append
-						       '&bib-entry-
-						       (car f)))
-					      (parent h)
-					      (body (cadr f))))
-		       (bib-parse-error f)))
-		fields)
-      m))
-
-;*---------------------------------------------------------------------*/
-;*    bib-sort/authors ...                                             */
-;*---------------------------------------------------------------------*/
-(define-public (bib-sort/authors l)
-   (define (cmp i1 i2 def)
-      (cond
-	 ((and (markup? i1) (markup? i2))
-	  (cmp (markup-body i1) (markup-body i2) def))
-	 ((markup? i1)
-	  (cmp (markup-body i1) i2 def))
-	 ((markup? i2)
-	  (cmp i1 (markup-body i2) def))
-	 ((and (string? i1) (string? i2))
-	  (if (string=? i1 i2)
-	      (def)
-	      (string<? i1 i2)))
-	 ((string? i1)
-	  #f)
-	 ((string? i2)
-	  #t)
-	 (else
-	  (def))))
-   (sort l (lambda (e1 e2)
-	      (cmp (markup-option e1 'author)
-		   (markup-option e2 'author)
-		   (lambda ()
-		      (cmp (markup-option e1 'year)
-			   (markup-option e2 'year)
-			   (lambda ()
-			      (cmp (markup-option e1 'title)
-				   (markup-option e2 'title)
-				   (lambda ()
-				      (cmp (markup-ident e1)
-					   (markup-ident e2)
-					   (lambda ()
-					      #t)))))))))))
-
-;*---------------------------------------------------------------------*/
-;*    bib-sort/idents ...                                              */
-;*---------------------------------------------------------------------*/
-(define-public (bib-sort/idents l)
-   (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f)))))
-
-;*---------------------------------------------------------------------*/
-;*    bib-sort/dates ...                                               */
-;*---------------------------------------------------------------------*/
-(define-public (bib-sort/dates l)
-   (sort l (lambda (p1 p2)
-	      (define (month-num m)
-		 (let ((body (markup-body m)))
-		    (if (not (string? body))
-			13
-			(let* ((s (if (> (string-length body) 3)
-				      (substring body 0 3)
-				      body))
-			       (sy (string->symbol (string-downcase body)))
-			       (c (assq sy '((jan . 1)
-					     (feb . 2)
-					     (mar . 3)
-					     (apr . 4)
-					     (may . 5)
-					     (jun . 6)
-					     (jul . 7)
-					     (aug . 8)
-					     (sep . 9)
-					     (oct . 10)
-					     (nov . 11)
-					     (dec . 12)))))
-			   (if (pair? c) (cdr c) 13)))))
-	      (let ((d1 (markup-option p1 'year))
-		    (d2 (markup-option p2 'year)))
-		 (cond
-		    ((not (markup? d1)) #f)
-		    ((not (markup? d2)) #t)
-		    (else
-		     (let ((y1 (markup-body d1))
-			   (y2 (markup-body d2)))
-			(cond
-			   ((string>? y1 y2) #t)
-			   ((string<? y1 y2) #f)
-			   (else
-			    (let ((d1 (markup-option p1 'month))
-				  (d2 (markup-option p2 'month)))
-			       (cond
-				  ((not (markup? d1)) #f)
-				  ((not (markup? d2)) #t)
-				  (else
-				   (let ((m1 (month-num d1))
-					 (m2 (month-num d2)))
-				      (> m1 m2))))))))))))))
-
-;*---------------------------------------------------------------------*/
-;*    resolve-the-bib ...                                              */
-;*---------------------------------------------------------------------*/
-(define-public (resolve-the-bib table n sort pred count opts)
-   (define (count! entries)
-      (let loop ((es entries)
-		 (i 1))
-	 (if (pair? es)
-	     (begin
-		(markup-option-add! (car es)
-				    :title
-				    (new markup
-				       (markup '&bib-entry-ident)
-				       (parent (car es))
-				       (options `((number ,i)))
-				       (body (new handle
-						(ast (car es))))))
-		(loop (cdr es) (+ i 1))))))
-   (if (not (bib-table? table))
-       (skribe-error 'resolve-the-bib "Illegal bibliography table" table)
-       (let* ((es (sort (hashtable->list table)))
-	      (fes (filter (if (procedure? pred)
-			       (lambda (m) (pred m n))
-			       (lambda (m) (pair? (markup-option m 'used))))
-			   es)))
-	  (count! (if (eq? count 'full) es fes))
-	  (new markup
-	     (markup '&the-bibliography)
-	     (options opts)
-	     (body fes)))))
-
-
-;;; bib.scm ends here