aboutsummaryrefslogtreecommitdiff
path: root/skribe/tools/skribebibtex/stklos/main.stk
diff options
context:
space:
mode:
authorLudovic Court`es2005-06-15 13:00:39 +0000
committerLudovic Court`es2005-06-15 13:00:39 +0000
commitfc42fe56a57eace2dbdb31574c2e161f0eacf839 (patch)
tree18111570156cb0e3df0d81c8d104517a2263fd2c /skribe/tools/skribebibtex/stklos/main.stk
downloadskribilo-fc42fe56a57eace2dbdb31574c2e161f0eacf839.tar.gz
skribilo-fc42fe56a57eace2dbdb31574c2e161f0eacf839.tar.lz
skribilo-fc42fe56a57eace2dbdb31574c2e161f0eacf839.zip
Initial import of Skribe 1.2d.
Initial import of Skribe 1.2d. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0
Diffstat (limited to 'skribe/tools/skribebibtex/stklos/main.stk')
-rw-r--r--skribe/tools/skribebibtex/stklos/main.stk118
1 files changed, 118 insertions, 0 deletions
diff --git a/skribe/tools/skribebibtex/stklos/main.stk b/skribe/tools/skribebibtex/stklos/main.stk
new file mode 100644
index 0000000..3225658
--- /dev/null
+++ b/skribe/tools/skribebibtex/stklos/main.stk
@@ -0,0 +1,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*))