aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2018-09-22 11:46:35 -0400
committerStefan Monnier2018-09-22 11:46:35 -0400
commit55ec674f5090f420c8982f5206e6566b5a664340 (patch)
treee38d5ca4c650db8ed0704ae9d20f3e935af89b05
parent3727bc7d599c24715a66de3e899a82b6f07d1aac (diff)
downloademacs-55ec674f5090f420c8982f5206e6566b5a664340.tar.gz
emacs-55ec674f5090f420c8982f5206e6566b5a664340.zip
* lisp/multifile.el: New file, extracted from etags.el
The main motivation for this change was the introduction of project-query-replace. dired's multi-file query&replace was implemented on top of etags.el even though it did not use TAGS in any way, so I moved this generic multifile code into its own package, with a nicer interface, and then used that in project.el. * lisp/progmodes/project.el (project-files): New generic function. (project-search, project-query-replace): New commands. * lisp/dired-aux.el (dired-do-search, dired-do-query-replace-regexp): Use multifile.el instead of etags.el. * lisp/progmodes/etags.el: Remove redundant :groups. (next-file-list): Remove var. (tags-loop-revert-buffers): Make it an obsolete alias. (next-file): Don't autoload (it can't do anything useful before some other etags.el function setup the multifile operation). (tags--all-files): New function, extracted from next-file. (tags-next-file): Rename from next-file. Rewrite using tags--all-files and multifile-next-file. (next-file): Keep it as an obsolete alias. (tags-loop-operate, tags-loop-scan): Mark as obsolete. (tags--compat-files, tags--compat-initialize): New function. (tags-loop-continue): Rewrite using multifile-continue. Mark as obsolete. (tags--last-search-operate-function): New var. (tags-search, tags-query-replace): Rewrite using multifile.el. * lisp/emacs-lisp/generator.el (iter-end-of-sequence): Use 'define-error'. (iter-make): New macro. (iter-empty): New iterator. * lisp/menu-bar.el (menu-bar-search-menu, menu-bar-replace-menu): tags-loop-continue -> multifile-continue.
-rw-r--r--lisp/dired-aux.el17
-rw-r--r--lisp/emacs-lisp/generator.el15
-rw-r--r--lisp/multifile.el217
-rw-r--r--lisp/progmodes/etags.el299
-rw-r--r--lisp/progmodes/project.el46
5 files changed, 397 insertions, 197 deletions
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 21ee50ce5cd..ce2ed13ad06 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -2832,7 +2832,7 @@ is part of a file name (i.e., has the text property `dired-filename')."
2832 "Search for a string through all marked files using Isearch." 2832 "Search for a string through all marked files using Isearch."
2833 (interactive) 2833 (interactive)
2834 (multi-isearch-files 2834 (multi-isearch-files
2835 (dired-get-marked-files nil nil 'dired-nondirectory-p nil t))) 2835 (dired-get-marked-files nil nil #'dired-nondirectory-p nil t)))
2836 2836
2837;;;###autoload 2837;;;###autoload
2838(defun dired-do-isearch-regexp () 2838(defun dired-do-isearch-regexp ()
@@ -2847,7 +2847,11 @@ is part of a file name (i.e., has the text property `dired-filename')."
2847Stops when a match is found. 2847Stops when a match is found.
2848To continue searching for next match, use command \\[tags-loop-continue]." 2848To continue searching for next match, use command \\[tags-loop-continue]."
2849 (interactive "sSearch marked files (regexp): ") 2849 (interactive "sSearch marked files (regexp): ")
2850 (tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p))) 2850 (multifile-initialize-search
2851 regexp
2852 (dired-get-marked-files nil nil #'dired-nondirectory-p)
2853 'default)
2854 (multifile-continue))
2851 2855
2852;;;###autoload 2856;;;###autoload
2853(defun dired-do-query-replace-regexp (from to &optional delimited) 2857(defun dired-do-query-replace-regexp (from to &optional delimited)
@@ -2860,13 +2864,16 @@ with the command \\[tags-loop-continue]."
2860 (query-replace-read-args 2864 (query-replace-read-args
2861 "Query replace regexp in marked files" t t))) 2865 "Query replace regexp in marked files" t t)))
2862 (list (nth 0 common) (nth 1 common) (nth 2 common)))) 2866 (list (nth 0 common) (nth 1 common) (nth 2 common))))
2863 (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p nil t)) 2867 (dolist (file (dired-get-marked-files nil nil #'dired-nondirectory-p nil t))
2864 (let ((buffer (get-file-buffer file))) 2868 (let ((buffer (get-file-buffer file)))
2865 (if (and buffer (with-current-buffer buffer 2869 (if (and buffer (with-current-buffer buffer
2866 buffer-read-only)) 2870 buffer-read-only))
2867 (error "File `%s' is visited read-only" file)))) 2871 (error "File `%s' is visited read-only" file))))
2868 (tags-query-replace from to delimited 2872 (multifile-initialize-replace
2869 '(dired-get-marked-files nil nil 'dired-nondirectory-p))) 2873 from to (dired-get-marked-files nil nil #'dired-nondirectory-p)
2874 (if (equal from (downcase from)) nil 'default)
2875 delimited)
2876 (multifile-continue))
2870 2877
2871(declare-function xref--show-xrefs "xref") 2878(declare-function xref--show-xrefs "xref")
2872(declare-function xref-query-replace-in-results "xref") 2879(declare-function xref-query-replace-in-results "xref")
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index 506df59d8e2..e38c7d91096 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -567,8 +567,11 @@ modified copy."
567 (unless ,normal-exit-symbol 567 (unless ,normal-exit-symbol
568 ,@unwind-forms)))))) 568 ,@unwind-forms))))))
569 569
570(put 'iter-end-of-sequence 'error-conditions '(iter-end-of-sequence)) 570(define-error 'iter-end-of-sequence "Iteration terminated"
571(put 'iter-end-of-sequence 'error-message "iteration terminated") 571 ;; FIXME: This was not defined originally as an `error' condition, so
572 ;; we reproduce this by passing itself as the parent, which avoids the
573 ;; default `error' parent. Maybe it *should* be in the `error' category?
574 'iter-end-of-sequence)
572 575
573(defun cps--make-close-iterator-form (terminal-state) 576(defun cps--make-close-iterator-form (terminal-state)
574 (if cps--cleanup-table-symbol 577 (if cps--cleanup-table-symbol
@@ -700,6 +703,14 @@ of values. Callers can retrieve each value using `iter-next'."
700 `(lambda ,arglist 703 `(lambda ,arglist
701 ,(cps-generate-evaluator body))) 704 ,(cps-generate-evaluator body)))
702 705
706(defmacro iter-make (&rest body)
707 "Return a new iterator."
708 (declare (debug t))
709 (cps-generate-evaluator body))
710
711(defconst iter-empty (lambda (_op _val) (signal 'iter-end-of-sequence nil))
712 "Trivial iterator that always signals the end of sequence.")
713
703(defun iter-next (iterator &optional yield-result) 714(defun iter-next (iterator &optional yield-result)
704 "Extract a value from an iterator. 715 "Extract a value from an iterator.
705YIELD-RESULT becomes the return value of `iter-yield' in the 716YIELD-RESULT becomes the return value of `iter-yield' in the
diff --git a/lisp/multifile.el b/lisp/multifile.el
new file mode 100644
index 00000000000..712da5cc774
--- /dev/null
+++ b/lisp/multifile.el
@@ -0,0 +1,217 @@
1;;; multifile.el --- Operations on multiple files -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2018 Free Software Foundation, Inc.
4
5;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6
7;; This program is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; This program is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see <https://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; Support functions for operations like search or query&replace applied to
23;; several files. This code was largely inspired&extracted from an earlier
24;; version of etags.el.
25
26;; TODO:
27;; - Maybe it would make sense to replace the multifile--* vars with a single
28;; global var holding a struct, and then stash those structs into a history
29;; of past operations, so you can perform a multifile-search while in the
30;; middle of a multifile-replace and later go back to that
31;; multifile-replace.
32;; - Make multi-isearch work on top of this library (might require changes
33;; to this library, of course).
34
35;;; Code:
36
37(require 'generator)
38
39(defgroup multifile nil
40 "Operations on multiple files."
41 :group 'tools)
42
43(defcustom multifile-revert-buffers 'silent
44 "Whether to revert files during multifile operation.
45 `silent' means to only do it if `revert-without-query' is applicable;
46 t means to offer to do it for all applicable files;
47 nil means never to do it"
48 :type '(choice (const silent) (const t) (const nil)))
49
50;; FIXME: This already exists in GNU ELPA's iterator.el. Maybe it should move
51;; to generator.el?
52(iter-defun multifile--list-to-iterator (list)
53 (while list (iter-yield (pop list))))
54
55(defvar multifile--iterator iter-empty)
56(defvar multifile--scan-function
57 (lambda () (user-error "No operation in progress")))
58(defvar multifile--operate-function #'ignore)
59(defvar multifile--freshly-initialized nil)
60
61;;;###autoload
62(defun multifile-initialize (files scan-function operate-function)
63 "Initialize a new round of operation on several files.
64FILES can be either a list of file names, or an iterator (used with `iter-next')
65which returns a file name at each step.
66SCAN-FUNCTION is a function called with no argument inside a buffer
67and it should return non-nil if that buffer has something on which to operate.
68OPERATE-FUNCTION is a function called with no argument; it is expected
69to perform the operation on the current file buffer and when done
70should return non-nil to mean that we should immediately continue
71operating on the next file and nil otherwise."
72 (setq multifile--iterator
73 (if (and (listp files) (not (functionp files)))
74 (multifile--list-to-iterator files)
75 files))
76 (setq multifile--scan-function scan-function)
77 (setq multifile--operate-function operate-function)
78 (setq multifile--freshly-initialized t))
79
80(defun multifile-next-file (&optional novisit)
81 ;; FIXME: Should we provide an interactive command, like tags-next-file?
82 (let ((next (condition-case nil
83 (iter-next multifile--iterator)
84 (iter-end-of-sequence nil))))
85 (unless next
86 (and novisit
87 (get-buffer " *next-file*")
88 (kill-buffer " *next-file*"))
89 (user-error "All files processed"))
90 (let* ((buffer (get-file-buffer next))
91 (new (not buffer)))
92 ;; Optionally offer to revert buffers
93 ;; if the files have changed on disk.
94 (and buffer multifile-revert-buffers
95 (not (verify-visited-file-modtime buffer))
96 (if (eq multifile-revert-buffers 'silent)
97 (and (not (buffer-modified-p buffer))
98 (let ((revertible nil))
99 (dolist (re revert-without-query)
100 (when (string-match-p re next)
101 (setq revertible t)))
102 revertible))
103 (y-or-n-p
104 (format
105 (if (buffer-modified-p buffer)
106 "File %s changed on disk. Discard your edits? "
107 "File %s changed on disk. Reread from disk? ")
108 next)))
109 (with-current-buffer buffer
110 (revert-buffer t t)))
111 (if (not (and new novisit))
112 (set-buffer (find-file-noselect next))
113 ;; Like find-file, but avoids random warning messages.
114 (set-buffer (get-buffer-create " *next-file*"))
115 (kill-all-local-variables)
116 (erase-buffer)
117 (setq new next)
118 (insert-file-contents new nil))
119 new)))
120
121(defun multifile-continue ()
122 "Continue last multi-file operation."
123 (interactive)
124 (let (new
125 ;; Non-nil means we have finished one file
126 ;; and should not scan it again.
127 file-finished
128 original-point
129 (messaged nil))
130 (while
131 (progn
132 ;; Scan files quickly for the first or next interesting one.
133 ;; This starts at point in the current buffer.
134 (while (or multifile--freshly-initialized file-finished
135 (save-restriction
136 (widen)
137 (not (funcall multifile--scan-function))))
138 ;; If nothing was found in the previous file, and
139 ;; that file isn't in a temp buffer, restore point to
140 ;; where it was.
141 (when original-point
142 (goto-char original-point))
143
144 (setq file-finished nil)
145 (setq new (multifile-next-file t))
146
147 ;; If NEW is non-nil, we got a temp buffer,
148 ;; and NEW is the file name.
149 (when (or messaged
150 (and (not multifile--freshly-initialized)
151 (> baud-rate search-slow-speed)
152 (setq messaged t)))
153 (message "Scanning file %s..." (or new buffer-file-name)))
154
155 (setq multifile--freshly-initialized nil)
156 (setq original-point (if new nil (point)))
157 (goto-char (point-min)))
158
159 ;; If we visited it in a temp buffer, visit it now for real.
160 (if new
161 (let ((pos (point)))
162 (erase-buffer)
163 (set-buffer (find-file-noselect new))
164 (setq new nil) ;No longer in a temp buffer.
165 (widen)
166 (goto-char pos))
167 (push-mark original-point t))
168
169 (switch-to-buffer (current-buffer))
170
171 ;; Now operate on the file.
172 ;; If value is non-nil, continue to scan the next file.
173 (save-restriction
174 (widen)
175 (funcall multifile--operate-function)))
176 (setq file-finished t))))
177
178;;;###autoload
179(defun multifile-initialize-search (regexp files case-fold)
180 (let ((last-buffer (current-buffer)))
181 (multifile-initialize
182 files
183 (lambda ()
184 (let ((case-fold-search
185 (if (memq case-fold '(t nil)) case-fold case-fold-search)))
186 (re-search-forward regexp nil t)))
187 (lambda ()
188 (unless (eq last-buffer (current-buffer))
189 (setq last-buffer (current-buffer))
190 (message "Scanning file %s...found" buffer-file-name))
191 nil))))
192
193;;;###autoload
194(defun multifile-initialize-replace (from to files case-fold &optional delimited)
195 "Initialize a new round of query&replace on several files.
196FROM is a regexp and TO is the replacement to use.
197FILES describes the file, as in `multifile-initialize'.
198CASE-FOLD can be t, nil, or `default', the latter one meaning to obey
199the default setting of `case-fold-search'.
200DELIMITED if non-nil means replace only word-delimited matches."
201 ;; FIXME: Not sure how the delimited-flag interacts with the regexp-flag in
202 ;; `perform-replace', so I just try to mimic the old code.
203 (multifile-initialize
204 files
205 (lambda ()
206 (let ((case-fold-search
207 (if (memql case-fold '(nil t)) case-fold case-fold-search)))
208 (if (re-search-forward from nil t)
209 ;; When we find a match, move back
210 ;; to the beginning of it so perform-replace
211 ;; will see it.
212 (goto-char (match-beginning 0)))))
213 (lambda ()
214 (perform-replace from to t t delimited nil multi-query-replace-map))))
215
216(provide 'multifile)
217;;; multifile.el ends here
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 4f07fe94855..6844e9b0f7c 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -26,9 +26,17 @@
26 26
27;;; Code: 27;;; Code:
28 28
29;; The namespacing of this package is a mess:
30;; - The file name is "etags", but the "exported" functionality doesn't use
31;; this name
32;; - Uses "etags-", "tags-", and "tag-" prefixes.
33;; - Many functions use "-tag-" or "-tags-", or even "-etags-" not as
34;; prefixes but somewhere within the name.
35
29(require 'ring) 36(require 'ring)
30(require 'button) 37(require 'button)
31(require 'xref) 38(require 'xref)
39(require 'multifile)
32 40
33;;;###autoload 41;;;###autoload
34(defvar tags-file-name nil 42(defvar tags-file-name nil
@@ -49,7 +57,6 @@ Use the `etags' program to make a tags table file.")
49 "Whether tags operations should be case-sensitive. 57 "Whether tags operations should be case-sensitive.
50A value of t means case-insensitive, a value of nil means case-sensitive. 58A value of t means case-insensitive, a value of nil means case-sensitive.
51Any other value means use the setting of `case-fold-search'." 59Any other value means use the setting of `case-fold-search'."
52 :group 'etags
53 :type '(choice (const :tag "Case-sensitive" nil) 60 :type '(choice (const :tag "Case-sensitive" nil)
54 (const :tag "Case-insensitive" t) 61 (const :tag "Case-insensitive" t)
55 (other :tag "Use default" default)) 62 (other :tag "Use default" default))
@@ -63,7 +70,6 @@ An element that is a directory means the file \"TAGS\" in that directory.
63To switch to a new list of tags tables, setting this variable is sufficient. 70To switch to a new list of tags tables, setting this variable is sufficient.
64If you set this variable, do not also set `tags-file-name'. 71If you set this variable, do not also set `tags-file-name'.
65Use the `etags' program to make a tags table file." 72Use the `etags' program to make a tags table file."
66 :group 'etags
67 :type '(repeat file)) 73 :type '(repeat file))
68 74
69;;;###autoload 75;;;###autoload
@@ -72,8 +78,7 @@ Use the `etags' program to make a tags table file."
72 "List of extensions tried by etags when `auto-compression-mode' is on. 78 "List of extensions tried by etags when `auto-compression-mode' is on.
73An empty string means search the non-compressed file." 79An empty string means search the non-compressed file."
74 :version "24.1" ; added xz 80 :version "24.1" ; added xz
75 :type '(repeat string) 81 :type '(repeat string))
76 :group 'etags)
77 82
78;; !!! tags-compression-info-list should probably be replaced by access 83;; !!! tags-compression-info-list should probably be replaced by access
79;; to directory list and matching jka-compr-compression-info-list. Currently, 84;; to directory list and matching jka-compr-compression-info-list. Currently,
@@ -91,14 +96,12 @@ An empty string means search the non-compressed file."
91t means do; nil means don't (always start a new list). 96t means do; nil means don't (always start a new list).
92Any other value means ask the user whether to add a new tags table 97Any other value means ask the user whether to add a new tags table
93to the current list (as opposed to starting a new list)." 98to the current list (as opposed to starting a new list)."
94 :group 'etags
95 :type '(choice (const :tag "Do" t) 99 :type '(choice (const :tag "Do" t)
96 (const :tag "Don't" nil) 100 (const :tag "Don't" nil)
97 (other :tag "Ask" ask-user))) 101 (other :tag "Ask" ask-user)))
98 102
99(defcustom tags-revert-without-query nil 103(defcustom tags-revert-without-query nil
100 "Non-nil means reread a TAGS table without querying, if it has changed." 104 "Non-nil means reread a TAGS table without querying, if it has changed."
101 :group 'etags
102 :type 'boolean) 105 :type 'boolean)
103 106
104(defvar tags-table-computed-list nil 107(defvar tags-table-computed-list nil
@@ -131,7 +134,6 @@ Each element is a list of strings which are file names.")
131 "Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'. 134 "Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
132The value in the buffer in which \\[find-tag] is done is used, 135The value in the buffer in which \\[find-tag] is done is used,
133not the value in the buffer \\[find-tag] goes to." 136not the value in the buffer \\[find-tag] goes to."
134 :group 'etags
135 :type 'hook) 137 :type 'hook)
136 138
137;;;###autoload 139;;;###autoload
@@ -140,7 +142,6 @@ not the value in the buffer \\[find-tag] goes to."
140If nil, and the symbol that is the value of `major-mode' 142If nil, and the symbol that is the value of `major-mode'
141has a `find-tag-default-function' property (see `put'), that is used. 143has a `find-tag-default-function' property (see `put'), that is used.
142Otherwise, `find-tag-default' is used." 144Otherwise, `find-tag-default' is used."
143 :group 'etags
144 :type '(choice (const nil) function)) 145 :type '(choice (const nil) function))
145 146
146(define-obsolete-variable-alias 'find-tag-marker-ring-length 147(define-obsolete-variable-alias 'find-tag-marker-ring-length
@@ -148,13 +149,11 @@ Otherwise, `find-tag-default' is used."
148 149
149(defcustom tags-tag-face 'default 150(defcustom tags-tag-face 'default
150 "Face for tags in the output of `tags-apropos'." 151 "Face for tags in the output of `tags-apropos'."
151 :group 'etags
152 :type 'face 152 :type 'face
153 :version "21.1") 153 :version "21.1")
154 154
155(defcustom tags-apropos-verbose nil 155(defcustom tags-apropos-verbose nil
156 "If non-nil, print the name of the tags file in the *Tags List* buffer." 156 "If non-nil, print the name of the tags file in the *Tags List* buffer."
157 :group 'etags
158 :type 'boolean 157 :type 'boolean
159 :version "21.1") 158 :version "21.1")
160 159
@@ -175,7 +174,6 @@ Example value:
175 ((\"Emacs Lisp\" Info-goto-emacs-command-node obarray) 174 ((\"Emacs Lisp\" Info-goto-emacs-command-node obarray)
176 (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray) 175 (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray)
177 (\"SCWM\" scwm-documentation scwm-obarray))" 176 (\"SCWM\" scwm-documentation scwm-obarray))"
178 :group 'etags
179 :type '(repeat (list (string :tag "Title") 177 :type '(repeat (list (string :tag "Title")
180 function 178 function
181 (sexp :tag "Tags to search"))) 179 (sexp :tag "Tags to search")))
@@ -209,9 +207,6 @@ use function `tags-table-files' to do so.")
209 207
210(defvar tags-included-tables nil 208(defvar tags-included-tables nil
211 "List of tags tables included by the current tags table.") 209 "List of tags tables included by the current tags table.")
212
213(defvar next-file-list nil
214 "List of files for \\[next-file] to process.")
215 210
216;; Hooks for file formats. 211;; Hooks for file formats.
217 212
@@ -328,10 +323,10 @@ file the tag was in."
328 323
329(defun tags-table-check-computed-list () 324(defun tags-table-check-computed-list ()
330 "Compute `tags-table-computed-list' from `tags-table-list' if necessary." 325 "Compute `tags-table-computed-list' from `tags-table-list' if necessary."
331 (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list))) 326 (let ((expanded-list (mapcar #'tags-expand-table-name tags-table-list)))
332 (or (equal tags-table-computed-list-for expanded-list) 327 (or (equal tags-table-computed-list-for expanded-list)
333 ;; The list (or default-directory) has changed since last computed. 328 ;; The list (or default-directory) has changed since last computed.
334 (let* ((compute-for (mapcar 'copy-sequence expanded-list)) 329 (let* ((compute-for (mapcar #'copy-sequence expanded-list))
335 (tables (copy-sequence compute-for)) ;Mutated in the loop. 330 (tables (copy-sequence compute-for)) ;Mutated in the loop.
336 (computed nil) 331 (computed nil)
337 table-buffer) 332 table-buffer)
@@ -351,7 +346,7 @@ file the tag was in."
351 (if (tags-included-tables) 346 (if (tags-included-tables)
352 ;; Insert the included tables into the list we 347 ;; Insert the included tables into the list we
353 ;; are processing. 348 ;; are processing.
354 (setcdr tables (nconc (mapcar 'tags-expand-table-name 349 (setcdr tables (nconc (mapcar #'tags-expand-table-name
355 (tags-included-tables)) 350 (tags-included-tables))
356 (cdr tables)))))) 351 (cdr tables))))))
357 ;; This table is not in core yet. Insert a placeholder 352 ;; This table is not in core yet. Insert a placeholder
@@ -502,7 +497,7 @@ buffers. If CORE-ONLY is nil, it is ignored."
502 ;; Select the tags table buffer and get the file list up to date. 497 ;; Select the tags table buffer and get the file list up to date.
503 (let ((tags-file-name (car tables))) 498 (let ((tags-file-name (car tables)))
504 (visit-tags-table-buffer 'same) 499 (visit-tags-table-buffer 'same)
505 (if (member this-file (mapcar 'expand-file-name 500 (if (member this-file (mapcar #'expand-file-name
506 (tags-table-files))) 501 (tags-table-files)))
507 ;; Found it. 502 ;; Found it.
508 (setq found tables)))) 503 (setq found tables))))
@@ -853,7 +848,7 @@ If no tags table is loaded, do nothing and return nil."
853(defun find-tag--default () 848(defun find-tag--default ()
854 (funcall (or find-tag-default-function 849 (funcall (or find-tag-default-function
855 (get major-mode 'find-tag-default-function) 850 (get major-mode 'find-tag-default-function)
856 'find-tag-default))) 851 #'find-tag-default)))
857 852
858(defvar last-tag nil 853(defvar last-tag nil
859 "Last tag found by \\[find-tag].") 854 "Last tag found by \\[find-tag].")
@@ -1698,18 +1693,14 @@ Point should be just after a string that matches TAG."
1698 (let ((bol (point))) 1693 (let ((bol (point)))
1699 (and (search-forward "\177" (line-end-position) t) 1694 (and (search-forward "\177" (line-end-position) t)
1700 (re-search-backward re bol t))))) 1695 (re-search-backward re bol t)))))
1701 1696(define-obsolete-variable-alias 'tags-loop-revert-buffers 'multifile-revert-buffers "27.1")
1702(defcustom tags-loop-revert-buffers nil
1703 "Non-nil means tags-scanning loops should offer to reread changed files.
1704These loops normally read each file into Emacs, but when a file
1705is already visited, they use the existing buffer.
1706When this flag is non-nil, they offer to revert the existing buffer
1707in the case where the file has changed since you visited it."
1708 :type 'boolean
1709 :group 'etags)
1710 1697
1711;;;###autoload 1698;;;###autoload
1712(defun next-file (&optional initialize novisit) 1699(defalias 'next-file 'tags-next-file)
1700(make-obsolete 'next-file
1701 "use tags-next-file or multifile-initialize and multifile-next-file instead" "27.1")
1702;;;###autoload
1703(defun tags-next-file (&optional initialize novisit)
1713 "Select next file among files in current tags table. 1704 "Select next file among files in current tags table.
1714 1705
1715A first argument of t (prefix arg, if interactive) initializes to the 1706A first argument of t (prefix arg, if interactive) initializes to the
@@ -1723,71 +1714,39 @@ Value is nil if the file was already visited;
1723if the file was newly read in, the value is the filename." 1714if the file was newly read in, the value is the filename."
1724 ;; Make the interactive arg t if there was any prefix arg. 1715 ;; Make the interactive arg t if there was any prefix arg.
1725 (interactive (list (if current-prefix-arg t))) 1716 (interactive (list (if current-prefix-arg t)))
1726 (cond ((not initialize) 1717 (when initialize ;; Not the first run.
1727 ;; Not the first run. 1718 (tags--compat-initialize initialize))
1728 ) 1719 (multifile-next-file novisit)
1729 ((eq initialize t) 1720 (switch-to-buffer (current-buffer)))
1730 ;; Initialize the list from the tags table.
1731 (save-excursion
1732 (let ((cbuf (current-buffer)))
1733 ;; Visit the tags table buffer to get its list of files.
1734 (visit-tags-table-buffer)
1735 ;; Copy the list so we can setcdr below, and expand the file
1736 ;; names while we are at it, in this buffer's default directory.
1737 (setq next-file-list (mapcar 'expand-file-name (tags-table-files)))
1738 ;; Iterate over all the tags table files, collecting
1739 ;; a complete list of referenced file names.
1740 (while (visit-tags-table-buffer t cbuf)
1741 ;; Find the tail of the working list and chain on the new
1742 ;; sublist for this tags table.
1743 (let ((tail next-file-list))
1744 (while (cdr tail)
1745 (setq tail (cdr tail)))
1746 ;; Use a copy so the next loop iteration will not modify the
1747 ;; list later returned by (tags-table-files).
1748 (if tail
1749 (setcdr tail (mapcar 'expand-file-name (tags-table-files)))
1750 (setq next-file-list (mapcar 'expand-file-name
1751 (tags-table-files)))))))))
1752 (t
1753 ;; Initialize the list by evalling the argument.
1754 (setq next-file-list (eval initialize))))
1755 (unless next-file-list
1756 (and novisit
1757 (get-buffer " *next-file*")
1758 (kill-buffer " *next-file*"))
1759 (user-error "All files processed"))
1760 (let* ((next (car next-file-list))
1761 (buffer (get-file-buffer next))
1762 (new (not buffer)))
1763 ;; Advance the list before trying to find the file.
1764 ;; If we get an error finding the file, don't get stuck on it.
1765 (setq next-file-list (cdr next-file-list))
1766 ;; Optionally offer to revert buffers
1767 ;; if the files have changed on disk.
1768 (and buffer tags-loop-revert-buffers
1769 (not (verify-visited-file-modtime buffer))
1770 (y-or-n-p
1771 (format
1772 (if (buffer-modified-p buffer)
1773 "File %s changed on disk. Discard your edits? "
1774 "File %s changed on disk. Reread from disk? ")
1775 next))
1776 (with-current-buffer buffer
1777 (revert-buffer t t)))
1778 (if (not (and new novisit))
1779 (find-file next)
1780 ;; Like find-file, but avoids random warning messages.
1781 (switch-to-buffer (get-buffer-create " *next-file*"))
1782 (kill-all-local-variables)
1783 (erase-buffer)
1784 (setq new next)
1785 (insert-file-contents new nil))
1786 new))
1787 1721
1722(defun tags--all-files ()
1723 (save-excursion
1724 (let ((cbuf (current-buffer))
1725 (files nil))
1726 ;; Visit the tags table buffer to get its list of files.
1727 (visit-tags-table-buffer)
1728 ;; Copy the list so we can setcdr below, and expand the file
1729 ;; names while we are at it, in this buffer's default directory.
1730 (setq files (mapcar #'expand-file-name (tags-table-files)))
1731 ;; Iterate over all the tags table files, collecting
1732 ;; a complete list of referenced file names.
1733 (while (visit-tags-table-buffer t cbuf)
1734 ;; Find the tail of the working list and chain on the new
1735 ;; sublist for this tags table.
1736 (let ((tail files))
1737 (while (cdr tail)
1738 (setq tail (cdr tail)))
1739 ;; Use a copy so the next loop iteration will not modify the
1740 ;; list later returned by (tags-table-files).
1741 (setf (if tail (cdr tail) files)
1742 (mapcar #'expand-file-name (tags-table-files)))))
1743 files)))
1744
1745(make-obsolete-variable 'tags-loop-operate 'multifile-initialize "27.1")
1788(defvar tags-loop-operate nil 1746(defvar tags-loop-operate nil
1789 "Form for `tags-loop-continue' to eval to change one file.") 1747 "Form for `tags-loop-continue' to eval to change one file.")
1790 1748
1749(make-obsolete-variable 'tags-loop-scan 'multifile-initialize "27.1")
1791(defvar tags-loop-scan 1750(defvar tags-loop-scan
1792 '(user-error "%s" 1751 '(user-error "%s"
1793 (substitute-command-keys 1752 (substitute-command-keys
@@ -1805,121 +1764,84 @@ Bind `case-fold-search' during the evaluation, depending on the value of
1805 case-fold-search))) 1764 case-fold-search)))
1806 (eval form))) 1765 (eval form)))
1807 1766
1767(defun tags--compat-files (files)
1768 (cond
1769 ((eq files t) (tags--all-files)) ;; Initialize the list from the tags table.
1770 ((functionp files) files)
1771 ((stringp (car-safe files)) files)
1772 (t
1773 ;; Backward compatibility <27.1
1774 ;; Initialize the list by evalling the argument.
1775 (eval files))))
1776
1777(defun tags--compat-initialize (initialize)
1778 (multifile-initialize
1779 (tags--compat-files initialize)
1780 (if tags-loop-operate
1781 (lambda () (tags-loop-eval tags-loop-operate))
1782 (lambda () (message "Scanning file %s...found" buffer-file-name) nil))
1783 (lambda () (tags-loop-eval tags-loop-scan))))
1808 1784
1809;;;###autoload 1785;;;###autoload
1810(defun tags-loop-continue (&optional first-time) 1786(defun tags-loop-continue (&optional first-time)
1811 "Continue last \\[tags-search] or \\[tags-query-replace] command. 1787 "Continue last \\[tags-search] or \\[tags-query-replace] command.
1812Used noninteractively with non-nil argument to begin such a command (the 1788Used noninteractively with non-nil argument to begin such a command (the
1813argument is passed to `next-file', which see). 1789argument is passed to `next-file', which see)."
1814 1790 ;; Two variables control the processing we do on each file: the value of
1815Two variables control the processing we do on each file: the value of 1791 ;; `tags-loop-scan' is a form to be executed on each file to see if it is
1816`tags-loop-scan' is a form to be executed on each file to see if it is 1792 ;; interesting (it returns non-nil if so) and `tags-loop-operate' is a form to
1817interesting (it returns non-nil if so) and `tags-loop-operate' is a form to 1793 ;; evaluate to operate on an interesting file. If the latter evaluates to
1818evaluate to operate on an interesting file. If the latter evaluates to 1794 ;; nil, we exit; otherwise we scan the next file.
1819nil, we exit; otherwise we scan the next file." 1795 (declare (obsolete multifile-continue "27.1"))
1820 (interactive) 1796 (interactive)
1821 (let (new 1797 (when first-time ;; Backward compatibility.
1822 ;; Non-nil means we have finished one file 1798 (tags--compat-initialize first-time))
1823 ;; and should not scan it again. 1799 (multifile-continue))
1824 file-finished
1825 original-point
1826 (messaged nil))
1827 (while
1828 (progn
1829 ;; Scan files quickly for the first or next interesting one.
1830 ;; This starts at point in the current buffer.
1831 (while (or first-time file-finished
1832 (save-restriction
1833 (widen)
1834 (not (tags-loop-eval tags-loop-scan))))
1835 ;; If nothing was found in the previous file, and
1836 ;; that file isn't in a temp buffer, restore point to
1837 ;; where it was.
1838 (when original-point
1839 (goto-char original-point))
1840
1841 (setq file-finished nil)
1842 (setq new (next-file first-time t))
1843
1844 ;; If NEW is non-nil, we got a temp buffer,
1845 ;; and NEW is the file name.
1846 (when (or messaged
1847 (and (not first-time)
1848 (> baud-rate search-slow-speed)
1849 (setq messaged t)))
1850 (message "Scanning file %s..." (or new buffer-file-name)))
1851
1852 (setq first-time nil)
1853 (setq original-point (if new nil (point)))
1854 (goto-char (point-min)))
1855 1800
1856 ;; If we visited it in a temp buffer, visit it now for real. 1801;; We use it to detect when the last loop was a tags-search.
1857 (if new 1802(defvar tags--last-search-operate-function nil)
1858 (let ((pos (point)))
1859 (erase-buffer)
1860 (set-buffer (find-file-noselect new))
1861 (setq new nil) ;No longer in a temp buffer.
1862 (widen)
1863 (goto-char pos))
1864 (push-mark original-point t))
1865
1866 (switch-to-buffer (current-buffer))
1867
1868 ;; Now operate on the file.
1869 ;; If value is non-nil, continue to scan the next file.
1870 (save-restriction
1871 (widen)
1872 (tags-loop-eval tags-loop-operate)))
1873 (setq file-finished t))
1874 (and messaged
1875 (null tags-loop-operate)
1876 (message "Scanning file %s...found" buffer-file-name))))
1877 1803
1878;;;###autoload 1804;;;###autoload
1879(defun tags-search (regexp &optional file-list-form) 1805(defun tags-search (regexp &optional files)
1880 "Search through all files listed in tags table for match for REGEXP. 1806 "Search through all files listed in tags table for match for REGEXP.
1881Stops when a match is found. 1807Stops when a match is found.
1882To continue searching for next match, use command \\[tags-loop-continue]. 1808To continue searching for next match, use command \\[tags-loop-continue].
1883 1809
1884If FILE-LIST-FORM is non-nil, it should be a form that, when 1810If FILES if non-nil should be a list or an iterator returning the files to search.
1885evaluated, will return a list of file names. The search will be 1811The search will be restricted to these files.
1886restricted to these files.
1887 1812
1888Also see the documentation of the `tags-file-name' variable." 1813Also see the documentation of the `tags-file-name' variable."
1889 (interactive "sTags search (regexp): ") 1814 (interactive "sTags search (regexp): ")
1890 (if (and (equal regexp "") 1815 (unless (and (equal regexp "")
1891 (eq (car tags-loop-scan) 're-search-forward) 1816 ;; FIXME: If some other multifile operation took place,
1892 (null tags-loop-operate)) 1817 ;; rather than search for "", we should repeat the last search!
1893 ;; Continue last tags-search as if by M-,. 1818 (eq multifile--operate-function
1894 (tags-loop-continue nil) 1819 tags--last-search-operate-function))
1895 (setq tags-loop-scan `(re-search-forward ',regexp nil t) 1820 (multifile-initialize-search
1896 tags-loop-operate nil) 1821 regexp
1897 (tags-loop-continue (or file-list-form t)))) 1822 (tags--compat-files (or files t))
1823 tags-case-fold-search)
1824 ;; Store it, so we can detect if some other multifile operation took
1825 ;; place since the last search!
1826 (setq tags--last-search-operate-function multifile--operate-function))
1827 (multifile-continue))
1898 1828
1899;;;###autoload 1829;;;###autoload
1900(defun tags-query-replace (from to &optional delimited file-list-form) 1830(defun tags-query-replace (from to &optional delimited files)
1901 "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. 1831 "Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
1902Third arg DELIMITED (prefix arg) means replace only word-delimited matches. 1832Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
1903If you exit (\\[keyboard-quit], RET or q), you can resume the query replace 1833If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
1904with the command \\[tags-loop-continue]. 1834with the command \\[tags-loop-continue].
1905Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. 1835For non-interactive use, superceded by `multifile-initialize-replace'."
1906 1836 (declare (advertised-calling-convention (from to &optional delimited) "27.1"))
1907If FILE-LIST-FORM is non-nil, it is a form to evaluate to
1908produce the list of files to search.
1909
1910See also the documentation of the variable `tags-file-name'."
1911 (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) 1837 (interactive (query-replace-read-args "Tags query replace (regexp)" t t))
1912 (setq tags-loop-scan `(let ,(unless (equal from (downcase from)) 1838 (multifile-initialize-replace
1913 '((case-fold-search nil))) 1839 from to
1914 (if (re-search-forward ',from nil t) 1840 (tags--compat-files (or files t))
1915 ;; When we find a match, move back 1841 (if (equal from (downcase from)) nil 'default)
1916 ;; to the beginning of it so perform-replace 1842 delimited)
1917 ;; will see it. 1843 (multifile-continue))
1918 (goto-char (match-beginning 0)))) 1844
1919 tags-loop-operate `(perform-replace ',from ',to t t ',delimited
1920 nil multi-query-replace-map))
1921 (tags-loop-continue (or file-list-form t)))
1922
1923(defun tags-complete-tags-table-file (string predicate what) ; Doc string? 1845(defun tags-complete-tags-table-file (string predicate what) ; Doc string?
1924 (save-excursion 1846 (save-excursion
1925 ;; If we need to ask for the tag table, allow that. 1847 ;; If we need to ask for the tag table, allow that.
@@ -1976,7 +1898,8 @@ directory specification."
1976 (funcall tags-apropos-function regexp)))) 1898 (funcall tags-apropos-function regexp))))
1977 (etags-tags-apropos-additional regexp)) 1899 (etags-tags-apropos-additional regexp))
1978 (with-current-buffer "*Tags List*" 1900 (with-current-buffer "*Tags List*"
1979 (eval-and-compile (require 'apropos)) 1901 (require 'apropos)
1902 (declare-function apropos-mode "apropos")
1980 (apropos-mode) 1903 (apropos-mode)
1981 ;; apropos-mode is derived from fundamental-mode and it kills 1904 ;; apropos-mode is derived from fundamental-mode and it kills
1982 ;; all local variables. 1905 ;; all local variables.
@@ -2006,14 +1929,14 @@ see the doc of that variable if you want to add names to the list."
2006 (when tags-table-list 1929 (when tags-table-list
2007 (setq desired-point (point-marker)) 1930 (setq desired-point (point-marker))
2008 (setq b (point)) 1931 (setq b (point))
2009 (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer)) 1932 (princ (mapcar #'abbreviate-file-name tags-table-list) (current-buffer))
2010 (make-text-button b (point) 'type 'tags-select-tags-table 1933 (make-text-button b (point) 'type 'tags-select-tags-table
2011 'etags-table (car tags-table-list)) 1934 'etags-table (car tags-table-list))
2012 (insert "\n")) 1935 (insert "\n"))
2013 (while set-list 1936 (while set-list
2014 (unless (eq (car set-list) tags-table-list) 1937 (unless (eq (car set-list) tags-table-list)
2015 (setq b (point)) 1938 (setq b (point))
2016 (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer)) 1939 (princ (mapcar #'abbreviate-file-name (car set-list)) (current-buffer))
2017 (make-text-button b (point) 'type 'tags-select-tags-table 1940 (make-text-button b (point) 'type 'tags-select-tags-table
2018 'etags-table (car (car set-list))) 1941 'etags-table (car (car set-list)))
2019 (insert "\n")) 1942 (insert "\n"))
@@ -2027,9 +1950,9 @@ see the doc of that variable if you want to add names to the list."
2027 'etags-table tags-file-name) 1950 'etags-table tags-file-name)
2028 (insert "\n")) 1951 (insert "\n"))
2029 (setq set-list (delete tags-file-name 1952 (setq set-list (delete tags-file-name
2030 (apply 'nconc (cons (copy-sequence tags-table-list) 1953 (apply #'nconc (cons (copy-sequence tags-table-list)
2031 (mapcar 'copy-sequence 1954 (mapcar #'copy-sequence
2032 tags-table-set-list))))) 1955 tags-table-set-list)))))
2033 (while set-list 1956 (while set-list
2034 (setq b (point)) 1957 (setq b (point))
2035 (insert (abbreviate-file-name (car set-list))) 1958 (insert (abbreviate-file-name (car set-list)))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index eab24e1ea60..f3f29cbac94 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -189,6 +189,18 @@ to find the list of ignores for each directory."
189(cl-defmethod project-roots ((project (head transient))) 189(cl-defmethod project-roots ((project (head transient)))
190 (list (cdr project))) 190 (list (cdr project)))
191 191
192(cl-defgeneric project-files (project &optional dirs)
193 "Return a list of files in directories DIRS in PROJECT.
194DIRS is a list of absolute directories; it should be some
195subset of the project roots and external roots."
196 ;; This default implementation only works if project-file-completion-table
197 ;; returns a "flat" completion table.
198 ;; FIXME: Maybe we should do the reverse: implement the default
199 ;; `project-file-completion-table' on top of `project-files'.
200 (all-completions
201 "" (project-file-completion-table
202 project (or dirs (project-roots project)))))
203
192(defgroup project-vc nil 204(defgroup project-vc nil
193 "Project implementation using the VC package." 205 "Project implementation using the VC package."
194 :version "25.1" 206 :version "25.1"
@@ -389,12 +401,17 @@ recognized."
389 ;; removing it when it has no matches. Neither seems natural 401 ;; removing it when it has no matches. Neither seems natural
390 ;; enough. Removal is confusing; early expansion makes the prompt 402 ;; enough. Removal is confusing; early expansion makes the prompt
391 ;; too long. 403 ;; too long.
392 (let* ((new-prompt (if default 404 (let* (;; (initial-input
405 ;; (let ((common-prefix (try-completion "" collection)))
406 ;; (if (> (length common-prefix) 0)
407 ;; (file-name-directory common-prefix))))
408 (new-prompt (if default
393 (format "%s (default %s): " prompt default) 409 (format "%s (default %s): " prompt default)
394 (format "%s: " prompt))) 410 (format "%s: " prompt)))
395 (res (completing-read new-prompt 411 (res (completing-read new-prompt
396 collection predicate t 412 collection predicate t
397 nil hist default inherit-input-method))) 413 nil ;; initial-input
414 hist default inherit-input-method)))
398 (if (and (equal res default) 415 (if (and (equal res default)
399 (not (test-completion res collection predicate))) 416 (not (test-completion res collection predicate)))
400 (completing-read (format "%s: " prompt) 417 (completing-read (format "%s: " prompt)
@@ -402,5 +419,30 @@ recognized."
402 inherit-input-method) 419 inherit-input-method)
403 res))) 420 res)))
404 421
422(declare-function multifile-continue "multifile" ())
423
424;;;###autoload
425(defun project-search (regexp)
426 "Search for REGEXP in all the files of the project.
427Stops when a match is found.
428To continue searching for next match, use command \\[multifile-continue]."
429 (interactive "sSearch (regexp): ")
430 (multifile-initialize-search
431 regexp (project-files (project-current t)) 'default)
432 (multifile-continue))
433
434;;;###autoload
435(defun project-query-replace (from to)
436 "Search for REGEXP in all the files of the project.
437Stops when a match is found.
438To continue searching for next match, use command \\[multifile-continue]."
439 (interactive
440 (pcase-let ((`(,from ,to)
441 (query-replace-read-args "Query replace (regexp)" t t)))
442 (list from to)))
443 (multifile-initialize-replace
444 from to (project-files (project-current t)) 'default)
445 (multifile-continue))
446
405(provide 'project) 447(provide 'project)
406;;; project.el ends here 448;;; project.el ends here