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