emacs-elpa-diffs
[Top][All Lists]
Advanced

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

[elpa] master 7c97304: Implement multi-buffer query-replace


From: Michael Heerdegen
Subject: [elpa] master 7c97304: Implement multi-buffer query-replace
Date: Sun, 23 Jul 2017 20:54:33 -0400 (EDT)

branch: master
commit 7c9730497e64ce3409158dc81421522ab1d25eae
Author: Michael Heerdegen <address@hidden>
Commit: Michael Heerdegen <address@hidden>

    Implement multi-buffer query-replace
---
 packages/el-search/el-search.el | 350 +++++++++++++++++++++++++---------------
 1 file changed, 221 insertions(+), 129 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index b6d1021..a3ce166 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -341,10 +341,6 @@
 ;;   already work using only syntax tables, sexp scanning and
 ;;   font-lock?
 ;;
-;; - For query-replace, maybe we should save the original buffer
-;;   string in a buffer-local variable, and make that ediff'able
-;;   against the new version.
-;;
 ;; - Replace: pause and warn when replacement might be wrong
 ;;   (ambiguous reader syntaxes; lost comments, comments that can't
 ;;   non-ambiguously be assigned to rewritten code)
@@ -356,8 +352,7 @@
 
 ;;;; Requirements
 
-(eval-when-compile
-  (require 'subr-x))
+(require 'subr-x) ;read-multiple-choice
 
 (require 'cl-lib)
 (require 'pcase)    ;we want to bind `pcase--dontwarn-upats' before pcase is 
autoloaded
@@ -416,6 +411,19 @@ tested.  "
   :type '(choice (repeat :tag "Regexps for ignored directories" regexp)
                 (const  :tag "No ignored directories" nil)))
 
+(defcustom el-search-replace-auto-save-buffers 'ask
+  "Whether to automatically save modified buffers.
+When non-nil, save modified file buffers when query-replace is
+finished there.  If the non-nil value is the symbol ask, ask for
+confirmation for each buffer.  You can still let all following
+buffers automatically be saved or left modified from the prompt.
+Save automatically for any other non-nil value.
+
+The default value is ask."
+  :type '(choice (const :tag "Off" nil)
+                 (const :tag "On"  t)
+                 (const :tag "Ask" ask)))
+
 (defvar el-search-read-expression-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map read-expression-map)
@@ -2524,132 +2532,207 @@ reindent."
                 (error "Error in `el-search--format-replacement' - please make 
a bug report"))))
         (kill-buffer orig-buffer)))))
 
-(defvar el-search-search-and-replace-help-string
-  "\
-y         Replace this match and move to the next.
-SPC or n  Skip this match and move to the next.
-r         Replace this match but don't move.
-!         Replace all remaining matches automatically.
-q         Quit.  To resume, use e.g. `repeat-complex-command'.
-?         Show this help.
-s         Toggle splicing mode.  When splicing mode is
-          on (default off), the replacement expression must
-          evaluate to a list, and the result is spliced into the
-          buffer, instead of just inserted.
-
-Hit any key to proceed."
-  "Help string for ? in `el-search-query-replace'.")
-
-(defun el-search--search-and-replace-pattern (pattern replacement &optional 
splice to-input-string)
-  (el-search-setup-search-1 pattern (lambda () (current-buffer)) t) ;for side 
effect only
-  (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
+(defun el-search--search-and-replace-pattern
+    (pattern replacement &optional splice to-input-string multiple)
+  (unless multiple
+    (el-search-setup-search-1 pattern
+                              (let ((current-buffer (current-buffer)))
+                                (lambda () (stream (list current-buffer))))
+                              t))
+  (let ((replace-all nil) (replace-all-and-following nil)
+        nbr-replaced nbr-skipped (done nil) (nbr-replaced-multi 0) 
(nbr-changed-buffers 0)
         (el-search-keep-hl t) (opoint (point))
         (get-replacement (el-search--matcher pattern replacement))
         (skip-matches-in-replacement 'ask)
         (matcher (el-search--matcher pattern))
-        (heuristic-matcher (el-search--current-heuristic-matcher)))
-    (unwind-protect
-        (progn
-
-          ;; Try to avoid to call time consuming `el-search-hl-other-matches' 
in the loop
-          (el-search-hl-other-matches matcher)
-          (add-hook 'window-scroll-functions #'el-search--after-scroll t t)
-
-          (while (and (not done) (el-search--search-pattern-1 matcher t nil 
heuristic-matcher))
-            (setq opoint (point))
-            (unless replace-all
-              (el-search-hl-sexp))
-            (let* ((region (list (point) (el-search--end-of-sexp)))
-                   (original-text (apply #'buffer-substring-no-properties 
region))
-                   (expr      (read original-text))
-                   (replaced-this nil)
-                   (new-expr  (funcall get-replacement expr))
-                   (get-replacement-string
-                    (lambda () (el-search--format-replacement
-                           new-expr original-text to-input-string splice)))
-                   (to-insert (funcall get-replacement-string))
-                   (replacement-contains-another-match
-                    (with-temp-buffer
-                      (emacs-lisp-mode)
-                      (insert to-insert)
-                      (goto-char 1)
-                      (el-search--skip-expression new-expr)
-                      (condition-case nil
-                          (progn (el-search--ensure-sexp-start)
-                                 (el-search-forward pattern nil t))
-                        (end-of-buffer nil))))
-                   (do-replace
-                    (lambda ()
-                      (save-excursion
-                        (save-restriction
-                          (widen)
-                          (el-search--replace-hunk (list (point) 
(el-search--end-of-sexp)) to-insert)))
-                      (el-search--ensure-sexp-start) ;skip potentially newly 
added whitespace
-                      (unless replace-all (el-search-hl-sexp (list opoint 
(point))))
-                      (cl-incf nbr-replaced)
-                      (setq replaced-this t))))
-              (if replace-all
-                  (funcall do-replace)
-                (redisplay) ;FIXME: why is this necessary?  Without this, 
read-char-choice recenters!?!
-                (while (not (pcase (if replaced-this
-                                       (read-char-choice "[SPC ! q]  (? for 
help)"
-                                                         '(?\ ?! ?q ?\C-g ?n 
??))
-                                     (read-char-choice
-                                      (concat "Replace this occurrence"
-                                              (if (or (string-match-p "\n" 
to-insert)
-                                                      (< 40 (length 
to-insert)))
-                                                  "" (format " with `%s'" 
to-insert))
-                                              "? "
-                                              (if splice "{splice} " "")
-                                              "[y SPC r ! s q]  (? for help)" )
-                                      '(?y ?n ?r ?\ ?! ?q ?\C-g ?s ??)))
-                              (?r (funcall do-replace)
-                                  nil)
-                              (?y (funcall do-replace)
-                                  t)
-                              ((or ?\ ?n)
-                               (unless replaced-this (cl-incf nbr-skipped))
-                               t)
-                              (?! (unless replaced-this
-                                    (funcall do-replace))
-                                  (setq replace-all t)
-                                  t)
-                              (?s (cl-callf not splice)
-                                  (setq to-insert (funcall 
get-replacement-string))
-                                  nil)
-                              ((or ?q ?\C-g)
-                               (setq done t)
-                               t)
-                              (?? (ignore (read-char 
el-search-search-and-replace-help-string))
-                                  nil)))))
-              (when replacement-contains-another-match
-                (el-search-hl-other-matches matcher))
-              (unless (or done (eobp))
-                (cond
-                 ((not (and replaced-this replacement-contains-another-match))
-                  (el-search--skip-expression nil t))
-                 ((eq skip-matches-in-replacement 'ask)
-                  (if (setq skip-matches-in-replacement
-                            (yes-or-no-p "Match in replacement - always skip? 
"))
-                      (forward-sexp)
-                    (el-search--skip-expression nil t)
-                    (when replace-all
-                      (setq replace-all nil)
-                      (message "Falling back to interactive mode")
-                      (sit-for 3.))))
-                 (skip-matches-in-replacement (forward-sexp))
-                 (t
-                  (el-search--skip-expression nil t)
-                  (message "Replacement contains another match%s"
-                           (if replace-all " - falling back to interactive 
mode" ""))
-                  (setq replace-all nil)
-                  (sit-for 2.))))))))
-    (el-search-hl-remove)
-    (goto-char opoint)
-    (message "Replaced %d matches%s"
-             nbr-replaced
-             (if (zerop nbr-skipped)  ""
-               (format "   (%d skipped)" nbr-skipped)))))
+        (heuristic-matcher (el-search--current-heuristic-matcher))
+        (save-all-answered nil))
+    (let ((replace-in-current-buffer
+           (lambda ()
+             (setq nbr-replaced 0)
+             (setq nbr-skipped  0)
+             (unwind-protect
+                 (progn
+
+                   ;; Try to avoid to call time consuming 
`el-search-hl-other-matches' in the loop
+                   (el-search-hl-other-matches matcher)
+                   (add-hook 'window-scroll-functions 
#'el-search--after-scroll t t)
+
+                   (while (and (not done) (el-search--search-pattern-1 matcher 
t nil heuristic-matcher))
+                     (setq opoint (point))
+                     (setf (el-search-head-position
+                            (el-search-object-head el-search--current-search))
+                           (copy-marker (point)))
+                     (setf (el-search-object-last-match 
el-search--current-search)
+                           (copy-marker (point)))
+                     (unless replace-all
+                       (el-search-hl-sexp))
+                     (let* ((region (list (point) (el-search--end-of-sexp)))
+                            (original-text (apply 
#'buffer-substring-no-properties region))
+                            (expr      (read original-text))
+                            (replaced-this nil)
+                            (new-expr  (funcall get-replacement expr))
+                            (get-replacement-string
+                             (lambda () (el-search--format-replacement
+                                    new-expr original-text to-input-string 
splice)))
+                            (to-insert (funcall get-replacement-string))
+                            (replacement-contains-another-match
+                             (with-temp-buffer
+                               (emacs-lisp-mode)
+                               (insert to-insert)
+                               (goto-char 1)
+                               (el-search--skip-expression new-expr)
+                               (condition-case nil
+                                   (progn (el-search--ensure-sexp-start)
+                                          (el-search-forward pattern nil t))
+                                 (end-of-buffer nil))))
+                            (do-replace
+                             (lambda ()
+                               (save-excursion
+                                 (save-restriction
+                                   (widen)
+                                   (el-search--replace-hunk (list (point) 
(el-search--end-of-sexp)) to-insert)))
+                               (el-search--ensure-sexp-start) ;skip 
potentially newly added whitespace
+                               (unless replace-all (el-search-hl-sexp (list 
opoint (point))))
+                               (cl-incf nbr-replaced)
+                               (cl-incf nbr-replaced-multi)
+                               (setq replaced-this t)))
+                            (query
+                             (lambda ()
+                               (car
+                                (read-multiple-choice
+                                 (if replaced-this ""
+                                   (concat "Replace"
+                                           (if (or (string-match-p "\n" 
to-insert)
+                                                   (< 40 (length to-insert)))
+                                               "" (format " with `%s'" 
to-insert))
+                                           "? "
+                                           (if splice "{splice} " "")))
+                                 (delq nil
+                                       (list
+                                        (and (not replaced-this)
+                                             '(?y "yes" "Replace this match 
and move to the next"))
+                                        (list ?n
+                                              (if replaced-this "next" "no")
+                                              "Go to the next match")
+                                        (and (not replaced-this)
+                                             '(?r "replace" "Replace this 
match but don't move"))
+                                        '(?! "all" "Replace all remaining 
matches in this buffer")
+                                        (and multiple
+                                             '(?A "All" "Replace all remaining 
matches in all buffers"))
+                                        (and (not replaced-this)
+                                             (list ?s (concat "splicing " (if 
splice "off" "on"))
+                                                   "\
+Toggle splicing mode.  When splicing mode is on (default off),
+the replacement expression must evaluate to a list, and the
+result is spliced into the buffer, instead of just inserted."))
+                                        '(?h "show" "Show replacement in a 
buffer")
+                                        '(?q "quit" "\
+Quit.  To resume, use e.g. `repeat-complex-command'."))))))))
+                       (if replace-all
+                           (funcall do-replace)
+                         (while (not (pcase (funcall query)
+                                       (?r (funcall do-replace)
+                                           nil)
+                                       (?y (funcall do-replace)
+                                           t)
+                                       (?n
+                                        (unless replaced-this (cl-incf 
nbr-skipped))
+                                        t)
+                                       (?! (unless replaced-this
+                                             (funcall do-replace))
+                                           (setq replace-all t)
+                                           t)
+                                       (?A (unless replaced-this
+                                             (funcall do-replace))
+                                           (setq replace-all t)
+                                           (setq replace-all-and-following t)
+                                           t)
+                                       (?s (cl-callf not splice)
+                                           (setq to-insert (funcall 
get-replacement-string))
+                                           nil)
+                                       (?h
+                                        (let* ((buffer (get-buffer-create
+                                                        
(generate-new-buffer-name "*Replacement*")))
+                                               (window 
(display-buffer-pop-up-window buffer ())))
+                                          (with-current-buffer buffer
+                                            (emacs-lisp-mode)
+                                            (save-excursion
+                                              (insert (funcall 
get-replacement-string))))
+                                          (read-char "Hit any key to proceed")
+                                          (delete-window window)
+                                          (kill-buffer buffer)
+                                          nil))
+                                       ((or ?q ?\C-g)
+                                        (setq done t)
+                                        t)))))
+                       (when replacement-contains-another-match
+                         (el-search-hl-other-matches matcher))
+                       (unless (or done (eobp))
+                         (cond
+                          ((not (and replaced-this
+                                     replacement-contains-another-match
+                                     skip-matches-in-replacement))
+                           (el-search--skip-expression nil t))
+                          ((eq skip-matches-in-replacement 'ask)
+                           (pcase (car (read-multiple-choice "Skip the 
match(es) in this replacement? "
+                                                             '((?y "yes")
+                                                               (?n "no")
+                                                               (?Y "always 
Yes")
+                                                               (?N "always 
No"))))
+                             ((and (or ?y ?Y) answer)
+                              (when (= answer ?Y) (setq 
skip-matches-in-replacement t))
+                              (forward-sexp))
+                             (answer
+                              (when (= answer ?N) (setq 
skip-matches-in-replacement nil))
+                              (el-search--skip-expression nil t)
+                              (when replace-all
+                                (setq replace-all nil)
+                                (message "Falling back to interactive mode")
+                                (sit-for 2.)))))
+                          (t (forward-sexp)))))))
+               (el-search-hl-remove)
+               (setf (el-search-head-position (el-search-object-head 
el-search--current-search))
+                     (point-max))
+               (goto-char opoint)
+               (if (> nbr-replaced 0)
+                   (progn
+                     (cl-incf nbr-changed-buffers)
+                     (when (pcase el-search-replace-auto-save-buffers
+                             ((or 'nil (guard (not buffer-file-name))) nil)
+                             ('ask
+                              (if save-all-answered
+                                  (cdr save-all-answered)
+                                (pcase (car (read-multiple-choice
+                                             (format
+                                              "Replaced %d matches%s - save 
this buffer? "
+                                              nbr-replaced
+                                              (if (zerop nbr-skipped)  ""
+                                                (format "   (%d skipped)" 
nbr-skipped)))
+                                             '((?y "yes")
+                                               (?n "no")
+                                               (?Y "Yes to all")
+                                               (?N "No to all"))))
+                                  (?y t)
+                                  (?n nil)
+                                  (?Y (cdr (setq save-all-answered (cons t 
t))))
+                                  (?N (cdr (setq save-all-answered (cons t 
nil)))))))
+                             (_ t))
+                       (save-buffer)))
+                 (unless multiple
+                   (message "Replaced %d matches%s"
+                            nbr-replaced
+                            (if (zerop nbr-skipped)  ""
+                              (format "   (%d skipped)" nbr-skipped)))))))))
+      (if (not multiple)
+          (funcall replace-in-current-buffer)
+        (while (and
+                (not done)
+                (progn (el-search-continue-search)
+                       (and el-search--success (not el-search--wrap-flag))))
+          (funcall replace-in-current-buffer)
+          (unless replace-all-and-following (setq replace-all nil)))
+        (message "Done.  Replaced %d matches in %d buffers." 
nbr-replaced-multi nbr-changed-buffers)))))
 
 (defun el-search-query-replace--read-args ()
   (barf-if-buffer-read-only)
@@ -2728,7 +2811,16 @@ used for history entries."
   (interactive (el-search-query-replace--read-args)) ;this binds the optional 
argument
   (setq this-command 'el-search-query-replace) ;in case we come from isearch
   (barf-if-buffer-read-only)
-  (el-search--search-and-replace-pattern from-pattern to-expr nil textual-to))
+  (el-search--search-and-replace-pattern
+   from-pattern to-expr nil textual-to
+   (and el-search--current-search
+        (eq last-command 'el-search-pattern)
+        (let ((buffer-stream (funcall
+                              (el-search-head-get-buffer-stream
+                               (el-search-object-head 
el-search--current-search)))))
+          (or (not (eq (stream-first buffer-stream) (current-buffer)))
+              (stream-first (stream-rest buffer-stream))))
+        (y-or-n-p "Multi-buffer query-replace all remaining matches of the 
current search? "))))
 
 (defun el-search--take-over-from-isearch (&optional goto-left-end)
   (let ((other-end (and goto-left-end isearch-other-end))



reply via email to

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