[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

BibTex -> Ref

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
;;  This file adds a new menu-item to the Tools Menu.
;;  The menu-item translates a bibliography file from BibTeX to Refer
;; (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
      (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
;; first addition

(if (string= (menu-item-title (first (last (menu-items *tools-menu*))))
  (add-menu-items *tools-menu*
                  (make-instance 'menu-item :menu-item-title "-")))

(remove-menu-items *tools-menu* (find-menu-item *tools-menu* "BibTeX ->

(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
;; required by Scribe to a special version of Refer format useable by
;; for the Macintosh. EndNote imports standard refer format, but its
;; to decide what catagory (reference type, for example: in-book, article
;; a Refer entry belongs to is limited. Niles & Associates (the authors of
;; EndNote) have provided a mechanism for properly translating these
;; They have added the %0 (zero) field that names the appropriate field
;; "%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
;; 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
;; 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
;; 3. Added the option I found in Refer of defining @string abbreviations.
;; There is one caveat left in the translator.  Expressions of the form
;; that BibTeX allows inside strings are not parsed by this program.  I
;; 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
;; If any of the two arguments is missing the function prompts the user
;; 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
;;     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
;; is included and and the file is distributed in original form along with
;; 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
;; 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
;; bibtex export style so you can keep your stuff in EndNote and just
;; 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

(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

(defvar *open-delimiters* '(#\( #\[ #\< #\" #\' #\{))

(defvar *close-delimiters* '(#\) #\] #\> #\" #\' #\}))

(defvar *matching-delimiters*
  (mapcar #'(lambda (x y) (cons x y)) *open-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
    (: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*
  (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
                     ;; value that is enclosed within delimiters like
                     ;; marks or parens.
                     ;; -- Arie Covrigaru Thu Feb 27, 1992 at 2:14PM EDT
                     (if (char= (peek-char t stream) #\,) (read-char
                     (unless (member (peek-char t stream)
                                     :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))
                     (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*))) ;
                        (cond ((char= char open-delim)
                               (setq delimiter-count (1+ delimiter-count)))
                              ((char= char close-delim)
                               (setq delimiter-count (1-
                        (vector-push (subst-special-char char)
                     (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
                           (unless (eql char #\,) (unread-char char
                           (list keyword (copy-seq *storage-string*))) ;
                        (vector-push (subst-special-char char)
            (t (error "Syntax error in input file.  Character is: ~s~%"

(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)
                              (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
               (if (and (initials-p first) (initials-p middle)) "" " ")
               (or middle "")
               (if middle " " "")
               (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"
    (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
      ;; refer has letter codes for its fields, from A-Z.  Each rhs
      ;; to a letter of the alphabet and missing or undefined letters are
      ;; 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
      (: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
      ((: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
                    ((eq ref-type :techreport) (write-tag output-stream #\R
                    (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
                             (eq ref-type :phdthesis)) #\I)
                        ((not (member :address ref-fields :key #'car)) #\C)
                        (t #\W))
      (: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
	       ((eq field *btr-custom-3-field*) (write-tag output-stream #\3
	       ((eq field *btr-custom-4-field*) (write-tag output-stream #\4
		(format t
			"~%Don't know field: (~a = ~s) in ~s~%" field value ref-label))))

(defun get-bib-file ()
  (choose-file-dialog :mac-file-type :text)
  (let (bib-file)
    (format t "Enter name of BibTeX file: ")
    (if (probe-file (setq bib-file (read-line)))

(defun get-refer-file (bib-file &aux refer-file)
  (setq refer-file (concatenate
                    (directory-namestring bib-file)
                    (pathname-name bib-file)
   :directory  refer-file
   :prompt "Save Refer format file as...")
  (let (response)
    (format t "Enter name of BibTeX file~%(~a): " refer-file)
    (if (string/= (setq response (read-line)) "")
      (setq refer-file response)

(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
              ((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)))
                  (setq old-percent-completed percent-completed)
                  (if (zerop (mod percent-completed
                    (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