source: project/release/4/scbib/trunk/modules/style.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: 2.3 KB
Line 
1;;
2;; scbib-style
3;;
4;; Copyright 2009 by Ivan Raikov.
5;;
6;;
7;; This program is free software: you can redistribute it and/or
8;; modify it under the terms of the GNU General Public License as
9;; published by the Free Software Foundation, either version 3 of the
10;; License, or (at your option) any later version.
11;;
12;; This program is distributed in the hope that it will be useful, but
13;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15;; General Public License for more details.
16;;
17;; A full copy of the GPL license can be found at
18;; <http://www.gnu.org/licenses/>.
19
20(module scbib-style
21
22  (bibstyle?
23   BibNil BibLit BibField BibKey 
24   BibEmph BibHilite BibCons BibCond
25   scbib-style-print-item)
26
27  (import scheme chicken)
28
29  (require-extension regex extras srfi-1 srfi-13 data-structures datatype scbib)
30
31 
32  (define-datatype bibstyle bibstyle?
33    (BibNil)
34    (BibLit     (text string?))
35    (BibField   (name symbol?))
36    (BibKey     (key-style procedure?))
37    (BibEmph    (contents bibstyle?))
38    (BibHilite  (contents bibstyle?))
39    (BibCons    (car bibstyle?) (cdr bibstyle?))
40    (BibCond    (test procedure?) (consequent bibstyle?) 
41                (alternate bibstyle?)))
42
43
44  (define (scbib-style-print-item style bibitem #!key (out #f) 
45                                  (escape identity) (emph identity) (hilite identity))
46
47    (define (get field . rest)
48      (let ((item (scbib-value bibitem field)))
49        (and item (escape item))))
50
51    (define (recur cont out)
52      (scbib-style-print-item style cont out: out
53                              escape: escape emph: emph 
54                              hilite: hilite))
55
56    (define (sub f x)
57      (let ((out1 (open-output-string)))
58        (recur x out1)
59        (let ((str (get-output-string out1)))
60          (close-output-port out1)
61          (fprintf out "~A" (f str)))))
62
63
64      (cases bibstyle style
65             (BibNil ()         (begin))
66             (BibLit (text)     (fprintf out "~A" (escape text)))
67             (BibField (name)   (fprintf out "~A" (get name)))
68             (BibKey (kstyle)   (fprintf out "~A" (scbib-get-abbrev bibitem kstyle)))
69             (BibEmph (cont)    (sub emph cont))
70             (BibHilite (cont)  (sub hilite cont))
71             (BibCons (kar kdr) (begin (recur kar out)
72                                       (recur kdr out)))
73
74             (BibCond (test consequent alternate)
75                      (if (test bibitem) (recur consequent out)
76                          (recur alternate out)))
77                                       
78             ))
79)
Note: See TracBrowser for help on using the repository browser.