diff options
Diffstat (limited to 'skribe/tools/skribebibtex')
| -rw-r--r-- | skribe/tools/skribebibtex/bigloo/Makefile | 70 | ||||
| -rw-r--r-- | skribe/tools/skribebibtex/bigloo/main.scm | 44 | ||||
| -rw-r--r-- | skribe/tools/skribebibtex/bigloo/skribebibtex.scm | 385 | ||||
| -rw-r--r-- | skribe/tools/skribebibtex/stklos/Makefile | 62 | ||||
| -rw-r--r-- | skribe/tools/skribebibtex/stklos/bibtex-lex.l | 75 | ||||
| -rw-r--r-- | skribe/tools/skribebibtex/stklos/bibtex-parser.y | 117 | ||||
| -rw-r--r-- | skribe/tools/skribebibtex/stklos/main.stk | 118 |
7 files changed, 871 insertions, 0 deletions
diff --git a/skribe/tools/skribebibtex/bigloo/Makefile b/skribe/tools/skribebibtex/bigloo/Makefile new file mode 100644 index 0000000..c2a4cc1 --- /dev/null +++ b/skribe/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/skribe/tools/skribebibtex/bigloo/main.scm b/skribe/tools/skribebibtex/bigloo/main.scm new file mode 100644 index 0000000..3ff89de --- /dev/null +++ b/skribe/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/skribe/tools/skribebibtex/bigloo/skribebibtex.scm b/skribe/tools/skribebibtex/bigloo/skribebibtex.scm new file mode 100644 index 0000000..b581537 --- /dev/null +++ b/skribe/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/skribe/tools/skribebibtex/stklos/Makefile b/skribe/tools/skribebibtex/stklos/Makefile new file mode 100644 index 0000000..3e31d88 --- /dev/null +++ b/skribe/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/skribe/tools/skribebibtex/stklos/bibtex-lex.l b/skribe/tools/skribebibtex/stklos/bibtex-lex.l new file mode 100644 index 0000000..03b4871 --- /dev/null +++ b/skribe/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/skribe/tools/skribebibtex/stklos/bibtex-parser.y b/skribe/tools/skribebibtex/stklos/bibtex-parser.y new file mode 100644 index 0000000..50236a9 --- /dev/null +++ b/skribe/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/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*)) |