Factor out `el-search--replace-hunk'
[gnu-emacs-elpa] / packages / el-search / el-search.el
1 ;;; el-search.el --- Expression based incremental search for emacs-lisp-mode -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2015 Free Software Foundation, Inc
4
5 ;; Author: Michael Heerdegen <michael_heerdegen@web.de>
6 ;; Maintainer: Michael Heerdegen <michael_heerdegen@web.de>
7 ;; Created: 29 Jul 2015
8 ;; Keywords: lisp
9 ;; Compatibility: GNU Emacs 25
10 ;; Version: 0.1.3
11 ;; Package-Requires: ((emacs "25"))
12
13
14 ;; This file is not part of GNU Emacs.
15
16 ;; GNU Emacs is free software: you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
20
21 ;; GNU Emacs is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
25
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28
29
30 ;;; Commentary:
31
32 ;; Introduction
33 ;; ============
34 ;;
35 ;;
36 ;; The main user entry point is `el-search-pattern'. This command
37 ;; prompts for a `pcase' pattern and searches the current buffer for
38 ;; matching expressions by iteratively `read'ing buffer contents. For
39 ;; any match, point is put at the beginning of the expression found
40 ;; (unlike isearch which puts point at the end of matches).
41 ;;
42 ;; Why is it based on `pcase'? Because pattern matching (and the
43 ;; ability to combine destructuring and condition testing) is well
44 ;; suited for this task. In addition, pcase allows to add specialized
45 ;; pattern types and to combine them with other patterns in a natural
46 ;; and transparent way out of the box.
47 ;;
48 ;; It doesn't matter how the code is actually formatted. Comments are
49 ;; ignored, and strings are treated as atomic objects, their contents
50 ;; are not being searched.
51 ;;
52 ;;
53 ;; Example 1: if you enter
54 ;;
55 ;; 97
56 ;;
57 ;; at the prompt, this will find any occurrence of the number 97 in
58 ;; the code, but not 977 or (+ 90 7) or "My string containing 97".
59 ;; But it will find anything `eq' to 97 after reading, e.g. #x61 or
60 ;; ?a.
61 ;;
62 ;;
63 ;; Example 2: If you enter the pattern
64 ;;
65 ;; `(defvar ,_)
66 ;;
67 ;; you search for all defvar forms that don't specify an init value.
68 ;;
69 ;; The following will search for defvar forms with a docstring whose
70 ;; first line is longer than 70 characters:
71 ;;
72 ;; `(defvar ,_ ,_
73 ;; ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
74 ;;
75 ;;
76 ;; When a search pattern is processed, the searched buffer is current
77 ;; with point at the beginning of the currently tested expression.
78 ;;
79 ;;
80 ;; Convenience
81 ;; ===========
82 ;;
83 ;; For pattern input, the minibuffer is put into `emacs-lisp-mode'.
84 ;;
85 ;; Any input PATTERN is silently transformed into (and exp PATTERN)
86 ;; so that you can always refer to the whole currently tested
87 ;; expression via the variable `exp'.
88 ;;
89 ;;
90 ;; Example 3:
91 ;;
92 ;; If you want to search a buffer for symbols that are defined in
93 ;; "cl-lib", you can use this pattern
94 ;;
95 ;; (guard (and (symbolp exp)
96 ;; (when-let ((file (symbol-file exp)))
97 ;; (string-match-p "cl-lib\\.elc?$" file))))
98 ;;
99 ;;
100 ;; ,----------------------------------------------------------------------
101 ;; | Q: "But I hate `pcase'! Can't we just do without?" |
102 ;; | |
103 ;; | A: Respect that you kept up until here! Just use (guard CODE), where|
104 ;; | CODE is any normal Elisp expression that returns non-nil when and |
105 ;; | only when you have a match. Use the variable `exp' to refer to |
106 ;; | the currently tested expression. Just like in the last example! |
107 ;; `----------------------------------------------------------------------
108 ;;
109 ;;
110 ;; It's cumbersome to write out the same complicated pattern
111 ;; constructs in the minibuffer again and again. You can define your
112 ;; own pcase pattern types for the purpose of el-search with
113 ;; `el-search-defpattern'. It is just like `pcase-defmacro', but the
114 ;; effect is limited to this package. See C-h f `el-search-pattern'
115 ;; for a list of predefined additional pattern forms.
116 ;;
117 ;;
118 ;; Replacing
119 ;; =========
120 ;;
121 ;; You can replace expressions with command `el-search-query-replace'.
122 ;; You are queried for a (pcase) pattern and a replacement expression.
123 ;; For each match of the pattern, the replacement expression is
124 ;; evaluated with the bindings created by the pcase matching in
125 ;; effect, and printed to produce the replacement string.
126 ;;
127 ;; Example: In some buffer you want to swap the two expressions at the
128 ;; places of the first two arguments in all calls of function `foo',
129 ;; so that e.g.
130 ;;
131 ;; (foo 'a (* 2 (+ 3 4)) t)
132 ;;
133 ;; becomes
134 ;;
135 ;; (foo (* 2 (+ 3 4)) 'a t).
136 ;;
137 ;; This will do it:
138 ;;
139 ;; M-x el-search-query-replace RET
140 ;; `(foo ,a ,b . ,rest) RET
141 ;; `(foo ,b ,a . ,rest) RET
142 ;;
143 ;; Type y to replace a match and go to the next one, r to replace
144 ;; without moving, SPC to go to the next match and ! to replace all
145 ;; remaining matches automatically. q quits. n is like SPC, so that
146 ;; y and n work like in isearch (meaning "yes" and "no") if you are
147 ;; used to that.
148 ;;
149 ;; It is possible to replace a match with multiple expressions using
150 ;; "splicing mode". When it is active, the replacement expression
151 ;; must evaluate to a list, and is spliced instead of inserted into
152 ;; the buffer for any replaced match. Use s to toggle splicing mode
153 ;; in a `el-search-query-replace' session.
154 ;;
155 ;;
156 ;; Suggested key bindings
157 ;; ======================
158 ;;
159 ;; (define-key emacs-lisp-mode-map [(control ?S)] #'el-search-pattern)
160 ;; (define-key emacs-lisp-mode-map [(control ?%)] #'el-search-query-replace)
161 ;;
162 ;; (define-key isearch-mode-map [(control ?S)] #'el-search-search-from-isearch)
163 ;; (define-key isearch-mode-map [(control ?%)] #'el-search-replace-from-isearch)
164 ;;
165 ;; (define-key el-search-read-expression-map [(control ?S)] #'exit-minibuffer)
166 ;;
167 ;; The bindings in `isearch-mode-map' let you conveniently switch to
168 ;; "el-search" searching from isearch. The binding in
169 ;; `el-search-read-expression-map' allows you to hit C-S twice to
170 ;; start a search for the last search pattern.
171 ;;
172 ;;
173 ;; Bugs, Known Limitations
174 ;; =======================
175 ;;
176 ;; - Replacing: in some cases the reader syntax of forms
177 ;; is changing due to reading+printing. "Some" because we can treat
178 ;; that problem in most cases.
179 ;;
180 ;; - Similarly: Comments are normally preserved (where it makes
181 ;; sense). But when replacing like `(foo ,a ,b) -> `(foo ,b ,a)
182 ;;
183 ;; in a content like
184 ;;
185 ;; (foo
186 ;; a
187 ;; ;;a comment
188 ;; b)
189 ;;
190 ;; the comment will be lost.
191 ;;
192 ;; FIXME: when we have resumable sessions, pause and warn about this case.
193 ;;
194 ;;
195 ;; Acknowledgments
196 ;; ===============
197 ;;
198 ;; Thanks to Stefan Monnier for corrections and advice.
199 ;;
200 ;;
201 ;; TODO:
202 ;;
203 ;; - implement backward searching
204 ;;
205 ;; - Make `el-search-pattern' accept an &optional limit, at least for
206 ;; the non-interactive use case?
207 ;;
208 ;; - improve docstrings
209 ;;
210 ;; - handle more reader syntaxes, e.g. #n, #n#
211 ;;
212 ;; - Implement sessions; add multi-file support based on iterators. A
213 ;; file list is read in (or the user can specify an iterator as a
214 ;; variable). The state in the current buffer is just (buffer
215 ;; . marker). Or should this be abstracted into an own lib? Could
216 ;; be named "files-session" or so.
217 ;;
218 ;; - Make `el-search--format-replacement' work non-heuristically.
219 ;; Idea: When replacing, for every variable V bound by the search
220 ;; pattern that directly corresponds to some text T, provide some
221 ;; "match data" V -> T. Use this when formatting the replacement.
222 ;; Maybe use a special marker to "paste" in expressions, like (paste
223 ;; V), whereby the `paste' flag lands in the replacement and can be
224 ;; replaced textually afterwards.
225
226
227
228 ;;; Code:
229
230 ;;;; Requirements
231
232 (eval-when-compile
233 (require 'subr-x))
234
235 (require 'cl-lib)
236 (require 'elisp-mode)
237 (require 'thingatpt)
238 (require 'help-fns) ;el-search--make-docstring
239
240
241 ;;;; Configuration stuff
242
243 (defgroup el-search nil
244 "Expression based search and replace for `emacs-lisp-mode'."
245 :group 'lisp)
246
247 (defcustom el-search-this-expression-identifier 'exp
248 "Identifier referring to the current expression in pattern input.
249 When entering a PATTERN in an interactive \"el-search\" command,
250 the pattern actually used will be
251
252 `(and ,el-search-this-expression-identifier ,pattern)
253
254 The default value is `exp'."
255 :type 'symbol)
256
257 (defface el-search-match '((((background dark)) (:background "#0000A0"))
258 (t (:background "DarkSlateGray3")))
259 "Face for highlighting the current match.")
260
261 (defface el-search-other-match '((((background dark)) (:background "#202060"))
262 (t (:background "DarkSlateGray1")))
263 "Face for highlighting the other matches.")
264
265 (defcustom el-search-smart-case-fold-search t
266 "Whether to use smart case folding in pattern matching.
267 When an \"el-search\" pattern involves regexp matching (like for
268 \"string\" or \"source\") and this option is non-nil,
269 case-fold-search will be temporarily bound to t if the according
270 regexp contains any upper case letter, and nil else. This is
271 done independently for every single matching operation.
272
273 If nil, the value of `case-fold-search' is decisive."
274 :type 'boolean)
275
276 (defcustom el-search-use-sloppy-strings nil
277 "Whether to allow the usage of \"sloppy strings\".
278 When this option is turned on, for faster typing you are allowed
279 to specify symbols instead of strings as arguments to an
280 \"el-search\" pattern type that would otherwise accept only
281 strings, and their names will be used as input (with other words,
282 this spares you to type the string delimiters in many cases).
283
284 For example,
285
286 \(source ^cl\)
287
288 is then equivalent to
289
290 \(source \"^cl\"\)
291
292 When this option is off, the first form would just signal an
293 error."
294 :type 'boolean)
295
296
297 ;;;; Helpers
298
299 (defun el-search--smart-string-match-p (regexp string)
300 "`string-match-p' taking `el-search-smart-case-fold-search' into account."
301 (let ((case-fold-search (if el-search-smart-case-fold-search
302 (not (let ((case-fold-search nil))
303 (string-match-p "[[:upper:]]" regexp)))
304 case-fold-search)))
305 (string-match-p regexp string)))
306
307 (defun el-search--pp-to-string (expr)
308 (let ((print-length nil)
309 (print-level nil))
310 (pp-to-string expr)))
311
312 (defvar el-search-read-expression-map
313 (let ((map (make-sparse-keymap)))
314 (set-keymap-parent map read-expression-map)
315 (define-key map [(control ?g)] #'abort-recursive-edit)
316 (define-key map [up] nil)
317 (define-key map [down] nil)
318 (define-key map [(control ?j)] #'newline)
319 map)
320 "Map for reading input with `el-search-read-expression'.")
321
322 (defun el-search--setup-minibuffer ()
323 (let ((inhibit-read-only t))
324 (put-text-property 1 (minibuffer-prompt-end) 'font-lock-face 'minibuffer-prompt))
325 (emacs-lisp-mode)
326 (use-local-map el-search-read-expression-map)
327 (setq font-lock-mode t)
328 (funcall font-lock-function 1)
329 (goto-char (minibuffer-prompt-end))
330 (when (looking-at ".*\n")
331 (indent-sexp))
332 (goto-char (point-max))
333 (when-let ((this-sexp (with-current-buffer (window-buffer (minibuffer-selected-window))
334 (thing-at-point 'sexp))))
335 (let ((more-defaults (list (concat "'" this-sexp))))
336 (setq-local minibuffer-default-add-function
337 (lambda () (if (listp minibuffer-default)
338 (append minibuffer-default more-defaults)
339 (cons minibuffer-default more-defaults)))))))
340
341 ;; $$$$$FIXME: this should be in Emacs! There is only a helper `read--expression'.
342 (defun el-search-read-expression (prompt &optional initial-contents hist default read)
343 "Read expression for `my-eval-expression'."
344 (minibuffer-with-setup-hook #'el-search--setup-minibuffer
345 (read-from-minibuffer prompt initial-contents el-search-read-expression-map read
346 (or hist 'read-expression-history) default)))
347
348 (defvar el-search-history '()
349 "List of search input strings.")
350
351 (defvar el-search-query-replace-history '()
352 "List of input strings from `el-search-query-replace'.")
353
354 (defvar el-search--initial-mb-contents nil)
355
356 (defun el-search--pushnew-to-history (input histvar)
357 (let ((hist-head (car (symbol-value histvar))))
358 (unless (or (string-match-p "\\`\\'" input)
359 (and (stringp hist-head)
360 (or (string= input hist-head)
361 (ignore-errors (equal (read input) (read hist-head))))))
362 (push (if (string-match-p "\\`.+\n" input)
363 (with-temp-buffer
364 (emacs-lisp-mode)
365 (insert "\n" input)
366 (indent-region 1 (point))
367 (buffer-string))
368 input)
369 (symbol-value histvar)))))
370
371 (defun el-search--read-pattern (prompt &optional default histvar)
372 (cl-callf or histvar 'el-search-history)
373 (let ((input (el-search-read-expression
374 prompt el-search--initial-mb-contents histvar default)))
375 (el-search--pushnew-to-history input histvar)
376 (if (not (string= input "")) input (car (symbol-value histvar)))))
377
378 (defun el-search--end-of-sexp ()
379 ;;Point must be at sexp beginning
380 (or (scan-sexps (point) 1) (point-max)))
381
382 (defun el-search--ensure-sexp-start ()
383 "Move point to the next sexp beginning position.
384 Don't move if already at beginning of a sexp. Point must not be
385 inside a string or comment. `read' the expression at that point
386 and return it."
387 ;; This doesn't catch end-of-buffer to keep the return value non-ambiguous
388 (let ((not-done t) res)
389 (while not-done
390 (let ((stop-here nil)
391 (looking-at-from-back (lambda (regexp n)
392 (and (> (point) n)
393 (save-excursion
394 (backward-char n)
395 (looking-at regexp))))))
396 (while (not stop-here)
397 (cond
398 ((eobp) (signal 'end-of-buffer nil))
399 ((looking-at (rx (and (* space) ";"))) (forward-line))
400 ((looking-at (rx (+ (or space "\n")))) (goto-char (match-end 0)))
401
402 ;; FIXME: can the rest be done more generically?
403 ((and (looking-at (rx (or (syntax symbol) (syntax word))))
404 (not (looking-at "\\_<"))
405 (not (funcall looking-at-from-back ",@" 2)))
406 (forward-symbol 1))
407 ((or (and (looking-at "'") (funcall looking-at-from-back "#" 1))
408 (and (looking-at "@") (funcall looking-at-from-back "," 1)))
409 (forward-char))
410 (t (setq stop-here t)))))
411 (condition-case nil
412 (progn
413 (setq res (save-excursion (read (current-buffer))))
414 (setq not-done nil))
415 (error (forward-char))))
416 res))
417
418 (defvar el-search--pcase-macros '()
419 "List of additional \"el-search\" pcase macros.")
420
421 (defun el-search--make-docstring ()
422 ;; code mainly from `pcase--make-docstring'
423 (let* ((main (documentation (symbol-function 'el-search-pattern) 'raw))
424 (ud (help-split-fundoc main 'pcase)))
425 (with-temp-buffer
426 (insert (or (cdr ud) main))
427 (mapc
428 (pcase-lambda (`(,symbol . ,fun))
429 (when-let ((doc (documentation fun)))
430 (insert "\n\n\n-- ")
431 (setq doc (help-fns--signature symbol doc fun fun nil))
432 (insert "\n" (or doc "Not documented."))))
433 (reverse el-search--pcase-macros))
434 (let ((combined-doc (buffer-string)))
435 (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
436
437 (put 'el-search-pattern 'function-documentation '(el-search--make-docstring))
438
439 (defmacro el-search-defpattern (name args &rest body)
440 "Like `pcase-defmacro', but limited to el-search patterns.
441 The semantics is exactly that of `pcase-defmacro', but the scope
442 of the definitions is limited to \"el-search\"."
443 (declare (indent 2) (debug defun))
444 `(setf (alist-get ',name el-search--pcase-macros)
445 (lambda ,args ,@body)))
446
447 (defun el-search--macroexpand-1 (pattern)
448 "Expand \"el-search\" PATTERN.
449 This is like `pcase--macroexpand', but expands only patterns
450 defined with `el-search-defpattern' and performs only one
451 expansion step.
452
453 Return PATTERN if this pattern type was not defined with
454 `el-search-defpattern'."
455 (if-let ((expander (alist-get (car-safe pattern) el-search--pcase-macros)))
456 (apply expander (cdr pattern))
457 pattern))
458
459 (defmacro el-search--with-additional-pcase-macros (&rest body)
460 `(cl-letf ,(mapcar (pcase-lambda (`(,symbol . ,fun))
461 `((get ',symbol 'pcase-macroexpander) #',fun))
462 el-search--pcase-macros)
463 ,@body))
464
465 (defun el-search--matcher (pattern &rest body)
466 (eval ;use `eval' to allow for user defined pattern types at run time
467 (let ((expression (make-symbol "expression")))
468 `(el-search--with-additional-pcase-macros
469 (let ((byte-compile-debug t) ;make undefined pattern types raise an error
470 (warning-suppress-log-types '((bytecomp)))
471 (pcase--dontwarn-upats (cons '_ pcase--dontwarn-upats)))
472 (byte-compile (lambda (,expression)
473 (pcase ,expression
474 (,pattern ,@(or body (list t)))
475 (_ nil)))))))))
476
477 (defun el-search--match-p (matcher expression)
478 (funcall matcher expression))
479
480 (defun el-search--wrap-pattern (pattern)
481 `(and ,el-search-this-expression-identifier ,pattern))
482
483 (defun el-search--skip-expression (expression &optional read)
484 ;; Move forward at least one character. Don't move into a string or
485 ;; comment. Don't move further than the beginning of the next sexp.
486 ;; Try to move as far as possible. Point must be at the beginning
487 ;; of an expression.
488 ;; If there are positions where `read' would succeed, but that do
489 ;; not represent a valid sexp start, move past them (e.g. when
490 ;; before "#'" move past both characters).
491 ;;
492 ;; EXPRESSION must be the (read) expression at point, but when READ
493 ;; is non-nil, ignore the first argument and read the expression at
494 ;; point instead.
495 (when read (setq expression (save-excursion (read (current-buffer)))))
496 (cond
497 ((or (null expression)
498 (equal [] expression)
499 (not (or (listp expression) (vectorp expression))))
500 (goto-char (el-search--end-of-sexp)))
501 ((looking-at (rx (or ",@" "," "#'" "'")))
502 (goto-char (match-end 0)))
503 (t (forward-char))))
504
505 (defun el-search--search-pattern-1 (matcher &optional noerror)
506 (let ((match-beg nil) (opoint (point)) current-expr)
507
508 ;; when inside a string or comment, move past it
509 (let ((syntax-here (syntax-ppss)))
510 (when (nth 3 syntax-here) ;inside a string
511 (goto-char (nth 8 syntax-here))
512 (forward-sexp))
513 (when (nth 4 syntax-here) ;inside a comment
514 (forward-line 1)
515 (while (and (not (eobp)) (looking-at (rx (and (* space) ";"))))
516 (forward-line 1))))
517
518 (if (catch 'no-match
519 (while (not match-beg)
520 (condition-case nil
521 (setq current-expr (el-search--ensure-sexp-start))
522 (end-of-buffer
523 (goto-char opoint)
524 (throw 'no-match t)))
525 (if (el-search--match-p matcher current-expr)
526 (setq match-beg (point)
527 opoint (point))
528 (el-search--skip-expression current-expr))))
529 (if noerror nil (signal 'end-of-buffer nil)))
530 match-beg))
531
532 (defun el-search--search-pattern (pattern &optional noerror)
533 "Search elisp buffer with `pcase' PATTERN.
534 Set point to the beginning of the occurrence found and return
535 point. Optional second argument, if non-nil, means if fail just
536 return nil (no error)."
537 (el-search--search-pattern-1 (el-search--matcher pattern) noerror))
538
539 (defun el-search--replace-hunk (region to-insert)
540 "Replace the text in REGION in current buffer with string TO-INSERT.
541 Add line breaks before and after TO-INSERT when appropriate and
542 reindent."
543 (atomic-change-group
544 (let* ((inhibit-message t)
545 (opoint (point))
546 (original-text (prog1 (apply #'buffer-substring-no-properties region)
547 (goto-char (car region))
548 (apply #'delete-region region)))
549 ;; care about other sexps in this line
550 (sexp-before-us (not (looking-back "\(\\|^\\s-*" (line-beginning-position))))
551 (sexp-after-us (not (looking-at "\\s-*[;\)]\\|$")))
552 (insert-newline-before
553 (or
554 (and (string-match-p "\n" to-insert)
555 (not (string-match-p "\n" original-text))
556 (or (and sexp-before-us sexp-after-us)
557 (looking-back
558 (rx (or (syntax word) (syntax symbol))
559 (+ blank)
560 (or (syntax word) (syntax symbol))
561 (* any))
562 (line-beginning-position))))
563 ;; (and sexp-before-us
564 ;; (> (+ (apply #'max (mapcar #'length (split-string to-insert "\n")))
565 ;; (- (point) (line-beginning-position)))
566 ;; fill-column))
567 ))
568 (insert-newline-after (and insert-newline-before sexp-after-us)))
569 (when insert-newline-before
570 (when (looking-back "\\s-+" (line-beginning-position))
571 (delete-region (match-beginning 0) (match-end 0)))
572 (insert "\n"))
573 (insert to-insert)
574 (when insert-newline-after
575 (insert "\n"))
576 (indent-region opoint (1+ (point))))))
577
578 (defun el-search--format-replacement (replacement original replace-expr-input splice)
579 ;; Return a printed representation of REPLACEMENT. Try to reuse the
580 ;; layout of subexpressions shared with the original (replaced)
581 ;; expression and the replace expression.
582 (if (and splice (not (listp replacement)))
583 (error "Expression to splice in is an atom")
584 (let ((orig-buffer (generate-new-buffer "orig-expr")))
585 (with-current-buffer orig-buffer
586 (emacs-lisp-mode)
587 (insert original)
588 (when replace-expr-input (insert "\n\n" replace-expr-input)))
589 (unwind-protect
590 (with-temp-buffer
591 (emacs-lisp-mode)
592 (insert (if splice
593 (mapconcat #'el-search--pp-to-string replacement " ")
594 (el-search--pp-to-string replacement)))
595 (goto-char 1)
596 (let (start this-sexp end orig-match-start orig-match-end done)
597 (while (and (< (point) (point-max))
598 (condition-case nil
599 (progn
600 (setq start (point)
601 this-sexp (read (current-buffer))
602 end (point))
603 t)
604 (end-of-buffer nil)))
605 (setq done nil orig-match-start nil)
606 (with-current-buffer orig-buffer
607 (goto-char 1)
608 (if (el-search--search-pattern `',this-sexp t)
609 (setq orig-match-start (point)
610 orig-match-end (progn (forward-sexp) (point)))
611 (setq done t)))
612 ;; find out whether we have a sequence of equal expressions
613 (while (and (not done)
614 (condition-case nil
615 (progn (setq this-sexp (read (current-buffer))) t)
616 ((invalid-read-syntax end-of-buffer end-of-file) nil)))
617 (if (with-current-buffer orig-buffer
618 (condition-case nil
619 (if (not (equal this-sexp (read (current-buffer))))
620 nil
621 (setq orig-match-end (point))
622 t)
623 ((invalid-read-syntax end-of-buffer end-of-file) nil)))
624 (setq end (point))
625 (setq done t)))
626 ;; FIXME: there could be another occurrence of THIS-SEXP in ORIG-BUFFER with more
627 ;; subsequent equal expressions after it
628 (if orig-match-start
629 (el-search--replace-hunk
630 (list start end)
631 (with-current-buffer orig-buffer
632 (buffer-substring-no-properties orig-match-start orig-match-end)))
633 (goto-char start)
634 (el-search--skip-expression nil t))
635 (condition-case nil
636 (el-search--ensure-sexp-start)
637 (end-of-buffer (goto-char (point-max))))))
638 (goto-char 1)
639 (forward-sexp)
640 (let ((result (buffer-substring 1 (point))))
641 (if (equal replacement (read result))
642 result
643 (error "Error in `el-search--format-replacement' - please make a bug report"))))
644 (kill-buffer orig-buffer)))))
645
646 (defun el-search--check-pattern-args (type args predicate &optional message)
647 "Check whether all ARGS fulfill PREDICATE.
648 Raise an error if not. The string arguments TYPE and optional
649 MESSAGE are used to construct the error message."
650 (mapc (lambda (arg)
651 (unless (funcall predicate arg)
652 (error (concat "Pattern `%s': "
653 (or message (format "argument doesn't fulfill %S" predicate))
654 ": %S")
655 type arg)))
656 args))
657
658 (defvar el-search-current-pattern nil)
659
660 (defvar el-search-success nil)
661
662
663 ;;;; Additional pattern type definitions
664
665 (defun el-search--split (matcher1 matcher2 list)
666 "Helper for the append pattern type.
667
668 When a splitting of LIST into two lists L1, L2 exist so that Li
669 is matched by MATCHERi, return (L1 L2) for such Li, else return
670 nil."
671 (let ((try-match (lambda (list1 list2)
672 (when (and (el-search--match-p matcher1 list1)
673 (el-search--match-p matcher2 list2))
674 (list list1 list2))))
675 (list1 list) (list2 '()) (match nil))
676 ;; don't use recursion, this could hit `max-lisp-eval-depth'
677 (while (and (not (setq match (funcall try-match list1 list2)))
678 (consp list1))
679 (let ((last-list1 (last list1)))
680 (if-let ((cdr-last-list1 (cdr last-list1)))
681 ;; list1 is a dotted list. Then list2 must be empty.
682 (progn (setcdr last-list1 nil)
683 (setq list2 cdr-last-list1))
684 (setq list1 (butlast list1 1)
685 list2 (cons (car last-list1) list2)))))
686 match))
687
688 (el-search-defpattern append (&rest patterns)
689 "Matches any list factorable into lists matched by PATTERNS in order.
690
691 PATTERNS is a list of patterns P1..Pn. Match any list L for that
692 lists L1..Ln exist that are matched by P1..Pn in order and L is
693 equal to the concatenation of L1..Ln. Ln is allowed to be no
694 list.
695
696 When different ways of matching are possible, it is unspecified
697 which one is chosen.
698
699 Example: the pattern
700
701 (append '(1 2 3) x (app car-safe 7))
702
703 matches the list (1 2 3 4 5 6 7 8 9) and binds `x' to (4 5 6)."
704 (if (null patterns)
705 '(pred null)
706 (pcase-let ((`(,pattern . ,more-patterns) patterns))
707 (cond
708 ((null more-patterns) pattern)
709 ((null (cdr more-patterns))
710 `(and (pred listp)
711 (app ,(apply-partially #'el-search--split
712 (el-search--matcher pattern)
713 (el-search--matcher (car more-patterns)))
714 (,'\` ((,'\, ,pattern)
715 (,'\, ,(car more-patterns)))))))
716 (t `(append ,pattern (append ,@more-patterns)))))))
717
718 (defun el-search--stringish-p (thing)
719 (or (stringp thing) (and el-search-use-sloppy-strings (symbolp thing))))
720
721 (el-search-defpattern string (&rest regexps)
722 "Matches any string that is matched by all REGEXPS."
723 (el-search--check-pattern-args "string" regexps #'el-search--stringish-p
724 "Argument not a string")
725 `(and (pred stringp)
726 ,@(mapcar (lambda (thing) `(pred (el-search--smart-string-match-p
727 ,(if (symbolp thing) (symbol-name thing) thing))))
728 regexps)))
729
730 (el-search-defpattern symbol (&rest regexps)
731 "Matches any symbol whose name is matched by all REGEXPS."
732 (el-search--check-pattern-args "symbol" regexps #'el-search--stringish-p
733 "Argument not a string")
734 `(and (pred symbolp)
735 (app symbol-name (string ,@regexps))))
736
737 (defun el-search--contains-p (matcher exp)
738 "Return non-nil when tree EXP contains a match for MATCHER.
739 Recurse on all types of sequences. In the positive case the
740 return value is (t elt), where ELT is a matching element found in
741 EXP."
742 (if (el-search--match-p matcher exp)
743 (list t exp)
744 (and (sequencep exp)
745 (let ((try-match (apply-partially #'el-search--contains-p matcher)))
746 (if (consp exp)
747 (or (funcall try-match (car exp))
748 (funcall try-match (cdr exp)))
749 (cl-some try-match exp))))))
750
751 (el-search-defpattern contains (&rest patterns)
752 "Matches trees that contain a match for all PATTERNs.
753 Searches any tree of sequences recursively for matches. Objects
754 of any kind matched by all PATTERNs are also matched.
755
756 Example: (contains (string \"H\") 17) matches ((\"Hallo\") x (5 [1 17]))"
757 (cond
758 ((null patterns) '_)
759 ((null (cdr patterns))
760 (let ((pattern (car patterns)))
761 `(app ,(apply-partially #'el-search--contains-p (el-search--matcher pattern))
762 (,'\` (t (,'\, ,pattern))))))
763 (t `(and ,@(mapcar (lambda (pattern) `(contains ,pattern)) patterns)))))
764
765 (el-search-defpattern not (pattern)
766 "Matches any object that is not matched by PATTERN."
767 `(app ,(apply-partially #'el-search--match-p (el-search--matcher pattern))
768 (pred not)))
769
770 (defun el-search--match-symbol-file (regexp symbol)
771 (when-let ((symbol-file (and (symbolp symbol)
772 (symbol-file symbol))))
773 (el-search--smart-string-match-p
774 (if (symbolp regexp) (concat "\\`" (symbol-name regexp) "\\'") regexp)
775 (file-name-sans-extension (file-name-nondirectory symbol-file)))))
776
777 (el-search-defpattern source (regexp)
778 "Matches any symbol whose `symbol-file' is matched by REGEXP.
779
780 This pattern matches when the object is a symbol for that
781 `symbol-file' returns a (non-nil) FILE-NAME that fulfills
782 (string-match-p REGEXP (file-name-sans-extension
783 (file-name-nondirectory FILENAME)))
784
785 REGEXP can also be a symbol, in which case
786
787 (concat \"^\" (symbol-name regexp) \"$\")
788
789 is used as regular expression."
790 (el-search--check-pattern-args "source" (list regexp) #'el-search--stringish-p
791 "Argument not a string")
792 `(pred (el-search--match-symbol-file ,(if (symbolp regexp) (symbol-name regexp) regexp))))
793
794 (defun el-search--match-key-sequence (keys expr)
795 (when-let ((expr-keys (pcase expr
796 ((or (pred stringp) (pred vectorp)) expr)
797 (`(kbd ,(and (pred stringp) string)) (ignore-errors (kbd string))))))
798 (apply #'equal
799 (mapcar (lambda (keys) (ignore-errors (key-description keys)))
800 (list keys expr-keys)))))
801
802 (el-search-defpattern keys (key-sequence)
803 "Matches descriptions of the KEY-SEQUENCE.
804 KEY-SEQUENCE is a string or vector representing a key sequence,
805 or an expression of the form (kbd STRING).
806
807 Match any description of the same key sequence in any of these
808 formats.
809
810 Example: the pattern
811
812 (keys (kbd \"C-s\"))
813
814 matches any of these expressions:
815
816 \"\\C-s\"
817 \"\C-s\"
818 (kbd \"C-s\")
819 [(control ?s)]"
820 (when (eq (car-safe key-sequence) 'kbd)
821 (setq key-sequence (kbd (cadr key-sequence))))
822 (el-search--check-pattern-args "keys" (list key-sequence) (lambda (x) (or (stringp x) (vectorp x)))
823 "argument not a string or vector")
824 `(pred (el-search--match-key-sequence ,key-sequence)))
825
826 (defun el-search--transform-nontrivial-lpat (expr)
827 (cond
828 ((symbolp expr) `(or (symbol ,(symbol-name expr))
829 (,'\` (,'quote (,'\, (symbol ,(symbol-name expr)))))
830 (,'\` (,'function (,'\, (symbol ,(symbol-name expr)))))))
831 ((stringp expr) `(string ,expr))
832 (t expr)))
833
834 (el-search-defpattern l (&rest lpats)
835 "Alternative pattern type for matching lists.
836 Match any list with subsequent elements matched by all LPATS in
837 order.
838
839 The idea is to be able to search for pieces of code (i.e. lists)
840 with very brief input by using a specialized syntax.
841
842 An LPAT can take the following forms:
843
844 SYMBOL Matches any symbol S matched by SYMBOL's name interpreted
845 as a regexp. Matches also 'S and #'S for any such S.
846 STRING Matches any string matched by STRING interpreted as a
847 regexp
848 _ Matches any list element
849 __ Matches any number of list elements (including zero)
850 ^ Matches zero elements, but only at the beginning of a list
851 $ Matches zero elements, but only at the end of a list
852 PAT Anything else is interpreted as a normal pcase pattern, and
853 matches one list element matched by it
854
855 ^ is only valid as the first, $ as the last of the LPATS.
856
857 Example: To match defuns that contain \"hl\" in their name and
858 have at least one mandatory, but also optional arguments, you
859 could use this pattern:
860
861 (l ^ 'defun hl (l _ &optional))"
862 (let ((match-start nil) (match-end nil))
863 (when (eq (car-safe lpats) '^)
864 (setq match-start t)
865 (cl-callf cdr lpats))
866 (when (eq (car-safe (last lpats)) '$)
867 (setq match-end t)
868 (cl-callf butlast lpats 1))
869 `(append ,@(if match-start '() '(_))
870 ,@(mapcar
871 (lambda (elt)
872 (pcase elt
873 ('__ '_)
874 ('_ '`(,_))
875 ('_? '(or '() `(,_))) ;FIXME: useful - document? or should we provide a (? PAT)
876 ;thing?
877 (_ `(,'\` ((,'\, ,(el-search--transform-nontrivial-lpat elt)))))))
878 lpats)
879 ,@(if match-end '() '(_)))))
880
881 (el-search-defpattern char-prop (property)
882 "Matches the object if completely covered with PROPERTY.
883 This pattern matches the object if its representation in the
884 search buffer is completely covered with the character property
885 PROPERTY.
886
887 This pattern always tests the complete expression in the search
888 buffer, it is not possible to test subexpressions calculated in
889 the search pattern."
890 `(guard (and (get-char-property (point) ',property)
891 ,(macroexp-let2 nil limit '(scan-sexps (point) 1)
892 `(= (next-single-char-property-change
893 (point) ',property nil ,limit)
894 ,limit)))))
895
896 (el-search-defpattern includes-prop (property)
897 "Matches the object if partly covered with PROPERTY.
898 This pattern matches the object if its representation in the
899 search buffer is partly covered with the character property
900 PROPERTY.
901
902 This pattern always tests the complete expression in the search
903 buffer, it is not possible to test subexpressions calculated in
904 the search pattern."
905 `(guard (or (get-char-property (point) ',property)
906 ,(macroexp-let2 nil limit '(scan-sexps (point) 1)
907 `(not (= (next-single-char-property-change
908 (point) ',property nil ,limit)
909 ,limit))))))
910
911 (el-search-defpattern change ()
912 "Matches the object if it is part of a change.
913 This is equivalent to (char-prop diff-hl-hunk).
914
915 You need `diff-hl-mode' turned on, provided by the library
916 \"diff-hl\" available in Gnu Elpa."
917 (or (bound-and-true-p diff-hl-mode)
918 (error "diff-hl-mode not enabled"))
919 '(char-prop diff-hl-hunk))
920
921 (el-search-defpattern changed ()
922 "Matches the object if it contains a change.
923 This is equivalent to (includes-prop diff-hl-hunk).
924
925 You need `diff-hl-mode' turned on, provided by the library
926 \"diff-hl\" available in Gnu Elpa."
927 (or (bound-and-true-p diff-hl-mode)
928 (error "diff-hl-mode not enabled"))
929 '(includes-prop diff-hl-hunk))
930
931
932 ;;;; Highlighting
933
934 (defvar-local el-search-hl-overlay nil)
935
936 (defvar-local el-search-hl-other-overlays '())
937
938 (defvar el-search-keep-hl nil)
939
940 (defun el-search-hl-sexp (&optional bounds)
941 (let ((bounds (or bounds
942 (list (point) (el-search--end-of-sexp)))))
943 (if (overlayp el-search-hl-overlay)
944 (apply #'move-overlay el-search-hl-overlay bounds)
945 (overlay-put (setq el-search-hl-overlay (apply #'make-overlay bounds))
946 'face 'el-search-match))
947 (overlay-put el-search-hl-overlay 'priority 1002))
948 (add-hook 'post-command-hook #'el-search-hl-post-command-fun t t))
949
950 (defun el-search--hl-other-matches-1 (pattern from to)
951 (mapc #'delete-overlay el-search-hl-other-overlays)
952 (setq el-search-hl-other-overlays '())
953 (let ((matcher (el-search--matcher pattern))
954 this-match-beg this-match-end
955 (done nil))
956 (save-excursion
957 (goto-char from)
958 (while (not done)
959 (setq this-match-beg (el-search--search-pattern-1 matcher t))
960 (if (not this-match-beg)
961 (setq done t)
962 (goto-char this-match-beg)
963 (setq this-match-end (el-search--end-of-sexp))
964 (let ((ov (make-overlay this-match-beg this-match-end)))
965 (overlay-put ov 'face 'el-search-other-match)
966 (overlay-put ov 'priority 1001)
967 (push ov el-search-hl-other-overlays)
968 (goto-char this-match-end)
969 (when (>= (point) to) (setq done t))))))))
970
971 (defun el-search-hl-other-matches (pattern)
972 "Highlight all matches visible in the selected window."
973 (el-search--hl-other-matches-1 pattern
974 (save-excursion
975 (goto-char (window-start))
976 (beginning-of-defun-raw)
977 (point))
978 (window-end))
979 (add-hook 'window-scroll-functions #'el-search--after-scroll t t))
980
981 (defun el-search--after-scroll (_win start)
982 (el-search--hl-other-matches-1 el-search-current-pattern
983 (save-excursion
984 (goto-char start)
985 (beginning-of-defun-raw)
986 (point))
987 (window-end nil t)))
988
989 (defun el-search-hl-remove ()
990 (when (overlayp el-search-hl-overlay)
991 (delete-overlay el-search-hl-overlay))
992 (remove-hook 'window-scroll-functions #'el-search--after-scroll t)
993 (mapc #'delete-overlay el-search-hl-other-overlays)
994 (setq el-search-hl-other-overlays '()))
995
996 (defun el-search-hl-post-command-fun ()
997 (unless (or el-search-keep-hl
998 (eq this-command 'el-search-query-replace)
999 (eq this-command 'el-search-pattern))
1000 (el-search-hl-remove)
1001 (remove-hook 'post-command-hook 'el-search-hl-post-command-fun t)))
1002
1003
1004 ;;;; Core functions
1005
1006 ;;;###autoload
1007 (defun el-search-pattern (pattern &optional no-error)
1008 "Start new or resume last elisp search.
1009
1010 Search current buffer for expressions that are matched by `pcase'
1011 PATTERN. Use `read' to transform buffer contents into
1012 expressions.
1013
1014 Use `emacs-lisp-mode' for reading input. Some keys in the
1015 minibuffer have a special binding: to make it possible to edit
1016 multi line input, C-j inserts a newline, and up and down move the
1017 cursor vertically - see `el-search-read-expression-map' for more
1018 details.
1019
1020
1021 Additional `pcase' pattern types to be used with this command can
1022 be defined with `el-search-defpattern'.
1023
1024 The following additional pattern types are currently defined:"
1025 (interactive (list (if (and (eq this-command last-command)
1026 el-search-success)
1027 el-search-current-pattern
1028 (let* ((input (el-search--read-pattern "Find pcase pattern: "
1029 (car el-search-history)))
1030 (pattern (read input)))
1031 ;; A very common mistake: input "foo" instead of "'foo"
1032 (when (and (symbolp pattern)
1033 (not (eq pattern '_))
1034 (or (not (boundp pattern))
1035 (not (eq (symbol-value pattern) pattern))))
1036 (error "Please don't forget the quote when searching for a symbol"))
1037 ;; Make input available also in query-replace history
1038 (el-search--pushnew-to-history input 'el-search-query-replace-history)
1039 ;; and wrap the PATTERN
1040 (el-search--wrap-pattern pattern)))))
1041 (if (not (called-interactively-p 'any))
1042 (el-search--search-pattern pattern no-error)
1043 (setq this-command 'el-search-pattern) ;in case we come from isearch
1044 (setq el-search-current-pattern pattern)
1045 (let ((opoint (point)))
1046 (when (and (eq this-command last-command) el-search-success)
1047 (el-search--skip-expression nil t))
1048 (setq el-search-success nil)
1049 (when (condition-case nil
1050 (el-search--search-pattern pattern)
1051 (end-of-buffer (message "No match")
1052 (goto-char opoint)
1053 (el-search-hl-remove)
1054 (ding)
1055 nil))
1056 (setq el-search-success t)
1057 (el-search-hl-sexp)
1058 (unless (eq this-command last-command)
1059 (el-search-hl-other-matches pattern))))))
1060
1061 (defvar el-search-search-and-replace-help-string
1062 "\
1063 y Replace this match and move to the next.
1064 SPC or n Skip this match and move to the next.
1065 r Replace this match but don't move.
1066 ! Replace all remaining matches automatically.
1067 q Quit. To resume, use e.g. `repeat-complex-command'.
1068 ? Show this help.
1069 s Toggle splicing mode. When splicing mode is
1070 on (default off), the replacement expression must
1071 evaluate to a list, and the result is spliced into the
1072 buffer, instead of just inserted.
1073
1074 Hit any key to proceed."
1075 "Help string for ? in `el-search-query-replace'.")
1076
1077 (defun el-search--search-and-replace-pattern (pattern replacement &optional splice to-input-string)
1078 (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
1079 (el-search-keep-hl t) (opoint (point))
1080 (get-replacement (el-search--matcher pattern replacement))
1081 (skip-matches-in-replacement 'ask))
1082 (unwind-protect
1083 (while (and (not done) (el-search--search-pattern pattern t))
1084 (setq opoint (point))
1085 (unless replace-all
1086 (el-search-hl-sexp)
1087 (unless (eq this-command last-command)
1088 (el-search-hl-other-matches pattern)))
1089 (let* ((region (list (point) (el-search--end-of-sexp)))
1090 (original-text (apply #'buffer-substring-no-properties region))
1091 (expr (read original-text))
1092 (replaced-this nil)
1093 (new-expr (funcall get-replacement expr))
1094 (get-replacement-string
1095 (lambda () (el-search--format-replacement new-expr original-text to-input-string splice)))
1096 (to-insert (funcall get-replacement-string))
1097 (replacement-contains-another-match
1098 (with-temp-buffer
1099 (emacs-lisp-mode)
1100 (insert to-insert)
1101 (goto-char 1)
1102 (el-search--skip-expression new-expr)
1103 (condition-case nil
1104 (progn (el-search--ensure-sexp-start)
1105 (el-search--search-pattern pattern t))
1106 (end-of-buffer nil))))
1107 (do-replace
1108 (lambda ()
1109 (save-excursion
1110 (el-search--replace-hunk (list (point) (el-search--end-of-sexp)) to-insert))
1111 (el-search--ensure-sexp-start) ;skip potentially newly added whitespace
1112 (el-search-hl-sexp (list opoint (point)))
1113 (cl-incf nbr-replaced)
1114 (setq replaced-this t))))
1115 (if replace-all
1116 (funcall do-replace)
1117 (while (not (pcase (if replaced-this
1118 (read-char-choice "[SPC ! q] (? for help)"
1119 '(?\ ?! ?q ?\C-g ?n ??))
1120 (read-char-choice
1121 (concat "Replace this occurrence"
1122 (if (or (string-match-p "\n" to-insert)
1123 (< 40 (length to-insert)))
1124 "" (format " with `%s'" to-insert))
1125 "? "
1126 (if splice "{splice} " "")
1127 "[y SPC r ! s q] (? for help)" )
1128 '(?y ?n ?r ?\ ?! ?q ?\C-g ?s ??)))
1129 (?r (funcall do-replace)
1130 nil)
1131 (?y (funcall do-replace)
1132 t)
1133 ((or ?\ ?n)
1134 (unless replaced-this (cl-incf nbr-skipped))
1135 t)
1136 (?! (unless replaced-this
1137 (funcall do-replace))
1138 (setq replace-all t)
1139 t)
1140 (?s (cl-callf not splice)
1141 (setq to-insert (funcall get-replacement-string))
1142 nil)
1143 ((or ?q ?\C-g)
1144 (setq done t)
1145 t)
1146 (?? (ignore (read-char el-search-search-and-replace-help-string))
1147 nil)))))
1148 (unless (or done (eobp))
1149 (cond
1150 ((not (and replaced-this replacement-contains-another-match))
1151 (el-search--skip-expression nil t))
1152 ((eq skip-matches-in-replacement 'ask)
1153 (if (setq skip-matches-in-replacement
1154 (yes-or-no-p "Match in replacement - always skip? "))
1155 (forward-sexp)
1156 (el-search--skip-expression nil t)
1157 (when replace-all
1158 (setq replace-all nil)
1159 (message "Falling back to interactive mode")
1160 (sit-for 3.))))
1161 (skip-matches-in-replacement (forward-sexp))
1162 (t
1163 (el-search--skip-expression nil t)
1164 (message "Replacement contains another match%s"
1165 (if replace-all " - falling back to interactive mode" ""))
1166 (setq replace-all nil)
1167 (sit-for 2.)))))))
1168 (el-search-hl-remove)
1169 (goto-char opoint)
1170 (message "Replaced %d matches%s"
1171 nbr-replaced
1172 (if (zerop nbr-skipped) ""
1173 (format " (%d skipped)" nbr-skipped)))))
1174
1175 (defun el-search-query-replace--read-args ()
1176 (barf-if-buffer-read-only)
1177 (let ((from-input (let ((el-search--initial-mb-contents
1178 (or el-search--initial-mb-contents
1179 (and (eq last-command 'el-search-pattern)
1180 (car el-search-history)))))
1181 (el-search--read-pattern "Query replace pattern: " nil
1182 'el-search-query-replace-history)))
1183 from to)
1184 (with-temp-buffer
1185 (emacs-lisp-mode)
1186 (insert from-input)
1187 (goto-char 1)
1188 (forward-sexp)
1189 (skip-chars-forward " \t\n\f")
1190 ;; FIXME: maybe more sanity tests here...
1191 (if (not (looking-at "->"))
1192 (setq from from-input
1193 to (let ((el-search--initial-mb-contents nil))
1194 (el-search--read-pattern "Replace with result of evaluation of: " from)))
1195 (delete-char 2)
1196 (goto-char 1)
1197 (forward-sexp)
1198 (setq from (buffer-substring 1 (point)))
1199 (skip-chars-forward " \t\n\f")
1200 (setq to (buffer-substring (point) (progn (forward-sexp) (point))))))
1201 (unless (and el-search-query-replace-history
1202 (not (string= from from-input))
1203 (string= from-input (car el-search-query-replace-history)))
1204 (push (with-temp-buffer
1205 (emacs-lisp-mode)
1206 (insert (let ((newline-in-from (string-match-p "\n" from))
1207 (newline-in-to (string-match-p "\n" to)))
1208 (format "%s%s%s ->%s%s"
1209 (if (and (or newline-in-from newline-in-to)
1210 (not (string-match-p "\\`\n" from))) "\n" "")
1211 (if newline-in-from "\n" "" ) from
1212 (if (and (or newline-in-from newline-in-to)
1213 (not (string-match-p "\\`\n" to))) "\n" " ") to)))
1214 (indent-region 1 (point-max))
1215 (buffer-string))
1216 el-search-query-replace-history))
1217 (el-search--pushnew-to-history from 'el-search-history)
1218 (list (el-search--wrap-pattern (read from)) (read to) to)))
1219
1220 ;;;###autoload
1221 (defun el-search-query-replace (from-pattern to-expr &optional textual-to)
1222 "Replace some matches of \"el-search\" pattern FROM-PATTERN.
1223
1224 TO-EXPR is an Elisp expression that is evaluated repeatedly for
1225 each match with bindings created in FROM-PATTERN in effect to
1226 produce a replacement expression. Operate from point
1227 to (point-max).
1228
1229 As each match is found, the user must type a character saying
1230 what to do with it. For directions, type ? at that time.
1231
1232 As an alternative to enter FROM-PATTERN and TO-EXPR separately,
1233 you can also give an input of the form
1234
1235 FROM-PATTERN -> TO-EXPR
1236
1237 to the first prompt and specify both expressions at once. This
1238 format is also used for history entries."
1239 (interactive (el-search-query-replace--read-args))
1240 (setq this-command 'el-search-query-replace) ;in case we come from isearch
1241 (setq el-search-current-pattern from-pattern)
1242 (barf-if-buffer-read-only)
1243 (el-search--search-and-replace-pattern from-pattern to-expr nil textual-to))
1244
1245 (defun el-search--take-over-from-isearch (&optional goto-left-end)
1246 (let ((other-end (and goto-left-end isearch-other-end))
1247 (input isearch-string))
1248 (isearch-exit)
1249 (when (and other-end (< other-end (point)))
1250 (goto-char other-end))
1251 input))
1252
1253 ;;;###autoload
1254 (defun el-search-search-from-isearch ()
1255 ;; FIXME: an interesting alternative would be to really integrate it
1256 ;; with Isearch, using `isearch-search-fun-function'.
1257 ;; Alas, this is not trivial if we want to transfer our optimizations.
1258 (interactive)
1259 (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
1260 ;; use `call-interactively' so we get recorded in `extended-command-history'
1261 (call-interactively #'el-search-pattern)))
1262
1263 ;;;###autoload
1264 (defun el-search-replace-from-isearch ()
1265 (interactive)
1266 (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch t))))
1267 (call-interactively #'el-search-query-replace)))
1268
1269
1270
1271 (provide 'el-search)
1272 ;;; el-search.el ends here