code.delx.au - gnu-emacs/blob - lisp/textmodes/reftex-cite.el

   1 ;;; reftex-cite.el --- creating citations with RefTeX
   2
   3 ;; Copyright (C) 1997-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Carsten Dominik <dominik@science.uva.nl>
   6 ;; Maintainer: auctex-devel@gnu.org
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'cl))
  28
  29 (require 'reftex)
  30
  31 ;;; Variables and constants
  32 (defvar reftex-cite-regexp-hist nil
  33   "The history list of regular expressions used for citations")
  34
  35 (defconst reftex-citation-prompt
  36   "Select: [n]ext [p]revious [r]estrict [ ]full_entry [q]uit RET [?]Help+more"
  37   "Prompt and help string for citation selection")
  38
  39 (defconst reftex-citation-help
  40   " n / p      Go to next/previous entry (Cursor motion works as well).
  41  g / r      Start over with new regexp / Refine with additional regexp.
  42  SPC        Show full database entry in other window.
  43  f          Toggle follow mode: Other window will follow with full db entry.
  44  .          Show insertion point.
  45  q          Quit without inserting \\cite macro into buffer.
  46  TAB        Enter citation key with completion.
  47  RET        Accept current entry (also on mouse-2) and create \\cite macro.
  48  m / u      Mark/Unmark the entry.
  49  e / E      Create BibTeX file with all (marked/unmarked) entries
  50  a / A      Put all (marked) entries into one/many \\cite commands.")
  51
  52 ;;; Find bibtex files
  53 (defmacro reftex-with-special-syntax-for-bib (&rest body)
  54   `(let ((saved-syntax (syntax-table)))
  55      (unwind-protect
  56          (progn
  57            (set-syntax-table reftex-syntax-table-for-bib)
  58            ,@body)
  59        (set-syntax-table saved-syntax))))
  60
  61 ;;;###autoload
  62 (defun reftex-default-bibliography ()
  63   "Return the expanded value of variable `reftex-default-bibliography'.
  64 The expanded value is cached."
  65   (unless (eq (get 'reftex-default-bibliography :reftex-raw)
  66               reftex-default-bibliography)
  67     (put 'reftex-default-bibliography :reftex-expanded
  68          (reftex-locate-bibliography-files
  69           default-directory reftex-default-bibliography))
  70     (put 'reftex-default-bibliography :reftex-raw
  71          reftex-default-bibliography))
  72   (get 'reftex-default-bibliography :reftex-expanded))
  73
  74 ;;;###autoload
  75 (defun reftex-bib-or-thebib ()
  76   "Test if BibTeX or \begin{thebibliography} should be used for the citation.
  77 Find the bof of the current file"
  78   (let* ((docstruct (symbol-value reftex-docstruct-symbol))
  79          (rest (or (member (list 'bof (buffer-file-name)) docstruct)
  80                    docstruct))
  81          (bib (assq 'bib rest))
  82          (thebib (assq 'thebib rest))
  83          (bibmem (memq bib rest))
  84          (thebibmem (memq thebib rest)))
  85     (when (not (or thebib bib))
  86       (setq bib (assq 'bib docstruct)
  87             thebib (assq 'thebib docstruct)
  88             bibmem (memq bib docstruct)
  89             thebibmem (memq thebib docstruct)))
  90     (if (> (length bibmem) (length thebibmem))
  91         (if bib 'bib nil)
  92       (if thebib 'thebib nil))))
  93
  94 ;;;###autoload
  95 (defun reftex-get-bibfile-list ()
  96   "Return list of bibfiles for current document.
  97 When using the chapterbib or bibunits package you should either
  98 use the same database files everywhere, or separate parts using
  99 different databases into different files (included into the mater file).
 100 Then this function will return the applicable database files."
 101
 102   ;; Ensure access to scanning info
 103   (reftex-access-scan-info)
 104   (or
 105    ;; Try inside this file (and its includes)
 106    (cdr (reftex-last-assoc-before-elt
 107          'bib (list 'eof (buffer-file-name))
 108          (member (list 'bof (buffer-file-name))
 109                  (symbol-value reftex-docstruct-symbol))))
 110    ;; Try after the beginning of this file
 111    (cdr (assq 'bib (member (list 'bof (buffer-file-name))
 112                            (symbol-value reftex-docstruct-symbol))))
 113    ;; Anywhere in the entire document
 114    (cdr (assq 'bib (symbol-value reftex-docstruct-symbol)))
 115    (error "\\bibliography statement missing or .bib files not found")))
 116
 117 ;;; Find a certain reference in any of the BibTeX files.
 118 ;;;###autoload
 119 (defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill
 120                                        highlight item return)
 121   "Find BibTeX KEY in any file in FILE-LIST in another window.
 122 If MARK-TO-KILL is non-nil, mark new buffer to kill.
 123 If HIGHLIGHT is non-nil, highlight the match.
 124 If ITEM in non-nil, search for bibitem instead of database entry.
 125 If RETURN is non-nil, just return the entry and restore point."
 126   (let* ((re
 127           (if item
 128               (concat "\\\\bibitem[ \t]*\\(\\[[^]]*\\]\\)?[ \t]*{"
 129                       (regexp-quote key) "}")
 130             (concat "@\\(?:\\w\\|\\s_\\)+[ \t\n\r]*[{(][ \t\n\r]*"
 131                     (regexp-quote key) "[, \t\r\n}]")))
 132          (buffer-conf (current-buffer))
 133          file buf pos oldpos)
 134
 135     (catch 'exit
 136       (while file-list
 137         (setq file (car file-list)
 138               file-list (cdr file-list))
 139         (unless (setq buf (reftex-get-file-buffer-force file mark-to-kill))
 140           (error "No such file %s" file))
 141         (set-buffer buf)
 142         (setq oldpos (point))
 143         (widen)
 144         (goto-char (point-min))
 145         (if (not (re-search-forward re nil t))
 146             (goto-char oldpos) ;; restore previous position of point
 147           (goto-char (match-beginning 0))
 148           (setq pos (point))
 149           (when return
 150             ;; Just return the relevant entry
 151             (if item (goto-char (match-end 0)))
 152             (setq return (buffer-substring
 153                           (point) (reftex-end-of-bib-entry item)))
 154             (goto-char oldpos) ;; restore point.
 155             (set-buffer buffer-conf)
 156             (throw 'exit return))
 157           (switch-to-buffer-other-window buf)
 158           (goto-char pos)
 159           (recenter 0)
 160           (if highlight
 161               (reftex-highlight 0 (match-beginning 0) (match-end 0)))
 162           (throw 'exit (selected-window))))
 163       (set-buffer buffer-conf)
 164       (if item
 165           (error "No \\bibitem with citation key %s" key)
 166         (error "No BibTeX entry with citation key %s" key)))))
 167
 168 ;;;###autoload
 169 (defun reftex-end-of-bib-entry (item)
 170   (save-excursion
 171     (condition-case nil
 172         (if item
 173             (progn (end-of-line)
 174                    (re-search-forward
 175                     "\\\\bibitem\\|\\end{thebibliography}")
 176                    (1- (match-beginning 0)))
 177           (progn (forward-list 1) (point)))
 178       (error (min (point-max) (+ 300 (point)))))))
 179
 180 (defun reftex--query-search-regexps (default)
 181   "Query for regexps for searching entries using DEFAULT as default.
 182 Return a list of regular expressions."
 183   (split-string
 184    (completing-read
 185     (concat
 186      "Regex { && Regex...}: "
 187      "[" default "]: ")
 188     ;; Ensure default is always in the completion list.
 189     (let ((def (when default (list default)))
 190           (coll (if reftex-mode
 191                     (if (fboundp 'LaTeX-bibitem-list)
 192                         (LaTeX-bibitem-list)
 193                       (cdr (assoc 'bibview-cache
 194                                   (symbol-value reftex-docstruct-symbol))))
 195                   nil)))
 196       (if (and def (member def coll))
 197           coll
 198         (cons def coll)))
 199     nil nil nil 'reftex-cite-regexp-hist)
 200    "[ \t]*&&[ \t]*"))
 201
 202 ;;; Parse bibtex buffers
 203 (defun reftex-extract-bib-entries (buffers)
 204   "Extract bib entries which match regexps from BUFFERS.
 205 BUFFERS is a list of buffers or file names.
 206 Return list with entries."
 207   (let* (re-list first-re rest-re
 208                  (buffer-list (if (listp buffers) buffers (list buffers)))
 209                  found-list entry buffer1 buffer alist
 210                  key-point start-point end-point default)
 211
 212     ;; Read a regexp, completing on known citation keys.
 213     (setq default (regexp-quote (reftex-get-bibkey-default)))
 214     (setq re-list (reftex--query-search-regexps default))
 215
 216     (if (or (null re-list ) (equal re-list '("")))
 217         (setq re-list (list default)))
 218
 219     (setq first-re (car re-list)    ; We'll use the first re to find things,
 220           rest-re  (cdr re-list))   ; the others to narrow down.
 221     (if (string-match "\\`[ \t]*\\'" (or first-re ""))
 222         (user-error "Empty regular expression"))
 223     (if (string-match first-re "")
 224         (user-error "Regular expression matches the empty string."))
 225
 226     (save-excursion
 227       (save-window-excursion
 228
 229         ;; Walk through all bibtex files
 230         (while buffer-list
 231           (setq buffer (car buffer-list)
 232                 buffer-list (cdr buffer-list))
 233           (if (and (bufferp buffer)
 234                    (buffer-live-p buffer))
 235               (setq buffer1 buffer)
 236             (setq buffer1 (reftex-get-file-buffer-force
 237                            buffer (not reftex-keep-temporary-buffers))))
 238           (if (not buffer1)
 239               (message "No such BibTeX file %s (ignored)" buffer)
 240             (message "Scanning bibliography database %s" buffer1)
 241             (unless (verify-visited-file-modtime buffer1)
 242               (when (y-or-n-p
 243                      (format "File %s changed on disk.  Reread from disk? "
 244                              (file-name-nondirectory
 245                               (buffer-file-name buffer1))))
 246                 (with-current-buffer buffer1 (revert-buffer t t)))))
 247
 248           (set-buffer buffer1)
 249           (reftex-with-special-syntax-for-bib
 250            (save-excursion
 251              (goto-char (point-min))
 252              (while (re-search-forward first-re nil t)
 253                (catch 'search-again
 254                  (setq key-point (point))
 255                  (unless (re-search-backward "\\(\\`\\|[\n\r]\\)[ \t]*\
 256 @\\(\\(?:\\w\\|\\s_\\)+\\)[ \t\n\r]*[{(]" nil t)
 257                    (throw 'search-again nil))
 258                  (setq start-point (point))
 259                  (goto-char (match-end 0))
 260                  (condition-case nil
 261                      (up-list 1)
 262                    (error (goto-char key-point)
 263                           (throw 'search-again nil)))
 264                  (setq end-point (point))
 265
 266                  ;; Ignore @string, @comment and @c entries or things
 267                  ;; outside entries
 268                  (when (or (string= (downcase (match-string 2)) "string")
 269                            (string= (downcase (match-string 2)) "comment")
 270                            (string= (downcase (match-string 2)) "c")
 271                            (< (point) key-point)) ; this means match not in {}
 272                    (goto-char key-point)
 273                    (throw 'search-again nil))
 274
 275                  ;; Well, we have got a match
 276                  ;;(setq entry (concat
 277                  ;;             (buffer-substring start-point (point)) "\n"))
 278                  (setq entry (buffer-substring start-point (point)))
 279
 280                  ;; Check if other regexp match as well
 281                  (setq re-list rest-re)
 282                  (while re-list
 283                    (unless (string-match (car re-list) entry)
 284                      ;; nope - move on
 285                      (throw 'search-again nil))
 286                    (pop re-list))
 287
 288                  (setq alist (reftex-parse-bibtex-entry
 289                               nil start-point end-point))
 290                  (push (cons "&entry" entry) alist)
 291
 292                  ;; check for crossref entries
 293                  (if (assoc "crossref" alist)
 294                      (setq alist
 295                            (append
 296                             alist (reftex-get-crossref-alist alist))))
 297
 298                  ;; format the entry
 299                  (push (cons "&formatted" (reftex-format-bib-entry alist))
 300                        alist)
 301
 302                  ;; make key the first element
 303                  (push (reftex-get-bib-field "&key" alist) alist)
 304
 305                  ;; add it to the list
 306                  (push alist found-list)))))
 307           (reftex-kill-temporary-buffers))))
 308     (setq found-list (nreverse found-list))
 309
 310     ;; Sorting
 311     (cond
 312      ((eq 'author reftex-sort-bibtex-matches)
 313       (sort found-list 'reftex-bib-sort-author))
 314      ((eq 'year   reftex-sort-bibtex-matches)
 315       (sort found-list 'reftex-bib-sort-year))
 316      ((eq 'reverse-year reftex-sort-bibtex-matches)
 317       (sort found-list 'reftex-bib-sort-year-reverse))
 318      (t found-list))))
 319
 320 (defun reftex-bib-sort-author (e1 e2)
 321   "Compare bib entries E1 and E2 by author.
 322 The name of the first different author/editor is used."
 323   (let ((al1 (reftex-get-bib-names "author" e1))
 324         (al2 (reftex-get-bib-names "author" e2)))
 325     (while (and al1 al2 (string= (car al1) (car al2)))
 326       (pop al1)
 327       (pop al2))
 328     (if (and (stringp (car al1))
 329              (stringp (car al2)))
 330         (string< (car al1) (car al2))
 331       (not (stringp (car al1))))))
 332
 333 (defun reftex-bib-sort-year (e1 e2)
 334   "Compare bib entries E1 and E2 by year in ascending order."
 335   (< (string-to-number (or (cdr (assoc "year" e1)) "0"))
 336      (string-to-number (or (cdr (assoc "year" e2)) "0"))))
 337
 338 (defun reftex-bib-sort-year-reverse (e1 e2)
 339   "Compare bib entries E1 and E2 by year in descending order."
 340   (> (string-to-number (or (cdr (assoc "year" e1)) "0"))
 341      (string-to-number (or (cdr (assoc "year" e2)) "0"))))
 342
 343 (defun reftex-get-crossref-alist (entry)
 344   "Return the alist from a crossref ENTRY."
 345   (let ((crkey (cdr (assoc "crossref" entry)))
 346         start)
 347     (save-excursion
 348       (save-restriction
 349         (widen)
 350         (if (re-search-forward
 351              (concat "@\\w+[{(][ \t\n\r]*" (regexp-quote crkey)
 352                      "[ \t\n\r]*,") nil t)
 353             (progn
 354               (setq start (match-beginning 0))
 355               (condition-case nil
 356                   (up-list 1)
 357                 (error nil))
 358               (reftex-parse-bibtex-entry nil start (point)))
 359           nil)))))
 360
 361 ;; Parse the bibliography environment
 362 (defun reftex-extract-bib-entries-from-thebibliography (files)
 363   "Extract bib-entries from the \begin{thebibliography} environment.
 364 Parsing is not as good as for the BibTeX database stuff.
 365 The environment should be located in FILES."
 366   (let* (start end buf entries re re-list file default)
 367     (unless files
 368       (error "Need file name to find thebibliography environment"))
 369     (while (setq file (pop files))
 370       (setq buf (reftex-get-file-buffer-force
 371                  file (not reftex-keep-temporary-buffers)))
 372       (unless buf
 373         (error "No such file %s" file))
 374       (message "Scanning thebibliography environment in %s" file)
 375
 376       (with-current-buffer buf
 377         (save-excursion
 378           (save-restriction
 379             (widen)
 380             (goto-char (point-min))
 381             (while (re-search-forward
 382                     "\\(\\`\\|[\n\r]\\)[ \t]*\\\\begin{thebibliography}" nil t)
 383               (beginning-of-line 2)
 384               (setq start (point))
 385               (if (re-search-forward
 386                    "\\(\\`\\|[\n\r]\\)[ \t]*\\\\end{thebibliography}" nil t)
 387                   (progn
 388                     (beginning-of-line 1)
 389                     (setq end (point))))
 390               (when (and start end)
 391                 (setq entries
 392                       (append entries
 393                               (mapcar 'reftex-parse-bibitem
 394                                       (delete ""
 395                                               (split-string
 396                                                (buffer-substring-no-properties
 397                                                 start end)
 398                                                "[ \t\n\r]*\\\\bibitem[ \t]*\
 399 \\(\\[[^]]*]\\)*[ \t]*"))))))
 400               (goto-char end))))))
 401     (unless entries
 402       (error "No bibitems found"))
 403
 404     ;; Read a regexp, completing on known citation keys.
 405     (setq default (regexp-quote (reftex-get-bibkey-default)))
 406     (setq re-list (reftex--query-search-regexps default))
 407
 408     (if (or (null re-list ) (equal re-list '("")))
 409         (setq re-list (list default)))
 410
 411     (if (string-match "\\`[ \t]*\\'" (car re-list))
 412         (error "Empty regular expression"))
 413
 414     (while (and (setq re (pop re-list)) entries)
 415       (setq entries
 416             (delq nil (mapcar
 417                        (lambda (x)
 418                          (if (string-match re (cdr (assoc "&entry" x)))
 419                              x nil))
 420                        entries))))
 421     (setq entries
 422           (mapcar
 423             (lambda (x)
 424               (push (cons "&formatted" (reftex-format-bibitem x)) x)
 425               (push (reftex-get-bib-field "&key" x) x)
 426               x)
 427            entries))
 428
 429     entries))
 430
 431 (defun reftex-get-bibkey-default ()
 432   "Return the word before the cursor.
 433 If the cursor is in a citation macro, return the word before the macro."
 434   (let* ((macro (reftex-what-macro 1)))
 435     (save-excursion
 436       (if (and macro (string-match "cite" (car macro)))
 437           (goto-char (cdr macro)))
 438       (skip-chars-backward "^a-zA-Z0-9")
 439       (reftex-this-word))))
 440
 441 ;;; Parse and format individual entries
 442 (defun reftex-get-bib-names (field entry)
 443   "Return a list with the author or editor names in ENTRY.
 444 If FIELD is empty try \"editor\" field."
 445   (let ((names (reftex-get-bib-field field entry)))
 446     (if (equal "" names)
 447         (setq names (reftex-get-bib-field "editor" entry)))
 448     (while (string-match "\\band\\b[ \t]*" names)
 449       (setq names (replace-match "\n" nil t names)))
 450     (while (string-match "[\\.a-zA-Z\\-]+\\.[ \t]*\\|,.*\\|[{}]+" names)
 451       (setq names (replace-match "" nil t names)))
 452     (while (string-match "^[ \t]+\\|[ \t]+$" names)
 453       (setq names (replace-match "" nil t names)))
 454     (while (string-match "[ \t][ \t]+" names)
 455       (setq names (replace-match " " nil t names)))
 456     (split-string names "\n")))
 457
 458 ;;;###autoload
 459 (defun reftex-parse-bibtex-entry (entry &optional from to raw)
 460   "Parse BibTeX ENTRY.
 461 If ENTRY is nil then parse the entry in current buffer between FROM and TO.
 462 If RAW is non-nil, keep double quotes/curly braces delimiting fields."
 463   (let (alist key start field)
 464     (save-excursion
 465       (save-restriction
 466         (if entry
 467             (progn
 468               (set-buffer (get-buffer-create " *RefTeX-scratch*"))
 469               (fundamental-mode)
 470               (set-syntax-table reftex-syntax-table-for-bib)
 471               (erase-buffer)
 472               (insert entry))
 473           (widen)
 474           (if (and from to) (narrow-to-region from to)))
 475         (goto-char (point-min))
 476
 477         (if (re-search-forward "@\\(\\(?:\\w\\|\\s_\\)+\\)[ \t\n\r]*\
 478 [{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t)
 479             (setq alist
 480                   (list
 481                    (cons "&type" (downcase (reftex-match-string 1)))
 482                    (cons "&key"  (reftex-match-string 2)))))
 483         (while (re-search-forward "\\(\\(?:\\w\\|-\\)+\\)[ \t\n\r]*=[ \t\n\r]*"
 484                                   nil t)
 485           (setq key (downcase (reftex-match-string 1)))
 486           (cond
 487            ((= (following-char) ?{)
 488             (cond
 489              (raw
 490               (setq start (point))
 491               (forward-char 1))
 492              (t
 493               (forward-char 1)
 494               (setq start (point))
 495               (condition-case nil
 496                   (up-list 1)
 497                 (error nil)))))
 498            ((= (following-char) ?\")
 499             (cond
 500              (raw
 501               (setq start (point))
 502               (forward-char 1))
 503              (t
 504               (forward-char 1)
 505               (setq start (point))))
 506             (while (and (search-forward "\"" nil t)
 507                         (= ?\\ (char-after (- (point) 2))))))
 508            (t
 509             (setq start (point))
 510             (re-search-forward "[ \t]*[\n\r,}]" nil 1)))
 511           ;; extract field value, ignore trailing comma if in RAW mode
 512           (let ((stop (if (and raw (not (= (char-after (1- (point))) ?,)))
 513                         (point)
 514                         (1- (point))) ))
 515             (setq field (buffer-substring-no-properties start stop)))
 516           ;; remove extra whitespace
 517           (while (string-match "[\n\t\r]\\|[ \t][ \t]+" field)
 518             (setq field (replace-match " " nil t field)))
 519           (push (cons key field) alist))))
 520     alist))
 521
 522 (defun reftex-get-bib-field (fieldname entry &optional format)
 523   "Extract the field FIELDNAME from ENTRY.
 524 If FORMAT is non-nil `format' entry accordingly."
 525   (let ((cell (assoc fieldname entry)))
 526     (if cell
 527         (if format
 528             (format format (cdr cell))
 529           (cdr cell))
 530       "")))
 531
 532 (defun reftex-format-bib-entry (entry)
 533   "Format a BibTeX ENTRY so that it is nice to look at."
 534   (let*
 535       ((auth-list (reftex-get-bib-names "author" entry))
 536        (authors (mapconcat 'identity auth-list ", "))
 537        (year      (reftex-get-bib-field "year" entry))
 538        (title     (reftex-get-bib-field "title" entry))
 539        (type      (reftex-get-bib-field "&type" entry))
 540        (key       (reftex-get-bib-field "&key"  entry))
 541        (extra
 542         (cond
 543          ((equal type "article")
 544           (concat (let ((jt (reftex-get-bib-field "journal" entry)))
 545                     ;; biblatex prefers the alternative journaltitle
 546                     ;; field, so check if that exists in case journal
 547                     ;; is empty.
 548                     (if (zerop (length jt))
 549                         (reftex-get-bib-field "journaltitle" entry)
 550                       jt))
 551                   " "
 552                   (reftex-get-bib-field "volume" entry) ", "
 553                   (reftex-get-bib-field "pages" entry)))
 554          ((equal type "book")
 555           (concat "book (" (reftex-get-bib-field "publisher" entry) ")"))
 556          ((equal type "phdthesis")
 557           (concat "PhD: " (reftex-get-bib-field "school" entry)))
 558          ((equal type "mastersthesis")
 559           (concat "Master: " (reftex-get-bib-field "school" entry)))
 560          ((equal type "inbook")
 561           (concat "Chap: " (reftex-get-bib-field "chapter" entry)
 562                   ", pp. " (reftex-get-bib-field "pages"   entry)))
 563          ((or (equal type "conference")
 564               (equal type "incollection")
 565               (equal type "inproceedings"))
 566           (reftex-get-bib-field "booktitle" entry "in: %s"))
 567          (t ""))))
 568     (setq authors (reftex-truncate authors 30 t t))
 569     (when (reftex-use-fonts)
 570       (put-text-property 0 (length key)     'face reftex-label-face
 571                          key)
 572       (put-text-property 0 (length authors) 'face reftex-bib-author-face
 573                          authors)
 574       (put-text-property 0 (length year)    'face reftex-bib-year-face
 575                          year)
 576       (put-text-property 0 (length title)   'face reftex-bib-title-face
 577                          title)
 578       (put-text-property 0 (length extra)   'face reftex-bib-extra-face
 579                          extra))
 580     (concat key "\n     " authors " " year " " extra "\n     " title "\n\n")))
 581
 582 (defun reftex-parse-bibitem (item)
 583   "Parse a \bibitem entry in ITEM."
 584   (let ((key "") (text ""))
 585     (when (string-match "\\`{\\([^}]+\\)}\\([^\000]*\\)" item)
 586       (setq key (match-string 1 item)
 587             text (match-string 2 item)))
 588     ;; Clean up the text a little bit
 589     (while (string-match "[\n\r\t]\\|[ \t][ \t]+" text)
 590       (setq text (replace-match " " nil t text)))
 591     (if (string-match "\\`[ \t]+" text)
 592         (setq text (replace-match "" nil t text)))
 593     (list
 594      (cons "&key" key)
 595      (cons "&text" text)
 596      (cons "&entry" (concat key " " text)))))
 597
 598 (defun reftex-format-bibitem (item)
 599   "Format a \bibitem entry in ITEM so that it is (relatively) nice to look at."
 600   (let ((text (reftex-get-bib-field "&text" item))
 601         (key  (reftex-get-bib-field "&key" item))
 602         (lines nil))
 603
 604     ;; Wrap the text into several lines.
 605     (while (and (> (length text) 70)
 606                 (string-match " " (substring text 60)))
 607         (push (substring text 0 (+ 60 (match-beginning 0))) lines)
 608         (setq text (substring text (+ 61 (match-beginning 0)))))
 609     (push text lines)
 610     (setq text (mapconcat 'identity (nreverse lines) "\n     "))
 611
 612     (when (reftex-use-fonts)
 613       (put-text-property 0 (length text) 'face reftex-bib-author-face text))
 614     (concat key "\n     " text "\n\n")))
 615
 616 ;;; Make a citation
 617
 618 ;; NB this is a global autoload - see reftex.el.
 619 ;;;###autoload
 620 (defun reftex-citation (&optional no-insert format-key)
 621   "Make a citation using BibTeX database files.
 622 After prompting for a regular expression, scans the buffers with
 623 bibtex entries (taken from the \\bibliography command) and offers the
 624 matching entries for selection.  The selected entry is formatted according
 625 to `reftex-cite-format' and inserted into the buffer.
 626
 627 If NO-INSERT is non-nil, nothing is inserted, only the selected key returned.
 628
 629 FORMAT-KEY can be used to pre-select a citation format.
 630
 631 When called with a `C-u' prefix, prompt for optional arguments in
 632 cite macros.  When called with a numeric prefix, make that many
 633 citations.  When called with point inside the braces of a `\\cite'
 634 command, it will add another key, ignoring the value of
 635 `reftex-cite-format'.
 636
 637 The regular expression uses an expanded syntax: && is interpreted as `and'.
 638 Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'.
 639 While entering the regexp, completion on knows citation keys is possible.
 640 `=' is a good regular expression to match all entries in all files."
 641   (interactive)
 642
 643   ;; check for recursive edit
 644   (reftex-check-recursive-edit)
 645
 646   ;; This function may also be called outside reftex-mode.
 647   ;; Thus look for the scanning info only if in reftex-mode.
 648
 649   (when reftex-mode
 650     (reftex-access-scan-info nil))
 651
 652   ;; Call reftex-do-citation, but protected
 653   (unwind-protect
 654       (reftex-do-citation current-prefix-arg no-insert format-key)
 655     (reftex-kill-temporary-buffers)))
 656
 657 (defun reftex-do-citation (&optional arg no-insert format-key)
 658   "This really does the work of `reftex-citation'."
 659   (let* ((format (reftex-figure-out-cite-format arg no-insert format-key))
 660          (docstruct-symbol reftex-docstruct-symbol)
 661          (selected-entries (reftex-offer-bib-menu))
 662          (insert-entries selected-entries)
 663          entry string cite-view)
 664
 665     (unless selected-entries (error "Quit"))
 666
 667     (if (stringp selected-entries)
 668         ;; Nonexistent entry
 669         (setq insert-entries (list (list selected-entries
 670                                          (cons "&key" selected-entries)))
 671               selected-entries nil)
 672       ;; It makes sense to compute the cite-view strings.
 673       (setq cite-view t))
 674
 675     (when (eq (car selected-entries) 'concat)
 676       ;; All keys go into a single command - we need to trick a little
 677       ;; FIXME: Unfortunately, this means that commenting does not work right.
 678       (pop selected-entries)
 679       (let ((concat-keys (mapconcat 'car selected-entries
 680                                     reftex-cite-key-separator)))
 681         (setq insert-entries
 682               (list (list concat-keys (cons "&key" concat-keys))))))
 683
 684     (unless no-insert
 685
 686       ;; We shall insert this into the buffer...
 687       (message "Formatting...")
 688
 689       (while (setq entry (pop insert-entries))
 690         ;; Format the citation and insert it
 691         (setq string (if reftex-format-cite-function
 692                          (funcall reftex-format-cite-function
 693                                   (reftex-get-bib-field "&key" entry)
 694                                   format)
 695                        (reftex-format-citation entry format)))
 696         (when (or (eq reftex-cite-prompt-optional-args t)
 697                   (and reftex-cite-prompt-optional-args
 698                        (equal arg '(4))))
 699           (let ((start 0) (nth 0) value)
 700             (while (setq start (string-match "\\[\\]" string start))
 701               (setq value (save-match-data
 702                             (read-string (format "Optional argument %d: "
 703                                                  (setq nth (1+ nth))))))
 704               (setq string (replace-match (concat "[" value "]") t t string))
 705               (setq start (1+ start)))))
 706         ;; Should we cleanup empty optional arguments?
 707         ;; if the first is empty, it can be removed.  If the second is empty,
 708         ;; it has to go.  If there is only a single arg and empty, it can go
 709         ;; as well.
 710         (when reftex-cite-cleanup-optional-args
 711           (cond
 712            ((string-match "\\([a-zA-Z0-9]\\)\\[\\]{" string)
 713             (setq string (replace-match "\\1{" nil nil string)))
 714            ((string-match "\\[\\]\\(\\[[a-zA-Z0-9., ]+\\]\\)" string)
 715             (setq string (replace-match "\\1" nil nil string)))
 716            ((string-match "\\[\\]\\[\\]" string)
 717             (setq string (replace-match "" t t string)))))
 718         (insert string))
 719
 720       ;; Reposition cursor?
 721       (when (string-match "\\?" string)
 722         (search-backward "?")
 723         (delete-char 1))
 724
 725       ;; Tell AUCTeX
 726       (when (and reftex-mode
 727                  (fboundp 'LaTeX-add-bibitems)
 728                  reftex-plug-into-AUCTeX)
 729         (apply 'LaTeX-add-bibitems (mapcar 'car selected-entries)))
 730
 731       ;; Produce the cite-view strings
 732       (when (and reftex-mode reftex-cache-cite-echo cite-view)
 733         (mapc (lambda (entry)
 734                 (reftex-make-cite-echo-string entry docstruct-symbol))
 735               selected-entries))
 736
 737       (message ""))
 738
 739     (set-marker reftex-select-return-marker nil)
 740     (reftex-kill-buffer "*RefTeX Select*")
 741
 742     ;; Check if the prefix arg was numeric, and call recursively
 743     (when (integerp arg)
 744       (if (> arg 1)
 745           (progn
 746             (skip-chars-backward "}")
 747             (decf arg)
 748             (reftex-do-citation arg))
 749         (forward-char 1)))
 750
 751     ;; Return the citation key
 752     (mapcar 'car selected-entries)))
 753
 754 (defun reftex-figure-out-cite-format (arg &optional no-insert format-key)
 755   "Check if there is already a cite command at point and change cite format
 756 in order to only add another reference in the same cite command."
 757   (let ((macro (car (reftex-what-macro 1)))
 758         (cite-format-value (reftex-get-cite-format))
 759         key format)
 760     (cond
 761      (no-insert
 762       ;; Format does not really matter because nothing will be inserted.
 763       (setq format "%l"))
 764
 765      ((and (stringp macro)
 766            (string-match "\\`\\\\cite\\|cite\\'" macro))
 767       ;; We are already inside a cite macro
 768       (if (or (not arg) (not (listp arg)))
 769           (setq format
 770                 (concat
 771                  (if (member (preceding-char) '(?\{ ?,))
 772                      ""
 773                    reftex-cite-key-separator)
 774                  "%l"
 775                  (if (member (following-char) '(?\} ?,))
 776                      ""
 777                    reftex-cite-key-separator)))
 778         (setq format "%l")))
 779      (t
 780       ;; Figure out the correct format
 781       (setq format
 782             (if (and (symbolp cite-format-value)
 783                      (assq cite-format-value reftex-cite-format-builtin))
 784                 (nth 2 (assq cite-format-value reftex-cite-format-builtin))
 785               cite-format-value))
 786       (when (listp format)
 787         (setq key
 788               (or format-key
 789                   (reftex-select-with-char
 790                    "" (concat "SELECT A CITATION FORMAT\n\n"
 791                               (mapconcat
 792                                (lambda (x)
 793                                  (format "[%c] %s  %s" (car x)
 794                                          (if (> (car x) 31) " " "")
 795                                          (cdr x)))
 796                                format "\n")))))
 797         (if (assq key format)
 798             (setq format (cdr (assq key format)))
 799           (error "No citation format associated with key `%c'" key)))))
 800     format))
 801
 802 ;;;###autoload
 803 (defun reftex-citep ()
 804   "Call `reftex-citation' with a format selector `?p'."
 805   (interactive)
 806   (reftex-citation nil ?p))
 807
 808 ;;;###autoload
 809 (defun reftex-citet ()
 810   "Call `reftex-citation' with a format selector `?t'."
 811   (interactive)
 812   (reftex-citation nil ?t))
 813
 814 (defvar reftex-select-bib-map)
 815 (defun reftex-offer-bib-menu ()
 816   "Offer bib menu and return list of selected items."
 817   (let ((bibtype (reftex-bib-or-thebib))
 818         found-list rtn key data selected-entries)
 819     (while
 820         (not
 821          (catch 'done
 822            ;; Scan bibtex files
 823            (setq found-list
 824               (cond
 825                ((eq bibtype 'bib)
 826 ;              ((assq 'bib (symbol-value reftex-docstruct-symbol))
 827                 ;; using BibTeX database files.
 828                 (reftex-extract-bib-entries (reftex-get-bibfile-list)))
 829                ((eq bibtype 'thebib)
 830 ;              ((assq 'thebib (symbol-value reftex-docstruct-symbol))
 831                 ;; using thebibliography environment.
 832                 (reftex-extract-bib-entries-from-thebibliography
 833                  (reftex-uniquify
 834                   (mapcar 'cdr
 835                           (reftex-all-assq
 836                            'thebib (symbol-value reftex-docstruct-symbol))))))
 837                (reftex-default-bibliography
 838                 (message "Using default bibliography")
 839                 (reftex-extract-bib-entries (reftex-default-bibliography)))
 840                (t (error "No valid bibliography in this document, and no default available"))))
 841
 842            (unless found-list
 843              (error "Sorry, no matches found"))
 844
 845           ;; Remember where we came from
 846           (setq reftex-call-back-to-this-buffer (current-buffer))
 847           (set-marker reftex-select-return-marker (point))
 848
 849           ;; Offer selection
 850           (save-window-excursion
 851             (delete-other-windows)
 852             (reftex-kill-buffer "*RefTeX Select*")
 853             (switch-to-buffer-other-window "*RefTeX Select*")
 854             (unless (eq major-mode 'reftex-select-bib-mode)
 855               (reftex-select-bib-mode))
 856             (let ((buffer-read-only nil))
 857               (erase-buffer)
 858               (reftex-insert-bib-matches found-list))
 859             (setq buffer-read-only t)
 860             (if (= 0 (buffer-size))
 861                 (error "No matches found"))
 862             (setq truncate-lines t)
 863             (goto-char 1)
 864             (while t
 865               (setq rtn
 866                     (reftex-select-item
 867                      reftex-citation-prompt
 868                      reftex-citation-help
 869                      reftex-select-bib-map
 870                      nil
 871                      'reftex-bibtex-selection-callback nil))
 872               (setq key (car rtn)
 873                     data (nth 1 rtn))
 874               (unless key (throw 'done t))
 875               (cond
 876                ((eq key ?g)
 877                 ;; Start over
 878                 (throw 'done nil))
 879                ((eq key ?r)
 880                 ;; Restrict with new regular expression
 881                 (setq found-list (reftex-restrict-bib-matches found-list))
 882                 (let ((buffer-read-only nil))
 883                   (erase-buffer)
 884                   (reftex-insert-bib-matches found-list))
 885                 (goto-char 1))
 886                ((eq key ?A)
 887                 ;; Take all (marked)
 888                 (setq selected-entries
 889                       (if reftex-select-marked
 890                           (mapcar 'car (nreverse reftex-select-marked))
 891                         found-list))
 892                 (throw 'done t))
 893                ((eq key ?a)
 894                 ;; Take all (marked), and push the symbol 'concat
 895                 (setq selected-entries
 896                       (cons 'concat
 897                             (if reftex-select-marked
 898                                 (mapcar 'car (nreverse reftex-select-marked))
 899                               found-list)))
 900                 (throw 'done t))
 901                ((eq key ?e)
 902                 ;; Take all (marked), and push the symbol 'concat
 903                 (reftex-extract-bib-file found-list reftex-select-marked)
 904                 (setq selected-entries "BibTeX database file created")
 905                 (throw 'done t))
 906                ((eq key ?E)
 907                 ;; Take all (marked), and push the symbol 'concat
 908                 (reftex-extract-bib-file found-list reftex-select-marked
 909                                          'complement)
 910                 (setq selected-entries "BibTeX database file created")
 911                 (throw 'done t))
 912                ((or (eq key ?\C-m)
 913                     (eq key 'return))
 914                 ;; Take selected
 915                 (setq selected-entries
 916                       (if reftex-select-marked
 917                           (cons 'concat
 918                                 (mapcar 'car (nreverse reftex-select-marked)))
 919                         (if data (list data) nil)))
 920                 (throw 'done t))
 921                ((stringp key)
 922                 ;; Got this one with completion
 923                 (setq selected-entries key)
 924                 (throw 'done t))
 925                (t
 926                 (ding))))))))
 927     selected-entries))
 928
 929 (defun reftex-restrict-bib-matches (found-list)
 930   "Limit FOUND-LIST with more regular expressions."
 931   (let ((re-list (split-string (read-string
 932                                 "RegExp [ && RegExp...]: "
 933                                 nil 'reftex-cite-regexp-hist)
 934                                "[ \t]*&&[ \t]*"))
 935         (found-list-r found-list)
 936         re)
 937     (while (setq re (pop re-list))
 938       (setq found-list-r
 939             (delq nil
 940                   (mapcar
 941                    (lambda (x)
 942                      (if (string-match
 943                           re (cdr (assoc "&entry" x)))
 944                          x
 945                        nil))
 946                    found-list-r))))
 947     (if found-list-r
 948         found-list-r
 949       (ding)
 950       found-list)))
 951
 952 (defun reftex-extract-bib-file (all &optional marked complement)
 953   "Limit FOUND-LIST with more regular expressions."
 954   (let ((file (read-file-name "File to create: ")))
 955     (find-file-other-window file)
 956     (if (> (buffer-size) 0)
 957         (unless (yes-or-no-p
 958                  (format "Overwrite non-empty file %s? " file))
 959           (error "Abort")))
 960     (erase-buffer)
 961     (setq all (delq nil
 962                     (mapcar
 963                      (lambda (x)
 964                        (if marked
 965                            (if (or (and (assoc x marked) (not complement))
 966                                    (and (not (assoc x marked)) complement))
 967                                (cdr (assoc "&entry" x))
 968                              nil)
 969                          (cdr (assoc "&entry" x))))
 970                      all)))
 971     (insert (mapconcat 'identity all "\n\n"))
 972     (save-buffer)
 973     (goto-char (point-min))))
 974
 975 (defun reftex-insert-bib-matches (list)
 976   "Insert the bib matches and number them correctly."
 977   (let ((mouse-face
 978          (if (memq reftex-highlight-selection '(mouse both))
 979              reftex-mouse-selected-face
 980            nil))
 981         tmp len)
 982     (mapc
 983      (lambda (x)
 984        (setq tmp (cdr (assoc "&formatted" x))
 985              len (length tmp))
 986        (put-text-property 0 len :data x tmp)
 987        (put-text-property 0 (1- len) 'mouse-face mouse-face tmp)
 988        (insert tmp))
 989      list))
 990   (run-hooks 'reftex-display-copied-context-hook))
 991
 992 (defun reftex-format-names (namelist n)
 993   (let (last (len (length namelist)))
 994     (if (= n 0) (setq n len))
 995     (cond
 996      ((< len 1) "")
 997      ((= 1 len) (car namelist))
 998      ((> len n) (concat (car namelist) (nth 2 reftex-cite-punctuation)))
 999      (t
1000       (setq n (min len n)
1001             last (nth (1- n) namelist))
1002       (setcdr (nthcdr (- n 2) namelist) nil)
1003       (concat
1004        (mapconcat 'identity namelist (nth 0 reftex-cite-punctuation))
1005        (nth 1 reftex-cite-punctuation)
1006        last)))))
1007
1008 (defun reftex-format-citation (entry format)
1009   "Format a citation from the info in the BibTeX ENTRY according to FORMAT."
1010   (unless (stringp format) (setq format "\\cite{%l}"))
1011
1012   (if (and reftex-comment-citations
1013            (string-match "%l" reftex-cite-comment-format))
1014       (error "reftex-cite-comment-format contains invalid %%l"))
1015
1016   (while (string-match
1017           "\\(\\`\\|[^%]\\)\\(\\(%\\([0-9]*\\)\\([a-zA-Z]\\)\\)[.,;: ]*\\)"
1018           format)
1019     (let ((n (string-to-number (match-string 4 format)))
1020           (l (string-to-char (match-string 5 format)))
1021           rpl b e)
1022       (save-match-data
1023         (setq rpl
1024               (cond
1025                ((= l ?l) (concat
1026                           (reftex-get-bib-field "&key" entry)
1027                           (if reftex-comment-citations
1028                               reftex-cite-comment-format
1029                             "")))
1030                ((= l ?a) (reftex-format-names
1031                           (reftex-get-bib-names "author" entry)
1032                           (or n 2)))
1033                ((= l ?A) (car (reftex-get-bib-names "author" entry)))
1034                ((= l ?b) (reftex-get-bib-field "booktitle" entry "in: %s"))
1035                ((= l ?B) (reftex-abbreviate-title
1036                           (reftex-get-bib-field "booktitle" entry "in: %s")))
1037                ((= l ?c) (reftex-get-bib-field "chapter" entry))
1038                ((= l ?d) (reftex-get-bib-field "edition" entry))
1039                ((= l ?e) (reftex-format-names
1040                           (reftex-get-bib-names "editor" entry)
1041                           (or n 2)))
1042                ((= l ?E) (car (reftex-get-bib-names "editor" entry)))
1043                ((= l ?h) (reftex-get-bib-field "howpublished" entry))
1044                ((= l ?i) (reftex-get-bib-field "institution" entry))
1045                ((= l ?j) (reftex-get-bib-field "journal" entry))
1046                ((= l ?k) (reftex-get-bib-field "key" entry))
1047                ((= l ?m) (reftex-get-bib-field "month" entry))
1048                ((= l ?n) (reftex-get-bib-field "number" entry))
1049                ((= l ?N) (reftex-get-bib-field "note" entry))
1050                ((= l ?o) (reftex-get-bib-field "organization" entry))
1051                ((= l ?p) (reftex-get-bib-field "pages" entry))
1052                ((= l ?P) (car (split-string
1053                                (reftex-get-bib-field "pages" entry)
1054                                "[- .]+")))
1055                ((= l ?s) (reftex-get-bib-field "school" entry))
1056                ((= l ?u) (reftex-get-bib-field "publisher" entry))
1057                ((= l ?U) (reftex-get-bib-field "url" entry))
1058                ((= l ?r) (reftex-get-bib-field "address" entry))
1059                ((= l ?t) (reftex-get-bib-field "title" entry))
1060                ((= l ?T) (reftex-abbreviate-title
1061                           (reftex-get-bib-field "title" entry)))
1062                ((= l ?v) (reftex-get-bib-field "volume" entry))
1063                ((= l ?y) (reftex-get-bib-field "year" entry)))))
1064
1065       (if (string= rpl "")
1066           (setq b (match-beginning 2) e (match-end 2))
1067         (setq b (match-beginning 3) e (match-end 3)))
1068       (setq format (concat (substring format 0 b) rpl (substring format e)))))
1069   (while (string-match "%%" format)
1070     (setq format (replace-match "%" t t format)))
1071   (while (string-match "[ ,.;:]*%<" format)
1072     (setq format (replace-match "" t t format)))
1073   format)
1074
1075 ;;;###autoload
1076 (defun reftex-make-cite-echo-string (entry docstruct-symbol)
1077   "Format a bibtex ENTRY for the echo area and cache the result."
1078   (let* ((key (reftex-get-bib-field "&key" entry))
1079          (string
1080           (let* ((reftex-cite-punctuation '(" " " & " " etal.")))
1081             (reftex-format-citation entry reftex-cite-view-format)))
1082          (cache (assq 'bibview-cache (symbol-value docstruct-symbol)))
1083          (cache-entry (assoc key (cdr cache))))
1084     (unless cache
1085       ;; This docstruct has no cache - make one.
1086       (set docstruct-symbol (cons (cons 'bibview-cache nil)
1087                                   (symbol-value docstruct-symbol))))
1088     (when reftex-cache-cite-echo
1089       (setq key (copy-sequence key))
1090       (set-text-properties 0 (length key) nil key)
1091       (set-text-properties 0 (length string) nil string)
1092       (if cache-entry
1093           (unless (string= (cdr cache-entry) string)
1094             (setcdr cache-entry string)
1095             (put reftex-docstruct-symbol 'modified t))
1096         (push (cons key string) (cdr cache))
1097         (put reftex-docstruct-symbol 'modified t)))
1098     string))
1099
1100 (defun reftex-bibtex-selection-callback (data ignore no-revisit)
1101   "Callback function to be called from the BibTeX selection, in
1102 order to display context.  This function is relatively slow and not
1103 recommended for follow mode.  It works OK for individual lookups."
1104   (let ((win (selected-window))
1105         (key (reftex-get-bib-field "&key" data))
1106         bibfile-list item bibtype)
1107
1108     (catch 'exit
1109       (with-current-buffer reftex-call-back-to-this-buffer
1110         (setq bibtype (reftex-bib-or-thebib))
1111         (cond
1112          ((eq bibtype 'bib)
1113 ;        ((assq 'bib (symbol-value reftex-docstruct-symbol))
1114           (setq bibfile-list (reftex-get-bibfile-list)))
1115          ((eq bibtype 'thebib)
1116 ;        ((assq 'thebib (symbol-value reftex-docstruct-symbol))
1117           (setq bibfile-list
1118                 (reftex-uniquify
1119                  (mapcar 'cdr
1120                          (reftex-all-assq
1121                           'thebib (symbol-value reftex-docstruct-symbol))))
1122                 item t))
1123          (reftex-default-bibliography
1124           (setq bibfile-list (reftex-default-bibliography)))
1125          (t (ding) (throw 'exit nil))))
1126
1127       (when no-revisit
1128         (setq bibfile-list (reftex-visited-files bibfile-list)))
1129
1130       (condition-case nil
1131           (reftex-pop-to-bibtex-entry
1132            key bibfile-list (not reftex-keep-temporary-buffers) t item)
1133         (error (ding))))
1134
1135     (select-window win)))
1136
1137 ;;; Global BibTeX file
1138 (defun reftex-all-used-citation-keys ()
1139   (reftex-access-scan-info)
1140   (let ((files (reftex-all-document-files)) file keys kk k)
1141     (save-current-buffer
1142       (while (setq file (pop files))
1143         (set-buffer (reftex-get-file-buffer-force file 'mark))
1144         (save-excursion
1145           (save-restriction
1146             (widen)
1147             (goto-char (point-min))
1148             (while (re-search-forward "\\(?:^\\|\\=\\)[^%\n\r]*?\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^]]*\\]\\)?{\\([^}]+\\)}" nil t)
1149               (setq kk (match-string-no-properties 3))
1150               (while (string-match "%.*\n?" kk)
1151                 (setq kk (replace-match "" t t kk)))
1152               (setq kk (split-string kk "[, \t\r\n]+"))
1153               (while (setq k (pop kk))
1154                 (or (member k keys)
1155                     (setq keys (cons k keys)))))))))
1156     (reftex-kill-temporary-buffers)
1157     keys))
1158
1159 (defun reftex-get-string-refs (alist)
1160   "Return a list of BibTeX @string references that appear as values in ALIST."
1161   (reftex-remove-if (lambda (x) (string-match "^\\([\"{]\\|[0-9]+$\\)" x))
1162                     ;; get list of values, discard keys
1163                     (mapcar 'cdr
1164                             ;; remove &key and &type entries
1165                             (reftex-remove-if (lambda (pair)
1166                                                 (string-match "^&" (car pair)))
1167                                               alist))))
1168
1169 ;;;###autoload
1170 (defun reftex-create-bibtex-file (bibfile)
1171   "Create a new BibTeX database BIBFILE with all entries referenced in document.
1172 The command prompts for a filename and writes the collected
1173 entries to that file.  Only entries referenced in the current
1174 document with any \\cite-like macros are used.  The sequence in
1175 the new file is the same as it was in the old database.
1176
1177 Entries referenced from other entries must appear after all
1178 referencing entries.
1179
1180 You can define strings to be used as header or footer for the
1181 created files in the variables `reftex-create-bibtex-header' or
1182 `reftex-create-bibtex-footer' respectively."
1183   (interactive "FNew BibTeX file: ")
1184   (let ((keys (reftex-all-used-citation-keys))
1185         (files (reftex-get-bibfile-list))
1186         file key entries beg end entry string-keys string-entries)
1187     (save-current-buffer
1188       (dolist (file files)
1189         (set-buffer (reftex-get-file-buffer-force file 'mark))
1190         (reftex-with-special-syntax-for-bib
1191          (save-excursion
1192            (save-restriction
1193              (widen)
1194              (goto-char (point-min))
1195              (while (re-search-forward "^[ \t]*@\\(?:\\w\\|\\s_\\)+[ \t\n\r]*\
1196 [{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t)
1197                (setq key (match-string 1)
1198                      beg (match-beginning 0)
1199                      end (progn
1200                            (goto-char (match-beginning 1))
1201                            (condition-case nil
1202                                (up-list 1)
1203                              (error (goto-char (match-end 0))))
1204                            (point)))
1205                (when (member key keys)
1206                  (setq entry (buffer-substring beg end)
1207                        entries (cons entry entries)
1208                        keys (delete key keys))
1209
1210                  ;; check for crossref entries
1211                  (let* ((attr-list (reftex-parse-bibtex-entry nil beg end))
1212                         (xref-key (cdr (assoc "crossref" attr-list))))
1213                    (if xref-key (pushnew xref-key keys)))
1214                  ;; check for string references
1215                  (let* ((raw-fields (reftex-parse-bibtex-entry nil beg end t))
1216                         (string-fields (reftex-get-string-refs raw-fields)))
1217                    (dolist (skey string-fields)
1218                      (unless (member skey string-keys)
1219                        (push skey string-keys)))))))))))
1220     ;; second pass: grab @string references
1221     (if string-keys
1222         (save-current-buffer
1223           (dolist (file files)
1224             (set-buffer (reftex-get-file-buffer-force file 'mark))
1225             (reftex-with-special-syntax-for-bib
1226              (save-excursion
1227                (save-restriction
1228                  (widen)
1229                  (goto-char (point-min))
1230                  (while (re-search-forward
1231                          "^[ \t]*@[Ss][Tt][Rr][Ii][Nn][Gg][ \t]*{[ \t]*\\([^ \t\r\n]+\\)"
1232                          nil t)
1233                    (setq key (match-string 1)
1234                          beg (match-beginning 0)
1235                          end (progn
1236                                (goto-char (match-beginning 1))
1237                                (condition-case nil
1238                                    (up-list 1)
1239                                  (error (goto-char (match-end 0))))
1240                                (point)))
1241                    (when (member key string-keys)
1242                      (setq entry (buffer-substring beg end)
1243                            string-entries (cons entry string-entries)
1244                            string-keys (delete key string-keys))))))))))
1245     (find-file-other-window bibfile)
1246     (if (> (buffer-size) 0)
1247         (unless (yes-or-no-p
1248                  (format "Overwrite non-empty file %s? " bibfile))
1249           (error "Abort")))
1250     (erase-buffer)
1251     (if reftex-create-bibtex-header (insert reftex-create-bibtex-header "\n\n"))
1252     (insert (mapconcat 'identity (reverse string-entries) "\n\n"))
1253     (if string-entries (insert "\n\n\n"))
1254     (insert (mapconcat 'identity (reverse entries) "\n\n"))
1255     (if reftex-create-bibtex-footer (insert "\n\n" reftex-create-bibtex-footer))
1256     (goto-char (point-min))
1257     (save-buffer)
1258     (message "%d entries extracted and copied to new database"
1259              (length entries))))
1260
1261 (provide 'reftex-cite)
1262 ;;; reftex-cite.el ends here
1263
1264 ;; Local Variables:
1265 ;; generated-autoload-file: "reftex.el"
1266 ;; End: