lisp/textmodes/reftex-global.el

   1 ;;; reftex-global.el --- operations on entire documents with RefTeX
   2
   3 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
   4 ;;   2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Carsten Dominik <dominik@science.uva.nl>
   7 ;; Maintainer: auctex-devel@gnu.org
   8 ;; Version: 4.31
   9 ;; Package: reftex
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (eval-when-compile (require 'cl))
  31 (provide 'reftex-global)
  32 (require 'reftex)
  33 ;;;
  34
  35 (defun reftex-create-tags-file ()
  36   "Create TAGS file by running `etags' on the current document.
  37 The TAGS file is also immediately visited with `visit-tags-table'."
  38   (interactive)
  39   (reftex-access-scan-info current-prefix-arg)
  40   (let* ((master (reftex-TeX-master-file))
  41          (files  (reftex-all-document-files))
  42          (cmd    (format "etags %s" (mapconcat 'shell-quote-argument
  43                                                files " "))))
  44     (with-current-buffer (reftex-get-file-buffer-force master)
  45       (message "Running etags to create TAGS file...")
  46       (shell-command cmd)
  47       (visit-tags-table "TAGS"))))
  48
  49 ;; History of grep commands.
  50 (defvar reftex-grep-history nil)
  51 (defvar reftex-grep-command "grep -n "
  52   "Last grep command used in \\[reftex-grep-document]; default for next grep.")
  53
  54 (defun reftex-grep-document (grep-cmd)
  55   "Run grep query through all files related to this document.
  56 With prefix arg, force to rescan document.
  57 No active TAGS table is required."
  58
  59   (interactive
  60    (list (read-from-minibuffer "Run grep on document (like this): "
  61                                reftex-grep-command nil nil
  62                                'reftex-grep-history)))
  63   (reftex-access-scan-info current-prefix-arg)
  64   (let* ((files  (reftex-all-document-files t))
  65          (cmd    (format
  66                   "%s %s" grep-cmd
  67                   (mapconcat 'identity files " "))))
  68     (grep cmd)))
  69
  70 (defun reftex-search-document (&optional regexp)
  71   "Regexp search through all files of the current document.
  72 Starts always in the master file.  Stops when a match is found.
  73 To continue searching for next match, use command \\[tags-loop-continue].
  74 No active TAGS table is required."
  75   (interactive)
  76   (let ((default (reftex-this-word)))
  77     (unless regexp
  78       (setq regexp (read-string (format "Search regexp in document [%s]: "
  79                                         default))))
  80     (if (string= regexp "") (setq regexp (regexp-quote default)))
  81
  82     (reftex-access-scan-info current-prefix-arg)
  83     (tags-search regexp (list 'reftex-all-document-files))))
  84
  85 (defun reftex-query-replace-document (&optional from to delimited)
  86   "Do `query-replace-regexp' of FROM with TO over the entire document.
  87 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
  88 If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
  89 with the command \\[tags-loop-continue].
  90 No active TAGS table is required."
  91   (interactive)
  92   (let ((default (reftex-this-word)))
  93     (unless from
  94       (setq from (read-string (format "Replace regexp in document [%s]: "
  95                                       default)))
  96       (if (string= from "") (setq from (regexp-quote default))))
  97     (unless to
  98       (setq to (read-string (format "Replace regexp %s with: " from))))
  99     (reftex-access-scan-info current-prefix-arg)
 100     (tags-query-replace from to (or delimited current-prefix-arg)
 101                         (list 'reftex-all-document-files))))
 102
 103 (defvar TeX-master)
 104 (defvar isearch-next-buffer-function)
 105
 106 (defun reftex-find-duplicate-labels ()
 107   "Produce a list of all duplicate labels in the document."
 108
 109   (interactive)
 110
 111   ;; Rescan the document to make sure
 112   (reftex-access-scan-info t)
 113
 114   (let ((master (reftex-TeX-master-file))
 115         (cnt 0)
 116         (dlist
 117          (mapcar
 118           (lambda (x)
 119             (let (x1)
 120               (cond
 121                ((memq (car x)
 122                       '(toc bof eof bib thebib label-numbers xr xr-doc
 123                             master-dir file-error bibview-cache appendix
 124                             is-multi index))
 125                 nil)
 126                (t
 127                 (setq x1 (reftex-all-assoc-string
 128                           (car x) (symbol-value reftex-docstruct-symbol)))
 129                 (if (< 1 (length x1))
 130                     (append (list (car x))
 131                             (mapcar (lambda(x)
 132                                       (abbreviate-file-name (nth 3 x)))
 133                                     x1))
 134                   (list nil))))))
 135           (reftex-uniquify-by-car (symbol-value reftex-docstruct-symbol)))))
 136
 137     (setq dlist (reftex-uniquify-by-car dlist))
 138     (if (null dlist) (error "No duplicate labels in document"))
 139     (switch-to-buffer-other-window "*Duplicate Labels*")
 140     (set (make-local-variable 'TeX-master) master)
 141     (erase-buffer)
 142     (insert "                MULTIPLE LABELS IN CURRENT DOCUMENT:\n")
 143     (insert
 144      " Move point to label and type `r' to run a query-replace on the label\n"
 145      " and its references.  Type `q' to exit this buffer.\n\n")
 146     (insert " LABEL               FILE\n")
 147     (insert " -------------------------------------------------------------\n")
 148     (use-local-map (make-sparse-keymap))
 149     (local-set-key [?q] (lambda () "Kill this buffer." (interactive)
 150                           (kill-buffer (current-buffer)) (delete-window)))
 151     (local-set-key [?r] 'reftex-change-label)
 152     (while dlist
 153       (when (and (car (car dlist))
 154                  (cdr (car dlist)))
 155         (incf cnt)
 156         (insert (mapconcat 'identity (car dlist) "\n    ") "\n"))
 157       (pop dlist))
 158     (goto-char (point-min))
 159     (when (= cnt 0)
 160       (kill-buffer (current-buffer))
 161       (delete-window)
 162       (message "Document does not contain duplicate labels."))))
 163
 164 (defun reftex-change-label (&optional from to)
 165   "Run `query-replace-regexp' of FROM with TO in all macro arguments.
 166 Works on the entire multifile document.
 167 If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
 168 with the command \\[tags-loop-continue].
 169 No active TAGS table is required."
 170   (interactive)
 171   (let ((default (reftex-this-word "-a-zA-Z0-9_*.:")))
 172     (unless from
 173       (setq from (read-string (format "Replace label globally [%s]: "
 174                                       default))))
 175     (if (string= from "") (setq from default))
 176     (unless to
 177       (setq to (read-string (format "Replace label %s with: "
 178                                     from))))
 179     (reftex-query-replace-document
 180      (concat "{" (regexp-quote from) "}")
 181      (format "{%s}" to))))
 182
 183 (defun reftex-renumber-simple-labels ()
 184   "Renumber all simple labels in the document to make them sequentially.
 185 Simple labels are the ones created by RefTeX, consisting only of the
 186 prefix and a number.  After the command completes, all these labels will
 187 have sequential numbers throughout the document.  Any references to
 188 the labels will be changed as well.  For this, RefTeX looks at the
 189 arguments of any macros which either start or end in the string `ref'.
 190 This command should be used with care, in particular in multifile
 191 documents.  You should not use it if another document refers to this
 192 one with the `xr' package."
 193   (interactive)
 194   ;; Resan the entire document
 195   (reftex-access-scan-info 1)
 196   ;; Get some insurance
 197   (if (and (reftex-is-multi)
 198            (not (yes-or-no-p "Replacing all simple labels in multiple files is risky.  Continue? ")))
 199       (error "Abort"))
 200   ;; Make the translation list
 201   (let* ((re-core (concat "\\("
 202                           (mapconcat 'cdr reftex-typekey-to-prefix-alist "\\|")
 203                           "\\)"))
 204          (label-re (concat "\\`" re-core "\\([0-9]+\\)\\'"))
 205          (search-re (concat "[{,]\\(" re-core "\\([0-9]+\\)\\)[,}]"))
 206          (error-fmt "Undefined label or reference %s. Ignore and continue? ")
 207          (label-numbers-alist (mapcar (lambda (x) (cons (cdr x) 0))
 208                                       reftex-typekey-to-prefix-alist))
 209          (files (reftex-all-document-files))
 210          (list (symbol-value reftex-docstruct-symbol))
 211          translate-alist n entry label new-label nr-cell changed-sequence)
 212
 213     (while (setq entry (pop list))
 214       (when (and (stringp (car entry))
 215                  (string-match label-re (car entry)))
 216         (setq label (car entry)
 217               nr-cell (assoc (match-string 1 (car entry))
 218                              label-numbers-alist))
 219         (if (assoc label translate-alist)
 220             (error "Duplicate label %s" label))
 221         (setq new-label (concat (match-string 1 (car entry))
 222                                 (int-to-string (incf (cdr nr-cell)))))
 223         (push (cons label new-label) translate-alist)
 224         (or (string= label new-label) (setq changed-sequence t))))
 225
 226     (unless changed-sequence
 227       (error "Simple labels are already in correct sequence"))
 228
 229     (reftex-ensure-write-access (reftex-all-document-files))
 230
 231     ;; Save all document buffers before this operation
 232     (reftex-save-all-document-buffers)
 233
 234     ;; First test to check for erros
 235     (setq n (reftex-translate
 236              files search-re translate-alist error-fmt 'test))
 237
 238     ;; Now the real thing.
 239     (if (yes-or-no-p
 240          (format "Replace %d items at %d places in %d files? "
 241                  (length translate-alist) n (length files)))
 242         (progn
 243           (let ((inhibit-quit t))  ;; Do not disturb...
 244             (reftex-translate
 245              files search-re translate-alist error-fmt nil)
 246             (setq quit-flag nil))
 247           (if (and (reftex-is-multi)
 248                    (yes-or-no-p "Save entire document? "))
 249               (reftex-save-all-document-buffers))
 250           ;; Rescan again...
 251           (reftex-access-scan-info 1)
 252           (message "Done replacing simple labels."))
 253       (message "No replacements done"))))
 254
 255 (defun reftex-translate (files search-re translate-alist error-fmt test)
 256   ;; In FILES, look for SEARCH-RE and replace match 1 of it with
 257   ;; its association in TRANSLATE-ALSIT.
 258   ;; If we do not find an association and TEST is non-nil, query
 259   ;; to ignore the problematic string.
 260   ;; If TEST is nil, it is ignored without query.
 261   ;; Return the number of replacements.
 262   (let ((n 0) file label match-data buf macro pos cell)
 263     (while (setq file (pop files))
 264       (setq buf (reftex-get-file-buffer-force file))
 265       (unless buf
 266         (error "No such file %s" file))
 267       (set-buffer buf)
 268       (save-excursion
 269         (save-restriction
 270           (widen)
 271           (goto-char (point-min))
 272           (while (re-search-forward search-re nil t)
 273             (backward-char)
 274             (save-excursion
 275               (setq label (reftex-match-string 1)
 276                     cell (assoc label translate-alist)
 277                     match-data (match-data)
 278                     macro (reftex-what-macro 1)
 279                     pos (cdr macro))
 280               (goto-char (or pos (point)))
 281               (when (and macro
 282                          (or (looking-at "\\\\ref")
 283                              (looking-at "\\\\[a-zA-Z]*ref\\(range\\)?[^a-zA-Z]")
 284                              (looking-at "\\\\ref[a-zA-Z]*[^a-zA-Z]")
 285                              (looking-at (format
 286                                           reftex-find-label-regexp-format
 287                                           (regexp-quote label)))))
 288                 ;; OK, we should replace it.
 289                 (set-match-data match-data)
 290                 (cond
 291                  ((and test (not cell))
 292                   ;; We've got a problem
 293                   (unwind-protect
 294                       (progn
 295                         (reftex-highlight 1 (match-beginning 0) (match-end 0))
 296                         (ding)
 297                         (or (y-or-n-p (format error-fmt label))
 298                             (error "Abort")))
 299                     (reftex-unhighlight 1)))
 300                  ((and test cell)
 301                   (incf n))
 302                  ((and (not test) cell)
 303                   ;; Replace
 304                   (goto-char (match-beginning 1))
 305                   (delete-region (match-beginning 1) (match-end 1))
 306                   (insert (cdr cell)))
 307                  (t nil))))))))
 308     n))
 309
 310 (defun reftex-save-all-document-buffers ()
 311   "Save all documents associated with the current document.
 312 The function is useful after a global action like replacing or renumbering
 313 labels."
 314   (interactive)
 315   (let ((files (reftex-all-document-files))
 316         file buffer)
 317     (save-current-buffer
 318       (while (setq file (pop files))
 319         (setq buffer (reftex-get-buffer-visiting file))
 320         (when buffer
 321           (set-buffer buffer)
 322           (save-buffer))))))
 323
 324 (defun reftex-ensure-write-access (files)
 325   "Make sure we have write access to all files in FILES.
 326 Also checks if buffers visiting the files are in read-only mode."
 327   (let (file buf)
 328     (while (setq file (pop files))
 329       (unless (file-exists-p file)
 330         (ding)
 331         (or (y-or-n-p (format "No such file %s. Continue? " file))
 332             (error "Abort")))
 333       (unless (file-writable-p file)
 334         (ding)
 335         (or (y-or-n-p (format "No write access to %s. Continue? " file))
 336             (error "Abort")))
 337       (when (and (setq buf (reftex-get-buffer-visiting file))
 338                  (with-current-buffer buf
 339                    buffer-read-only))
 340         (ding)
 341         (or (y-or-n-p (format "Buffer %s is read-only. Continue? "
 342                               (buffer-name buf)))
 343             (error "Abort"))))))
 344
 345 ;;; Multi-file RefTeX Isearch
 346
 347 ;; `reftex-isearch-wrap-function', `reftex-isearch-push-state-function',
 348 ;; `reftex-isearch-pop-state-function', `reftex-isearch-isearch-search'
 349 ;; functions remain here only for backward-compatibility with Emacs 22
 350 ;; and are obsolete since Emacs 23 that supports a single function
 351 ;; variable `multi-isearch-next-buffer-function'.
 352
 353 (defun reftex-isearch-wrap-function ()
 354   (if (not isearch-word)
 355       (switch-to-buffer
 356        (funcall isearch-next-buffer-function (current-buffer) t)))
 357   (goto-char (if isearch-forward (point-min) (point-max))))
 358
 359 (defun reftex-isearch-push-state-function ()
 360   `(lambda (cmd)
 361      (reftex-isearch-pop-state-function cmd ,(current-buffer))))
 362
 363 (defun reftex-isearch-pop-state-function (cmd buffer)
 364   (switch-to-buffer buffer))
 365
 366 (defun reftex-isearch-isearch-search (string bound noerror)
 367   (let ((nxt-buff nil)
 368         (search-fun
 369          (cond
 370           (isearch-word
 371            (if isearch-forward 'word-search-forward 'word-search-backward))
 372           (isearch-regexp
 373            (if isearch-forward 're-search-forward 're-search-backward))
 374           (t
 375            (if isearch-forward 'search-forward 'search-backward)))))
 376     (or
 377      (funcall search-fun string bound noerror)
 378      (unless bound
 379        (condition-case nil
 380            (when isearch-next-buffer-function
 381              (while (not (funcall search-fun string bound noerror))
 382                (cond
 383                 (isearch-forward
 384                  (setq nxt-buff
 385                        (funcall isearch-next-buffer-function
 386                                 (current-buffer)))
 387                  (if (not nxt-buff)
 388                      (progn
 389                        (error "Wrap forward"))
 390                    (switch-to-buffer nxt-buff)
 391                    (goto-char (point-min))))
 392                 (t
 393                  (setq nxt-buff
 394                        (funcall isearch-next-buffer-function
 395                                          (current-buffer)))
 396                  (if (not nxt-buff)
 397                      (progn
 398                        (error "Wrap backward"))
 399                    (switch-to-buffer nxt-buff)
 400                    (goto-char (point-max))))))
 401              (point))
 402          (error nil))))))
 403
 404 ;; This function is called when isearch reaches the end of a
 405 ;; buffer. For reftex what we want to do is not wrap to the
 406 ;; beginning, but switch to the next buffer in the logical order of
 407 ;; the document.  This function looks through list of files in the
 408 ;; document (reftex-all-document-files), searches for the current
 409 ;; buffer and switches to the next/previous one in the logical order
 410 ;; of the document.  If WRAPP is true then wrap the search to the
 411 ;; beginning/end of the file list, depending of the search direction.
 412 (defun reftex-isearch-switch-to-next-file (crt-buf &optional wrapp)
 413   (reftex-access-scan-info)
 414   (let ((cb (buffer-file-name crt-buf))
 415         (flist (reftex-all-document-files)))
 416     (when flist
 417       (if wrapp
 418           (unless isearch-forward
 419               (setq flist (last flist)))
 420         (unless isearch-forward
 421           (setq flist (reverse flist)))
 422         (while (not (string= (car flist) cb))
 423           (setq flist (cdr flist)))
 424         (setq flist (cdr flist)))
 425       (when flist
 426         (find-file-noselect (car flist))))))
 427
 428 ;;;###autoload
 429 (defun reftex-isearch-minor-mode (&optional arg)
 430   "When on, isearch searches the whole document, not only the current file.
 431 This minor mode allows isearch to search through all the files of
 432 the current TeX document.
 433
 434 With no argument, this command toggles
 435 `reftex-isearch-minor-mode'.  With a prefix argument ARG, turn
 436 `reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off."
 437   (interactive "P")
 438   (let ((old-reftex-isearch-minor-mode reftex-isearch-minor-mode))
 439     (setq reftex-isearch-minor-mode
 440           (not (or (and (null arg) reftex-isearch-minor-mode)
 441                    (<= (prefix-numeric-value arg) 0))))
 442     (unless (eq reftex-isearch-minor-mode old-reftex-isearch-minor-mode)
 443       (if reftex-isearch-minor-mode
 444           (progn
 445             (dolist (crt-buf (buffer-list))
 446               (with-current-buffer crt-buf
 447                 (when reftex-mode
 448                   (if (boundp 'multi-isearch-next-buffer-function)
 449                       (set (make-local-variable 'multi-isearch-next-buffer-function)
 450                            'reftex-isearch-switch-to-next-file)
 451                     (set (make-local-variable 'isearch-wrap-function)
 452                          'reftex-isearch-wrap-function)
 453                     (set (make-local-variable 'isearch-search-fun-function)
 454                          (lambda () 'reftex-isearch-isearch-search))
 455                     (set (make-local-variable 'isearch-push-state-function)
 456                          'reftex-isearch-push-state-function)
 457                     (set (make-local-variable 'isearch-next-buffer-function)
 458                          'reftex-isearch-switch-to-next-file))
 459                   (setq reftex-isearch-minor-mode t))))
 460             (add-hook 'reftex-mode-hook 'reftex-isearch-minor-mode))
 461         (dolist (crt-buf (buffer-list))
 462           (with-current-buffer crt-buf
 463             (when reftex-mode
 464               (if (boundp 'multi-isearch-next-buffer-function)
 465                   (kill-local-variable 'multi-isearch-next-buffer-function)
 466                 (kill-local-variable 'isearch-wrap-function)
 467                 (kill-local-variable 'isearch-search-fun-function)
 468                 (kill-local-variable 'isearch-push-state-function)
 469                 (kill-local-variable 'isearch-next-buffer-function))
 470               (setq reftex-isearch-minor-mode nil))))
 471         (remove-hook 'reftex-mode-hook 'reftex-isearch-minor-mode)))
 472     ;; Force modeline redisplay.
 473     (set-buffer-modified-p (buffer-modified-p))))
 474
 475 (add-minor-mode 'reftex-isearch-minor-mode "/I" nil nil
 476                 'reftex-isearch-minor-mode)
 477
 478 ;; arch-tag: 2dbf7633-92c8-4340-8656-7aa019d0f80d
 479 ;;; reftex-global.el ends here