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