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, 0 insertions, 871 deletions
diff --git a/skribe/tools/skribebibtex/bigloo/Makefile b/skribe/tools/skribebibtex/bigloo/Makefile deleted file mode 100644 index c2a4cc1..0000000 --- a/skribe/tools/skribebibtex/bigloo/Makefile +++ /dev/null @@ -1,70 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index 3ff89de..0000000 --- a/skribe/tools/skribebibtex/bigloo/main.scm +++ /dev/null @@ -1,44 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index b581537..0000000 --- a/skribe/tools/skribebibtex/bigloo/skribebibtex.scm +++ /dev/null @@ -1,385 +0,0 @@ -;*=====================================================================*/ -;* .../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 deleted file mode 100644 index 3e31d88..0000000 --- a/skribe/tools/skribebibtex/stklos/Makefile +++ /dev/null @@ -1,62 +0,0 @@ -# -# 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 deleted file mode 100644 index 03b4871..0000000 --- a/skribe/tools/skribebibtex/stklos/bibtex-lex.l +++ /dev/null @@ -1,75 +0,0 @@ -;;;; -*- 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 deleted file mode 100644 index 50236a9..0000000 --- a/skribe/tools/skribebibtex/stklos/bibtex-parser.y +++ /dev/null @@ -1,117 +0,0 @@ -;;;; -*- 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 deleted file mode 100644 index 3225658..0000000 --- a/skribe/tools/skribebibtex/stklos/main.stk +++ /dev/null @@ -1,118 +0,0 @@ -;;;; -;;;; 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*)) |