From c23335b3c7ee9f48a7f68fc8828e5b6546649a1a Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Fri, 24 Nov 2006 14:46:30 +0000 Subject: Cleaned up `(skribilo biblio)' a bit. * doc/user/bib.skb: Replaced `default-bib-table' with `*bib-table*'. * src/guile/skribilo/biblio.scm: Clean up. (skribe-open-bib-file): Renamed to `open-bib-file'. * src/guile/skribilo/package/base.scm: Use `*bib-table*' instead of `default-bib-table'. * src/guile/skribilo/utils/compat.scm: Autoload `biblio'. (default-bib-table): New. (skribe-open-bib-file): New. git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-79 --- src/guile/skribilo/biblio.scm | 103 +++++++++++++----------------------- src/guile/skribilo/package/base.scm | 8 +-- src/guile/skribilo/utils/compat.scm | 13 +++++ 3 files changed, 55 insertions(+), 69 deletions(-) (limited to 'src/guile') diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm index 1fb4b78..55f2ea9 100644 --- a/src/guile/skribilo/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -1,5 +1,6 @@ ;;; biblio.scm -- Bibliography functions. ;;; +;;; Copyright 2001, 2002, 2003, 2004 Manuel Serrano ;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI ;;; Copyright 2005, 2006 Ludovic Courtès ;;; @@ -24,9 +25,10 @@ :use-module (skribilo utils strings) :use-module (skribilo utils syntax) ;; `when', `unless' + :use-module (srfi srfi-1) :autoload (srfi srfi-34) (raise) :use-module (srfi srfi-35) - :use-module (srfi srfi-1) + :use-module (srfi srfi-39) :autoload (skribilo condition) (&file-search-error) :autoload (skribilo reader) (%default-reader) @@ -36,9 +38,9 @@ :use-module (ice-9 optargs) :use-module (oop goops) - :export (bib-table? make-bib-table default-bib-table + :export (bib-table? make-bib-table *bib-table* bib-add! bib-duplicate bib-for-each bib-map - skribe-open-bib-file parse-bib + open-bib-file parse-bib bib-load! resolve-bib resolve-the-bib make-bib-entry @@ -52,27 +54,15 @@ ;;; 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) - -;; FIXME: Should be a fluid? -(define *bib-table* #f) - -;; Forward declarations -(define skribe-open-bib-file #f) -(define parse-bib #f) - -;;; ====================================================================== ;;; -;;; Utilities +;;; Accessors. ;;; -;;; ====================================================================== (define (make-bib-table ident) (make-hash-table)) @@ -80,10 +70,9 @@ (define (bib-table? obj) (hash-table? obj)) -(define (default-bib-table) - (unless *bib-table* - (set! *bib-table* (make-bib-table "default-bib-table"))) - *bib-table*) +;; The current bib table. +(define *bib-table* + (make-parameter (make-bib-table "default-bib-table"))) (define (%bib-error who entry) (let ((msg "bibliography syntax error on entry")) @@ -91,22 +80,34 @@ (skribe-line-error (%epair-file entry) (%epair-line entry) who msg entry) (skribe-error who msg entry)))) -(define* (bib-for-each proc :optional (table (default-bib-table))) +(define (bib-add! table . entries) + (if (not (bib-table? table)) + (skribe-error 'bib-add! "Illegal bibliography table" table) + (for-each (lambda (entry) + (cond + ((and (list? entry) (> (length entry) 2)) + (let* ((kind (car entry)) + (key (format #f "~A" (cadr entry))) + (fields (cddr entry)) + (old (hash-ref table key))) + (if old + (bib-duplicate key #f old) + (hash-set! table key + (make-bib-entry kind key fields #f))))) + (else + (%bib-error 'bib-add! entry)))) + entries))) + +(define* (bib-for-each proc :optional (table (*bib-table*))) (hash-for-each (lambda (ident entry) (proc ident entry)) table)) -(define* (bib-map proc :optional (table (default-bib-table))) +(define* (bib-map proc :optional (table (*bib-table*))) (hash-map->list (lambda (ident entry) (proc ident entry)) table)) - -;;; ====================================================================== -;;; -;;; BIB-DUPLICATE -;;; -;;; ====================================================================== (define (bib-duplicate ident from old) (let ((ofrom (markup-option old 'from))) (skribe-warning 2 @@ -120,11 +121,11 @@ " ignoring redefinition.")))) -;;; ====================================================================== + ;;; -;;; PARSE-BIB +;;; Parsing. ;;; -;;; ====================================================================== + (define (parse-bib table port) (let ((read %default-reader)) ;; FIXME: We should use a fluid (if (not (bib-table? table)) @@ -146,43 +147,15 @@ (else (%bib-error 'bib-parse 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) - (cond - ((and (list? entry) (> (length entry) 2)) - (let* ((kind (car entry)) - (key (format #f "~A" (cadr entry))) - (fields (cddr entry)) - (old (hash-ref table key))) - (if old - (bib-duplicate key #f old) - (hash-set! table key - (make-bib-entry kind key fields #f))))) - (else - (%bib-error 'bib-add! entry)))) - entries))) - - -;;; ====================================================================== -;;; -;;; SKRIBE-OPEN-BIB-FILE -;;; -;;; ====================================================================== -;; FIXME: Factoriser -(define (skribe-open-bib-file file command) +(define* (open-bib-file file :optional (command #f)) (let ((path (search-path (*bib-path*) file))) (if (string? path) (begin (when (> (*verbose*) 0) - (format (current-error-port) " [loading bibliography: ~S]\n" path)) + (format (current-error-port) + " [loading bibliography: ~S]\n" path)) + ;; FIXME: The following `open-input-file' won't work with actual + ;; commands. We need to use `(ice-9 popen)'. (open-input-file (if (string? command) (string-append "| " (format #f command path)) @@ -209,7 +182,7 @@ (if (not (bib-table? table)) (skribe-error 'bib-load "Illegal bibliography table" table) ;; read the file - (let ((p (skribe-open-bib-file filename command))) + (let ((p (open-bib-file filename command))) (if (not (input-port? p)) (skribe-error 'bib-load "Can't open data base" filename) (unwind-protect diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm index 4c9e84c..01e8667 100644 --- a/src/guile/skribilo/package/base.scm +++ b/src/guile/skribilo/package/base.scm @@ -33,7 +33,7 @@ :autoload (skribilo engine) (engine?) ;; optional ``sub-packages'' - :autoload (skribilo biblio) (default-bib-table resolve-bib + :autoload (skribilo biblio) (*bib-table* resolve-bib bib-load! bib-add!) :autoload (skribilo color) (skribe-use-color!) :autoload (skribilo source) (language? source-read-lines source-fontify) @@ -1015,7 +1015,7 @@ (subsection #f) (subsubsection #f) (bib #f) - (bib-table (default-bib-table)) + (bib-table (*bib-table*)) (url #f) (figure #f) (mark #f) @@ -1245,7 +1245,7 @@ ;*---------------------------------------------------------------------*/ (define-markup (bibliography #!rest files #!key - (command #f) (bib-table (default-bib-table))) + (command #f) (bib-table (*bib-table*))) (for-each (lambda (f) (cond ((string? f) @@ -1267,7 +1267,7 @@ (define-markup (the-bibliography #!rest opts #!key pred - (bib-table (default-bib-table)) + (bib-table (*bib-table*)) (sort bib-sort/authors) (count 'partial)) (if (not (memq count '(partial full))) diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index 118f294..4905cef 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -35,6 +35,7 @@ :autoload (skribilo lib) (type-name) :autoload (skribilo resolve) (*document-being-resolved*) :autoload (skribilo output) (*document-being-output*) + :autoload (skribilo biblio) (*bib-table* open-bib-file) :use-module (skribilo debug) :re-export (file-size) ;; re-exported from `(skribilo utils files)' @@ -207,6 +208,18 @@ (or (find-markups ident) '())) + +;;; +;;; Bibliography. +;;; + +(define-public (default-bib-table) + (*bib-table*)) + +(define-public (skribe-open-bib-file file command) + (open-bib-file file command)) + + ;;; ;;; Debugging facilities. -- cgit v1.2.3