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