;;;;
;;;; 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*))