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