From fc42fe56a57eace2dbdb31574c2e161f0eacf839 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 15 Jun 2005 13:00:39 +0000
Subject: 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
---
tools/skribebibtex/bigloo/Makefile | 70 ++++++
tools/skribebibtex/bigloo/main.scm | 44 ++++
tools/skribebibtex/bigloo/skribebibtex.scm | 385 +++++++++++++++++++++++++++++
tools/skribebibtex/stklos/Makefile | 62 +++++
tools/skribebibtex/stklos/bibtex-lex.l | 75 ++++++
tools/skribebibtex/stklos/bibtex-parser.y | 117 +++++++++
tools/skribebibtex/stklos/main.stk | 118 +++++++++
7 files changed, 871 insertions(+)
create mode 100644 tools/skribebibtex/bigloo/Makefile
create mode 100644 tools/skribebibtex/bigloo/main.scm
create mode 100644 tools/skribebibtex/bigloo/skribebibtex.scm
create mode 100644 tools/skribebibtex/stklos/Makefile
create mode 100644 tools/skribebibtex/stklos/bibtex-lex.l
create mode 100644 tools/skribebibtex/stklos/bibtex-parser.y
create mode 100644 tools/skribebibtex/stklos/main.stk
(limited to 'tools/skribebibtex')
diff --git a/tools/skribebibtex/bigloo/Makefile b/tools/skribebibtex/bigloo/Makefile
new file mode 100644
index 0000000..c2a4cc1
--- /dev/null
+++ b/tools/skribebibtex/bigloo/Makefile
@@ -0,0 +1,70 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/tools/skribebibtex/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Thu Dec 20 10:42:25 2001 */
+#* Last change : Tue Oct 26 19:34:00 2004 (eg) */
+#* Copyright : 2001-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Makefile to compile the bibtex->Skribe translator */
+#*=====================================================================*/
+
+#*---------------------------------------------------------------------*/
+#* Standard configuration */
+#*---------------------------------------------------------------------*/
+include ../../../etc/bigloo/Makefile.skb
+
+#*---------------------------------------------------------------------*/
+#* Binary */
+#*---------------------------------------------------------------------*/
+TARGETNAME = skribebibtex
+
+#*---------------------------------------------------------------------*/
+#* Objects */
+#*---------------------------------------------------------------------*/
+_BGL_OBJECTS = skribebibtex main
+_C_OBJECTS =
+_JAVA_OBJECTS =
+
+_OBJECTS = $(_BGL_OBJECTS) $(_C_OBJECTS)
+OBJECTS = $(_OBJECTS:%=o/%.o)
+
+_CLASSES = $(_BGL_OBJECTS) $(_JAVA_OBJECTS)
+CLASSES = $(_OBJECTS:%=o/class_s/bigloo/skribe/$(TARGETNAME)/%.class)
+
+_BGL_SOURCES = $(_BGL_OBJECTS:%=%.scm)
+_C_SOURCES = $(_C_OBJECTS:%=%.c)
+_JAVA_SOURCES = $(_JAVA_OBJECTS:%=%.java)
+
+SOURCES = $(_BGL_SOURCES) $(_C_SOURCES) $(_JAVA_SOURCES)
+INCLUDES =
+
+#*---------------------------------------------------------------------*/
+#* Sources */
+#*---------------------------------------------------------------------*/
+POPULATION = $(SOURCES) $(INCLUDES) Makefile
+
+#*---------------------------------------------------------------------*/
+#* all, c & jvm */
+#*---------------------------------------------------------------------*/
+all: bin-$(TARGET)
+c: bin-c
+jvm: bin-jvm
+
+#*---------------------------------------------------------------------*/
+#* Standard Skribe Makefile */
+#*---------------------------------------------------------------------*/
+include ../../../etc/bigloo/Makefile.tpl
+
+#*---------------------------------------------------------------------*/
+#* pop: */
+#*---------------------------------------------------------------------*/
+pop:
+ @ echo $(POPULATION:%=tools/$(TARGETNAME)/bigloo/%)
+
+#*---------------------------------------------------------------------*/
+#* clean */
+#*---------------------------------------------------------------------*/
+clean: stdclean
+
+
diff --git a/tools/skribebibtex/bigloo/main.scm b/tools/skribebibtex/bigloo/main.scm
new file mode 100644
index 0000000..3ff89de
--- /dev/null
+++ b/tools/skribebibtex/bigloo/main.scm
@@ -0,0 +1,44 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/tools/skribebibtex/main.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Oct 12 14:57:58 2001 */
+;* Last change : Fri Oct 24 12:00:23 2003 (serrano) */
+;* Copyright : 2001-03 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The entry point of the bibtex->skribe translator */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module main
+ (import skribebibtex)
+ (main main))
+
+;*---------------------------------------------------------------------*/
+;* main ... */
+;*---------------------------------------------------------------------*/
+(define (main argv)
+ (define (usage args-parse-usage)
+ (print "usage: skribebibtex [options] [input]")
+ (newline)
+ (args-parse-usage #f))
+ (let ((stage 'scr)
+ (dest #f)
+ (in #f))
+ (args-parse (cdr argv)
+ ((("-h" "--help") (help "This help message"))
+ (usage args-parse-usage)
+ (exit 0))
+ ((("--options") (help "Display the options and exit"))
+ (args-parse-usage #t)
+ (exit 0))
+ (("-o" ?out (help "Set the destination file"))
+ (set! dest out))
+ (else
+ (set! in else)))
+ (if (string? dest)
+ (with-output-to-file dest (lambda () (skribebibtex in)))
+ (skribebibtex in))))
+
diff --git a/tools/skribebibtex/bigloo/skribebibtex.scm b/tools/skribebibtex/bigloo/skribebibtex.scm
new file mode 100644
index 0000000..b581537
--- /dev/null
+++ b/tools/skribebibtex/bigloo/skribebibtex.scm
@@ -0,0 +1,385 @@
+;*=====================================================================*/
+;* .../skribe/tools/skribebibtex/bigloo/skribebibtex.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Oct 12 14:57:58 2001 */
+;* Last change : Sun Apr 10 09:10:02 2005 (serrano) */
+;* Copyright : 2001-05 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The bibtex->skribe translator */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribebibtex
+ (export (skribebibtex in)))
+
+;*---------------------------------------------------------------------*/
+;* skribebibtex ... */
+;*---------------------------------------------------------------------*/
+(define (skribebibtex in)
+ (let* ((port (if (string? in)
+ (let ((p (open-input-file in)))
+ (if (not (input-port? p))
+ (error "skribebibtext"
+ "Can't read input file"
+ in)
+ p))
+ (current-input-port)))
+ (sexp (parse-bibtex port)))
+ (for-each (lambda (e)
+ (match-case e
+ ((?kind ?ident . ?fields)
+ (display* "("
+ (string-downcase (symbol->string kind))
+ " \"" ident "\"")
+ (for-each (lambda (f)
+ (display* "\n (" (car f) " ")
+ (write (cdr f))
+ (display ")"))
+ fields)
+ (print ")\n"))))
+ sexp)))
+
+;*---------------------------------------------------------------------*/
+;* *bibtex-string-table* ... */
+;*---------------------------------------------------------------------*/
+(define *bibtex-string-table* #unspecified)
+
+;*---------------------------------------------------------------------*/
+;* make-bibtex-hashtable ... */
+;*---------------------------------------------------------------------*/
+(define (make-bibtex-hashtable)
+ (let ((table (make-hashtable)))
+ (for-each (lambda (k)
+ (let ((cp (string-capitalize k)))
+ (hashtable-put! table k cp)
+ (hashtable-put! table cp cp)))
+ '("jan" "feb" "mar" "apr" "may" "jun" "jul"
+ "aug" "sep" "oct" "nov" "dec"))
+ table))
+
+;*---------------------------------------------------------------------*/
+;* parse-bibtex ... */
+;*---------------------------------------------------------------------*/
+(define (parse-bibtex port::input-port)
+ (set! *bibtex-string-table* (make-bibtex-hashtable))
+ (cond-expand
+ (bigloo2.6
+ (try (read/lalrp bibtex-parser bibtex-lexer port)
+ (lambda (escape proc mes obj)
+ (match-case obj
+ ((?token (?fname . ?pos) . ?val)
+ (error/location proc "bibtex parse error" token fname pos))
+ (else
+ (notify-error proc mes obj)
+ (error proc mes obj))))))
+ (else
+ (with-exception-handler
+ (lambda (e)
+ (if (&io-parse-error? e)
+ (let ((o (&error-obj e)))
+ (match-case o
+ ((?token (?fname . ?pos) . ?val)
+ (error/location (&error-proc e)
+ "bibtex parse error"
+ token
+ fname
+ pos))
+ (else
+ (raise e))))
+ (raise e)))
+ (lambda ()
+ (read/lalrp bibtex-parser bibtex-lexer port))))))
+
+;*---------------------------------------------------------------------*/
+;* the-coord ... */
+;*---------------------------------------------------------------------*/
+(define (the-coord port)
+ (cons (input-port-name port) (input-port-position port)))
+
+;*---------------------------------------------------------------------*/
+;* bibtex-lexer ... */
+;*---------------------------------------------------------------------*/
+(define bibtex-lexer
+ (regular-grammar ((blank (in " \t\n")))
+ ;; separators
+ ((+ blank)
+ (list 'BLANK (the-coord (the-port))))
+ ;; comments
+ ((: "%" (* all))
+ (ignore))
+ ;; egal sign
+ (#\=
+ (list 'EGAL (the-coord (the-port))))
+ ;; sharp sign
+ ((: (* blank) #\# (* blank))
+ (list 'SHARP (the-coord (the-port))))
+ ;; open bracket
+ (#\{
+ (list 'BRA-OPEN (the-coord (the-port))))
+ ;; close bracket
+ (#\}
+ (list 'BRA-CLO (the-coord (the-port))))
+ ;; comma
+ (#\,
+ (list 'COMMA (the-coord (the-port))))
+ ;; double quote
+ ((: #\\ (in "\"\\_"))
+ (list 'CHAR (the-coord (the-port)) (the-character)))
+ ;; optional linebreak
+ ((: #\\ #\-)
+ (ignore))
+ ;; special latin characters
+ ((or "{\\'e}" "\\'e")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\o}" "\\o")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\~{n}}" "\\~{n}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\~{N}}" "\\~{N}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\^{o}}" "\\^{o}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\^{O}}" "\\^{O}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\\"{o}}" "\\\"{o}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\\"{O}}" "\\\"{O}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\`e}" "\\`e")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\`a}" "\\`a")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\\"i}" "{\\\"{i}}" "\\\"i" "\\\"{i}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\\"u}" "\\\"u")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\`u}" "\\`u")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ;; latex commands
+ ((: #\\ alpha (+ (or alpha digit)))
+ (let ((s (the-substring 1 (the-length))))
+ (cond
+ ((member s '("pi" "Pi" "lambda" "Lambda"))
+ (list 'IDENT (the-coord (the-port)) s))
+ (else
+ (ignore)))))
+ ;; strings
+ ((: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
+ (list 'STRING
+ (the-coord (the-port))
+ (the-substring 1 (-fx (the-length) 1))))
+ ;; commands
+ ((: "@" (+ alpha))
+ (let* ((str (string-upcase (the-substring 1 (the-length))))
+ (sym (string->symbol str)))
+ (case sym
+ ((STRING)
+ (list 'BIBSTRING (the-coord (the-port))))
+ (else
+ (list 'BIBITEM (the-coord (the-port)) sym)))))
+ ;; digit
+ ((+ digit)
+ (list 'NUMBER (the-coord (the-port)) (the-string)))
+ ;; ident
+ ((+ (or alpha digit (in ".:-&/?+*")))
+ (list 'IDENT (the-coord (the-port)) (the-string)))
+ ;; default
+ (else
+ (let ((c (the-failure)))
+ (if (eof-object? c)
+ c
+ (list 'CHAR (the-coord (the-port)) c))))))
+
+;*---------------------------------------------------------------------*/
+;* bibtex-parser ... */
+;*---------------------------------------------------------------------*/
+(define bibtex-parser
+ (lalr-grammar
+ ;; tokens
+ (CHAR IDENT STRING COMMA BRA-OPEN BRA-CLO SHARP BLANK NUMBER EGAL
+ BIBSTRING BIBITEM)
+
+ ;; bibtex
+ (bibtex
+ (()
+ '())
+ ((bibtex string-def)
+ bibtex)
+ ((bibtex bibtex-entry)
+ (cons bibtex-entry bibtex))
+ ((bibtex BLANK)
+ bibtex))
+
+ ;; blank*
+ (blank*
+ (() '())
+ ((blank* BLANK) '()))
+
+ ;; string-def
+ (string-def
+ ((BIBSTRING BRA-OPEN blank* IDENT blank* EGAL blank* bibtex-entry-value BRA-CLO)
+ (bibtex-string-def! (cadr IDENT) bibtex-entry-value)))
+
+ ;; bibtex-entry
+ (bibtex-entry
+ ((BIBITEM blank* BRA-OPEN blank* IDENT blank* COMMA
+ bibtex-entry-item* BRA-CLO)
+ (make-bibtex-entry (cadr BIBITEM)
+ (cadr IDENT)
+ bibtex-entry-item*)))
+
+ ;; bibtex-entry-item*
+ (bibtex-entry-item*
+ ((blank*)
+ '())
+ ((bibtex-entry-item)
+ (list bibtex-entry-item))
+ ((bibtex-entry-item COMMA bibtex-entry-item*)
+ (cons bibtex-entry-item bibtex-entry-item*)))
+
+ ;; bibtex-entry-item
+ (bibtex-entry-item
+ ((blank* IDENT blank* EGAL blank* bibtex-entry-value blank*)
+ (cons (cadr IDENT) bibtex-entry-value)))
+
+ ;; bibtex-entry-value
+ (bibtex-entry-value
+ ((NUMBER)
+ (list (cadr NUMBER)))
+ ((bibtex-entry-value-string)
+ bibtex-entry-value-string)
+ ((BRA-OPEN bibtex-entry-value-block* BRA-CLO)
+ bibtex-entry-value-block*))
+
+ ;; bibtex-entry-value-string
+ (bibtex-entry-value-string
+ ((bibtex-entry-value-string-simple)
+ (list bibtex-entry-value-string-simple))
+ ((bibtex-entry-value-string SHARP bibtex-entry-value-string-simple)
+ `(,@bibtex-entry-value-string ,bibtex-entry-value-string-simple)))
+
+ ;; bibtex-entry-value-string-simple
+ (bibtex-entry-value-string-simple
+ ((STRING)
+ (cadr STRING))
+ ((IDENT)
+ `(ref ,(cadr IDENT))))
+
+ ;; bibtex-entry-value-block*
+ (bibtex-entry-value-block*
+ (()
+ '())
+ ((bibtex-entry-value-block* bibtex-entry-value-block)
+ (append bibtex-entry-value-block* bibtex-entry-value-block)))
+
+ ;; bibtex-entry-value-block
+ (bibtex-entry-value-block
+ ((BRA-OPEN bibtex-entry-value-block* BRA-CLO)
+ bibtex-entry-value-block*)
+ ((COMMA)
+ (list ","))
+ ((IDENT)
+ (list (cadr IDENT)))
+ ((BLANK)
+ (list " "))
+ ((EGAL)
+ (list "="))
+ ((CHAR)
+ (list (cadr CHAR)))
+ ((NUMBER)
+ (list (cadr NUMBER)))
+ ((STRING)
+ (list (string-append "\"" (cadr STRING) "\""))))))
+
+;*---------------------------------------------------------------------*/
+;* bibtex-string-def! ... */
+;*---------------------------------------------------------------------*/
+(define (bibtex-string-def! ident value)
+ (define (->string value)
+ (if (string? value)
+ value
+ (match-case value
+ (((and ?s (? string?)))
+ s)
+ (((and ?n (? number?)))
+ (number->string n))
+ (else
+ (apply string-append (map ->string value))))))
+ (hashtable-put! *bibtex-string-table* ident (->string value)))
+
+;*---------------------------------------------------------------------*/
+;* make-bibtex-entry ... */
+;*---------------------------------------------------------------------*/
+(define (make-bibtex-entry kind ident value)
+ (define (parse-entry-value line)
+ (let ((name (car line))
+ (val (cdr line)))
+ (let loop ((val (reverse val))
+ (res ""))
+ (cond
+ ((null? val)
+ (cons name (untexify res)))
+ ((char? (car val))
+ (loop (cdr val) (string-append (string (car val)) res)))
+ ((string? (car val))
+ (loop (cdr val) (string-append (car val) res)))
+ (else
+ (match-case (car val)
+ ((ref ?ref)
+ (let ((h (hashtable-get *bibtex-string-table* ref)))
+ (loop (cdr val)
+ (if (string? h)
+ (string-append h res)
+ res))))
+ (else
+ (loop (cdr val) res))))))))
+ (let ((fields (map parse-entry-value value)))
+ `(,kind ,ident ,@fields)))
+
+;*---------------------------------------------------------------------*/
+;* untexify ... */
+;*---------------------------------------------------------------------*/
+(define (untexify val)
+ (define (untexify-math-string str)
+ (string-case str
+ ((+ (out #\_ #\^ #\space #\Newline #\tab))
+ (let ((s (the-string)))
+ (string-append s (ignore))))
+ ((+ (in "^_"))
+ (ignore))
+ ((+ (in " \n\t"))
+ (string-append " " (ignore)))
+ (else
+ "")))
+ (define (untexify-string str)
+ (let ((s (pregexp-replace* "C[$]\\^[$]_[+][+][$][$]" str "C++")))
+ (string-case (pregexp-replace* "[{}]" s "")
+ ((+ (out #\\ #\$ #\space #\Newline #\tab #\~))
+ (let ((s (the-string)))
+ (string-append s (ignore))))
+ ((: #\\ (+ (or (: "c" (out #\h))
+ (: "ch" (out #\a))
+ (: "cha" (out #\r))
+ (: "char" (out digit))
+ (out #\\ #\space #\c))))
+ (ignore))
+ ((: #\\ "char" (+ digit))
+ (string-append
+ (string
+ (integer->char
+ (string->integer
+ (the-substring 5 (the-length)))))
+ (ignore)))
+ ((: #\$ (* (out #\$)) #\$)
+ (let ((s (the-substring 1 (-fx (the-length) 1))))
+ (string-append (untexify-math-string s) (ignore))))
+ ((+ (in " \n\t~"))
+ (string-append " " (ignore)))
+ (else
+ ""))))
+ (if (string? val)
+ (untexify-string val)
+ (map untexify val)))
diff --git a/tools/skribebibtex/stklos/Makefile b/tools/skribebibtex/stklos/Makefile
new file mode 100644
index 0000000..3e31d88
--- /dev/null
+++ b/tools/skribebibtex/stklos/Makefile
@@ -0,0 +1,62 @@
+#
+# Makefile for STklos skribebibtex
+#
+# Author: Erick Gallesio [eg@essi.fr]
+# Creation date: 26-Oct-2004 18:40 (eg)
+# Last file update: 8-Nov-2004 15:25 (eg)
+
+include ../../../etc/stklos/Makefile.skb
+include ../../../etc/Makefile.config
+
+POPULATION = Makefile bibtex-lex.l bibtex-parser.y skribebibtex.stk main.stk
+BINDIR = ../../../bin
+TARGET = skribebibtex
+EXE = $(BINDIR)/$(TARGET).stklos
+
+all: $(EXE)
+
+$(EXE): main.stk bibtex-lex.stk bibtex-parser.stk
+ stklos-compile -l -o $(EXE) main.stk
+
+bibtex-lex.stk: bibtex-lex.l
+ stklos-genlex bibtex-lex.l bibtex-lex.stk bibtex-lex
+
+bibtex-parser.stk: bibtex-parser.y
+ stklos -f bibtex-parser.y
+
+bibtex: bibtex-lex.stk
+
+
+#======================================================================
+# install ...
+#======================================================================
+install: $(INSTALL_BINDIR)
+ cp $(EXE) $(INSTALL_BINDIR)/$(TARGET).stklos \
+ && chmod $(BMASK) $(INSTALL_BINDIR)/$(TARGET).stklos
+ rm -f $(INSTALL_BINDIR)/$(TARGET)
+ ln -s $(TARGET).stklos $(INSTALL_BINDIR)/$(TARGET)
+
+$(INSTALL_BINDIR):
+ mkdir -p $(INSTALL_BINDIR) && chmod a+rx $(INSTALL_BINDIR)
+
+
+#======================================================================
+# uninstall ...
+#======================================================================
+uninstall:
+ rm $(INSTALL_BINDIR)/$(TARGET)
+ rm $(INSTALL_BINDIR)/$(TARGET).stklos
+
+
+#======================================================================
+# pop ...
+#======================================================================
+pop:
+ @echo $(POPULATION:%=tools/skribebibtex/stklos/%)
+
+#======================================================================
+# clean ...
+#======================================================================
+
+clean:
+ rm -f $(EXE) bibtex-lex.stk bibtex-parser.stk *~
diff --git a/tools/skribebibtex/stklos/bibtex-lex.l b/tools/skribebibtex/stklos/bibtex-lex.l
new file mode 100644
index 0000000..03b4871
--- /dev/null
+++ b/tools/skribebibtex/stklos/bibtex-lex.l
@@ -0,0 +1,75 @@
+;;;; -*- Scheme -*-
+;;;; bibtex-lex.l -- SILex input for BibTeX
+;;;;
+;;;; 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: 21-Oct-2004 17:47 (eg)
+;;;; Last file update: 25-Oct-2004 20:16 (eg)
+;;;;
+
+
+space [ \n\9]
+alpha [-+a-zA-Z����������������������������./:()?!'&_~]
+
+%%
+
+;; Spaces
+{space}+ (list 'BLANK)
+;; Comment
+\%.*$ (yycontinue)
+;; equal sign
+= (list 'EQUAL)
+;; Open Bracket
+\{ (list 'LBRACKET)
+;; Close Bracket
+\} (list 'RBRACKET)
+;; Comma
+, (list 'COMMA)
+;; Strings
+\"[^\"]*\" (list 'STRING yytext)
+;; Commands
+@{alpha}+ (let* ((str (string-downcase
+ (substring yytext 1
+ (string-length yytext))))
+ (sym (string->symbol str)))
+ (case sym
+ ((string) (list 'BIBSTRING))
+ (else (list 'BIBITEM sym))))
+;; Ident
+{alpha}({alpha}|[0-9])* (list 'IDENT yytext)
+;; Number
+[0-9]+ (list 'NUMBER yytext)
+;; Diacritic
+\\['`^\"][aeiouAEIOU] (lex-char (string-ref yytext 1)
+ (string-ref yytext 2))
+\{\\['`^\"][aeiouAEIOU]\} (lex-char (string-ref yytext 2)
+ (string-ref yytext 3))
+
+;; Unrecognized character
+. (begin
+ (format (current-error-port)
+ "Skipping character ~S\n" yytext)
+ (yycontinue))
+
+;;;; ======================================================================
+<<EOF>> '*eoi*
+<<ERROR>> (error 'bibtex-lexer "Parse error" yytext)
+
+
diff --git a/tools/skribebibtex/stklos/bibtex-parser.y b/tools/skribebibtex/stklos/bibtex-parser.y
new file mode 100644
index 0000000..50236a9
--- /dev/null
+++ b/tools/skribebibtex/stklos/bibtex-parser.y
@@ -0,0 +1,117 @@
+;;;; -*- Scheme -*-
+;;;; bibtex-parser.y -- SILex input for BibTeX
+;;;;
+;;;; 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: 21-Oct-2004 17:47 (eg)
+;;;; Last file update: 22-Oct-2004 18:14 (eg)
+;;;;
+
+(load "lalr")
+
+(define (main args)
+ ;; Build the parser
+ (lalr-parser
+ ;; Options
+ (output: parser "bibtex-parser.stk")
+
+ ;; Terminal symbols
+ (CHAR BLANK IDENT STRING COMMA LBRACKET RBRACKET NUMBER EQUAL
+ BIBSTRING BIBITEM)
+
+ ;; Rules
+ (S
+ ()
+ (S string-def)
+ (S blank*)
+ (S bibtex-entry))
+
+
+ (blank*
+ ()
+ (blank* BLANK))
+
+
+ (string-def
+ (BIBSTRING LBRACKET blank* IDENT blank* EQUAL blank* entry-value
+ blank* RBRACKET)
+ : (bibtex-string-def! (car $4) (car $8)))
+
+
+ (bibtex-entry
+ (BIBITEM LBRACKET blank* IDENT blank* COMMA blank* entry-item* RBRACKET)
+ : (make-bibentry $1 $4 $8))
+
+
+ (entry-item*
+ (blank*)
+ : '()
+ (entry-item)
+ : (list $1)
+ (entry-item COMMA entry-item*)
+ : (cons $1 $3))
+
+
+ (entry-item
+ (blank* IDENT blank* EQUAL blank* entry-value blank*)
+ : (cons (car $2) $6))
+
+
+ (entry-value
+ (NUMBER)
+ : (list (car $1))
+ (STRING)
+ : $1
+ (IDENT)
+ : (bibtex-string-ref (car $1))
+ (LBRACKET entry-value-block* RBRACKET)
+ : (list (apply string-append $2)))
+
+
+ (entry-value-block*
+ ()
+ : '()
+ (entry-value-block* entry-value-block)
+ : (append $1 $2))
+
+
+ (entry-value-block
+ (LBRACKET entry-value-block* RBRACKET)
+ : $2
+ (COMMA)
+ : (list ",")
+ (IDENT)
+ : $1
+ (BLANK)
+ : (list " ")
+ (EQUAL)
+ : (list "=")
+ (CHAR)
+ : $1
+ (NUMBER)
+ : $1
+ (STRING)
+ : $1)
+ )
+ ;; Terminate
+ 0)
+
+
+
\ No newline at end of file
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*))
--
cgit v1.2.3