diff options
Diffstat (limited to 'tools/skribebibtex/stklos/main.stk')
| -rw-r--r-- | tools/skribebibtex/stklos/main.stk | 118 |
1 files changed, 118 insertions, 0 deletions
diff --git a/tools/skribebibtex/stklos/main.stk b/tools/skribebibtex/stklos/main.stk new file mode 100644 index 0000000..3225658 --- /dev/null +++ b/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*)) |