lisp/textmodes/reftex-global.el

   1 ;;; reftex-global.el --- operations on entire documents with RefTeX
   2 ;; Copyright (c) 1997, 1998, 1999, 2000, 2003 Free Software Foundation, Inc.
   3
   4 ;; Author: Carsten Dominik <dominik@science.uva.nl>
   5 ;; Version: 4.21
   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-global)
  30 (require 'reftex)
  31 ;;;
  32
  33 (defun reftex-create-tags-file ()
  34   "Create TAGS file by running `etags' on the current document.
  35 The TAGS file is also immediately visited with `visit-tags-table'."
  36   (interactive)
  37   (reftex-access-scan-info current-prefix-arg)
  38   (let* ((master (reftex-TeX-master-file))
  39          (files  (reftex-all-document-files))
  40          (cmd    (format "etags %s" (mapconcat 'identity files " "))))
  41     (save-excursion
  42       (set-buffer (reftex-get-file-buffer-force master))
  43       (message "Running etags to create TAGS file...")
  44       (shell-command cmd)
  45       (visit-tags-table "TAGS"))))
  46
  47 ;; History of grep commands.
  48 (defvar reftex-grep-history nil)
  49 (defvar reftex-grep-command "grep -n "
  50   "Last grep command used in \\[reftex-grep-document]; default for next grep.")
  51
  52 (defun reftex-grep-document (grep-cmd)
  53   "Run grep query through all files related to this document.
  54 With prefix arg, force to rescan document.
  55 No active TAGS table is required."
  56
  57   (interactive
  58    (list (read-from-minibuffer "Run grep on document (like this): "
  59                                reftex-grep-command nil nil
  60                                'reftex-grep-history)))
  61   (reftex-access-scan-info current-prefix-arg)
  62   (let* ((files  (reftex-all-document-files t))
  63          (cmd    (format
  64                   "%s %s" grep-cmd
  65                   (mapconcat 'identity files " "))))
  66     (grep cmd)))
  67
  68 (defun reftex-search-document (&optional regexp)
  69   "Regexp search through all files of the current document.
  70 Starts always in the master file.  Stops when a match is found.
  71 To continue searching for next match, use command \\[tags-loop-continue].
  72 No active TAGS table is required."
  73   (interactive)
  74   (let ((default (reftex-this-word)))
  75     (unless regexp
  76       (setq regexp (read-string (format "Search regexp in document [%s]: "
  77                                         default))))
  78     (if (string= regexp "") (setq regexp (regexp-quote default)))
  79
  80     (reftex-access-scan-info current-prefix-arg)
  81     (tags-search regexp (list 'reftex-all-document-files))))
  82
  83 (defun reftex-query-replace-document (&optional from to delimited)
  84   "Do `query-replace-regexp' of FROM with TO over the entire document.
  85 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
  86 If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
  87 with the command \\[tags-loop-continue].
  88 No active TAGS table is required."
  89   (interactive)
  90   (let ((default (reftex-this-word)))
  91     (unless from
  92       (setq from (read-string (format "Replace regexp in document [%s]: "
  93                                       default)))
  94       (if (string= from "") (setq from (regexp-quote default))))
  95     (unless to
  96       (setq to (read-string (format "Replace regexp %s with: " from))))
  97     (reftex-access-scan-info current-prefix-arg)
  98     (tags-query-replace from to (or delimited current-prefix-arg)
  99                         (list 'reftex-all-document-files))))
 100
 101 (defun reftex-find-duplicate-labels ()
 102   "Produce a list of all duplicate labels in the document."
 103
 104   (interactive)
 105
 106   ;; Rescan the document to make sure
 107   (reftex-access-scan-info t)
 108
 109   (let ((master (reftex-TeX-master-file))
 110         (cnt 0)
 111         (dlist
 112          (mapcar
 113           (lambda (x)
 114             (let (x1)
 115               (cond
 116                ((memq (car x)
 117                       '(toc bof eof bib thebib label-numbers xr xr-doc
 118                             master-dir file-error bibview-cache appendix
 119                             is-multi index))
 120                 nil)
 121                (t
 122                 (setq x1 (reftex-all-assoc-string
 123                           (car x) (symbol-value reftex-docstruct-symbol)))
 124                 (if (< 1 (length x1))
 125                     (append (list (car x))
 126                             (mapcar (lambda(x)
 127                                       (abbreviate-file-name (nth 3 x)))
 128                                     x1))
 129                   (list nil))))))
 130           (reftex-uniquify-by-car (symbol-value reftex-docstruct-symbol)))))
 131
 132     (setq dlist (reftex-uniquify-by-car dlist))
 133     (if (null dlist) (error "No duplicate labels in document"))
 134     (switch-to-buffer-other-window "*Duplicate Labels*")
 135     (set (make-local-variable 'TeX-master) master)
 136     (erase-buffer)
 137     (insert "                MULTIPLE LABELS IN CURRENT DOCUMENT:\n")
 138     (insert
 139      " Move point to label and type `r' to run a query-replace on the label\n"
 140      " and its references.  Type `q' to exit this buffer.\n\n")
 141     (insert " LABEL               FILE\n")
 142     (insert " -------------------------------------------------------------\n")
 143     (use-local-map (make-sparse-keymap))
 144     (local-set-key [?q] (lambda () "Kill this buffer." (interactive)
 145                           (kill-buffer (current-buffer)) (delete-window)))
 146     (local-set-key [?r] 'reftex-change-label)
 147     (while dlist
 148       (when (and (car (car dlist))
 149                  (cdr (car dlist)))
 150         (incf cnt)
 151         (insert (mapconcat 'identity (car dlist) "\n    ") "\n"))
 152       (pop dlist))
 153     (goto-char (point-min))
 154     (when (= cnt 0)
 155       (kill-buffer (current-buffer))
 156       (delete-window)
 157       (message "Document does not contain duplicate labels."))))
 158
 159 (defun reftex-change-label (&optional from to)
 160   "Run `query-replace-regexp' of FROM with TO in all macro arguments.
 161 Works on the entire multifile document.
 162 If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
 163 with the command \\[tags-loop-continue].
 164 No active TAGS table is required."
 165   (interactive)
 166   (let ((default (reftex-this-word "-a-zA-Z0-9_*.:")))
 167     (unless from
 168       (setq from (read-string (format "Replace label globally [%s]: "
 169                                       default))))
 170     (if (string= from "") (setq from default))
 171     (unless to
 172       (setq to (read-string (format "Replace label %s with: "
 173                                     from))))
 174     (reftex-query-replace-document
 175      (concat "{" (regexp-quote from) "}")
 176      (format "{%s}" to))))
 177
 178 (defun reftex-renumber-simple-labels ()
 179   "Renumber all simple labels in the document to make them sequentially.
 180 Simple labels are the ones created by RefTeX, consisting only of the
 181 prefix and a number.  After the command completes, all these labels will
 182 have sequential numbers throughout the document.  Any references to
 183 the labels will be changed as well.  For this, RefTeX looks at the
 184 arguments of any macros which either start or end in the string `ref'.
 185 This command should be used with care, in particular in multifile
 186 documents.  You should not use it if another document refers to this
 187 one with the `xr' package."
 188   (interactive)
 189   ;; Resan the entire document
 190   (reftex-access-scan-info 1)
 191   ;; Get some insurance
 192   (if (and (reftex-is-multi)
 193            (not (yes-or-no-p "Replacing all simple labels in multiple files is risky.  Continue? ")))
 194       (error "Abort"))
 195   ;; Make the translation list
 196   (let* ((re-core (concat "\\("
 197                           (mapconcat 'cdr reftex-typekey-to-prefix-alist "\\|")
 198                           "\\)"))
 199          (label-re (concat "\\`" re-core "\\([0-9]+\\)\\'"))
 200          (search-re (concat "[{,]\\(" re-core "\\([0-9]+\\)\\)[,}]"))
 201          (error-fmt "Undefined label or reference %s. Ignore and continue? ")
 202          (label-numbers-alist (mapcar (lambda (x) (cons (cdr x) 0))
 203                                       reftex-typekey-to-prefix-alist))
 204          (files (reftex-all-document-files))
 205          (list (symbol-value reftex-docstruct-symbol))
 206          translate-alist n entry label new-label nr-cell changed-sequence)
 207
 208     (while (setq entry (pop list))
 209       (when (and (stringp (car entry))
 210                  (string-match label-re (car entry)))
 211         (setq label (car entry)
 212               nr-cell (assoc (match-string 1 (car entry))
 213                              label-numbers-alist))
 214         (if (assoc label translate-alist)
 215             (error "Duplicate label %s" label))
 216         (setq new-label (concat (match-string 1 (car entry))
 217                                 (int-to-string (incf (cdr nr-cell)))))
 218         (push (cons label new-label) translate-alist)
 219         (or (string= label new-label) (setq changed-sequence t))))
 220
 221     (unless changed-sequence
 222       (error "Simple labels are already in correct sequence"))
 223
 224     (reftex-ensure-write-access (reftex-all-document-files))
 225
 226     ;; Save all document buffers before this operation
 227     (reftex-save-all-document-buffers)
 228
 229     ;; First test to check for erros
 230     (setq n (reftex-translate
 231              files search-re translate-alist error-fmt 'test))
 232
 233     ;; Now the real thing.
 234     (if (yes-or-no-p
 235          (format "Replace %d items at %d places in %d files? "
 236                  (length translate-alist) n (length files)))
 237         (progn
 238           (let ((inhibit-quit t))  ;; Do not disturb...
 239             (reftex-translate
 240              files search-re translate-alist error-fmt nil)
 241             (setq quit-flag nil))
 242           (if (and (reftex-is-multi)
 243                    (yes-or-no-p "Save entire document? "))
 244               (reftex-save-all-document-buffers))
 245           ;; Rescan again...
 246           (reftex-access-scan-info 1)
 247           (message "Done replacing simple labels."))
 248       (message "No replacements done"))))
 249
 250 (defun reftex-translate (files search-re translate-alist error-fmt test)
 251   ;; In FILES, look for SEARCH-RE and replace match 1 of it with
 252   ;; its association in TRANSLATE-ALSIT.
 253   ;; If we do not find an association and TEST is non-nil, query
 254   ;; to ignore the problematic string.
 255   ;; If TEST is nil, it is ignored without query.
 256   ;; Return the number of replacements.
 257   (let ((n 0) file label match-data buf macro pos cell)
 258     (while (setq file (pop files))
 259       (setq buf (reftex-get-file-buffer-force file))
 260       (unless buf
 261         (error "No such file %s" file))
 262       (set-buffer buf)
 263       (save-excursion
 264         (save-restriction
 265           (widen)
 266           (goto-char (point-min))
 267           (while (re-search-forward search-re nil t)
 268             (backward-char)
 269             (save-excursion
 270               (setq label (reftex-match-string 1)
 271                     cell (assoc label translate-alist)
 272                     match-data (match-data)
 273                     macro (reftex-what-macro 1)
 274                     pos (cdr macro))
 275               (goto-char (or pos (point)))
 276               (when (and macro
 277                          (or (looking-at "\\\\ref")
 278                              (looking-at "\\\\[a-zA-Z]*ref\\(range\\)?[^a-zA-Z]")
 279                              (looking-at "\\\\ref[a-zA-Z]*[^a-zA-Z]")
 280                              (looking-at (format
 281                                           reftex-find-label-regexp-format
 282                                           (regexp-quote label)))))
 283                 ;; OK, we should replace it.
 284                 (set-match-data match-data)
 285                 (cond
 286                  ((and test (not cell))
 287                   ;; We've got a problem
 288                   (unwind-protect
 289                       (progn
 290                         (reftex-highlight 1 (match-beginning 0) (match-end 0))
 291                         (ding)
 292                         (or (y-or-n-p (format error-fmt label))
 293                             (error "Abort")))
 294                     (reftex-unhighlight 1)))
 295                  ((and test cell)
 296                   (incf n))
 297                  ((and (not test) cell)
 298                   ;; Replace
 299                   (goto-char (match-beginning 1))
 300                   (delete-region (match-beginning 1) (match-end 1))
 301                   (insert (cdr cell)))
 302                  (t nil))))))))
 303     n))
 304
 305 (defun reftex-save-all-document-buffers ()
 306   "Save all documents associated with the current document.
 307 The function is useful after a global action like replacing or renumbering
 308 labels."
 309   (interactive)
 310   (let ((files (reftex-all-document-files))
 311         file buffer)
 312     (save-excursion
 313       (while (setq file (pop files))
 314         (setq buffer (reftex-get-buffer-visiting file))
 315         (when buffer
 316           (set-buffer buffer)
 317           (save-buffer))))))
 318
 319 (defun reftex-ensure-write-access (files)
 320   "Make sure we have write access to all files in FILES.
 321 Also checks if buffers visiting the files are in read-only mode."
 322   (let (file buf)
 323     (while (setq file (pop files))
 324       (unless (file-exists-p file)
 325         (ding)
 326         (or (y-or-n-p (format "No such file %s. Continue? " file))
 327             (error "Abort")))
 328       (unless (file-writable-p file)
 329         (ding)
 330         (or (y-or-n-p (format "No write access to %s. Continue? " file))
 331             (error "Abort")))
 332       (when (and (setq buf (reftex-get-buffer-visiting file))
 333                  (save-excursion
 334                    (set-buffer buf)
 335                    buffer-read-only))
 336         (ding)
 337         (or (y-or-n-p (format "Buffer %s is read-only. Continue? "
 338                               (buffer-name buf)))
 339             (error "Abort"))))))
 340
 341 ;;; arch-tag: 2dbf7633-92c8-4340-8656-7aa019d0f80d
 342 ;;; reftex-global.el ends here