diff options
| author | Stefan Monnier | 2018-09-22 11:46:35 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2018-09-22 11:46:35 -0400 |
| commit | 55ec674f5090f420c8982f5206e6566b5a664340 (patch) | |
| tree | e38d5ca4c650db8ed0704ae9d20f3e935af89b05 | |
| parent | 3727bc7d599c24715a66de3e899a82b6f07d1aac (diff) | |
| download | emacs-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.el | 17 | ||||
| -rw-r--r-- | lisp/emacs-lisp/generator.el | 15 | ||||
| -rw-r--r-- | lisp/multifile.el | 217 | ||||
| -rw-r--r-- | lisp/progmodes/etags.el | 299 | ||||
| -rw-r--r-- | lisp/progmodes/project.el | 46 |
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')." | |||
| 2847 | Stops when a match is found. | 2847 | Stops when a match is found. |
| 2848 | To continue searching for next match, use command \\[tags-loop-continue]." | 2848 | To 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. |
| 705 | YIELD-RESULT becomes the return value of `iter-yield' in the | 716 | YIELD-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. | ||
| 64 | FILES can be either a list of file names, or an iterator (used with `iter-next') | ||
| 65 | which returns a file name at each step. | ||
| 66 | SCAN-FUNCTION is a function called with no argument inside a buffer | ||
| 67 | and it should return non-nil if that buffer has something on which to operate. | ||
| 68 | OPERATE-FUNCTION is a function called with no argument; it is expected | ||
| 69 | to perform the operation on the current file buffer and when done | ||
| 70 | should return non-nil to mean that we should immediately continue | ||
| 71 | operating 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. | ||
| 196 | FROM is a regexp and TO is the replacement to use. | ||
| 197 | FILES describes the file, as in `multifile-initialize'. | ||
| 198 | CASE-FOLD can be t, nil, or `default', the latter one meaning to obey | ||
| 199 | the default setting of `case-fold-search'. | ||
| 200 | DELIMITED 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. |
| 50 | A value of t means case-insensitive, a value of nil means case-sensitive. | 58 | A value of t means case-insensitive, a value of nil means case-sensitive. |
| 51 | Any other value means use the setting of `case-fold-search'." | 59 | Any 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. | |||
| 63 | To switch to a new list of tags tables, setting this variable is sufficient. | 70 | To switch to a new list of tags tables, setting this variable is sufficient. |
| 64 | If you set this variable, do not also set `tags-file-name'. | 71 | If you set this variable, do not also set `tags-file-name'. |
| 65 | Use the `etags' program to make a tags table file." | 72 | Use 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. |
| 73 | An empty string means search the non-compressed file." | 79 | An 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." | |||
| 91 | t means do; nil means don't (always start a new list). | 96 | t means do; nil means don't (always start a new list). |
| 92 | Any other value means ask the user whether to add a new tags table | 97 | Any other value means ask the user whether to add a new tags table |
| 93 | to the current list (as opposed to starting a new list)." | 98 | to 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'. |
| 132 | The value in the buffer in which \\[find-tag] is done is used, | 135 | The value in the buffer in which \\[find-tag] is done is used, |
| 133 | not the value in the buffer \\[find-tag] goes to." | 136 | not 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." | |||
| 140 | If nil, and the symbol that is the value of `major-mode' | 142 | If nil, and the symbol that is the value of `major-mode' |
| 141 | has a `find-tag-default-function' property (see `put'), that is used. | 143 | has a `find-tag-default-function' property (see `put'), that is used. |
| 142 | Otherwise, `find-tag-default' is used." | 144 | Otherwise, `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. | ||
| 1704 | These loops normally read each file into Emacs, but when a file | ||
| 1705 | is already visited, they use the existing buffer. | ||
| 1706 | When this flag is non-nil, they offer to revert the existing buffer | ||
| 1707 | in 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 | ||
| 1715 | A first argument of t (prefix arg, if interactive) initializes to the | 1706 | A first argument of t (prefix arg, if interactive) initializes to the |
| @@ -1723,71 +1714,39 @@ Value is nil if the file was already visited; | |||
| 1723 | if the file was newly read in, the value is the filename." | 1714 | if 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. |
| 1812 | Used noninteractively with non-nil argument to begin such a command (the | 1788 | Used noninteractively with non-nil argument to begin such a command (the |
| 1813 | argument is passed to `next-file', which see). | 1789 | argument is passed to `next-file', which see)." |
| 1814 | 1790 | ;; Two variables control the processing we do on each file: the value of | |
| 1815 | Two 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 |
| 1817 | interesting (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 |
| 1818 | evaluate to operate on an interesting file. If the latter evaluates to | 1794 | ;; nil, we exit; otherwise we scan the next file. |
| 1819 | nil, 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. |
| 1881 | Stops when a match is found. | 1807 | Stops when a match is found. |
| 1882 | To continue searching for next match, use command \\[tags-loop-continue]. | 1808 | To continue searching for next match, use command \\[tags-loop-continue]. |
| 1883 | 1809 | ||
| 1884 | If FILE-LIST-FORM is non-nil, it should be a form that, when | 1810 | If FILES if non-nil should be a list or an iterator returning the files to search. |
| 1885 | evaluated, will return a list of file names. The search will be | 1811 | The search will be restricted to these files. |
| 1886 | restricted to these files. | ||
| 1887 | 1812 | ||
| 1888 | Also see the documentation of the `tags-file-name' variable." | 1813 | Also 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. |
| 1902 | Third arg DELIMITED (prefix arg) means replace only word-delimited matches. | 1832 | Third arg DELIMITED (prefix arg) means replace only word-delimited matches. |
| 1903 | If you exit (\\[keyboard-quit], RET or q), you can resume the query replace | 1833 | If you exit (\\[keyboard-quit], RET or q), you can resume the query replace |
| 1904 | with the command \\[tags-loop-continue]. | 1834 | with the command \\[tags-loop-continue]. |
| 1905 | Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. | 1835 | For non-interactive use, superceded by `multifile-initialize-replace'." |
| 1906 | 1836 | (declare (advertised-calling-convention (from to &optional delimited) "27.1")) | |
| 1907 | If FILE-LIST-FORM is non-nil, it is a form to evaluate to | ||
| 1908 | produce the list of files to search. | ||
| 1909 | |||
| 1910 | See 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. | ||
| 194 | DIRS is a list of absolute directories; it should be some | ||
| 195 | subset 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. | ||
| 427 | Stops when a match is found. | ||
| 428 | To 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. | ||
| 437 | Stops when a match is found. | ||
| 438 | To 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 |