;*=====================================================================*/
;*    serrano/prgm/project/skribe/src/bigloo/bib.bgl                   */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Fri Dec  7 06:12:29 2001                          */
;*    Last change :  Tue Nov  2 17:14:02 2004 (serrano)                */
;*    Copyright   :  2001-04 Manuel Serrano                            */
;*    -------------------------------------------------------------    */
;*    Skribe Bibliography                                              */
;*    -------------------------------------------------------------    */
;*    Implementation: @label bib@                                      */
;*    bigloo: @path ../common/bib.scm@                                 */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    The module                                                       */
;*---------------------------------------------------------------------*/
(module skribe_bib
   
   (include "new.sch")
   
   (import  skribe_types
	    skribe_lib
	    skribe_resolve
	    skribe_eval
	    skribe_read)
   
   (export  (bib-table?::bool ::obj)
	    (make-bib-table ::bstring) 
	    (default-bib-table)
	    (bib-load! ::obj ::bstring ::obj)
	    (bib-add! ::obj . entries)
	    (resolve-bib ::obj ::obj)
	    (resolve-the-bib ::obj ::obj ::procedure ::obj ::symbol ::pair-nil)
	    (bib-sort/authors::pair-nil ::pair-nil)
	    (bib-sort/idents::pair-nil ::pair-nil)
	    (bib-sort/dates::pair-nil ::pair-nil)))

;*---------------------------------------------------------------------*/
;*    bib-table? ...                                                   */
;*---------------------------------------------------------------------*/
(define (bib-table? obj)
   (hashtable? obj))

;*---------------------------------------------------------------------*/
;*    *bib-table* ...                                                  */
;*---------------------------------------------------------------------*/
(define *bib-table* #f)

;*---------------------------------------------------------------------*/
;*    make-bib-table ...                                               */
;*---------------------------------------------------------------------*/
(define (make-bib-table ident)
   (make-hashtable))

;*---------------------------------------------------------------------*/
;*    default-bib-table ...                                            */
;*---------------------------------------------------------------------*/
(define (default-bib-table)
   (if (not *bib-table*)
       (set! *bib-table* (make-bib-table "default-bib-table")))
   *bib-table*)

;*---------------------------------------------------------------------*/
;*    bib-parse-error ...                                              */
;*---------------------------------------------------------------------*/
(define (bib-parse-error entry)
   (if (epair? entry)
       (match-case (cer entry)
	  ((at ?fname ?pos ?-)
	   (error/location "parse-biblio"
			   "bibliography syntax error"
			   entry
			   fname
			   pos))
	  (else
	   (error 'bib-parse "bibliography syntax error" entry)))
       (error 'bib-parse "bibliography syntax error" entry)))

;*---------------------------------------------------------------------*/
;*    bib-duplicate ...                                                */
;*---------------------------------------------------------------------*/
(define (bib-duplicate ident from old)
   (let ((ofrom (markup-option old 'from)))
      (skribe-warning 2
		      'bib
		      (format "Duplicated bibliographic entry ~a'.\n" ident)
		      (if ofrom
			  (format " Using version of `~a'.\n" ofrom)
			  "")
		      (if from
			  (format " Ignoring version of `~a'." from)
			  " Ignoring redefinition."))))
   
;*---------------------------------------------------------------------*/
;*    parse-bib ...                                                    */
;*---------------------------------------------------------------------*/
(define (parse-bib table port)
   (if (not (bib-table? table))
       (skribe-error 'parse-bib "Illegal bibliography table" table)
       (let ((from (input-port-name port)))
	  (let loop ((entry (skribe-read port)))
	     (if (not (eof-object? entry))
		 (match-case entry
		    (((and (? symbol?) ?kind) (and (? symbol?) ?ident) . ?fds)
		     (let* ((ident (symbol->string ident))
			    (old (hashtable-get table ident)))
			(if old
			    (bib-duplicate ident from old)
			    (hashtable-put! table
					    ident
					    (make-bib-entry kind
							    ident
							    fds
							    from))))
		     (loop (skribe-read port)))
		    (((and (? symbol?) ?kind) (and (? string?) ?ident) . ?fds)
		     (let ((old (hashtable-get table ident)))
			(if old
			    (bib-duplicate ident from old)
			    (hashtable-put! table
					    ident
					    (make-bib-entry kind
							    ident
							    fds
							    from))))
		     (loop (skribe-read port)))
		    (else
		     (bib-parse-error entry))))))))

;*---------------------------------------------------------------------*/
;*    bib-add! ...                                                     */
;*---------------------------------------------------------------------*/
(define (bib-add! table . entries)
   (if (not (bib-table? table))
       (skribe-error 'bib-add! "Illegal bibliography table" table)
       (for-each (lambda (entry)
		    (match-case entry
		       (((and (? symbol?) ?kind) (and (? symbol?) ?ident) . ?fs)
			(let* ((ident (symbol->string ident))
			       (old (hashtable-get table ident)))
			   (if old
			       (bib-duplicate ident #f old)
			       (hashtable-put! table
					       ident
					       (make-bib-entry kind
							       ident fs #f)))))
		       (((and (? symbol?) ?kind) (and (? string?) ?ident) . ?fs)
			(let ((old (hashtable-get table ident)))
			   (if old
			       (bib-duplicate ident #f old)
			       (hashtable-put! table
					       ident
					       (make-bib-entry kind
							       ident fs #f)))))
		       (else
			(bib-parse-error entry))))
		 entries)))