emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master 55ec674: * lisp/multifile.el: New file, extracted f


From: Stefan Monnier
Subject: [Emacs-diffs] master 55ec674: * lisp/multifile.el: New file, extracted from etags.el
Date: Sat, 22 Sep 2018 11:46:40 -0400 (EDT)

branch: master
commit 55ec674f5090f420c8982f5206e6566b5a664340
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * 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.
---
 lisp/dired-aux.el            |  17 ++-
 lisp/emacs-lisp/generator.el |  15 ++-
 lisp/multifile.el            | 217 +++++++++++++++++++++++++++++++
 lisp/progmodes/etags.el      | 299 ++++++++++++++++---------------------------
 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 21ee50c..ce2ed13 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 506df59..e38c7d9 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 0000000..712da5c
--- /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 <address@hidden>
+
+;; 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
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 4f07fe9..6844e9b 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 eab24e1..f3f29cb 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]