From: Stefan Monnier Date: Sat, 22 Sep 2018 15:46:35 +0000 (-0400) Subject: * lisp/multifile.el: New file, extracted from etags.el X-Git-Tag: emacs-27.0.90~4388 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=55ec674f5090f420c8982f5206e6566b5a664340;p=emacs.git * 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. --- 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')." "Search for a string through all marked files using Isearch." (interactive) (multi-isearch-files - (dired-get-marked-files nil nil 'dired-nondirectory-p nil t))) + (dired-get-marked-files nil nil #'dired-nondirectory-p nil t))) ;;;###autoload (defun dired-do-isearch-regexp () @@ -2847,7 +2847,11 @@ is part of a file name (i.e., has the text property `dired-filename')." Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]." (interactive "sSearch marked files (regexp): ") - (tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p))) + (multifile-initialize-search + regexp + (dired-get-marked-files nil nil #'dired-nondirectory-p) + 'default) + (multifile-continue)) ;;;###autoload (defun dired-do-query-replace-regexp (from to &optional delimited) @@ -2860,13 +2864,16 @@ with the command \\[tags-loop-continue]." (query-replace-read-args "Query replace regexp in marked files" t t))) (list (nth 0 common) (nth 1 common) (nth 2 common)))) - (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p nil t)) + (dolist (file (dired-get-marked-files nil nil #'dired-nondirectory-p nil t)) (let ((buffer (get-file-buffer file))) (if (and buffer (with-current-buffer buffer buffer-read-only)) (error "File `%s' is visited read-only" file)))) - (tags-query-replace from to delimited - '(dired-get-marked-files nil nil 'dired-nondirectory-p))) + (multifile-initialize-replace + from to (dired-get-marked-files nil nil #'dired-nondirectory-p) + (if (equal from (downcase from)) nil 'default) + delimited) + (multifile-continue)) (declare-function xref--show-xrefs "xref") (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." (unless ,normal-exit-symbol ,@unwind-forms)))))) -(put 'iter-end-of-sequence 'error-conditions '(iter-end-of-sequence)) -(put 'iter-end-of-sequence 'error-message "iteration terminated") +(define-error 'iter-end-of-sequence "Iteration terminated" + ;; FIXME: This was not defined originally as an `error' condition, so + ;; we reproduce this by passing itself as the parent, which avoids the + ;; default `error' parent. Maybe it *should* be in the `error' category? + 'iter-end-of-sequence) (defun cps--make-close-iterator-form (terminal-state) (if cps--cleanup-table-symbol @@ -700,6 +703,14 @@ of values. Callers can retrieve each value using `iter-next'." `(lambda ,arglist ,(cps-generate-evaluator body))) +(defmacro iter-make (&rest body) + "Return a new iterator." + (declare (debug t)) + (cps-generate-evaluator body)) + +(defconst iter-empty (lambda (_op _val) (signal 'iter-end-of-sequence nil)) + "Trivial iterator that always signals the end of sequence.") + (defun iter-next (iterator &optional yield-result) "Extract a value from an iterator. 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 @@ +;;; multifile.el --- Operations on multiple files -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Stefan Monnier + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Support functions for operations like search or query&replace applied to +;; several files. This code was largely inspired&extracted from an earlier +;; version of etags.el. + +;; TODO: +;; - Maybe it would make sense to replace the multifile--* vars with a single +;; global var holding a struct, and then stash those structs into a history +;; of past operations, so you can perform a multifile-search while in the +;; middle of a multifile-replace and later go back to that +;; multifile-replace. +;; - Make multi-isearch work on top of this library (might require changes +;; to this library, of course). + +;;; Code: + +(require 'generator) + +(defgroup multifile nil + "Operations on multiple files." + :group 'tools) + +(defcustom multifile-revert-buffers 'silent + "Whether to revert files during multifile operation. + `silent' means to only do it if `revert-without-query' is applicable; + t means to offer to do it for all applicable files; + nil means never to do it" + :type '(choice (const silent) (const t) (const nil))) + +;; FIXME: This already exists in GNU ELPA's iterator.el. Maybe it should move +;; to generator.el? +(iter-defun multifile--list-to-iterator (list) + (while list (iter-yield (pop list)))) + +(defvar multifile--iterator iter-empty) +(defvar multifile--scan-function + (lambda () (user-error "No operation in progress"))) +(defvar multifile--operate-function #'ignore) +(defvar multifile--freshly-initialized nil) + +;;;###autoload +(defun multifile-initialize (files scan-function operate-function) + "Initialize a new round of operation on several files. +FILES can be either a list of file names, or an iterator (used with `iter-next') +which returns a file name at each step. +SCAN-FUNCTION is a function called with no argument inside a buffer +and it should return non-nil if that buffer has something on which to operate. +OPERATE-FUNCTION is a function called with no argument; it is expected +to perform the operation on the current file buffer and when done +should return non-nil to mean that we should immediately continue +operating on the next file and nil otherwise." + (setq multifile--iterator + (if (and (listp files) (not (functionp files))) + (multifile--list-to-iterator files) + files)) + (setq multifile--scan-function scan-function) + (setq multifile--operate-function operate-function) + (setq multifile--freshly-initialized t)) + +(defun multifile-next-file (&optional novisit) + ;; FIXME: Should we provide an interactive command, like tags-next-file? + (let ((next (condition-case nil + (iter-next multifile--iterator) + (iter-end-of-sequence nil)))) + (unless next + (and novisit + (get-buffer " *next-file*") + (kill-buffer " *next-file*")) + (user-error "All files processed")) + (let* ((buffer (get-file-buffer next)) + (new (not buffer))) + ;; Optionally offer to revert buffers + ;; if the files have changed on disk. + (and buffer multifile-revert-buffers + (not (verify-visited-file-modtime buffer)) + (if (eq multifile-revert-buffers 'silent) + (and (not (buffer-modified-p buffer)) + (let ((revertible nil)) + (dolist (re revert-without-query) + (when (string-match-p re next) + (setq revertible t))) + revertible)) + (y-or-n-p + (format + (if (buffer-modified-p buffer) + "File %s changed on disk. Discard your edits? " + "File %s changed on disk. Reread from disk? ") + next))) + (with-current-buffer buffer + (revert-buffer t t))) + (if (not (and new novisit)) + (set-buffer (find-file-noselect next)) + ;; Like find-file, but avoids random warning messages. + (set-buffer (get-buffer-create " *next-file*")) + (kill-all-local-variables) + (erase-buffer) + (setq new next) + (insert-file-contents new nil)) + new))) + +(defun multifile-continue () + "Continue last multi-file operation." + (interactive) + (let (new + ;; Non-nil means we have finished one file + ;; and should not scan it again. + file-finished + original-point + (messaged nil)) + (while + (progn + ;; Scan files quickly for the first or next interesting one. + ;; This starts at point in the current buffer. + (while (or multifile--freshly-initialized file-finished + (save-restriction + (widen) + (not (funcall multifile--scan-function)))) + ;; If nothing was found in the previous file, and + ;; that file isn't in a temp buffer, restore point to + ;; where it was. + (when original-point + (goto-char original-point)) + + (setq file-finished nil) + (setq new (multifile-next-file t)) + + ;; If NEW is non-nil, we got a temp buffer, + ;; and NEW is the file name. + (when (or messaged + (and (not multifile--freshly-initialized) + (> baud-rate search-slow-speed) + (setq messaged t))) + (message "Scanning file %s..." (or new buffer-file-name))) + + (setq multifile--freshly-initialized nil) + (setq original-point (if new nil (point))) + (goto-char (point-min))) + + ;; If we visited it in a temp buffer, visit it now for real. + (if new + (let ((pos (point))) + (erase-buffer) + (set-buffer (find-file-noselect new)) + (setq new nil) ;No longer in a temp buffer. + (widen) + (goto-char pos)) + (push-mark original-point t)) + + (switch-to-buffer (current-buffer)) + + ;; Now operate on the file. + ;; If value is non-nil, continue to scan the next file. + (save-restriction + (widen) + (funcall multifile--operate-function))) + (setq file-finished t)))) + +;;;###autoload +(defun multifile-initialize-search (regexp files case-fold) + (let ((last-buffer (current-buffer))) + (multifile-initialize + files + (lambda () + (let ((case-fold-search + (if (memq case-fold '(t nil)) case-fold case-fold-search))) + (re-search-forward regexp nil t))) + (lambda () + (unless (eq last-buffer (current-buffer)) + (setq last-buffer (current-buffer)) + (message "Scanning file %s...found" buffer-file-name)) + nil)))) + +;;;###autoload +(defun multifile-initialize-replace (from to files case-fold &optional delimited) + "Initialize a new round of query&replace on several files. +FROM is a regexp and TO is the replacement to use. +FILES describes the file, as in `multifile-initialize'. +CASE-FOLD can be t, nil, or `default', the latter one meaning to obey +the default setting of `case-fold-search'. +DELIMITED if non-nil means replace only word-delimited matches." + ;; FIXME: Not sure how the delimited-flag interacts with the regexp-flag in + ;; `perform-replace', so I just try to mimic the old code. + (multifile-initialize + files + (lambda () + (let ((case-fold-search + (if (memql case-fold '(nil t)) case-fold case-fold-search))) + (if (re-search-forward from nil t) + ;; When we find a match, move back + ;; to the beginning of it so perform-replace + ;; will see it. + (goto-char (match-beginning 0))))) + (lambda () + (perform-replace from to t t delimited nil multi-query-replace-map)))) + +(provide 'multifile) +;;; 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 @@ ;;; Code: +;; The namespacing of this package is a mess: +;; - The file name is "etags", but the "exported" functionality doesn't use +;; this name +;; - Uses "etags-", "tags-", and "tag-" prefixes. +;; - Many functions use "-tag-" or "-tags-", or even "-etags-" not as +;; prefixes but somewhere within the name. + (require 'ring) (require 'button) (require 'xref) +(require 'multifile) ;;;###autoload (defvar tags-file-name nil @@ -49,7 +57,6 @@ Use the `etags' program to make a tags table file.") "Whether tags operations should be case-sensitive. A value of t means case-insensitive, a value of nil means case-sensitive. Any other value means use the setting of `case-fold-search'." - :group 'etags :type '(choice (const :tag "Case-sensitive" nil) (const :tag "Case-insensitive" t) (other :tag "Use default" default)) @@ -63,7 +70,6 @@ An element that is a directory means the file \"TAGS\" in that directory. To switch to a new list of tags tables, setting this variable is sufficient. If you set this variable, do not also set `tags-file-name'. Use the `etags' program to make a tags table file." - :group 'etags :type '(repeat file)) ;;;###autoload @@ -72,8 +78,7 @@ Use the `etags' program to make a tags table file." "List of extensions tried by etags when `auto-compression-mode' is on. An empty string means search the non-compressed file." :version "24.1" ; added xz - :type '(repeat string) - :group 'etags) + :type '(repeat string)) ;; !!! tags-compression-info-list should probably be replaced by access ;; to directory list and matching jka-compr-compression-info-list. Currently, @@ -91,14 +96,12 @@ An empty string means search the non-compressed file." t means do; nil means don't (always start a new list). Any other value means ask the user whether to add a new tags table to the current list (as opposed to starting a new list)." - :group 'etags :type '(choice (const :tag "Do" t) (const :tag "Don't" nil) (other :tag "Ask" ask-user))) (defcustom tags-revert-without-query nil "Non-nil means reread a TAGS table without querying, if it has changed." - :group 'etags :type 'boolean) (defvar tags-table-computed-list nil @@ -131,7 +134,6 @@ Each element is a list of strings which are file names.") "Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'. The value in the buffer in which \\[find-tag] is done is used, not the value in the buffer \\[find-tag] goes to." - :group 'etags :type 'hook) ;;;###autoload @@ -140,7 +142,6 @@ not the value in the buffer \\[find-tag] goes to." If nil, and the symbol that is the value of `major-mode' has a `find-tag-default-function' property (see `put'), that is used. Otherwise, `find-tag-default' is used." - :group 'etags :type '(choice (const nil) function)) (define-obsolete-variable-alias 'find-tag-marker-ring-length @@ -148,13 +149,11 @@ Otherwise, `find-tag-default' is used." (defcustom tags-tag-face 'default "Face for tags in the output of `tags-apropos'." - :group 'etags :type 'face :version "21.1") (defcustom tags-apropos-verbose nil "If non-nil, print the name of the tags file in the *Tags List* buffer." - :group 'etags :type 'boolean :version "21.1") @@ -175,7 +174,6 @@ Example value: ((\"Emacs Lisp\" Info-goto-emacs-command-node obarray) (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray) (\"SCWM\" scwm-documentation scwm-obarray))" - :group 'etags :type '(repeat (list (string :tag "Title") function (sexp :tag "Tags to search"))) @@ -209,9 +207,6 @@ use function `tags-table-files' to do so.") (defvar tags-included-tables nil "List of tags tables included by the current tags table.") - -(defvar next-file-list nil - "List of files for \\[next-file] to process.") ;; Hooks for file formats. @@ -328,10 +323,10 @@ file the tag was in." (defun tags-table-check-computed-list () "Compute `tags-table-computed-list' from `tags-table-list' if necessary." - (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list))) + (let ((expanded-list (mapcar #'tags-expand-table-name tags-table-list))) (or (equal tags-table-computed-list-for expanded-list) ;; The list (or default-directory) has changed since last computed. - (let* ((compute-for (mapcar 'copy-sequence expanded-list)) + (let* ((compute-for (mapcar #'copy-sequence expanded-list)) (tables (copy-sequence compute-for)) ;Mutated in the loop. (computed nil) table-buffer) @@ -351,7 +346,7 @@ file the tag was in." (if (tags-included-tables) ;; Insert the included tables into the list we ;; are processing. - (setcdr tables (nconc (mapcar 'tags-expand-table-name + (setcdr tables (nconc (mapcar #'tags-expand-table-name (tags-included-tables)) (cdr tables)))))) ;; This table is not in core yet. Insert a placeholder @@ -502,7 +497,7 @@ buffers. If CORE-ONLY is nil, it is ignored." ;; Select the tags table buffer and get the file list up to date. (let ((tags-file-name (car tables))) (visit-tags-table-buffer 'same) - (if (member this-file (mapcar 'expand-file-name + (if (member this-file (mapcar #'expand-file-name (tags-table-files))) ;; Found it. (setq found tables)))) @@ -853,7 +848,7 @@ If no tags table is loaded, do nothing and return nil." (defun find-tag--default () (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default))) + #'find-tag-default))) (defvar last-tag nil "Last tag found by \\[find-tag].") @@ -1698,18 +1693,14 @@ Point should be just after a string that matches TAG." (let ((bol (point))) (and (search-forward "\177" (line-end-position) t) (re-search-backward re bol t))))) - -(defcustom tags-loop-revert-buffers nil - "Non-nil means tags-scanning loops should offer to reread changed files. -These loops normally read each file into Emacs, but when a file -is already visited, they use the existing buffer. -When this flag is non-nil, they offer to revert the existing buffer -in the case where the file has changed since you visited it." - :type 'boolean - :group 'etags) +(define-obsolete-variable-alias 'tags-loop-revert-buffers 'multifile-revert-buffers "27.1") ;;;###autoload -(defun next-file (&optional initialize novisit) +(defalias 'next-file 'tags-next-file) +(make-obsolete 'next-file + "use tags-next-file or multifile-initialize and multifile-next-file instead" "27.1") +;;;###autoload +(defun tags-next-file (&optional initialize novisit) "Select next file among files in current tags table. 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; if the file was newly read in, the value is the filename." ;; Make the interactive arg t if there was any prefix arg. (interactive (list (if current-prefix-arg t))) - (cond ((not initialize) - ;; Not the first run. - ) - ((eq initialize t) - ;; Initialize the list from the tags table. - (save-excursion - (let ((cbuf (current-buffer))) - ;; Visit the tags table buffer to get its list of files. - (visit-tags-table-buffer) - ;; Copy the list so we can setcdr below, and expand the file - ;; names while we are at it, in this buffer's default directory. - (setq next-file-list (mapcar 'expand-file-name (tags-table-files))) - ;; Iterate over all the tags table files, collecting - ;; a complete list of referenced file names. - (while (visit-tags-table-buffer t cbuf) - ;; Find the tail of the working list and chain on the new - ;; sublist for this tags table. - (let ((tail next-file-list)) - (while (cdr tail) - (setq tail (cdr tail))) - ;; Use a copy so the next loop iteration will not modify the - ;; list later returned by (tags-table-files). - (if tail - (setcdr tail (mapcar 'expand-file-name (tags-table-files))) - (setq next-file-list (mapcar 'expand-file-name - (tags-table-files))))))))) - (t - ;; Initialize the list by evalling the argument. - (setq next-file-list (eval initialize)))) - (unless next-file-list - (and novisit - (get-buffer " *next-file*") - (kill-buffer " *next-file*")) - (user-error "All files processed")) - (let* ((next (car next-file-list)) - (buffer (get-file-buffer next)) - (new (not buffer))) - ;; Advance the list before trying to find the file. - ;; If we get an error finding the file, don't get stuck on it. - (setq next-file-list (cdr next-file-list)) - ;; Optionally offer to revert buffers - ;; if the files have changed on disk. - (and buffer tags-loop-revert-buffers - (not (verify-visited-file-modtime buffer)) - (y-or-n-p - (format - (if (buffer-modified-p buffer) - "File %s changed on disk. Discard your edits? " - "File %s changed on disk. Reread from disk? ") - next)) - (with-current-buffer buffer - (revert-buffer t t))) - (if (not (and new novisit)) - (find-file next) - ;; Like find-file, but avoids random warning messages. - (switch-to-buffer (get-buffer-create " *next-file*")) - (kill-all-local-variables) - (erase-buffer) - (setq new next) - (insert-file-contents new nil)) - new)) + (when initialize ;; Not the first run. + (tags--compat-initialize initialize)) + (multifile-next-file novisit) + (switch-to-buffer (current-buffer))) +(defun tags--all-files () + (save-excursion + (let ((cbuf (current-buffer)) + (files nil)) + ;; Visit the tags table buffer to get its list of files. + (visit-tags-table-buffer) + ;; Copy the list so we can setcdr below, and expand the file + ;; names while we are at it, in this buffer's default directory. + (setq files (mapcar #'expand-file-name (tags-table-files))) + ;; Iterate over all the tags table files, collecting + ;; a complete list of referenced file names. + (while (visit-tags-table-buffer t cbuf) + ;; Find the tail of the working list and chain on the new + ;; sublist for this tags table. + (let ((tail files)) + (while (cdr tail) + (setq tail (cdr tail))) + ;; Use a copy so the next loop iteration will not modify the + ;; list later returned by (tags-table-files). + (setf (if tail (cdr tail) files) + (mapcar #'expand-file-name (tags-table-files))))) + files))) + +(make-obsolete-variable 'tags-loop-operate 'multifile-initialize "27.1") (defvar tags-loop-operate nil "Form for `tags-loop-continue' to eval to change one file.") +(make-obsolete-variable 'tags-loop-scan 'multifile-initialize "27.1") (defvar tags-loop-scan '(user-error "%s" (substitute-command-keys @@ -1805,121 +1764,84 @@ Bind `case-fold-search' during the evaluation, depending on the value of case-fold-search))) (eval form))) +(defun tags--compat-files (files) + (cond + ((eq files t) (tags--all-files)) ;; Initialize the list from the tags table. + ((functionp files) files) + ((stringp (car-safe files)) files) + (t + ;; Backward compatibility <27.1 + ;; Initialize the list by evalling the argument. + (eval files)))) + +(defun tags--compat-initialize (initialize) + (multifile-initialize + (tags--compat-files initialize) + (if tags-loop-operate + (lambda () (tags-loop-eval tags-loop-operate)) + (lambda () (message "Scanning file %s...found" buffer-file-name) nil)) + (lambda () (tags-loop-eval tags-loop-scan)))) ;;;###autoload (defun tags-loop-continue (&optional first-time) "Continue last \\[tags-search] or \\[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the -argument is passed to `next-file', which see). - -Two variables control the processing we do on each file: the value of -`tags-loop-scan' is a form to be executed on each file to see if it is -interesting (it returns non-nil if so) and `tags-loop-operate' is a form to -evaluate to operate on an interesting file. If the latter evaluates to -nil, we exit; otherwise we scan the next file." +argument is passed to `next-file', which see)." + ;; Two variables control the processing we do on each file: the value of + ;; `tags-loop-scan' is a form to be executed on each file to see if it is + ;; interesting (it returns non-nil if so) and `tags-loop-operate' is a form to + ;; evaluate to operate on an interesting file. If the latter evaluates to + ;; nil, we exit; otherwise we scan the next file. + (declare (obsolete multifile-continue "27.1")) (interactive) - (let (new - ;; Non-nil means we have finished one file - ;; and should not scan it again. - file-finished - original-point - (messaged nil)) - (while - (progn - ;; Scan files quickly for the first or next interesting one. - ;; This starts at point in the current buffer. - (while (or first-time file-finished - (save-restriction - (widen) - (not (tags-loop-eval tags-loop-scan)))) - ;; If nothing was found in the previous file, and - ;; that file isn't in a temp buffer, restore point to - ;; where it was. - (when original-point - (goto-char original-point)) - - (setq file-finished nil) - (setq new (next-file first-time t)) - - ;; If NEW is non-nil, we got a temp buffer, - ;; and NEW is the file name. - (when (or messaged - (and (not first-time) - (> baud-rate search-slow-speed) - (setq messaged t))) - (message "Scanning file %s..." (or new buffer-file-name))) - - (setq first-time nil) - (setq original-point (if new nil (point))) - (goto-char (point-min))) + (when first-time ;; Backward compatibility. + (tags--compat-initialize first-time)) + (multifile-continue)) - ;; If we visited it in a temp buffer, visit it now for real. - (if new - (let ((pos (point))) - (erase-buffer) - (set-buffer (find-file-noselect new)) - (setq new nil) ;No longer in a temp buffer. - (widen) - (goto-char pos)) - (push-mark original-point t)) - - (switch-to-buffer (current-buffer)) - - ;; Now operate on the file. - ;; If value is non-nil, continue to scan the next file. - (save-restriction - (widen) - (tags-loop-eval tags-loop-operate))) - (setq file-finished t)) - (and messaged - (null tags-loop-operate) - (message "Scanning file %s...found" buffer-file-name)))) +;; We use it to detect when the last loop was a tags-search. +(defvar tags--last-search-operate-function nil) ;;;###autoload -(defun tags-search (regexp &optional file-list-form) +(defun tags-search (regexp &optional files) "Search through all files listed in tags table for match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]. -If FILE-LIST-FORM is non-nil, it should be a form that, when -evaluated, will return a list of file names. The search will be -restricted to these files. +If FILES if non-nil should be a list or an iterator returning the files to search. +The search will be restricted to these files. Also see the documentation of the `tags-file-name' variable." (interactive "sTags search (regexp): ") - (if (and (equal regexp "") - (eq (car tags-loop-scan) 're-search-forward) - (null tags-loop-operate)) - ;; Continue last tags-search as if by M-,. - (tags-loop-continue nil) - (setq tags-loop-scan `(re-search-forward ',regexp nil t) - tags-loop-operate nil) - (tags-loop-continue (or file-list-form t)))) + (unless (and (equal regexp "") + ;; FIXME: If some other multifile operation took place, + ;; rather than search for "", we should repeat the last search! + (eq multifile--operate-function + tags--last-search-operate-function)) + (multifile-initialize-search + regexp + (tags--compat-files (or files t)) + tags-case-fold-search) + ;; Store it, so we can detect if some other multifile operation took + ;; place since the last search! + (setq tags--last-search-operate-function multifile--operate-function)) + (multifile-continue)) ;;;###autoload -(defun tags-query-replace (from to &optional delimited file-list-form) +(defun tags-query-replace (from to &optional delimited files) "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. -Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. - -If FILE-LIST-FORM is non-nil, it is a form to evaluate to -produce the list of files to search. - -See also the documentation of the variable `tags-file-name'." +For non-interactive use, superceded by `multifile-initialize-replace'." + (declare (advertised-calling-convention (from to &optional delimited) "27.1")) (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) - (setq tags-loop-scan `(let ,(unless (equal from (downcase from)) - '((case-fold-search nil))) - (if (re-search-forward ',from nil t) - ;; When we find a match, move back - ;; to the beginning of it so perform-replace - ;; will see it. - (goto-char (match-beginning 0)))) - tags-loop-operate `(perform-replace ',from ',to t t ',delimited - nil multi-query-replace-map)) - (tags-loop-continue (or file-list-form t))) - + (multifile-initialize-replace + from to + (tags--compat-files (or files t)) + (if (equal from (downcase from)) nil 'default) + delimited) + (multifile-continue)) + (defun tags-complete-tags-table-file (string predicate what) ; Doc string? (save-excursion ;; If we need to ask for the tag table, allow that. @@ -1976,7 +1898,8 @@ directory specification." (funcall tags-apropos-function regexp)))) (etags-tags-apropos-additional regexp)) (with-current-buffer "*Tags List*" - (eval-and-compile (require 'apropos)) + (require 'apropos) + (declare-function apropos-mode "apropos") (apropos-mode) ;; apropos-mode is derived from fundamental-mode and it kills ;; all local variables. @@ -2006,14 +1929,14 @@ see the doc of that variable if you want to add names to the list." (when tags-table-list (setq desired-point (point-marker)) (setq b (point)) - (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer)) + (princ (mapcar #'abbreviate-file-name tags-table-list) (current-buffer)) (make-text-button b (point) 'type 'tags-select-tags-table 'etags-table (car tags-table-list)) (insert "\n")) (while set-list (unless (eq (car set-list) tags-table-list) (setq b (point)) - (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer)) + (princ (mapcar #'abbreviate-file-name (car set-list)) (current-buffer)) (make-text-button b (point) 'type 'tags-select-tags-table 'etags-table (car (car set-list))) (insert "\n")) @@ -2027,9 +1950,9 @@ see the doc of that variable if you want to add names to the list." 'etags-table tags-file-name) (insert "\n")) (setq set-list (delete tags-file-name - (apply 'nconc (cons (copy-sequence tags-table-list) - (mapcar 'copy-sequence - tags-table-set-list))))) + (apply #'nconc (cons (copy-sequence tags-table-list) + (mapcar #'copy-sequence + tags-table-set-list))))) (while set-list (setq b (point)) (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." (cl-defmethod project-roots ((project (head transient))) (list (cdr project))) +(cl-defgeneric project-files (project &optional dirs) + "Return a list of files in directories DIRS in PROJECT. +DIRS is a list of absolute directories; it should be some +subset of the project roots and external roots." + ;; This default implementation only works if project-file-completion-table + ;; returns a "flat" completion table. + ;; FIXME: Maybe we should do the reverse: implement the default + ;; `project-file-completion-table' on top of `project-files'. + (all-completions + "" (project-file-completion-table + project (or dirs (project-roots project))))) + (defgroup project-vc nil "Project implementation using the VC package." :version "25.1" @@ -389,12 +401,17 @@ recognized." ;; removing it when it has no matches. Neither seems natural ;; enough. Removal is confusing; early expansion makes the prompt ;; too long. - (let* ((new-prompt (if default + (let* (;; (initial-input + ;; (let ((common-prefix (try-completion "" collection))) + ;; (if (> (length common-prefix) 0) + ;; (file-name-directory common-prefix)))) + (new-prompt (if default (format "%s (default %s): " prompt default) (format "%s: " prompt))) (res (completing-read new-prompt collection predicate t - nil hist default inherit-input-method))) + nil ;; initial-input + hist default inherit-input-method))) (if (and (equal res default) (not (test-completion res collection predicate))) (completing-read (format "%s: " prompt) @@ -402,5 +419,30 @@ recognized." inherit-input-method) res))) +(declare-function multifile-continue "multifile" ()) + +;;;###autoload +(defun project-search (regexp) + "Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]." + (interactive "sSearch (regexp): ") + (multifile-initialize-search + regexp (project-files (project-current t)) 'default) + (multifile-continue)) + +;;;###autoload +(defun project-query-replace (from to) + "Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]." + (interactive + (pcase-let ((`(,from ,to) + (query-replace-read-args "Query replace (regexp)" t t))) + (list from to))) + (multifile-initialize-replace + from to (project-files (project-current t)) 'default) + (multifile-continue)) + (provide 'project) ;;; project.el ends here