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

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