lisp/textmodes/reftex-ref.el

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