aboutsummaryrefslogtreecommitdiff
path: root/legacy/bigloo/bib.bgl
diff options
context:
space:
mode:
authorLudovic Court`es2005-11-02 10:08:38 +0000
committerLudovic Court`es2005-11-02 10:08:38 +0000
commitb76d5e1b252967521f210eac10ddbf089dde8c6a (patch)
tree00fc81c51256991c04799d79a749bbdd5b9fad30 /legacy/bigloo/bib.bgl
parentba63b8d4780428d9f63f6ace7f49361b77401112 (diff)
parentf553cb65b157b6df9563cefa593902d59301461b (diff)
downloadskribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.gz
skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.lz
skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.zip
Cleaned up the source tree and the installation process.
Patches applied: * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-6 Cosmetic changes. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7 Removed useless files, integrated packages. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-8 Removed useless files, integrated packages. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9 Moved the STkLos and Bigloo code to `legacy'. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-10 Installed Autoconf/Automake machinery. Fixed a few things. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-11 Changes related to source-highlighting and to the manual. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-10
Diffstat (limited to 'legacy/bigloo/bib.bgl')
-rw-r--r--legacy/bigloo/bib.bgl161
1 files changed, 161 insertions, 0 deletions
diff --git a/legacy/bigloo/bib.bgl b/legacy/bigloo/bib.bgl
new file mode 100644
index 0000000..6b0f7dd
--- /dev/null
+++ b/legacy/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)))
+
+
+