summaryrefslogtreecommitdiff
path: root/tools/skribebibtex/stklos/main.stk
blob: db1b031d0fb07a39b4db0e10adf8b4b35a6bf96b (about) (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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 
;;;; 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*))