[AUCTeX-devel] RefTeX: "Create BibTeX file" with cross references

[Wolfgang Mayer]

The attached patch makes reftex-create-bibtex-file include entries that are
cross-referenced from cited entries. Also, the required @String definitions are
now included in the resulting bib-file.

Custom variables reftex-create-bibtex-header and reftex-create-bibtex-footer 
allow to include custom material at the top/bottom of the generated file 
(useful to set file-local variables, etc.)


Regards,

- Wolfgang

diff -up reftex-4.33/lisp/reftex-cite.el.orig reftex-4.33/lisp/reftex-cite.el
--- reftex-4.33/lisp/reftex-cite.el.orig        2007-08-24 07:06:03.000000000 
+0930
+++ reftex-4.33/lisp/reftex-cite.el     2008-05-02 09:25:40.000000000 +0930
@@ -450,7 +450,8 @@
       (setq names (replace-match " " nil t names)))
     (split-string names "\n")))
 
-(defun reftex-parse-bibtex-entry (entry &optional from to)
+(defun reftex-parse-bibtex-entry (entry &optional from to raw)
+  ; if RAW is non-nil, keep double quotes/curly braces delimiting fields
   (let (alist key start field)
     (save-excursion
       (save-restriction
@@ -462,7 +463,7 @@
               (erase-buffer)
               (insert entry))
           (widen)
-          (narrow-to-region from to))
+          (if (and from to) (narrow-to-region from to)))
         (goto-char (point-min))
 
         (if (re-search-forward "@\\(\\(?:\\w\\|\\s_\\)+\\)[ \t\n\r]*\
@@ -476,28 +477,42 @@
           (setq key (downcase (reftex-match-string 1)))
           (cond
            ((= (following-char) ?{)
-            (forward-char 1)
-            (setq start (point))
-            (condition-case nil
-                (up-list 1)
-              (error nil)))
+            (cond 
+             (raw 
+              (setq start (point)) 
+              (forward-char 1))
+             (t 
+              (forward-char 1)
+              (setq start (point))
+              (condition-case nil
+                  (up-list 1)
+                (error nil)))))
            ((= (following-char) ?\")
-            (forward-char 1)
-            (setq start (point))
+            (cond
+             (raw
+              (setq start (point))
+              (forward-char 1))
+             (t
+              (forward-char 1)
+              (setq start (point))))
             (while (and (search-forward "\"" nil t)
                         (= ?\\ (char-after (- (point) 2))))))
            (t
             (setq start (point))
             (re-search-forward "[ \t]*[\n\r,}]" nil 1)))
-          (setq field (buffer-substring-no-properties start (1- (point))))
+          ;; extract field value, ignore trailing comma if in RAW mode
+          (let ((stop (if (and raw (not (= (char-after (1- (point))) ?,)))
+                        (point)
+                        (1- (point))) ))
+            (setq field (buffer-substring-no-properties start stop)))
           ;; remove extra whitespace
           (while (string-match "[\n\t\r]\\|[ \t][ \t]+" field)
             (setq field (replace-match " " nil t field)))
           ;; remove leading garbage
-          (if (string-match "^[ \t{]+" field)
+          (if (string-match (if raw "^[ \t]+" "^[ \t{]+") field)
               (setq field (replace-match "" nil t field)))
           ;; remove trailing garbage
-          (if (string-match "[ \t}]+$" field)
+          (if (string-match (if raw "[ \t]+$" "[ \t}]+$") field)
               (setq field (replace-match "" nil t field)))
           (push (cons key field) alist))))
     alist))
@@ -1135,18 +1150,36 @@ While entering the regexp, completion on
     (reftex-kill-temporary-buffers)
     keys))
 
+(defun reftex-stringrefp (string)
+  "Return non-nil if STRING is not enclosed in double quotes 
+   or curly braces and is not a number."
+  (not 
+   (or
+    (string-match "^[\"{]" string)
+    (string-match "^[0-9]+$" string))))
+
+(defun reftex-get-string-refs (alist) 
+  "Return a list of BibTeX @string references that appear as values in alist."
+  (remove-if-not 'reftex-stringrefp 
+                 ; get list of values, discard keys
+                 (mapcar 'cdr 
+                         ; remove &key and &type entries
+                         (remove-if (lambda (pair) (string-match "^&" (car 
pair)))
+                                    alist))))
+
 (defun reftex-create-bibtex-file (bibfile)
   "Create a new BibTeX database file with all entries referenced in document.
 The command prompts for a filename and writes the collected entries to
 that file.  Only entries referenced in the current document with
 any \\cite-like macros are used.
-The sequence in the new file is the same as it was in the old database."
+The sequence in the new file is the same as it was in the old database.
+Entries referenced from other entries must appear after all referencing 
entries."
   (interactive "FNew BibTeX file: ")
   (let ((keys (reftex-all-used-citation-keys))
         (files (reftex-get-bibfile-list))
-        file key entries beg end entry)
+        file key entries beg end entry string-keys string-entries)
     (save-excursion
-      (while (setq file (pop files))
+      (dolist (file files)
         (set-buffer (reftex-get-file-buffer-force file 'mark))
         (reftex-with-special-syntax-for-bib
          (save-excursion
@@ -1167,14 +1200,55 @@ The sequence in the new file is the same
                (when (member key keys)
                  (setq entry (buffer-substring beg end)
                        entries (cons entry entries)
-                       keys (delete key keys)))))))))
+                       keys (delete key keys))
+
+                 ;; check for crossref entries
+                 (let* ((attr-list (reftex-parse-bibtex-entry nil beg end))
+                        (xref-key (cdr (assoc "crossref" attr-list))))
+                   (if xref-key (pushnew xref-key keys)))
+                 ;; check for string references
+                 (let* ((raw-fields (reftex-parse-bibtex-entry nil beg end t))
+                        (string-fields (reftex-get-string-refs raw-fields)))
+                   (dolist (skey string-fields)
+                     (unless (member skey string-keys)
+                       (push skey string-keys))))
+                 )))))))
+    ;;; second pass: grab @string references
+    (if string-keys
+        (save-excursion
+          (dolist (file files)
+            (set-buffer (reftex-get-file-buffer-force file 'mark))
+            (reftex-with-special-syntax-for-bib
+             (save-excursion
+               (save-restriction
+                 (widen)
+                 (goto-char (point-min))
+                 (while (re-search-forward
+                         "^[ address@hidden \t]*{[ \t]*\\([^ \t\r\n]+\\)"
+                         nil t)
+                   (setq key (match-string 1)
+                         beg (match-beginning 0)
+                         end (progn
+                               (goto-char (match-beginning 1))
+                               (condition-case nil
+                                   (up-list 1)
+                                 (error (goto-char (match-end 0))))
+                               (point)))
+                   (when (member key string-keys)
+                     (setq entry (buffer-substring beg end)
+                           string-entries (cons entry string-entries)
+                           string-keys (delete key string-keys))))))))))
     (find-file-other-window bibfile)
     (if (> (buffer-size) 0)
         (unless (yes-or-no-p
                  (format "Overwrite non-empty file %s? " bibfile))
           (error "Abort")))
     (erase-buffer)
+    (if reftex-create-bibtex-header (insert reftex-create-bibtex-header 
"\n\n"))
+    (insert (mapconcat 'identity (reverse string-entries) "\n\n"))
+    (if string-entries (insert "\n\n\n"))
     (insert (mapconcat 'identity (reverse entries) "\n\n"))
+    (if reftex-create-bibtex-footer (insert "\n\n" 
reftex-create-bibtex-footer))
     (goto-char (point-min))
     (save-buffer)
     (message "%d entries extracted and copied to new database"
diff -up reftex-4.33/lisp/reftex-vars.el.orig reftex-4.33/lisp/reftex-vars.el
--- reftex-4.33/lisp/reftex-vars.el.orig        2007-08-24 07:06:02.000000000 
+0930
+++ reftex-4.33/lisp/reftex-vars.el     2008-05-02 09:19:45.000000000 +0930
@@ -1194,6 +1194,16 @@ should return the string to insert into 
   :group 'reftex-citation-support
   :type 'string)
 
+(defcustom reftex-create-bibtex-header nil
+  "Header to insert in BibTeX files generated by RefTeX."
+  :group 'reftex-citation-support
+  :type 'string)
+
+(defcustom reftex-create-bibtex-footer nil
+  "Footer to insert in BibTeX files generated by RefTeX."
+  :group 'reftex-citation-support
+  :type 'string)
+
 ;; Index Support Configuration
 
 (defgroup reftex-index-support nil