[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
BibTex -> Ref
- To: info-mcl@ministry.cambridge.apple.com
- Subject: BibTex -> Ref
- From: fuhrman@litsun.epfl.ch (Cris Fuhrman)
- Date: Sun, 05 Sep 1993 21:17:19 +0100
- Distribution: world
- Followup-to: comp.lang.lisp.mcl
- Newsgroups: comp.lang.lisp.mcl
- Organization: Ecole Polytechnique Federale de Lausanne
I spent some time searching for a utility that allows me to import BibTeX
references into EndNote Plus on the Mac, and finally I found it!
The problem is, it's LISP source, and I don't have MCL. :(
So, would someone have the kindness to make an application out of the
following source code and make it available via FTP? I promise to send you
a postcard from Switzerland.
There are two files that I found at
cambridge.apple.com:pub/MACL/CONTRIB/bibtex-refer.sea.hqx (sorry if the
longer lines have wrapped, I tried to turn that off in my NewsReader):
-------------------- Cut Here ---------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File : bibtex-refer-init.Lisp
;; Version : 1.0
;; Author : Arie Covrigaru
;; Organization : University of Michigan
;; Created On : Tue Feb 26, 1991 at 1:45AM EDT
;; Last Modified By: Arie Covrigaru
;; Last Modified On: Tue Mar 3, 1992 at 3:18PM EDT
;; Update Count : 15
;;
;; PURPOSE
;;
;; This file adds a new menu-item to the Tools Menu.
;; The menu-item translates a bibliography file from BibTeX to Refer
;;
;; TABLE OF CONTENTS
;;
;;
;;
;; (C) Copyright 1992, University of Michigan, all rights reserved.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require :bibtex-refer)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Make a new menu-item
(defvar *bibtex-refer-menu-item*
(make-instance 'menu-item
:menu-item-title "BibTeX -> Refer"
:menu-item-action #'(lambda ()
(eval-enqueue '(bib-to-ref)))
)
)
;; Squeeze it into the middle of the tools menu
#|
(let ((rest-tools-items (cdr (member "Listener Commands"
(menu-items *tools-menu*)
:test #'string-equal
:key #'(lambda (item)
(menu-item-title item))))))
(if rest-tools-items
(progn
(apply #'remove-menu-items *tools-menu* rest-tools-items)
(apply #'add-menu-items *tools-menu*
(cons *bibtex-refer-menu-item* rest-tools-items))
)
(warn "Couldn't find Fred Commands menu-item"))
)
|#
;; Add it into the end of the tools menu, and add a separator if this is
the
;; first addition
(if (string= (menu-item-title (first (last (menu-items *tools-menu*))))
"Environment
(add-menu-items *tools-menu*
(make-instance 'menu-item :menu-item-title "-")))
(remove-menu-items *tools-menu* (find-menu-item *tools-menu* "BibTeX ->
Refer"))
(add-menu-items *tools-menu* *bibtex-refer-menu-item*)
-------------------- Cut Here ---------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File : bibtex-refer.lisp
;; Version : 3.0
;; Author : Curt Stevens, University of Colorado at Boulder.
;; Created On : 1989
;; Last Modified By: Arie Covrigaru, University of Michigan at Ann Arbor.
;; Last Modified On: Sun Mar 8, 1992 at 10:19PM EDT
;;
;; The original version of this code was written to translate the BibTeX
format
;; required by Scribe to a special version of Refer format useable by
EndNote
;; for the Macintosh. EndNote imports standard refer format, but its
abilities
;; to decide what catagory (reference type, for example: in-book, article
etc.)
;; a Refer entry belongs to is limited. Niles & Associates (the authors of
;; EndNote) have provided a mechanism for properly translating these
entries.
;; They have added the %0 (zero) field that names the appropriate field
(ie.,
;; "%0 Book" tells EndNote to import this reference into the "Book"
reference type).
;; In order to obtain the original code (this is a "BibTeX -> Standard
Refer"
;; translator) contact Curt Stevens at stevens@cs.colorado.edu.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; History:
;; ========
;;
;; -- Arie Covrigaru Thu Feb 27, 1992 at 2:14PM EDT
;; Fixed the case of having a comma after the last field
;; value that is enclosed within delimiters like quotation
;; marks or parens which caused an end-of-file error.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Contents:
;; ========
;;
;; This program translates text files that contain references in the BibTeX
;; format into files in the Refer format. Those can be read by EndNote and
;; thus made into an EndNote bibliography. This is version 3.0 as I
perceive
;; it because the original author wrote the program to translate Scribe to
;; Refer and the person I received the program from made modifications for
;; translating BibTeX to Refer.
;;
;; I am the third person to modify this program in the following:
;;
;; 1. Cleaned the code, removing the last remains of references to scribe.
;; 2. Added the option of reading non quoted (as opposed to "quoted") field
values.
;; 3. Added the option I found in Refer of defining @string abbreviations.
;;
;; There is one caveat left in the translator. Expressions of the form
{$5^{th}$}
;; that BibTeX allows inside strings are not parsed by this program. I
didn't
;; think the effort worthwhile.
;;
;; The main function in this program is bib-to-ref. It takes two optional
;; arguments, the name of a source (BibTeX) file and the name of Refer
file.
;; If any of the two arguments is missing the function prompts the user
with
;; the standard Mac file-save dialogs for choosing/saving files.
;;
;; Notes:
;;
;; i. This program was written in Macintosh Common Lisp 2.0 but it is
;; fully compatible with MACL 1.3.2 and with no modifications it
;; can be used in any standard Common Lisp.
;;
;; ii. The translator's parsing scheme is based on the names of reference
;; types and fields that I found in EndNote. If you changed those
;; names, added fields or used another computer (the defintions of
references
;; are kept in the EndNote Prefs file) the translator might not work
;; as advertised.
;;
;; Arie Covrigaru, AI Lab, University of Michigan, Ann Arbor MI.
;; arie@eecs.umich.edu
;;
;; Modifications made by Wally Mann
;; ================================
;; Add the definition of (whitespacep)
;; Include :keywords for the #\K tag.
;; The Symbolics Genera 7.2 can't return file length for UNIX file system.
;; Thus ... modified to ignore percentage reporting if file length unknown.
;; Modified to put CROSSREF fields into the EndNote Custom 1.
;; Modified to put COMMENT fields into the EndNote Notes. And in general,
;; provided a custom-1 through custom-4 environment variables.
;;
;; This is the note from the original author:
;; =========================================
;;
;; Copyright 1989 Curt Stevens, University of Colorado at Boulder.
;; Permission to distribute this file is granted so long as this copyright
notice
;; is included and and the file is distributed in original form along with
any
;; modified versions.
;;
;; This is the note from the person I received the program from:
;; ============================================================
;;
;; Here you go. It is based on a scribe->refer conversion program so
that's
;; why there are all the scribe references in the code. I just did a quick
;; and dirty job of patching it up for bibtex. I've also got a
semi-finished
;; bibtex export style so you can keep your stuff in EndNote and just
generate
;; bibtex files when you need them. The code actually was written for
;; Mac Allegro CL so you should be able to run it without any mods.
;;
;; Seth Goldman
;; seth@aic.hrl.hac.com
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some user definable switches
(defvar *btr-print-warnings* t
"If t, warning messages are printed for each field that is not
understood.")
(defvar *btr-progress-frequency* 5
"a number between 0 and 100 that signals the printing of progress")
(defvar *btr-percent-progress-style* t
"If t, the progress is printed in percent completed, otherwise it
the number of references read is printed.")
(defvar *btr-special-characters* '(#\Return #\Linefeed #\Tab)
"A bag of characters that should not appear in field values")
(defconstant *btr-custom-1-field* :crossref)
(defconstant *btr-custom-2-field* nil)
(defconstant *btr-custom-3-field* nil)
(defconstant *btr-custom-4-field* nil)
;; Init *bib-readtable* -- Not user definable
(defvar *bib-readtable* (copy-readtable))
(defvar *cl-readtable* (copy-readtable))
(set-macro-character #\@ 'read-at-sign nil *bib-readtable*)
(set-macro-character #\% 'read-percent-sign nil *bib-readtable*)
(dolist (delim '(#\( #\) #\< #\> #\[ #\] #\' #\" #\, #\= #\{ #\}))
(set-syntax-from-char delim #\space *bib-readtable*))
(defvar *storage-string* (make-array 2048 :element-type 'character
:fill-pointer 0))
(defvar *abbreviations-alist* nil
"list of string abbreviations of the form @string{ key = \"string to
substitute\"}")
(defvar *open-delimiters* '(#\( #\[ #\< #\" #\' #\{))
(defvar *close-delimiters* '(#\) #\] #\> #\" #\' #\}))
(defvar *matching-delimiters*
(mapcar #'(lambda (x y) (cons x y)) *open-delimiters*
*close-delimiters*))
(defvar *bibtex-type-to-endnote-name-map*
'((:article . "Journal Article")
(:book . "Book") (:proceedings . "Book")
(:inbook . "Book Section") (:incollection . "Book Section")
(:inproceedings . "Conference Proceedings") (:conference . "Conference
Proceedings")
(:mastersthesis . "Thesis") (:phdthesis . "Thesis")
(:manual . "Report") (:techreport . "Report")
(:misc . "Generic") (:unpublished . "Generic")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Here start all the reading functions
#-:ccl ;; This function is defined in the CCL kernel
(defun whitespacep (char)
(case char
(#\space t)
(#\tab t)
(#\page t)
(#\return t)
(#\linefeed t)
(t nil)))
(defun gobble-whitespace (&optional (stream *standard-input*) &aux ch)
(declare (special *cl-readtable*))
(catch :done
(let ((*readtable* *cl-readtable*))
(loop (setq ch (peek-char nil stream))
(if (whitespacep ch)
(read-char stream)
(throw :done ch))))))
(defun subst-special-char (ch)
(declare (special *btr-special-characters*))
(if (member ch *btr-special-characters* :test #'char=)
(values #\Space)
(values ch))
)
(defun read-pair (ref-type stream &aux ch)
(declare (special *matching-delimiters* *close-delimiters*
*open-delimiters*
*storage-string*))
(let ((keyword (if (eql ref-type :string)
(write-to-string (read-preserving-whitespace stream))
(let ((*package* (find-package "KEYWORD"))
)
;; Fixed the case of having a comma after the last
field
;; value that is enclosed within delimiters like
quotation
;; marks or parens.
;; -- Arie Covrigaru Thu Feb 27, 1992 at 2:14PM EDT
(if (char= (peek-char t stream) #\,) (read-char
stream))
(unless (member (peek-char t stream)
*close-delimiters*
:test #'eql)
(read-preserving-whitespace stream)))))
)
(when keyword
(setq ch (gobble-whitespace stream)) ; consume the "=" sign
(cond ((char= ch #\=)
(read-char stream)
(gobble-whitespace stream)
(setf (fill-pointer *storage-string*) 0)
(let* ((open-delim (read-char stream))
(close-delim
(cdr (assoc open-delim *matching-delimiters*)))
(delimiter-count (if close-delim 1 0)))
(cond (close-delim ; field is enclosed within delimiters
(do ((char (read-char stream) (read-char stream)))
((and (= delimiter-count 1)
(eql char close-delim)) ; end test
(list keyword (copy-seq *storage-string*))) ;
returned
(cond ((char= char open-delim)
(setq delimiter-count (1+ delimiter-count)))
((char= char close-delim)
(setq delimiter-count (1-
delimiter-count))))
(vector-push (subst-special-char char)
*storage-string*)))
(t ; field has no delimiters
(unread-char open-delim stream)
(do ((char (read-char stream) (read-char stream)))
((or (eql char #\,)
(member char *close-delimiters* :test
#'eql))
(unless (eql char #\,) (unread-char char
stream))
(list keyword (copy-seq *storage-string*))) ;
returned
(vector-push (subst-special-char char)
*storage-string*))))
)
)
(t (error "Syntax error in input file. Character is: ~s~%"
ch)))
)
)
)
(defun read-label (stream)
(declare (special *storage-string*))
(setf (fill-pointer *storage-string*) 0)
(do ((char (read-char stream) (read-char stream)))
((eql char #\,) ; end test
(copy-seq *storage-string*)) ; returned
(vector-push (subst-special-char char) *storage-string*))
)
(defun read-percent-sign (stream char)
(declare (ignore char))
(read-line stream) ;ignore rest of line
(values :comment)
)
(defun read-at-sign (stream char &aux pair)
(declare (ignore char) (special *matching-delimiters*))
(let* ((ref-type (let ((*package* (find-package "KEYWORD")))
(read-preserving-whitespace stream)))
(open-delim (progn (gobble-whitespace stream) (read-char stream)))
(close-delim (cdr (assoc open-delim *matching-delimiters*)))
)
(cond ((eq ref-type :comment)
(do ((char (read-char stream) (read-char stream)))
((eql char close-delim) ; end test
(values ref-type)))) ; evaled at end
((eq ref-type :string)
(do ()
((eql (peek-char nil stream) close-delim) ; end test
(read-char stream)
(pushnew pair *abbreviations-alist* :test #'equalp) ;
evaled at end
(values ref-type)
)
(gobble-whitespace stream)
(if (setq pair (read-pair ref-type stream))
(gobble-whitespace stream))
)
)
(t (gobble-whitespace stream)
(do ((key (read-label stream)) (pairs nil))
((eql (peek-char nil stream) close-delim) ; end test
(read-char stream)
(list ref-type key (nreverse pairs))) ; evaled at end
(gobble-whitespace stream)
(when (setq pair (read-pair ref-type stream))
(push pair pairs)
(gobble-whitespace stream)))
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; ...and here start the writing functions
(defun write-tag (output-stream tag-char tag-value)
(let ((abbreviation-string
(cadr (assoc tag-value
*abbreviations-alist* :test #'string-equal))))
(format output-stream
"%~A ~A~%" tag-char (or abbreviation-string tag-value))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Possible input values for the author/s fields are:
;; first last
;; first last, extra
;; first middle last, extra
;; last, first i.
;; last, f.i.
;; last, extra., first i.
;; last, extra., f.i.
;;
;; Connectors are "and" or "&".
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun parse-authors (value &aux result pos)
(do ((pos1 (search " and " value) (search " and " value))
(pos2 (search " & " value) (search " & " value)))
((and (null pos1) (null pos2)) (push (parse-author value) result))
(setq pos (min (or pos1 (length value)) (or pos2 (length value))))
(push (parse-author (subseq value 0 pos)) result)
(setq value
(string-left-trim " " (subseq value
(+ pos (if (eq pos pos1) 5 3))))))
(nreverse result)
)
(defun parse-author (value &aux pos pos2 last extra first middle)
(if (setq pos (position #\, value))
(if (> (setq pos2 (or (position #\space value) 0)) pos)
(progn ; last name first
(setq last (subseq value 0 pos))
(setq value (string-left-trim " " (subseq value (1+ pos))))
(if (setq pos (position #\, value))
(progn ; last, extra, ...
(setq extra (subseq value 0 pos))
(setq value (string-left-trim " " (subseq value (1+ pos))))))
(multiple-value-bind (f m l)
(parse-author1
(concatenate 'string value " "))
(declare (ignore l))
(setq first f)
(setq middle m)))
(progn ; normal with extra
(multiple-value-bind (f m l)
(parse-author1 (subseq value 0 pos))
(setq first f) (setq middle m) (setq last l))
(setq extra (string-left-trim " " (subseq value (1+ pos))))))
(multiple-value-bind (f m l)
(parse-author1 value)
(setq first f) (setq middle m) (setq last l)))
(concatenate 'string
first
(if (and (initials-p first) (initials-p middle)) "" " ")
(or middle "")
(if middle " " "")
last
(if extra (format nil ", ~a" extra))))
(defun parse-author1 (value &aux first middle last)
; first middle* last
(do ((pos (position #\space value) (position #\space value)))
((null pos) (setq last value))
(if (null first)
(if (position #\. (subseq value 0 pos))
(if (= pos 4) ;"F.M."
(progn (setq first (subseq value 0 2))
(setq middle (subseq value 2 4)))
(setq first (subseq value 0 2)))
(setq first (subseq value 0 pos)))
(if (null middle)
(setq middle (subseq value 0 pos))
(setq middle (concatenate 'string middle " "
(subseq value 0 pos)))))
(setq value (string-left-trim " " (subseq value (1+ pos)))))
(values first middle last)
)
(defun initials-p (str)
(and (eq (length str) 2) (eq (elt str 1) #\.)))
(defun parse-ref-type (ref)
(case (car ref)
(:book (if (member :editor (third ref) :key #'car)
"Edited Book"
"Book"))
(otherwise (cdr (assoc (car ref) *bibtex-type-to-endnote-name-map*))))
)
(defun parse-tag (output-stream tag-pair this-ref)
(let ((field (car tag-pair))
(value (cadr tag-pair))
(ref-type (first this-ref))
(ref-label (second this-ref))
(ref-fields (third this-ref))
)
(case field
;; field items are bibtex document types, rhs's are modified refer
values
;; refer has letter codes for its fields, from A-Z. Each rhs
corresponds
;; to a letter of the alphabet and missing or undefined letters are
replaced
;; by a comment.
(:author (dolist (auth (parse-authors value))
(write-tag output-stream #\A auth)))
; #\B is included in the :title case
(:address (write-tag output-stream #\C value))
(:year (write-tag output-stream #\D value))
(:month (let ((list-tail (member :year ref-fields :key #'car)))
(write-tag output-stream #\8
(if list-tail (concatenate
'string value ", " (cadar
list-tail))
value))))
(:editor (if (member :author ref-fields :key #'car)
(dolist (editor (parse-authors value))
(write-tag output-stream #\E editor))
(dolist (auth (parse-authors value))
(write-tag output-stream #\A auth))))
; #\F is written explicitly, taken from the label
; #\G missing
; #\H missing
(:publisher (write-tag output-stream #\I value))
((:journal :booktitle) (write-tag output-stream #\J value))
((:key :howpublished :keywords) (write-tag output-stream #\K value))
; #\L Is not defined in Refer
; #\M Is not defined in Refer
;; The number might be defined in EndNote with the tag #\@
;; Check it out and modify here or in the Reference definition
;; in EndNote.
(:number (write-tag output-stream #\N value))
((:note :notes :comment :location) (write-tag output-stream #\O
value))
((:pages :page) (write-tag output-stream #\P value))
; #\Q is missing
; #\R is defined with N in the :number case
(:series (write-tag output-stream #\S value))
(:title (cond ((eq ref-type :inbook) (write-tag output-stream #\B
value))
((eq ref-type :techreport) (write-tag output-stream #\R
value))
(t (write-tag output-stream #\T value))))
(:volume (write-tag output-stream
(if (member :series ref-fields :key #'car)
#\U #\V) value))
((:organization :school :institution)
(write-tag output-stream
(cond ((or (eq ref-type :techreport) (eq ref-type
:masterthesis)
(eq ref-type :phdthesis)) #\I)
((not (member :address ref-fields :key #'car)) #\C)
(t #\W))
value))
(:abstract (write-tag output-stream #\X value))
;; misc field descriptors
(:edition (write-tag output-stream #\7 value))
(:type (write-tag output-stream #\9 value))
;; misc field descriptors in Refer that are ignored
((:chapter) nil)
(t (cond ((eq field *btr-custom-1-field*) (write-tag output-stream
#\1 value))
((eq field *btr-custom-2-field*) (write-tag output-stream #\2
value))
((eq field *btr-custom-3-field*) (write-tag output-stream #\3
value))
((eq field *btr-custom-4-field*) (write-tag output-stream #\4
value))
(*btr-print-warnings*
(format t
"~%Don't know field: (~a = ~s) in ~s~%" field value ref-label))))
)
)
)
(defun get-bib-file ()
#+:ccl
(choose-file-dialog :mac-file-type :text)
#-:ccl
(let (bib-file)
(format t "Enter name of BibTeX file: ")
(if (probe-file (setq bib-file (read-line)))
bib-file)
)
)
(defun get-refer-file (bib-file &aux refer-file)
(setq refer-file (concatenate
'string
(directory-namestring bib-file)
(pathname-name bib-file)
".refer"))
#+:ccl
(choose-new-file-dialog
:directory refer-file
:prompt "Save Refer format file as...")
#-:ccl
(let (response)
(format t "Enter name of BibTeX file~%(~a): " refer-file)
(if (string/= (setq response (read-line)) "")
(setq refer-file response)
refer-file)
)
)
(defun bib-to-ref (&optional (bib-file (get-bib-file))
(refer-file (get-refer-file bib-file)))
(declare (special *btr-percent-progress-style* *btr-progress-frequency*))
(when (and bib-file (probe-file bib-file))
(let ((*readtable* *bib-readtable*) (total-file-length 0))
(setf *abbreviations-alist* nil)
(format t "~%;Proccessing file ~s " (namestring bib-file))
(with-open-file (in-stream bib-file :direction :input)
(with-open-file (out-stream refer-file :direction :output
:if-exists :supersede
:if-does-not-exist :create)
(setq total-file-length (file-length in-stream))
(do ((ref (read in-stream nil) (read in-stream nil))
(ref-number 0) (percent-completed 0) (old-percent-completed
0))
((null ref) ; end test
(format t "~%Processed ~a references." ref-number) ; result
)
(unless (atom ref)
(setq ref-number (1+ ref-number))
(terpri out-stream)
(write-tag out-stream #\0 (parse-ref-type ref)) ; write
reference type
(write-tag out-stream #\F (second ref)) ; write
reference label
(dolist (this-pair (third ref))
(parse-tag out-stream this-pair ref))
(if *btr-percent-progress-style*
(when (and total-file-length
(/= (setq percent-completed
(round (* (/ (file-position in-stream)
total-file-length) 100)))
old-percent-completed))
(setq old-percent-completed percent-completed)
(if (zerop (mod percent-completed
*btr-progress-frequency*))
(format t "~a%" percent-completed))
)
(if (zerop (mod ref-number *btr-progress-frequency*))
(format t "~a" ref-number)
)
)
(format t ".")
)
)
)
)
)
)
)
-------------------- Cut Here ---------------------------
Cris FUHRMAN, fuhrman@litsun.epfl.ch
Laboratoire d'informatique technique
EPFL-LIT, IN Ecublens, CH-1015 Lausanne, Switzerland