Initial import of Skribe 1.2d.

Initial import of Skribe 1.2d.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0

1 files changed, 161 insertions, 0 deletions

diff --git a/src/bigloo/bib.bgl b/src/bigloo/bib.bgl
new file mode 100644
index 0000000..6b0f7dd
--- /dev/null
+++ b/src/bigloo/bib.bgl
@@ -0,0 +1,161 @@
+;*=====================================================================*/
+;*    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)))
+
+
+