source: project/release/4/scbib/trunk/modules/style.scm @ 15281

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

Initial import of scbib, a library for managing bibliographic data.

File size: 1.7 KB
Line 
1;;;
2;;; scbib-style
3;;;
4;;; Copyright 2009 by Ivan Raikov.
5;;;
6
7(module scbib-style
8
9  (bibstyle?
10   BibNil BibLit BibField BibKey 
11   BibEmph BibHilite BibCons BibCond
12   scbib-style-print-item)
13
14  (import scheme chicken regex extras srfi-1 srfi-13)
15
16  (require-extension datatype scbib)
17
18 
19  (define-datatype bibstyle bibstyle?
20    (BibNil)
21    (BibLit     (text string?))
22    (BibField   (name symbol?))
23    (BibKey     (key-style procedure?))
24    (BibEmph    (contents bibstyle?))
25    (BibHilite  (contents bibstyle?))
26    (BibCons    (car bibstyle?) (cdr bibstyle?))
27    (BibCond    (test procedure?) (consequent bibstyle?) 
28                (alternate bibstyle?)))
29
30
31  (define (scbib-style-print-item style bibitem #!key (out #f) 
32                                  (escape identity) (emph identity) (hilite identity))
33
34    (define (get field . rest)
35      (let ((item (scbib-value bibitem field)))
36        (and item (escape item))))
37
38    (define (recur cont out)
39      (scbib-style-print-item style cont out: out
40                              escape: escape emph: emph 
41                              hilite: hilite))
42
43    (define (sub f x)
44      (let ((out1 (open-output-string)))
45        (recur x out1)
46        (let ((str (get-output-string out1)))
47          (close-output-port out1)
48          (fprintf out "~A" (f str)))))
49
50
51      (cases bibstyle style
52             (BibNil ()         (begin))
53             (BibLit (text)     (fprintf out "~A" (escape text)))
54             (BibField (name)   (fprintf out "~A" (get name)))
55             (BibKey (kstyle)   (fprintf out "~A" (scbib-get-abbrev bibitem kstyle)))
56             (BibEmph (cont)    (sub emph cont))
57             (BibHilite (cont)  (sub hilite cont))
58             (BibCons (kar kdr) (begin (recur kar out)
59                                       (recur kdr out)))
60
61             (BibCond (test consequent alternate)
62                      (if (test bibitem) (recur consequent out)
63                          (recur alternate out)))
64                                       
65             ))
66)
Note: See TracBrowser for help on using the repository browser.