procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/multifile.el: New file, extracted from etags.el

Browse source 
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.
This commit is contained in:
Stefan Monnier 2018-09-22 11:46:35 -04:00
parent 3727bc7d59
commit 55ec674f50
5 changed files with 397 additions and 197 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lisp/dired-aux.el
View file

@ -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")

15
lisp/emacs-lisp/generator.el
View file

@ -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

217
lisp/multifile.el Normal file
View file

@ -0,0 +1,217 @@
;;; multifile.el --- Operations on multiple files -*- lexical-binding: t; -*-
;; Copyright (C) 2018 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; 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 <https://www.gnu.org/licenses/>.
;;; 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

299
lisp/progmodes/etags.el
View file

@ -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))
(when first-time ;; Backward compatibility.
(tags--compat-initialize first-time))
(multifile-continue))
(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)))
;; 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)))

46
lisp/progmodes/project.el
View file

@ -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