]> code.delx.au - gnu-emacs-elpa/blob - packages/el-search/el-search.el
Merge commit '1a7c480d1e15133b942201f5964fda5e7d74919f' from context-coloring
[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
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 ;; It doesn't matter how the code is actually formatted. Comments are
43 ;; ignored, and strings are treated as atomic objects, their contents
44 ;; are not being searched.
45 ;;
46 ;; Example 1: if you enter
47 ;;
48 ;; 97
49 ;;
50 ;; at the prompt, this will find any occurrence of the number 97 in
51 ;; the code, but not 977 or (+ 90 7) or "My string containing 97".
52 ;; But it will find anything `eq' to 97 after reading, e.g. #x61 or
53 ;; ?a.
54 ;;
55 ;;
56 ;; Example 2: If you enter the pattern
57 ;;
58 ;; `(defvar ,_)
59 ;;
60 ;; you search for all defvar forms that don't specify an init value.
61 ;;
62 ;; The following will search for defvar forms with a docstring whose
63 ;; first line is longer than 70 characters:
64 ;;
65 ;; `(defvar ,_ ,_
66 ;; ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
67 ;;
68 ;;
69 ;; When a search pattern is processed, the searched buffer is current
70 ;; with point at the beginning of the currently tested expression.
71 ;;
72 ;;
73 ;; Example 3:
74 ;;
75 ;; I can be useful to use (guard EXP) patterns for side effects.
76 ;;
77 ;; The following pattern will search for symbols defined in any
78 ;; library whose name starts with "cl". As a side effect, it prints
79 ;; the current line number, whether we have a macro or a function, and
80 ;; the defining file in the echo area for each match:
81 ;;
82 ;; (and (pred symbolp)
83 ;; (let file (symbol-file exp))
84 ;; (guard file)
85 ;; (let lib-name (file-name-sans-extension
86 ;; (file-name-nondirectory file)))
87 ;; (guard (string-match-p "^cl" lib-name))
88 ;; (or (and (pred macrop) (let type "macro "))
89 ;; (and (pred functionp) (let type "function "))
90 ;; (let type ""))
91 ;; (guard (message "Line %d: %s`%S' (from \"%s\")"
92 ;; (line-number-at-pos)
93 ;; type
94 ;; exp
95 ;; lib-name)))
96 ;;
97 ;; `message' never returns nil, so the last `guard' always "matches".
98 ;;
99 ;;
100 ;; Convenience
101 ;; ===========
102 ;;
103 ;; For pattern input, the minibuffer is put into `emacs-lisp-mode'.
104 ;;
105 ;; Any input PATTERN is silently transformed into (and exp PATTERN)
106 ;; so that you can always refer to the whole currently tested
107 ;; expression via the variable `exp'.
108 ;;
109 ;; Example 4:
110 ;;
111 ;; If you want to search a buffer for symbols that are defined in
112 ;; "cl-lib", you can use this pattern
113 ;;
114 ;; (guard (and (symbolp exp)
115 ;; (when-let ((file (symbol-file exp)))
116 ;; (string-match-p "cl-lib\\.elc?$" file))))
117 ;;
118 ;;
119 ;; ,----------------------------------------------------------------------
120 ;; | Q: "But I hate `pcase'! Can't we just do without?" |
121 ;; | |
122 ;; | A: Respect that you kept up until here! Just use (guard CODE), where|
123 ;; | CODE is any normal Elisp expression that returns non-nil when and |
124 ;; | only when you have a match. Use the variable `exp' to refer to |
125 ;; | the currently tested expression. Just like in the last example! |
126 ;; `----------------------------------------------------------------------
127 ;;
128 ;;
129 ;; It's cumbersome to write out the same complicated pattern
130 ;; constructs in the minibuffer again and again. You can define your
131 ;; own pcase pattern types for the purpose of el-search with
132 ;; `el-search-defpattern'. It is just like `pcase-defmacro', but the
133 ;; effect is limited to this package. See C-h f `el-search-pattern'
134 ;; for a list of predefined additional pattern forms.
135 ;;
136 ;;
137 ;; Replacing
138 ;; =========
139 ;;
140 ;; You can replace expressions with command `el-search-query-replace'.
141 ;; You are queried for a (pcase) pattern and a replacement expression.
142 ;; For each match of the pattern, the replacement expression is
143 ;; evaluated with the bindings created by the pcase matching in
144 ;; effect, and printed to produce the replacement string.
145 ;;
146 ;; Example: In some buffer you want to swap the two expressions at the
147 ;; places of the first two arguments in all calls of function `foo',
148 ;; so that e.g.
149 ;;
150 ;; (foo 'a (* 2 (+ 3 4)) t)
151 ;;
152 ;; becomes
153 ;;
154 ;; (foo (* 2 (+ 3 4)) 'a t).
155 ;;
156 ;; This will do it:
157 ;;
158 ;; M-x el-search-query-replace RET
159 ;; `(foo ,a ,b . ,rest) RET
160 ;; `(foo ,b ,a . ,rest) RET
161 ;;
162 ;; Type y to replace a match and go to the next one, r to replace
163 ;; without moving, SPC to go to the next match and ! to replace all
164 ;; remaining matches automatically. q quits. n is like SPC, so that
165 ;; y and n work like in isearch (meaning "yes" and "no") if you are
166 ;; used to that.
167 ;;
168 ;;
169 ;; Suggested key bindings
170 ;; ======================
171 ;;
172 ;; (define-key emacs-lisp-mode-map [(control ?S)] #'el-search-pattern)
173 ;; (define-key emacs-lisp-mode-map [(control ?%)] #'el-search-query-replace)
174 ;;
175 ;; (define-key isearch-mode-map [(control ?S)] #'el-search-search-from-isearch)
176 ;; (define-key isearch-mode-map [(control ?%)] #'el-search-replace-from-isearch)
177 ;;
178 ;; The bindings in `isearch-mode-map' let you conveniently switch to
179 ;; elisp searching from isearch.
180 ;;
181 ;;
182 ;; Bugs, Known Limitations
183 ;; =======================
184 ;;
185 ;; - Replacing: in some cases the reader syntax of forms
186 ;; is changing due to reading+printing. "Some" because we can treat
187 ;; that problem in most cases.
188 ;;
189 ;; - Similarly: Comments are normally preserved (where it makes
190 ;; sense). But when replacing like `(foo ,a ,b) -> `(foo ,b ,a)
191 ;;
192 ;; in a content like
193 ;;
194 ;; (foo
195 ;; a
196 ;; ;;a comment
197 ;; b)
198 ;;
199 ;; the comment will be lost.
200 ;;
201 ;;
202 ;; Acknowledgments
203 ;; ===============
204 ;;
205 ;; Thanks to Stefan Monnier for corrections and advice.
206 ;;
207 ;;
208 ;; TODO:
209 ;;
210 ;; - implement backward searching
211 ;;
212 ;; - improve docstrings
213 ;;
214 ;; - handle more reader syntaxes, e.g. #n, #n#
215 ;;
216 ;; - Implement sessions; add multi-file support based on iterators. A
217 ;; file list is read in (or the user can specify an iterator as a
218 ;; variable). The state in the current buffer is just (buffer
219 ;; . marker). Or should this be abstracted into an own lib? Could be
220 ;; named "files-session" or so.
221
222
223
224 ;;; Code:
225
226 ;;;; Requirements
227
228 (eval-when-compile
229 (require 'subr-x))
230
231 (require 'cl-lib)
232 (require 'elisp-mode)
233 (require 'thingatpt)
234 (require 'help-fns) ;el-search--make-docstring
235
236
237 ;;;; Configuration stuff
238
239 (defgroup el-search nil
240 "Expression based search and replace for `emacs-lisp-mode'."
241 :group 'lisp)
242
243 (defcustom el-search-this-expression-identifier 'exp
244 "Name of the identifier referring to the current expression.
245 The default value is `exp'. You can use this name in the search
246 prompt to refer to the value of the currently tested expression."
247 :type 'symbol)
248
249 (defface el-search-match '((((background dark)) (:background "#0000A0"))
250 (t (:background "DarkSlateGray1")))
251 "Face for highlighting the current match.")
252
253
254 ;;;; Helpers
255
256 (defun el-search--print (expr)
257 (let ((print-quoted t)
258 (print-length nil)
259 (print-level nil))
260 (prin1-to-string expr)))
261
262 (defvar el-search-read-expression-map
263 (let ((map (make-sparse-keymap)))
264 (set-keymap-parent map read-expression-map)
265 (define-key map [(control ?g)] #'abort-recursive-edit)
266 (define-key map [up] nil)
267 (define-key map [down] nil)
268 (define-key map [(control meta backspace)] #'backward-kill-sexp)
269 (define-key map [(control ?S)] #'exit-minibuffer)
270 map)
271 "Map for reading input with `el-search-read-expression'.")
272
273 ;; $$$$$FIXME: this should be in Emacs! There is only a helper `read--expression'.
274 (defun el-search-read-expression (prompt &optional initial-contents hist default read)
275 "Read expression for `my-eval-expression'."
276 (minibuffer-with-setup-hook
277 (lambda ()
278 (emacs-lisp-mode)
279 (use-local-map el-search-read-expression-map)
280 (setq font-lock-mode t)
281 (funcall font-lock-function 1)
282 (backward-sexp)
283 (indent-sexp)
284 (goto-char (point-max)))
285 (read-from-minibuffer prompt initial-contents el-search-read-expression-map read
286 (or hist 'read-expression-history) default)))
287
288 (defvar el-search--initial-mb-contents nil)
289
290 (defun el-search--read-pattern (prompt &optional default read)
291 (let ((this-sexp (sexp-at-point)))
292 (minibuffer-with-setup-hook
293 (lambda ()
294 (when this-sexp
295 (let ((more-defaults (list (concat "'" (el-search--print this-sexp)))))
296 (setq-local minibuffer-default-add-function
297 (lambda () (if (listp minibuffer-default)
298 (append minibuffer-default more-defaults)
299 (cons minibuffer-default more-defaults)))))))
300 (el-search-read-expression
301 prompt el-search--initial-mb-contents 'el-search-history default read))))
302
303 (defun el-search--end-of-sexp ()
304 ;;Point must be at sexp beginning
305 (or (scan-sexps (point) 1) (point-max)))
306
307 (defun el-search--ensure-sexp-start ()
308 "Move point to the beginning of the next sexp if necessary.
309 Don't move if already at beginning of a sexp.
310 Point must not be inside a string or comment."
311 (let ((not-done t) res)
312 (while not-done
313 (let ((stop-here nil)
314 (looking-at-from-back (lambda (regexp n)
315 (save-excursion
316 (backward-char n)
317 (looking-at regexp)))))
318 (while (not stop-here)
319 (cond
320 ((eobp) (signal 'end-of-buffer nil))
321 ((looking-at (rx (and (* space) ";"))) (forward-line))
322 ((looking-at (rx (+ (or space "\n")))) (goto-char (match-end 0)))
323
324 ;; FIXME: can the rest be done more generically?
325 ((and (looking-at (rx (or (syntax symbol) (syntax word))))
326 (not (looking-at "\\_<"))
327 (not (funcall looking-at-from-back ",@" 2)))
328 (forward-symbol 1))
329 ((or (and (looking-at "'") (funcall looking-at-from-back "#" 1))
330 (and (looking-at "@") (funcall looking-at-from-back "," 1)))
331 (forward-char))
332 (t (setq stop-here t)))))
333 (condition-case nil
334 (progn
335 (setq res (save-excursion (read (current-buffer))))
336 (setq not-done nil))
337 (error (forward-char))))
338 res))
339
340 (defvar el-search--pcase-macros '()
341 "List of additional \"el-search\" pcase macros.")
342
343 (defun el-search--make-docstring ()
344 ;; code mainly from `pcase--make-docstring'
345 (let* ((main (documentation (symbol-function 'el-search-pattern) 'raw))
346 (ud (help-split-fundoc main 'pcase)))
347 (with-temp-buffer
348 (insert (or (cdr ud) main))
349 (mapc
350 (pcase-lambda (`(,symbol . ,fun))
351 (when-let ((doc (documentation fun)))
352 (insert "\n\n-- ")
353 (setq doc (help-fns--signature symbol doc nil fun nil))
354 (insert "\n" (or doc "Not documented."))))
355 (reverse el-search--pcase-macros))
356 (let ((combined-doc (buffer-string)))
357 (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
358
359 (put 'el-search-pattern 'function-documentation '(el-search--make-docstring))
360
361 (defmacro el-search-defpattern (name args &rest body)
362 "Like `pcase-defmacro', but limited to el-search patterns.
363 The semantics is exactly that of `pcase-defmacro', but the scope
364 of the definitions is limited to \"el-search\"."
365 (declare (indent 2) (debug defun))
366 `(setf (alist-get ',name el-search--pcase-macros)
367 (lambda ,args ,@body)))
368
369 (el-search-defpattern string (&rest regexps)
370 "Matches any string that is matched by all REGEXPS."
371 (let ((string (make-symbol "string"))
372 (regexp (make-symbol "regexp")))
373 `(and (pred stringp)
374 (pred (lambda (,string)
375 (cl-every
376 (lambda (,regexp) (string-match-p ,regexp ,string))
377 (list ,@regexps)))))))
378
379 (el-search-defpattern symbol (&rest regexps)
380 "Matches any symbol whose name is matched by all REGEXPS."
381 `(and (pred symbolp)
382 (app symbol-name (string ,@regexps))))
383
384 (defun el-search--match-symbol-file (regexp symbol)
385 (when-let ((symbol-file (and (symbolp symbol)
386 (symbol-file symbol))))
387 (string-match-p
388 (if (symbolp regexp) (concat "\\`" (symbol-name regexp) "\\'") regexp)
389 (file-name-sans-extension (file-name-nondirectory symbol-file)))))
390
391 (el-search-defpattern source (regexp)
392 "Matches any symbol whose `symbol-file' is matched by REGEXP.
393
394 This pattern matches when the object is a symbol for that
395 `symbol-file' returns a (non-nil) FILE-NAME that fulfills
396 (string-match-p REGEXP (file-name-sans-extension
397 (file-name-nondirectory FILENAME)))
398
399 REGEXP can also be a symbol, in which case
400
401 (concat \"^\" (symbol-name regexp) \"$\")
402
403 is used as regular expression."
404 `(pred (el-search--match-symbol-file ,regexp)))
405
406 (defun el-search--match-key-sequence (keys expr)
407 (when-let ((expr-keys (pcase expr
408 ((or (pred stringp) (pred vectorp)) expr)
409 (`(kbd ,(and (pred stringp) string)) (ignore-errors (kbd string))))))
410 (apply #'equal
411 (mapcar (lambda (keys) (ignore-errors (key-description keys)))
412 (list keys expr-keys)))))
413
414 (el-search-defpattern keys (key-sequence)
415 "Matches any description of the KEY-SEQUENCE.
416 KEY-SEQUENCE is a key description in a format that Emacs
417 understands.
418
419 This pattern matches any description of the same key sequence.
420
421 Example: the pattern
422
423 (keys (kbd \"C-s\"))
424
425 matches any of these expressions:
426
427 (kbd \"C-s\")
428 [(control ?s)]
429 \"\\C-s\"
430
431 Any of these could be used as equivalent KEY-SEQUENCE in terms of
432 this pattern type."
433 `(pred (el-search--match-key-sequence ,key-sequence)))
434
435 (defmacro el-search--with-additional-pcase-macros (&rest body)
436 `(cl-letf ,(mapcar (pcase-lambda (`(,symbol . ,fun))
437 `((get ',symbol 'pcase-macroexpander) #',fun))
438 el-search--pcase-macros)
439 ,@body))
440
441 (defun el-search--matcher (pattern &rest body)
442 (eval
443 `(el-search--with-additional-pcase-macros
444 (let ((warning-suppress-log-types '((bytecomp))))
445 (byte-compile
446 (lambda (expression)
447 (pcase expression
448 (,pattern ,@(or body (list t)))
449 (_ nil))))))))
450
451 (defun el-search--match-p (matcher expression)
452 (funcall matcher expression))
453
454 (defun el-search--wrap-pattern (pattern)
455 `(and ,el-search-this-expression-identifier ,pattern))
456
457 (defun el-search--skip-expression (expression &optional read)
458 ;; Move forward at least one character. Don't move into a string or
459 ;; comment. Don't move further than the beginning of the next sexp.
460 ;; Try to move as far as possible. Point must be at the beginning
461 ;; of an expression.
462 ;; If there are positions where `read' would succeed, but that do
463 ;; not represent a valid sexp start, move past them (e.g. when
464 ;; before "#'" move past both characters).
465 ;;
466 ;; EXPRESSION must be the (read) expression at point, but when READ
467 ;; is non-nil, ignore the first argument and read the expression at
468 ;; point instead.
469 (when read (setq expression (save-excursion (read (current-buffer)))))
470 (cond
471 ((or (null expression)
472 (equal [] expression)
473 (not (or (listp expression) (vectorp expression))))
474 (goto-char (el-search--end-of-sexp)))
475 ((looking-at (rx (or ",@" "," "#'" "'")))
476 (goto-char (match-end 0)))
477 (t (forward-char))))
478
479 (defun el-search--search-pattern (pattern &optional noerror)
480 "Search elisp buffer with `pcase' PATTERN.
481 Set point to the beginning of the occurrence found and return
482 point. Optional second argument, if non-nil, means if fail just
483 return nil (no error)."
484
485 (let ((matcher (el-search--matcher pattern)) (match-beg nil) (opoint (point)) current-expr)
486
487 ;; when inside a string or comment, move past it
488 (let ((syntax-here (syntax-ppss)))
489 (when (nth 3 syntax-here) ;inside a string
490 (goto-char (nth 8 syntax-here))
491 (forward-sexp))
492 (when (nth 4 syntax-here) ;inside a comment
493 (forward-line 1)
494 (while (and (not (eobp)) (looking-at (rx (and (* space) ";"))))
495 (forward-line 1))))
496
497 (if (catch 'no-match
498 (while (not match-beg)
499 (condition-case nil
500 (setq current-expr (el-search--ensure-sexp-start))
501 (end-of-buffer
502 (goto-char opoint)
503 (throw 'no-match t)))
504 (if (el-search--match-p matcher current-expr)
505 (setq match-beg (point)
506 opoint (point))
507 (el-search--skip-expression current-expr))))
508 (if noerror nil (signal 'end-of-buffer nil)))
509 match-beg))
510
511 (defun el-search--do-subsexps (pos do-fun &optional ret-fun bound)
512 ;; In current buffer, for any expression start between POS and BOUND
513 ;; or (point-max), in order, call two argument function DO-FUN with
514 ;; the current sexp string and the ending position of the current
515 ;; sexp. When done, with RET-FUN given, call it with no args and
516 ;; return the result; else, return nil.
517 (save-excursion
518 (goto-char pos)
519 (condition-case nil
520 (while (< (point) (or bound (point-max)))
521 (let* ((this-sexp-end (save-excursion (thing-at-point--end-of-sexp) (point)))
522 (this-sexp-string (buffer-substring-no-properties (point) this-sexp-end)))
523 (funcall do-fun this-sexp-string this-sexp-end)
524 (el-search--skip-expression (read this-sexp-string))
525 (el-search--ensure-sexp-start)))
526 (end-of-buffer))
527 (when ret-fun (funcall ret-fun))))
528
529 (defun el-search--create-read-map (&optional pos)
530 (let ((mapping '()))
531 (el-search--do-subsexps
532 (or pos (point))
533 (lambda (sexp _) (push (cons (read sexp) sexp) mapping))
534 (lambda () (nreverse mapping))
535 (save-excursion (thing-at-point--end-of-sexp) (point)))))
536
537 (defun el-search--repair-replacement-layout (printed mapping)
538 (with-temp-buffer
539 (insert printed)
540 (el-search--do-subsexps
541 (point-min)
542 (lambda (sexp sexp-end)
543 (when-let ((old (cdr (assoc (read sexp) mapping))))
544 (delete-region (point) sexp-end)
545 (when (string-match-p "\n" old)
546 (unless (looking-back "^[[:space:]]*" (line-beginning-position))
547 (insert "\n"))
548 (unless (looking-at "[[:space:]\)]*$")
549 (insert "\n")
550 (backward-char)))
551 (save-excursion (insert old))))
552 (lambda () (buffer-substring (point-min) (point-max))))))
553
554
555 ;;;; Highlighting
556
557 (defvar-local el-search-hl-overlay nil)
558
559 (defvar el-search-keep-hl nil)
560
561 (defun el-search-hl-sexp-at-point ()
562 (let ((bounds (list (point) (el-search--end-of-sexp))))
563 (if (overlayp el-search-hl-overlay)
564 (apply #'move-overlay el-search-hl-overlay bounds)
565 (overlay-put (setq el-search-hl-overlay (apply #'make-overlay bounds))
566 'face 'el-search-match)))
567 (add-hook 'post-command-hook #'el-search-hl-post-command-fun t t))
568
569 (defun el-search-hl-remove ()
570 (when (overlayp el-search-hl-overlay)
571 (delete-overlay el-search-hl-overlay)))
572
573 (defun el-search-hl-post-command-fun ()
574 (unless (or el-search-keep-hl
575 (eq this-command 'el-search-query-replace)
576 (eq this-command 'el-search-pattern))
577 (el-search-hl-remove)
578 (remove-hook 'post-command-hook 'el-search-hl-post-command-fun t)))
579
580
581 ;;;; Core functions
582
583 (defvar el-search-history '()
584 "List of input strings.")
585
586 (defvar el-search-success nil)
587 (defvar el-search-current-pattern nil)
588
589 ;;;###autoload
590 (defun el-search-pattern (pattern)
591 "Start new or resume last elisp search.
592
593 Search current buffer for expressions that are matched by `pcase'
594 PATTERN. Use `read' to transform buffer contents into
595 expressions.
596
597
598 Additional `pcase' pattern types to be used with this command can
599 be defined with `el-search-defpattern'.
600
601 The following additional pattern types are currently defined:\n"
602 (interactive (list (if (and (eq this-command last-command)
603 el-search-success)
604 el-search-current-pattern
605 (let ((pattern
606 (el-search--read-pattern "Find pcase pattern: "
607 (car el-search-history)
608 t)))
609 ;; A very common mistake: input "foo" instead of "'foo"
610 (when (and (symbolp pattern)
611 (not (eq pattern '_))
612 (or (not (boundp pattern))
613 (not (eq (symbol-value pattern) pattern))))
614 (error "Please don't forget the quote when searching for a symbol"))
615 (el-search--wrap-pattern pattern)))))
616 (setq this-command 'el-search-pattern) ;in case we come from isearch
617 (setq el-search-current-pattern pattern)
618 (let ((opoint (point)))
619 (when (and (eq this-command last-command) el-search-success)
620 (el-search--skip-expression nil t))
621 (setq el-search-success nil)
622 (message "%s" (substitute-command-keys "Type \\[el-search-pattern] to repeat"))
623 (when (condition-case nil
624 (el-search--search-pattern pattern)
625 (end-of-buffer (message "No match")
626 (goto-char opoint)
627 (el-search-hl-remove)
628 (ding)
629 nil))
630 (setq el-search-success t)
631 (el-search-hl-sexp-at-point))))
632
633 (defun el-search-search-and-replace-pattern (pattern replacement &optional mapping)
634 (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
635 (el-search-keep-hl t) (opoint (point))
636 (get-replacement (el-search--matcher pattern replacement)))
637 (unwind-protect
638 (while (and (not done) (el-search--search-pattern pattern t))
639 (setq opoint (point))
640 (unless replace-all (el-search-hl-sexp-at-point))
641 (let* ((read-mapping (el-search--create-read-map))
642 (region (list (point) (el-search--end-of-sexp)))
643 (substring (apply #'buffer-substring-no-properties region))
644 (expr (read substring))
645 (replaced-this nil)
646 (new-expr (funcall get-replacement expr))
647 (to-insert (el-search--repair-replacement-layout
648 (el-search--print new-expr) (append mapping read-mapping)))
649 (do-replace (lambda ()
650 (atomic-change-group
651 (apply #'delete-region region)
652 (let ((inhibit-message t)
653 (opoint (point)))
654 (insert to-insert)
655 (indent-region opoint (point))
656 (goto-char opoint)
657 (el-search-hl-sexp-at-point)))
658 (cl-incf nbr-replaced)
659 (setq replaced-this t))))
660 (if replace-all
661 (funcall do-replace)
662 (while (not (pcase (if replaced-this
663 (read-char-choice "[SPC ! q]" '(?\ ?! ?q ?n))
664 (read-char-choice
665 (concat "Replace this occurrence"
666 (if (or (string-match-p "\n" to-insert)
667 (< 40 (length to-insert)))
668 "" (format " with `%s'" to-insert))
669 "? [y SPC r ! q]" )
670 '(?y ?n ?r ?\ ?! ?q)))
671 (?r (funcall do-replace)
672 nil)
673 (?y (funcall do-replace)
674 t)
675 ((or ?\ ?n)
676 (unless replaced-this (cl-incf nbr-skipped))
677 t)
678 (?! (unless replaced-this
679 (funcall do-replace))
680 (setq replace-all t)
681 t)
682 (?q (setq done t)
683 t)))))
684 (unless (or done (eobp)) (el-search--skip-expression nil t)))))
685 (el-search-hl-remove)
686 (goto-char opoint)
687 (message "Replaced %d matches%s"
688 nbr-replaced
689 (if (zerop nbr-skipped) ""
690 (format " (%d skipped)" nbr-skipped)))))
691
692 (defun el-search-query-replace-read-args ()
693 (barf-if-buffer-read-only)
694 (let* ((from (el-search--read-pattern "Replace from: "))
695 (to (let ((el-search--initial-mb-contents nil))
696 (el-search--read-pattern "Replace with result of evaluation of: " from))))
697 (list (el-search--wrap-pattern (read from)) (read to)
698 (with-temp-buffer
699 (insert to)
700 (el-search--create-read-map 1)))))
701
702 ;;;###autoload
703 (defun el-search-query-replace (from to &optional mapping)
704 "Replace some occurrences of FROM pattern with evaluated TO."
705 (interactive (el-search-query-replace-read-args))
706 (setq this-command 'el-search-query-replace) ;in case we come from isearch
707 (setq el-search-current-pattern from)
708 (barf-if-buffer-read-only)
709 (el-search-search-and-replace-pattern from to mapping))
710
711 (defun el-search--take-over-from-isearch ()
712 (let ((other-end isearch-other-end)
713 (input isearch-string))
714 (isearch-exit)
715 (when (and other-end (< other-end (point)))
716 (goto-char other-end))
717 input))
718
719 ;;;###autoload
720 (defun el-search-search-from-isearch ()
721 ;; FIXME: an interesting alternative would be to really integrate it
722 ;; with Isearch, using `isearch-search-fun-function'.
723 ;; Alas, this is not trivial if we want to transfer our optimizations.
724 (interactive)
725 (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
726 ;; use `call-interactively' so we get recorded in `extended-command-history'
727 (call-interactively #'el-search-pattern)))
728
729 ;;;###autoload
730 (defun el-search-replace-from-isearch ()
731 (interactive)
732 (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
733 (call-interactively #'el-search-query-replace)))
734
735
736
737 (provide 'el-search)
738 ;;; el-search.el ends here