summaryrefslogtreecommitdiff
path: root/lisp/fileloop.el
diff options
context:
space:
mode:
authorDmitry Gutov <dgutov@yandex.ru>2019-02-07 12:20:09 +0300
committerDmitry Gutov <dgutov@yandex.ru>2019-02-07 12:23:09 +0300
commit5e627fa5f5db8f27ea789d61148e7d5ade644956 (patch)
tree0d671bb2c79d7d959db34688d7c32a644697795a /lisp/fileloop.el
parent1289ae999b85c6a8059c2f9116db4fd8dbe3b418 (diff)
downloademacs-5e627fa5f5db8f27ea789d61148e7d5ade644956.tar.gz
Rename multifile.el to fileloop.el
* lisp/multifile.el: Rename to fileloop.el as discussed in https://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00475.html. Update symbol prefixes and all callers
Diffstat (limited to 'lisp/fileloop.el')
-rw-r--r--lisp/fileloop.el217
1 files changed, 217 insertions, 0 deletions
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
new file mode 100644
index 00000000000..2e77811a576
--- /dev/null
+++ b/lisp/fileloop.el
@@ -0,0 +1,217 @@
+;;; fileloop.el --- Operations on multiple files -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2019 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 fileloop--* 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 fileloop-search while in the
+;; middle of a fileloop-replace and later go back to that
+;; fileloop-replace.
+;; - Make multi-isearch work on top of this library (might require changes
+;; to this library, of course).
+
+;;; Code:
+
+(require 'generator)
+
+(defgroup fileloop nil
+ "Operations on multiple files."
+ :group 'tools)
+
+(defcustom fileloop-revert-buffers 'silent
+ "Whether to revert files during fileloop 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 fileloop--list-to-iterator (list)
+ (while list (iter-yield (pop list))))
+
+(defvar fileloop--iterator iter-empty)
+(defvar fileloop--scan-function
+ (lambda () (user-error "No operation in progress")))
+(defvar fileloop--operate-function #'ignore)
+(defvar fileloop--freshly-initialized nil)
+
+;;;###autoload
+(defun fileloop-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 fileloop--iterator
+ (if (and (listp files) (not (functionp files)))
+ (fileloop--list-to-iterator files)
+ files))
+ (setq fileloop--scan-function scan-function)
+ (setq fileloop--operate-function operate-function)
+ (setq fileloop--freshly-initialized t))
+
+(defun fileloop-next-file (&optional novisit)
+ ;; FIXME: Should we provide an interactive command, like tags-next-file?
+ (let ((next (condition-case nil
+ (iter-next fileloop--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 fileloop-revert-buffers
+ (not (verify-visited-file-modtime buffer))
+ (if (eq fileloop-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 fileloop-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 fileloop--freshly-initialized file-finished
+ (save-restriction
+ (widen)
+ (not (funcall fileloop--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 (fileloop-next-file t))
+
+ ;; If NEW is non-nil, we got a temp buffer,
+ ;; and NEW is the file name.
+ (when (or messaged
+ (and (not fileloop--freshly-initialized)
+ (> baud-rate search-slow-speed)
+ (setq messaged t)))
+ (message "Scanning file %s..." (or new buffer-file-name)))
+
+ (setq fileloop--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 fileloop--operate-function)))
+ (setq file-finished t))))
+
+;;;###autoload
+(defun fileloop-initialize-search (regexp files case-fold)
+ (let ((last-buffer (current-buffer)))
+ (fileloop-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 fileloop-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 `fileloop-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.
+ (fileloop-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 'fileloop)
+;;; fileloop.el ends here