[AUCTeX-diffs] Changes to reftex/lisp/reftex-cite.el,v

[Ralf Angeli]

CVSROOT:        /sources/auctex
Module name:    reftex
Changes by:     Ralf Angeli <angeli>    08/06/07 09:05:33

Index: reftex-cite.el
===================================================================
RCS file: /sources/auctex/reftex/lisp/reftex-cite.el,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -b -r1.48 -r1.49
--- reftex-cite.el      7 Mar 2008 20:29:08 -0000       1.48
+++ reftex-cite.el      7 Jun 2008 09:05:32 -0000       1.49
@@ -458,7 +458,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
@@ -470,7 +471,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]*\
@@ -484,28 +485,42 @@
           (setq key (downcase (reftex-match-string 1)))
           (cond
            ((= (following-char) ?{)
+            (cond 
+             (raw 
+              (setq start (point)) 
+              (forward-char 1))
+             (t 
             (forward-char 1)
             (setq start (point))
             (condition-case nil
                 (up-list 1)
-              (error nil)))
+                (error nil)))))
            ((= (following-char) ?\")
-            (forward-char 1)
+            (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))
@@ -1143,18 +1158,36 @@
     (reftex-kill-temporary-buffers)
     keys))
 
+(defun reftex-stringref-p (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-stringref-p
+                 ; 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
@@ -1175,14 +1208,55 @@
                (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"