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