diff options
Diffstat (limited to 'skribe/tools/skribebibtex/bigloo')
| -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 |
3 files changed, 499 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))) |