source: project/release/4/scbib/trunk/modules/bibtex.scm @ 15306

Last change on this file since 15306 was 15306, checked in by Ivan Raikov, 11 years ago

scbib documentation and bug fixes

File size: 3.2 KB
Line 
1;;
2;; scbib - a bibliography management system
3;;
4;; Copyright (C) 2004 Satoru Takabayashi <satoru@namazu.org>
5;;
6;; You can redistribute it and/or modify it under the terms of
7;; the Gauche's licence.
8;;
9;; Ported to Chicken Scheme and modified by Ivan Raikov.
10;;
11;;
12;;
13;; This program is free software: you can redistribute it and/or
14;; modify it under the terms of the GNU General Public License as
15;; published by the Free Software Foundation, either version 3 of the
16;; License, or (at your option) any later version.
17;;
18;; This program is distributed in the hope that it will be useful, but
19;; WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21;; General Public License for more details.
22;;
23;; A full copy of the GPL license can be found at
24;; <http://www.gnu.org/licenses/>.
25
26(module scbib-bibtex
27
28  (scbib-bibtex-print-item)
29
30  (import scheme chicken)
31
32  (require-extension regex extras srfi-1 srfi-13 scbib)
33
34
35(define (scbib-bibtex-print-item bibitem . rest)
36 (let-optionals rest ((key-style #f) (output-port #t))
37  (define (scbib-bibtex-print-sub bibitem)
38    (define (authors)
39      (let ((authors (scbib-get-authors bibitem)))
40        (cond ((eq? authors #f)
41               "")
42              ((= (length authors) 1)
43               (car authors))
44              (else
45               (string-join authors " and ")))))
46
47    (define (editors)
48      (let ((editors (scbib-values bibitem 'editor)))
49        (cond ((eq? editors #f)
50               #f)
51              ((= (length editors) 1)
52               (car editors))
53              (else
54               (string-join editors " and ")))))
55
56    (define r1 (regexp "#"))
57    (define r2 (regexp "~"))
58    (define r3 (regexp "\\/\\\\~\\{\\}"))
59    (define r4 (regexp "\\/"))
60    (define (escape string)
61      (set! string (string-substitute  r1  "\\#" string #t))
62      (set! string (string-substitute  r2  "\\~{}" string #t))
63      (set! string (string-substitute  r3  "\\slash\\~{}" string #t))
64      (set! string (string-substitute  r4  "{\\slash}" string #t))
65      string)
66
67    (define (get field)
68      (let ((item (scbib-value bibitem field)))
69        (if item
70            (escape item)
71            #f)))
72
73    (define (itemize field-name item)
74      (if item
75          (format #f "    ~a = {~a},\n" field-name item)
76          ""))
77
78    (define (note)
79      (let ((x (get 'note)))
80        (or x (if (equal? (get 'bibtype) "web")
81                  (get 'web)
82                  #f))))
83
84    (format output-port "@~a{~a,\n~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a}\n"
85            (let ((bibtype (get 'bibtype)))
86              (if (string=? bibtype "web")
87                  "misc"
88                  bibtype))
89            (scbib-get-abbrev bibitem key-style)
90            (itemize "author" (authors))
91            (itemize "editor" (editors))
92            (itemize "title" (get 'title))
93            (itemize "series" (get 'series))
94            (itemize "edition" (get 'edition))
95            (itemize "publisher" (get 'publisher))
96            (itemize "year" (get 'year))
97
98            (itemize "pages" (get 'pages))
99            (itemize "booktitle" (get 'booktitle))
100            (itemize "organization" (get 'organization))
101            (itemize "address" (get 'address))
102            (itemize "note" (note))
103;           (itemize "month" (get 'month))
104            (itemize "volume" (get 'volume))
105            (itemize "number" (get 'number))
106            (itemize "school" (get 'school))
107            (itemize "journal" (get 'journal)))
108    )
109
110  (scbib-bibtex-print-sub bibitem)))
111
112)
Note: See TracBrowser for help on using the repository browser.