blob: 3225658ba988cd8f5103334f05fe27309504bc17 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
;;;;
;;;; main.stk -- Skribebibtex Main
;;;;
;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 22-Oct-2004 10:29 (eg)
;;;; Last file update: 26-Oct-2004 21:52 (eg)
;;;;
(define *bibtex-strings* (make-hash-table string=?))
(define *debug* (getenv "DEBUG"))
(define *in* (current-input-port))
(define *out* (current-output-port))
(define (bibtex-string-def! str val)
(hash-table-put! *bibtex-strings* str val))
(define (bibtex-string-ref str)
(list (hash-table-get *bibtex-strings* str str)))
(define (lex-char accent letter)
(list 'CHAR
(case accent
((#\') (case letter
((#\a) "�") ((#\e) "�") ((#\i) "�") ((#\o) "�") ((#\u) "�")
((#\A) "�") ((#\E) "�") ((#\I) "�") ((#\O) "�") ((#\U) "�")
(else "?")))
((#\`) (case letter
((#\a) "�") ((#\e) "�") ((#\i) "�") ((#\o) "�") ((#\u) "�")
((#\A) "�") ((#\E) "�") ((#\I) "�") ((#\O) "�") ((#\U) "�")
(else "?")))
((#\^) (case letter
((#\a) "�") ((#\e) "�") ((#\i) "�") ((#\o) "�") ((#\u) "�")
((#\A) "�") ((#\E) "�") ((#\I) "�") ((#\O) "�") ((#\U) "�")
(else "?")))
((#\") (case letter
((#\a) "�") ((#\e) "�") ((#\i) "�") ((#\o) "�") ((#\u) "�")
((#\A) "�") ((#\E) "�") ((#\I) "�") ((#\O) "�") ((#\U) "�")
(else "?")))
(else "?"))))
(define (make-bibentry kind key infos)
(define (pretty-string s)
(if (and (string? s)
(>= (string-length s) 2)
(eq? #\" (string-ref s 0))
(eq? #\" (string-ref s (- (string-length s) 1))))
(substring s 1 (- (string-length s) 1))
s))
(format *out* ";;;;\n(~A ~S\n" (car kind) (car key))
(for-each (lambda (x) (format *out* " (~A ~S)\n"
(car x)
(pretty-string (cadr x))))
infos)
(format *out* ")\n\n"))
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
(include "bibtex-lex.stk")
(include "bibtex-parser.stk")
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
(define (bibtex2scheme in out)
(let* ((lex (bibtex-lex in))
(scan (lambda ()
(let ((tok (lexer-next-token lex)))
(when *debug*
(format (current-error-port) "token = ~S\n" tok))
tok)))
(error (lambda (a b) (error 'bibtex-parser "~A~A" a b))))
(parser scan error)))
(define (main args)
;; Parse the program arguments
(parse-arguments args
"Usage: skribebibtex [options] [input]"
(("help" :alternate "h" :help "provide help for the command")
(arg-usage (current-error-port))
(exit 0))
(("options" :help "display the options and exit")
(arg-usage (current-output-port) #t)
(exit 0))
(("output" :alternate "o" :arg file :help "set the output to <file>")
(let ((port (open-file file "w")))
(if port
(set! *out* port)
(die (format "~A: bad output file ~S" 'skribebibtex file) 1))))
(else
(cond
((= (length other-arguments) 1)
(let* ((file (car other-arguments))
(port (open-file file "r")))
(if port
(set! *in* file)
(die (format "~A: bad input file ~S" 'skribebibtex file) 1)))))))
(bibtex2scheme *in* *out*))
|
