Update FSF's address.
[bpt/emacs.git] / lisp / textmodes / reftex-ref.el
1 ;;; reftex-ref.el --- code to create labels and references with RefTeX
2 ;; Copyright (c) 1997, 1998, 1999, 2000, 2003, 2004, 2005
3 ;; Free Software Foundation, Inc.
4
5 ;; Author: Carsten Dominik <dominik@science.uva.nl>
6 ;; Version: 4.28
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 2, or (at your option)
13 ;; 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; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 (eval-when-compile (require 'cl))
30 (provide 'reftex-ref)
31 (require 'reftex)
32 (require 'reftex-parse)
33 ;;;
34
35 (defun reftex-label-location (&optional bound)
36 "Return the environment or macro which determines the label type at point.
37 If optional BOUND is an integer, limit backward searches to that point."
38
39 (let* ((loc1 (reftex-what-macro reftex-label-mac-list bound))
40 (loc2 (reftex-what-environment reftex-label-env-list bound))
41 (loc3 (reftex-what-special-env 1 bound))
42 (p1 (or (cdr loc1) 0))
43 (p2 (or (cdr loc2) 0))
44 (p3 (or (cdr loc3) 0))
45 (pmax (max p1 p2 p3)))
46
47 (setq reftex-location-start pmax)
48 (cond
49 ((= p1 pmax)
50 ;; A macro. Default context after macro name.
51 (setq reftex-default-context-position (+ p1 (length (car loc1))))
52 (or (car loc1) "section"))
53 ((= p2 pmax)
54 ;; An environment. Default context after \begin{name}.
55 (setq reftex-default-context-position (+ p2 8 (length (car loc2))))
56 (or (car loc2) "section"))
57 ((= p3 pmax)
58 ;; A special. Default context right there.
59 (setq reftex-default-context-position p3)
60 (setq loc3 (car loc3))
61 (cond ((null loc3) "section")
62 ((symbolp loc3) (symbol-name loc3))
63 ((stringp loc3) loc3)
64 (t "section")))
65 (t ;; This should not happen, I think?
66 "section"))))
67
68 (defun reftex-label-info-update (cell)
69 ;; Update information about just one label in a different file.
70 ;; CELL contains the old info list
71 (let* ((label (nth 0 cell))
72 (typekey (nth 1 cell))
73 ;; (text (nth 2 cell))
74 (file (nth 3 cell))
75 (comment (nth 4 cell))
76 (note (nth 5 cell))
77 (buf (reftex-get-file-buffer-force
78 file (not (eq t reftex-keep-temporary-buffers)))))
79 (if (not buf)
80 (list label typekey "" file comment "LOST LABEL. RESCAN TO FIX.")
81 (save-excursion
82 (set-buffer buf)
83 (save-restriction
84 (widen)
85 (goto-char 1)
86
87 (if (or (re-search-forward
88 (format reftex-find-label-regexp-format
89 (regexp-quote label)) nil t)
90 (re-search-forward
91 (format reftex-find-label-regexp-format2
92 (regexp-quote label)) nil t))
93
94 (progn
95 (backward-char 1)
96 (append (reftex-label-info label file) (list note)))
97 (list label typekey "" file "LOST LABEL. RESCAN TO FIX.")))))))
98
99 (defun reftex-label-info (label &optional file bound derive env-or-mac)
100 ;; Return info list on LABEL at point.
101 (let* ((prefix (if (string-match "^[a-zA-Z0-9]+:" label)
102 (match-string 0 label)))
103 (typekey (cdr (assoc prefix reftex-prefix-to-typekey-alist)))
104 (file (or file (buffer-file-name)))
105 (trust reftex-trust-label-prefix)
106 (in-comment (reftex-in-comment)))
107 (if (and typekey
108 (cond ((eq trust t) t)
109 ((null trust) nil)
110 ((stringp trust) (string-match trust typekey))
111 ((listp trust) (member typekey trust))
112 (t nil)))
113 (list label typekey
114 (reftex-nicify-text (reftex-context-substring))
115 file in-comment)
116 (let* ((env-or-mac (or env-or-mac (reftex-label-location bound)))
117 (typekey (nth 1 (assoc env-or-mac reftex-env-or-mac-alist)))
118 (parse (nth 2 (assoc env-or-mac reftex-env-or-mac-alist)))
119 (text (reftex-short-context env-or-mac parse reftex-location-start
120 derive)))
121 (list label typekey text file in-comment)))))
122
123 ;;; Creating labels ---------------------------------------------------------
124
125 (defun reftex-label (&optional environment no-insert)
126 "Insert a unique label. Return the label.
127 If ENVIRONMENT is given, don't bother to find out yourself.
128 If NO-INSERT is non-nil, do not insert label into buffer.
129 With prefix arg, force to rescan document first.
130 When you are prompted to enter or confirm a label, and you reply with
131 just the prefix or an empty string, no label at all will be inserted.
132 A new label is also recorded into the label list.
133 This function is controlled by the settings of reftex-insert-label-flags."
134
135 (interactive)
136
137 ;; Ensure access to scanning info and rescan buffer if prefix are is '(4).
138 (reftex-access-scan-info current-prefix-arg)
139
140 ;; Find out what kind of environment this is and abort if necessary.
141 (if (or (not environment)
142 (not (assoc environment reftex-env-or-mac-alist)))
143 (setq environment (reftex-label-location)))
144 (unless environment
145 (error "Can't figure out what kind of label should be inserted"))
146
147 ;; Ok, go ahead.
148 (catch 'exit
149 (let* ((entry (assoc environment reftex-env-or-mac-alist))
150 (typekey (nth 1 entry))
151 (format (nth 3 entry))
152 (macro-cell (reftex-what-macro 1))
153 (entry1 (assoc (car macro-cell) reftex-env-or-mac-alist))
154 label naked prefix valid default force-prompt rescan-is-useful)
155 (when (and (or (nth 5 entry) (nth 5 entry1))
156 (memq (preceding-char) '(?\[ ?\{)))
157 ;; This is an argument of a label macro. Insert naked label.
158 (setq naked t format "%s"))
159
160 (setq prefix (or (cdr (assoc typekey reftex-typekey-to-prefix-alist))
161 (concat typekey "-")))
162 ;; Replace any escapes in the prefix
163 (setq prefix (reftex-replace-prefix-escapes prefix))
164
165 ;; Make a default label.
166 (cond
167
168 ((reftex-typekey-check typekey (nth 0 reftex-insert-label-flags))
169 ;; Derive a label from context.
170 (setq reftex-active-toc (reftex-last-assoc-before-elt
171 'toc (car (reftex-where-am-I))
172 (symbol-value reftex-docstruct-symbol)))
173 (setq default (reftex-no-props
174 (nth 2 (reftex-label-info " " nil nil t))))
175 ;; Catch the cases where the is actually no context available.
176 (if (or (string-match "NO MATCH FOR CONTEXT REGEXP" default)
177 (string-match "INVALID VALUE OF PARSE" default)
178 (string-match "SECTION HEADING NOT FOUND" default)
179 (string-match "HOOK ERROR" default)
180 (string-match "^[ \t]*$" default))
181 (setq default prefix
182 force-prompt t) ; need to prompt
183 (setq default
184 (concat prefix
185 (funcall reftex-string-to-label-function default)))
186
187 ;; Make it unique.
188 (setq default (reftex-uniquify-label default nil "-"))))
189
190 ((reftex-typekey-check typekey (nth 1 reftex-insert-label-flags))
191 ;; Minimal default: the user will be prompted.
192 (setq default prefix))
193
194 (t
195 ;; Make an automatic label.
196 (setq default (reftex-uniquify-label prefix t))))
197
198 ;; Should we ask the user?
199 (if (or (reftex-typekey-check typekey
200 (nth 1 reftex-insert-label-flags)) ; prompt
201 force-prompt)
202
203 (while (not valid)
204 ;; iterate until we get a valid label
205
206 (setq label (read-string
207 (if naked "Naked Label: " "Label: ")
208 default))
209
210 ;; Lets make sure that this is a valid label
211 (cond
212
213 ((string-match (concat "\\`\\(" (regexp-quote prefix)
214 "\\)?[ \t]*\\'")
215 label)
216 ;; No label at all, please
217 (message "No label inserted.")
218 (throw 'exit nil))
219
220 ;; Test if label contains strange characters
221 ((string-match reftex-label-illegal-re label)
222 (message "Label \"%s\" contains invalid characters" label)
223 (ding)
224 (sit-for 2))
225
226 ;; Look it up in the label list
227 ((setq entry (assoc label
228 (symbol-value reftex-docstruct-symbol)))
229 (ding)
230 (if (y-or-n-p
231 (format "Label '%s' exists. Use anyway? " label))
232 (setq valid t)))
233
234 ;; Label is ok
235 (t
236 (setq valid t))))
237 (setq label default))
238
239 ;; Insert the label into the label list
240 (let* ((here-I-am-info
241 (save-excursion
242 (if (and (or naked no-insert)
243 (integerp (cdr macro-cell)))
244 (goto-char (cdr macro-cell)))
245 (reftex-where-am-I)))
246 (here-I-am (car here-I-am-info))
247 (note (if (cdr here-I-am-info)
248 ""
249 "POSITION UNCERTAIN. RESCAN TO FIX."))
250 (file (buffer-file-name))
251 (text nil)
252 (tail (memq here-I-am (symbol-value reftex-docstruct-symbol))))
253
254 (or (cdr here-I-am-info) (setq rescan-is-useful t))
255
256 (when tail
257 (push (list label typekey text file nil note) (cdr tail))
258 (put reftex-docstruct-symbol 'modified t)))
259
260 ;; Insert the label into the buffer
261 (unless no-insert
262 (insert
263 (if reftex-format-label-function
264 (funcall reftex-format-label-function label format)
265 (format format label)))
266 (if (and reftex-plug-into-AUCTeX
267 (fboundp 'LaTeX-add-labels))
268 ;; Tell AUCTeX about this
269 (LaTeX-add-labels label)))
270
271 ;; Delete the corresponding selection buffers to force update on next use.
272 (when reftex-auto-update-selection-buffers
273 (reftex-erase-buffer (reftex-make-selection-buffer-name typekey))
274 (reftex-erase-buffer (reftex-make-selection-buffer-name " ")))
275
276 (when (and rescan-is-useful reftex-allow-automatic-rescan)
277 (reftex-parse-one))
278
279 ;; return value of the function is the label
280 label)))
281
282 (defun reftex-string-to-label (string)
283 "Convert a string (a sentence) to a label.
284 Uses `reftex-derive-label-parameters' and `reftex-label-illegal-re'. It
285 also applies `reftex-translate-to-ascii-function' to the string."
286 (when (and reftex-translate-to-ascii-function
287 (fboundp reftex-translate-to-ascii-function))
288 (setq string (funcall reftex-translate-to-ascii-function string)))
289 (apply 'reftex-convert-string string
290 "[-~ \t\n\r,;]+" reftex-label-illegal-re nil nil
291 reftex-derive-label-parameters))
292
293 (defun reftex-latin1-to-ascii (string)
294 ;; Translate the upper 128 chars in the Latin-1 charset to ASCII equivalents
295 (let ((tab "@@@@@@@@@@@@@@@@@@'@@@@@@@@@@@@@ icLxY|S\"ca<--R-o|23'uq..1o>423?AAAAAAACEEEEIIIIDNOOOOOXOUUUUYP3aaaaaaaceeeeiiiidnooooo:ouuuuypy")
296 (emacsp (not (featurep 'xemacs))))
297 (mapconcat
298 (lambda (c)
299 (cond ((and (> c 127) (< c 256)) ; 8 bit Latin-1
300 (char-to-string (aref tab (- c 128))))
301 ((and emacsp ; Not for XEmacs
302 (> c 2175) (< c 2304)) ; Mule Latin-1
303 (char-to-string (aref tab (- c 2176))))
304 (t (char-to-string c))))
305 string "")))
306
307 (defun reftex-replace-prefix-escapes (prefix)
308 ;; Replace %escapes in a label prefix
309 (save-match-data
310 (let (letter (num 0) replace)
311 (while (string-match "\\%\\([a-zA-Z]\\)" prefix num)
312 (setq letter (match-string 1 prefix))
313 (setq replace
314 (save-match-data
315 (cond
316 ((equal letter "f")
317 (file-name-sans-extension
318 (file-name-nondirectory (buffer-file-name))))
319 ((equal letter "F")
320 (let ((masterdir (file-name-directory (reftex-TeX-master-file)))
321 (file (file-name-sans-extension (buffer-file-name))))
322 (if (string-match (concat "\\`" (regexp-quote masterdir))
323 file)
324 (substring file (length masterdir))
325 file)))
326 ((equal letter "m")
327 (file-name-sans-extension
328 (file-name-nondirectory (reftex-TeX-master-file))))
329 ((equal letter "M")
330 (file-name-nondirectory
331 (substring (file-name-directory (reftex-TeX-master-file))
332 0 -1)))
333 ((equal letter "u")
334 (or (user-login-name) ""))
335 ((equal letter "S")
336 (let* (macro level-exp level)
337 (save-excursion
338 (save-match-data
339 (when (re-search-backward reftex-section-regexp nil t)
340 (setq macro (reftex-match-string 2)
341 level-exp (cdr (assoc macro reftex-section-levels-all))
342 level (if (symbolp level-exp)
343 (abs (save-match-data
344 (funcall level-exp)))
345 (abs level-exp))))
346 (cdr (or (assoc macro reftex-section-prefixes)
347 (assoc level reftex-section-prefixes)
348 (assq t reftex-section-prefixes)
349 (list t "sec:")))))))
350 (t ""))))
351 (setq num (1- (+ (match-beginning 1) (length replace)))
352 prefix (replace-match replace nil nil prefix)))
353 prefix)))
354
355 (defun reftex-uniquify-label (label &optional force separator)
356 ;; Make label unique by appending a number.
357 ;; Optional FORCE means, force appending a number, even if label is unique.
358 ;; Optional SEPARATOR is a string to stick between label and number.
359
360 ;; Ensure access to scanning info
361 (reftex-access-scan-info)
362
363 (cond
364 ((and (not force)
365 (not (assoc label (symbol-value reftex-docstruct-symbol))))
366 label)
367 (t
368 (let* ((label-numbers (assq 'label-numbers
369 (symbol-value reftex-docstruct-symbol)))
370 (label-numbers-alist (cdr label-numbers))
371 (cell (or (assoc label label-numbers-alist)
372 (car (setcdr label-numbers
373 (cons (cons label 0)
374 label-numbers-alist)))))
375 (num (1+ (cdr cell)))
376 (sep (or separator "")))
377 (while (assoc (concat label sep (int-to-string num))
378 (symbol-value reftex-docstruct-symbol))
379 (incf num))
380 (setcdr cell num)
381 (concat label sep (int-to-string num))))))
382
383 ;;; Referencing labels ------------------------------------------------------
384
385 ;; Help string for the reference label menu
386 (defconst reftex-select-label-prompt
387 "Select: [n]ext [p]revious [r]escan [ ]context e[x]tern [q]uit RET [?]HELP+more")
388
389 (defconst reftex-select-label-help
390 " n / p Go to next/previous label (Cursor motion works as well)
391 C-c C-n/p Go to next/previous section heading.
392 b / l Jump back to previous selection / Reuse last referenced label.
393 z Jump to a specific section, e.g. '3 z' jumps to section 3.
394 g / s Update menu / Switch label type.
395 r / C-u r Reparse document / Reparse entire document.
396 x Switch to label menu of external document (with LaTeX package `xr').
397 F t c Toggle: [F]ile borders, [t]able of contents, [c]ontext
398 # % Toggle: [#] label counters, [%] labels in comments
399 SPC / f Show full context in other window / Toggle follow mode.
400 . Show insertion point in other window.
401 v / V Toggle \\ref <-> \\vref / Rotate \\ref <=> \\fref <=> \\Fref
402 TAB Enter a label with completion.
403 m , - + Mark entry. `,-+' also assign a separator.
404 a / A Put all marked entries into one/many \\ref commands.
405 q / RET Quit without referencing / Accept current label (also on mouse-2).")
406
407 (defun reftex-reference (&optional type no-insert cut)
408 "Make a LaTeX reference. Look only for labels of a certain TYPE.
409 With prefix arg, force to rescan buffer for labels. This should only be
410 necessary if you have recently entered labels yourself without using
411 reftex-label. Rescanning of the buffer can also be requested from the
412 label selection menu.
413 The function returns the selected label or nil.
414 If NO-INSERT is non-nil, do not insert \\ref command, just return label.
415 When called with 2 C-u prefix args, disable magic word recognition."
416
417 (interactive)
418
419 ;; check for active recursive edits
420 (reftex-check-recursive-edit)
421
422 ;; Ensure access to scanning info and rescan buffer if prefix are is '(4)
423 (reftex-access-scan-info current-prefix-arg)
424
425 (unless type
426 ;; guess type from context
427 (if (and reftex-guess-label-type
428 (setq type (reftex-guess-label-type)))
429 (setq cut (cdr type)
430 type (car type))
431 (setq type (reftex-query-label-type))))
432
433 (let* ((refstyle
434 (cond ((reftex-typekey-check type reftex-vref-is-default) "\\vref")
435 ((reftex-typekey-check type reftex-fref-is-default) "\\fref")
436 (t "\\ref")))
437 (reftex-format-ref-function reftex-format-ref-function)
438 (form "\\ref{%s}")
439 label labels sep sep1)
440
441 ;; Have the user select a label
442 (set-marker reftex-select-return-marker (point))
443 (setq labels (save-excursion
444 (reftex-offer-label-menu type)))
445 (reftex-ensure-compiled-variables)
446 (set-marker reftex-select-return-marker nil)
447 ;; If the first entry is the symbol 'concat, concat all labels.
448 ;; We keep the cdr of the first label for typekey etc information.
449 (if (eq (car labels) 'concat)
450 (setq labels (list (list (mapconcat 'car (cdr labels) ",")
451 (cdr (nth 1 labels))))))
452 (setq type (nth 1 (car labels))
453 form (or (cdr (assoc type reftex-typekey-to-format-alist))
454 form))
455
456 (cond
457 (no-insert
458 ;; Just return the first label
459 (car (car labels)))
460 ((null labels)
461 (message "Quit")
462 nil)
463 (t
464 (while labels
465 (setq label (car (car labels))
466 sep (nth 2 (car labels))
467 sep1 (cdr (assoc sep reftex-multiref-punctuation))
468 labels (cdr labels))
469 (when cut
470 (backward-delete-char cut)
471 (setq cut nil))
472
473 ;; remove ~ if we do already have a space
474 (when (and (= ?~ (string-to-char form))
475 (member (preceding-char) '(?\ ?\t ?\n ?~)))
476 (setq form (substring form 1)))
477 ;; do we have a special format?
478 (setq reftex-format-ref-function
479 (cond
480 ((string= refstyle "\\vref") 'reftex-format-vref)
481 ((string= refstyle "\\fref") 'reftex-format-fref)
482 ((string= refstyle "\\Fref") 'reftex-format-Fref)
483 (t reftex-format-ref-function)))
484 ;; ok, insert the reference
485 (if sep1 (insert sep1))
486 (insert
487 (if reftex-format-ref-function
488 (funcall reftex-format-ref-function label form)
489 (format form label label)))
490 ;; take out the initial ~ for good
491 (and (= ?~ (string-to-char form))
492 (setq form (substring form 1))))
493 (message "")
494 label))))
495
496 (defun reftex-guess-label-type ()
497 ;; Examine context to guess what a \ref might want to reference.
498 (let ((words reftex-words-to-typekey-alist)
499 (case-fold-search t)
500 (bound (max (point-min) (- (point) 35)))
501 matched cell)
502 (save-excursion
503 (while (and (setq cell (pop words))
504 (not (setq matched
505 (re-search-backward (car cell) bound t))))))
506 (if matched
507 (cons (cdr cell) (- (match-end 0) (match-end 1)))
508 nil)))
509
510 (defvar reftex-select-label-map)
511 (defun reftex-offer-label-menu (typekey)
512 ;; Offer a menu with the appropriate labels.
513 (let* ((buf (current-buffer))
514 (xr-data (assq 'xr (symbol-value reftex-docstruct-symbol)))
515 (xr-alist (cons (cons "" (buffer-file-name)) (nth 1 xr-data)))
516 (xr-index 0)
517 (here-I-am (car (reftex-where-am-I)))
518 (here-I-am1 here-I-am)
519 (toc (reftex-typekey-check typekey reftex-label-menu-flags 0))
520 (files (reftex-typekey-check typekey reftex-label-menu-flags 7))
521 (context (not (reftex-typekey-check
522 typekey reftex-label-menu-flags 3)))
523 (counter (reftex-typekey-check
524 typekey reftex-label-menu-flags 2))
525 (follow (reftex-typekey-check
526 typekey reftex-label-menu-flags 4))
527 (commented (nth 5 reftex-label-menu-flags))
528 (prefix "")
529 selection-buffers
530 offset rtn key data last-data entries)
531
532 (unwind-protect
533 (catch 'exit
534 (while t
535 (save-window-excursion
536 (delete-other-windows)
537 (setq reftex-call-back-to-this-buffer buf
538 reftex-latex-syntax-table (syntax-table))
539 (let ((default-major-mode 'reftex-select-label-mode))
540 (if reftex-use-multiple-selection-buffers
541 (switch-to-buffer-other-window
542 (save-excursion
543 (set-buffer buf)
544 (reftex-make-selection-buffer-name typekey)))
545 (switch-to-buffer-other-window "*RefTeX Select*")
546 (reftex-erase-buffer)))
547 (unless (eq major-mode 'reftex-select-label-mode)
548 (reftex-select-label-mode))
549 (add-to-list 'selection-buffers (current-buffer))
550 (setq truncate-lines t)
551 (setq mode-line-format
552 (list "---- " 'mode-line-buffer-identification
553 " " 'global-mode-string " (" mode-name ")"
554 " S<" 'refstyle ">"
555 " -%-"))
556 (cond
557 ((= 0 (buffer-size))
558 (let ((buffer-read-only nil))
559 (message "Creating Selection Buffer...")
560 (setq offset (reftex-insert-docstruct
561 buf
562 toc
563 typekey
564 nil ; index
565 files
566 context
567 counter
568 commented
569 (or here-I-am offset)
570 prefix
571 nil ; no a toc buffer
572 ))))
573 (here-I-am
574 (setq offset (reftex-get-offset buf here-I-am typekey)))
575 (t (setq offset t)))
576 (setq buffer-read-only t)
577 (setq offset (or offset t))
578
579 (setq here-I-am nil) ; turn off determination of offset
580 (setq rtn
581 (reftex-select-item
582 reftex-select-label-prompt
583 reftex-select-label-help
584 reftex-select-label-map
585 offset
586 'reftex-show-label-location follow))
587 (setq key (car rtn)
588 data (nth 1 rtn)
589 last-data (nth 2 rtn)
590 offset t)
591 (unless key (throw 'exit nil))
592 (cond
593 ((eq key ?g)
594 ;; update buffer
595 (reftex-erase-buffer))
596 ((or (eq key ?r)
597 (eq key ?R))
598 ;; rescan buffer
599 (and current-prefix-arg (setq key ?R))
600 (reftex-erase-buffer)
601 (reftex-reparse-document buf last-data key))
602 ((eq key ?c)
603 ;; toggle context mode
604 (reftex-erase-buffer)
605 (setq context (not context)))
606 ((eq key ?s)
607 ;; switch type
608 (setq here-I-am here-I-am1)
609 (setq typekey (reftex-query-label-type)))
610 ((eq key ?t)
611 ;; toggle table of contents display, or change depth
612 (reftex-erase-buffer)
613 (if current-prefix-arg
614 (setq reftex-toc-max-level (prefix-numeric-value
615 current-prefix-arg))
616 (setq toc (not toc))))
617 ((eq key ?F)
618 ;; toggle display of included file borders
619 (reftex-erase-buffer)
620 (setq files (not files)))
621 ((eq key ?#)
622 ;; toggle counter display
623 (reftex-erase-buffer)
624 (setq counter (not counter)))
625 ((eq key ?%)
626 ;; toggle display of commented labels
627 (reftex-erase-buffer)
628 (setq commented (not commented)))
629 ((eq key ?l)
630 ;; reuse the last referenced label again
631 (setq entries reftex-last-used-reference)
632 (throw 'exit t))
633 ((eq key ?x)
634 ;; select an external document
635 (setq xr-index (reftex-select-external-document
636 xr-alist xr-index))
637 (setq buf (or (reftex-get-file-buffer-force
638 (cdr (nth xr-index xr-alist)))
639 (error "Cannot switch document"))
640 prefix (or (car (nth xr-index xr-alist)) ""))
641 (set-buffer buf)
642 (reftex-access-scan-info))
643 ((stringp key)
644 (setq entries
645 (list
646 (list
647 (or (assoc key (symbol-value reftex-docstruct-symbol))
648 (list key typekey)))))
649 (throw 'exit t))
650 ((memq key '(?a ?A return))
651 (cond
652 (reftex-select-marked
653 (setq entries (nreverse reftex-select-marked)))
654 (data
655 (setq entries (list (list data))))
656 (t (setq entries nil)))
657 (when entries
658 (if (equal key ?a) (push 'concat entries))
659 (setq reftex-last-used-reference entries))
660 (set-buffer buf)
661 (throw 'exit t))
662 (t (error "This should not happen (reftex-offer-label-menu)"))))))
663 (save-excursion
664 (while reftex-buffers-with-changed-invisibility
665 (set-buffer (car (car reftex-buffers-with-changed-invisibility)))
666 (setq buffer-invisibility-spec
667 (cdr (pop reftex-buffers-with-changed-invisibility)))))
668 (mapcar (lambda (buf) (and (buffer-live-p buf) (bury-buffer buf)))
669 selection-buffers)
670 (reftex-kill-temporary-buffers))
671 ;; Add the prefixes, put together the relevant information in the form
672 ;; (LABEL TYPEKEY SEPARATOR) and return a list of those.
673 (mapcar (lambda (x)
674 (if (listp x)
675 (list (concat prefix (car (car x)))
676 (nth 1 (car x))
677 (nth 2 x))
678 x))
679 entries)))
680
681 (defun reftex-reparse-document (&optional buffer data key)
682 ;; Rescan the document.
683 (save-window-excursion
684 (save-excursion
685 (if buffer
686 (if (not (bufferp buffer))
687 (error "No such buffer %s" (buffer-name buffer))
688 (set-buffer buffer)))
689 (let ((arg (if (eq key ?R) '(16) '(4)))
690 (file (nth 3 data)))
691 (reftex-access-scan-info arg file)))))
692
693 (defun reftex-query-label-type ()
694 ;; Ask for label type
695 (let ((key (reftex-select-with-char
696 reftex-type-query-prompt reftex-type-query-help 3)))
697 (unless (member (char-to-string key) reftex-typekey-list)
698 (error "No such label type: %s" (char-to-string key)))
699 (char-to-string key)))
700
701 (defun reftex-show-label-location (data forward no-revisit
702 &optional stay error)
703 ;; View the definition site of a label in another window.
704 ;; DATA is an entry from the docstruct list.
705 ;; FORWARD indicates if the label is likely forward from current point.
706 ;; NO-REVISIT means do not load a file to show this label.
707 ;; STAY means leave the new window selected.
708 ;; ERROR means throw an error exception when the label cannot be found.
709 ;; If ERROR is nil, the return value of this function indicates success.
710 (let* ((this-window (selected-window))
711 (errorf (if error 'error 'message))
712 label file buffer re found)
713
714 (catch 'exit
715 (setq label (nth 0 data)
716 file (nth 3 data))
717
718 (unless file
719 (funcall errorf "Unknown label - reparse might help")
720 (throw 'exit nil))
721
722 ;; Goto the file in another window
723 (setq buffer
724 (if no-revisit
725 (reftex-get-buffer-visiting file)
726 (reftex-get-file-buffer-force
727 file (not reftex-keep-temporary-buffers))))
728 (if buffer
729 ;; good - the file is available
730 (switch-to-buffer-other-window buffer)
731 ;; we have got a problem here. The file does not exist.
732 ;; Let' get out of here..
733 (funcall errorf "Label %s not found" label)
734 (throw 'exit nil))
735
736 ;; search for that label
737 (setq re (format reftex-find-label-regexp-format (regexp-quote label)))
738 (setq found
739 (if forward
740 (re-search-forward re nil t)
741 (re-search-backward re nil t)))
742 (unless found
743 (goto-char (point-min))
744 (unless (setq found (re-search-forward re nil t))
745 ;; Ooops. Must be in a macro with distributed args.
746 (setq found
747 (re-search-forward
748 (format reftex-find-label-regexp-format2
749 (regexp-quote label)) nil t))))
750 (if (match-end 3)
751 (progn
752 (reftex-highlight 0 (match-beginning 3) (match-end 3))
753 (reftex-show-entry (match-beginning 3) (match-end 3))
754 (recenter '(4))
755 (unless stay (select-window this-window)))
756 (select-window this-window)
757 (funcall errorf "Label %s not found" label))
758 found)))
759
760 (defvar font-lock-mode)
761 (defun reftex-show-entry (beg-hlt end-hlt)
762 ;; Show entry if point is hidden
763 (let* ((n (/ (reftex-window-height) 2))
764 (beg (save-excursion
765 (re-search-backward "[\n\r]" nil 1 n) (point)))
766 (end (save-excursion
767 (re-search-forward "[\n\r]" nil 1 n) (point))))
768 (cond
769 ((and (boundp 'buffer-invisibility-spec) buffer-invisibility-spec
770 (get-char-property (1+ beg-hlt) 'invisible))
771 ;; Invisible with text properties. That is easy to change.
772 (push (cons (current-buffer) buffer-invisibility-spec)
773 reftex-buffers-with-changed-invisibility)
774 (setq buffer-invisibility-spec nil))
775 ((string-match "\r" (buffer-substring beg end))
776 ;; Invisible with selective display. We need to copy it.
777 (let ((string (buffer-substring-no-properties beg end)))
778 (switch-to-buffer "*RefTeX Context Copy*")
779 (setq buffer-read-only nil)
780 (erase-buffer)
781 (insert string)
782 (subst-char-in-region (point-min) (point-max) ?\r ?\n t)
783 (goto-char (- beg-hlt beg))
784 (reftex-highlight 0 (1+ (- beg-hlt beg)) (1+ (- end-hlt beg)))
785 (if (reftex-refontify)
786 (when (or (not (eq major-mode 'latex-mode))
787 (not font-lock-mode))
788 (latex-mode)
789 (run-hook-with-args
790 'reftex-pre-refontification-functions
791 reftex-call-back-to-this-buffer 'reftex-hidden)
792 (turn-on-font-lock))
793 (when (or (not (eq major-mode 'fundamental-mode))
794 font-lock-mode)
795 (fundamental-mode)))
796 (run-hooks 'reftex-display-copied-context-hook)
797 (setq buffer-read-only t))))))
798
799 (defun reftex-varioref-vref ()
800 "Insert a reference using the `\\vref' macro from the varioref package."
801 (interactive)
802 (let ((reftex-format-ref-function 'reftex-format-vref))
803 (reftex-reference)))
804 (defun reftex-fancyref-fref ()
805 "Insert a reference using the `\\fref' macro from the fancyref package."
806 (interactive)
807 (let ((reftex-format-ref-function 'reftex-format-fref)
808 ;;(reftex-guess-label-type nil) ;FIXME do we want this????
809 )
810 (reftex-reference)))
811 (defun reftex-fancyref-Fref ()
812 "Insert a reference using the `\\Fref' macro from the fancyref package."
813 (interactive)
814 (let ((reftex-format-ref-function 'reftex-format-Fref)
815 ;;(reftex-guess-label-type nil) ;FIXME do we want this????
816 )
817 (reftex-reference)))
818
819 (defun reftex-format-vref (label fmt)
820 (while (string-match "\\\\ref{" fmt)
821 (setq fmt (replace-match "\\vref{" t t fmt)))
822 (format fmt label label))
823 (defun reftex-format-Fref (label def-fmt)
824 (format "\\Fref{%s}" label))
825 (defun reftex-format-fref (label def-fmt)
826 (format "\\fref{%s}" label))
827
828 (defun reftex-goto-label (&optional other-window)
829 "Prompt for a label (with completion) and jump to the location of this label.
830 Optional prefix argument OTHER-WINDOW goes to the label in another window."
831 (interactive "P")
832 (reftex-access-scan-info)
833 (let* ((wcfg (current-window-configuration))
834 (docstruct (symbol-value reftex-docstruct-symbol))
835 (label (completing-read "Label: " docstruct
836 (lambda (x) (stringp (car x))) t))
837 (selection (assoc label docstruct))
838 (where (progn
839 (reftex-show-label-location selection t nil 'stay)
840 (point-marker))))
841 (unless other-window
842 (set-window-configuration wcfg)
843 (switch-to-buffer (marker-buffer where))
844 (goto-char where))
845 (reftex-unhighlight 0)))
846
847
848
849 ;;; arch-tag: 52f14032-fb76-4d31-954f-750c72415675
850 ;;; reftex-ref.el ends here