1 ;;; el-search.el --- Expression based incremental search for emacs-lisp-mode -*- lexical-binding: t -*-
3 ;; Copyright (C) 2015 Free Software Foundation, Inc
5 ;; Author: Michael Heerdegen <michael_heerdegen@web.de>
6 ;; Maintainer: Michael Heerdegen <michael_heerdegen@web.de>
7 ;; Created: 29 Jul 2015
9 ;; Compatibility: GNU Emacs 25
11 ;; Package-Requires: ((emacs "25"))
14 ;; This file is not part of GNU Emacs.
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.
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.
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/>.
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).
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.
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.
53 ;; Example 1: if you enter
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
63 ;; Example 2: If you enter the pattern
67 ;; you search for all defvar forms that don't specify an init value.
69 ;; The following will search for defvar forms with a docstring whose
70 ;; first line is longer than 70 characters:
73 ;; ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
76 ;; When a search pattern is processed, the searched buffer is current
77 ;; with point at the beginning of the currently tested expression.
83 ;; For pattern input, the minibuffer is put into `emacs-lisp-mode'.
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'.
92 ;; If you want to search a buffer for symbols that are defined in
93 ;; "cl-lib", you can use this pattern
95 ;; (guard (and (symbolp exp)
96 ;; (when-let ((file (symbol-file exp)))
97 ;; (string-match-p "cl-lib\\.elc?$" file))))
100 ;; ,----------------------------------------------------------------------
101 ;; | Q: "But I hate `pcase'! Can't we just do without?" |
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 ;; `----------------------------------------------------------------------
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.
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.
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',
131 ;; (foo 'a (* 2 (+ 3 4)) t)
135 ;; (foo (* 2 (+ 3 4)) 'a t).
139 ;; M-x el-search-query-replace RET
140 ;; `(foo ,a ,b . ,rest) RET
141 ;; `(foo ,b ,a . ,rest) RET
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
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.
156 ;; Suggested key bindings
157 ;; ======================
159 ;; (define-key emacs-lisp-mode-map [(control ?S)] #'el-search-pattern)
160 ;; (define-key emacs-lisp-mode-map [(control ?%)] #'el-search-query-replace)
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)
165 ;; The bindings in `isearch-mode-map' let you conveniently switch to
166 ;; elisp searching from isearch.
169 ;; Bugs, Known Limitations
170 ;; =======================
172 ;; - Replacing: in some cases the reader syntax of forms
173 ;; is changing due to reading+printing. "Some" because we can treat
174 ;; that problem in most cases.
176 ;; - Similarly: Comments are normally preserved (where it makes
177 ;; sense). But when replacing like `(foo ,a ,b) -> `(foo ,b ,a)
186 ;; the comment will be lost.
192 ;; Thanks to Stefan Monnier for corrections and advice.
197 ;; - When replacing like (progn A B C) -> A B C, the layout of the
198 ;; whole "group" A B C as a unit is lost. Instead of restoring layout
199 ;; as we do now (via "read mappings"), we could just make a backup of
200 ;; the original expression as a string, and use our search machinery
201 ;; to find occurrences in the replacement recursively.
203 ;; - detect infloops when replacing automatically (e.g. for 1 -> '(1))
205 ;; - highlight matches around point in a timer
207 ;; - implement backward searching
209 ;; - improve docstrings
211 ;; - handle more reader syntaxes, e.g. #n, #n#
213 ;; - Implement sessions; add multi-file support based on iterators. A
214 ;; file list is read in (or the user can specify an iterator as a
215 ;; variable). The state in the current buffer is just (buffer
216 ;; . marker). Or should this be abstracted into an own lib? Could
217 ;; be named "files-session" or so.
229 (require 'elisp-mode)
231 (require 'help-fns) ;el-search--make-docstring
234 ;;;; Configuration stuff
236 (defgroup el-search nil
237 "Expression based search and replace for `emacs-lisp-mode'."
240 (defcustom el-search-this-expression-identifier 'exp
241 "Name of the identifier referring to the current expression.
242 The default value is `exp'. You can use this name in the search
243 prompt to refer to the value of the currently tested expression."
246 (defface el-search-match '((((background dark)) (:background "#0000A0"))
247 (t (:background "DarkSlateGray1")))
248 "Face for highlighting the current match.")
253 (defun el-search--print (expr)
254 (let ((print-quoted t)
257 (prin1-to-string expr)))
259 (defvar el-search-read-expression-map
260 (let ((map (make-sparse-keymap)))
261 (set-keymap-parent map read-expression-map)
262 (define-key map [(control ?g)] #'abort-recursive-edit)
263 (define-key map [up] nil)
264 (define-key map [down] nil)
265 (define-key map [(control meta backspace)] #'backward-kill-sexp)
266 (define-key map [(control ?S)] #'exit-minibuffer)
268 "Map for reading input with `el-search-read-expression'.")
270 ;; $$$$$FIXME: this should be in Emacs! There is only a helper `read--expression'.
271 (defun el-search-read-expression (prompt &optional initial-contents hist default read)
272 "Read expression for `my-eval-expression'."
273 (minibuffer-with-setup-hook
276 (use-local-map el-search-read-expression-map)
277 (setq font-lock-mode t)
278 (funcall font-lock-function 1)
281 (goto-char (point-max)))
282 (read-from-minibuffer prompt initial-contents el-search-read-expression-map read
283 (or hist 'read-expression-history) default)))
285 (defvar el-search--initial-mb-contents nil)
287 (defun el-search--read-pattern (prompt &optional default read)
288 (let ((this-sexp (sexp-at-point)))
289 (minibuffer-with-setup-hook
292 (let ((more-defaults (list (concat "'" (el-search--print this-sexp)))))
293 (setq-local minibuffer-default-add-function
294 (lambda () (if (listp minibuffer-default)
295 (append minibuffer-default more-defaults)
296 (cons minibuffer-default more-defaults)))))))
297 (el-search-read-expression
298 prompt el-search--initial-mb-contents 'el-search-history default read))))
300 (defun el-search--end-of-sexp ()
301 ;;Point must be at sexp beginning
302 (or (scan-sexps (point) 1) (point-max)))
304 (defun el-search--ensure-sexp-start ()
305 "Move point to the beginning of the next sexp if necessary.
306 Don't move if already at beginning of a sexp.
307 Point must not be inside a string or comment."
308 (let ((not-done t) res)
310 (let ((stop-here nil)
311 (looking-at-from-back (lambda (regexp n)
314 (looking-at regexp)))))
315 (while (not stop-here)
317 ((eobp) (signal 'end-of-buffer nil))
318 ((looking-at (rx (and (* space) ";"))) (forward-line))
319 ((looking-at (rx (+ (or space "\n")))) (goto-char (match-end 0)))
321 ;; FIXME: can the rest be done more generically?
322 ((and (looking-at (rx (or (syntax symbol) (syntax word))))
323 (not (looking-at "\\_<"))
324 (not (funcall looking-at-from-back ",@" 2)))
326 ((or (and (looking-at "'") (funcall looking-at-from-back "#" 1))
327 (and (looking-at "@") (funcall looking-at-from-back "," 1)))
329 (t (setq stop-here t)))))
332 (setq res (save-excursion (read (current-buffer))))
334 (error (forward-char))))
337 (defvar el-search--pcase-macros '()
338 "List of additional \"el-search\" pcase macros.")
340 (defun el-search--make-docstring ()
341 ;; code mainly from `pcase--make-docstring'
342 (let* ((main (documentation (symbol-function 'el-search-pattern) 'raw))
343 (ud (help-split-fundoc main 'pcase)))
345 (insert (or (cdr ud) main))
347 (pcase-lambda (`(,symbol . ,fun))
348 (when-let ((doc (documentation fun)))
350 (setq doc (help-fns--signature symbol doc fun fun nil))
351 (insert "\n" (or doc "Not documented."))))
352 (reverse el-search--pcase-macros))
353 (let ((combined-doc (buffer-string)))
354 (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
356 (put 'el-search-pattern 'function-documentation '(el-search--make-docstring))
358 (defmacro el-search-defpattern (name args &rest body)
359 "Like `pcase-defmacro', but limited to el-search patterns.
360 The semantics is exactly that of `pcase-defmacro', but the scope
361 of the definitions is limited to \"el-search\"."
362 (declare (indent 2) (debug defun))
363 `(setf (alist-get ',name el-search--pcase-macros)
364 (lambda ,args ,@body)))
367 (defmacro el-search--with-additional-pcase-macros (&rest body)
368 `(cl-letf ,(mapcar (pcase-lambda (`(,symbol . ,fun))
369 `((get ',symbol 'pcase-macroexpander) #',fun))
370 el-search--pcase-macros)
373 (defun el-search--matcher (pattern &rest body)
374 (eval ;use `eval' to allow for user defined pattern types at run time
375 `(el-search--with-additional-pcase-macros
376 (let ((byte-compile-debug t) ;make undefined pattern types raise an error
377 (warning-suppress-log-types '((bytecomp)))
378 (pcase--dontwarn-upats (cons '_ pcase--dontwarn-upats)))
379 (byte-compile (lambda (expression)
381 (,pattern ,@(or body (list t)))
384 (defun el-search--match-p (matcher expression)
385 (funcall matcher expression))
387 (defun el-search--wrap-pattern (pattern)
388 `(and ,el-search-this-expression-identifier ,pattern))
390 (defun el-search--skip-expression (expression &optional read)
391 ;; Move forward at least one character. Don't move into a string or
392 ;; comment. Don't move further than the beginning of the next sexp.
393 ;; Try to move as far as possible. Point must be at the beginning
395 ;; If there are positions where `read' would succeed, but that do
396 ;; not represent a valid sexp start, move past them (e.g. when
397 ;; before "#'" move past both characters).
399 ;; EXPRESSION must be the (read) expression at point, but when READ
400 ;; is non-nil, ignore the first argument and read the expression at
402 (when read (setq expression (save-excursion (read (current-buffer)))))
404 ((or (null expression)
405 (equal [] expression)
406 (not (or (listp expression) (vectorp expression))))
407 (goto-char (el-search--end-of-sexp)))
408 ((looking-at (rx (or ",@" "," "#'" "'")))
409 (goto-char (match-end 0)))
412 (defun el-search--search-pattern-1 (matcher &optional noerror)
413 (let ((match-beg nil) (opoint (point)) current-expr)
415 ;; when inside a string or comment, move past it
416 (let ((syntax-here (syntax-ppss)))
417 (when (nth 3 syntax-here) ;inside a string
418 (goto-char (nth 8 syntax-here))
420 (when (nth 4 syntax-here) ;inside a comment
422 (while (and (not (eobp)) (looking-at (rx (and (* space) ";"))))
426 (while (not match-beg)
428 (setq current-expr (el-search--ensure-sexp-start))
431 (throw 'no-match t)))
432 (if (el-search--match-p matcher current-expr)
433 (setq match-beg (point)
435 (el-search--skip-expression current-expr))))
436 (if noerror nil (signal 'end-of-buffer nil)))
439 (defun el-search--search-pattern (pattern &optional noerror)
440 "Search elisp buffer with `pcase' PATTERN.
441 Set point to the beginning of the occurrence found and return
442 point. Optional second argument, if non-nil, means if fail just
443 return nil (no error)."
444 (el-search--search-pattern-1 (el-search--matcher pattern) noerror))
446 (defun el-search--do-subsexps (pos do-fun &optional ret-fun bound)
447 ;; In current buffer, for any expression start between POS and BOUND
448 ;; or (point-max), in order, call two argument function DO-FUN with
449 ;; the current sexp string and the ending position of the current
450 ;; sexp. When done, with RET-FUN given, call it with no args and
451 ;; return the result; else, return nil.
455 (while (< (point) (or bound (point-max)))
456 (let* ((this-sexp-end (save-excursion (thing-at-point--end-of-sexp) (point)))
457 (this-sexp-string (buffer-substring-no-properties (point) this-sexp-end)))
458 (funcall do-fun this-sexp-string this-sexp-end)
459 (el-search--skip-expression (read this-sexp-string))
460 (el-search--ensure-sexp-start)))
462 (when ret-fun (funcall ret-fun))))
464 (defun el-search--create-read-map (&optional pos)
466 (el-search--do-subsexps
468 (lambda (sexp _) (push (cons (read sexp) sexp) mapping))
469 (lambda () (nreverse mapping))
470 (save-excursion (thing-at-point--end-of-sexp) (point)))))
472 (defun el-search--repair-replacement-layout (printed mapping)
475 (el-search--do-subsexps
477 (lambda (sexp sexp-end)
478 (when-let ((old (cdr (assoc (read sexp) mapping))))
479 (delete-region (point) sexp-end)
480 (when (string-match-p "\n" old)
481 (unless (looking-back "^[[:space:]]*" (line-beginning-position))
483 (unless (looking-at "[[:space:]\)]*$")
486 (save-excursion (insert old))))
487 (lambda () (buffer-substring (point-min) (point-max))))))
489 (defun el-search--check-pattern-args (type args predicate &optional message)
490 "Check whether all ARGS fulfill PREDICATE.
491 Raise an error if not. TYPE and optional argument MESSAGE are
492 used to construct the error message."
494 (unless (funcall predicate arg)
495 (error (concat "Pattern `%S': "
496 (or message (format "argument doesn't fulfill %S" predicate))
502 ;;;; Additional pattern type definitions
504 (defun el-search--split (matcher1 matcher2 list)
505 "Helper for the append pattern type.
507 When a splitting of LIST into two lists L1, L2 exist so that Li
508 is matched by MATCHERi, return (L1 L2) for such Li, else return
510 (let ((try-match (lambda (list1 list2)
511 (when (and (el-search--match-p matcher1 list1)
512 (el-search--match-p matcher2 list2))
513 (list list1 list2))))
514 (list1 list) (list2 '()) (match nil))
515 ;; don't use recursion, this could hit `max-lisp-eval-depth'
516 (while (and (not (setq match (funcall try-match list1 list2)))
518 (let ((last-list1 (last list1)))
519 (if-let ((cdr-last-list1 (cdr last-list1)))
520 ;; list1 is a dotted list. Then list2 must be empty.
521 (progn (setcdr last-list1 nil)
522 (setq list2 cdr-last-list1))
523 (setq list1 (butlast list1 1)
524 list2 (cons (car last-list1) list2)))))
527 (el-search-defpattern append (&rest patterns)
528 "Matches any list factorable into lists matched by PATTERNS in order.
530 PATTERNS is a list of patterns P1..Pn. Match any list L for that
531 lists L1..Ln exist that are matched by P1..Pn in order and L is
532 equal to the concatenation of L1..Ln. Ln is allowed to be no
535 When different ways of matching are possible, it is unspecified
540 (append '(1 2 3) x (app car-safe 7))
542 matches the list (1 2 3 4 5 6 7 8 9) and binds `x' to (4 5 6)."
545 (pcase-let ((`(,pattern . ,more-patterns) patterns))
547 ((null more-patterns) pattern)
548 ((null (cdr more-patterns))
550 (app ,(apply-partially #'el-search--split
551 (el-search--matcher pattern)
552 (el-search--matcher (car more-patterns)))
553 (,'\` ((,'\, ,pattern)
554 (,'\, ,(car more-patterns)))))))
555 (t `(append ,pattern (append ,@more-patterns)))))))
557 (el-search-defpattern string (&rest regexps)
558 "Matches any string that is matched by all REGEXPS."
559 (el-search--check-pattern-args 'string regexps #'stringp)
560 (let ((string (make-symbol "string"))
561 (regexp (make-symbol "regexp")))
563 (pred (lambda (,string)
565 (lambda (,regexp) (string-match-p ,regexp ,string))
566 (list ,@regexps)))))))
568 (el-search-defpattern symbol (&rest regexps)
569 "Matches any symbol whose name is matched by all REGEXPS."
570 (el-search--check-pattern-args 'symbol regexps #'stringp)
572 (app symbol-name (string ,@regexps))))
574 (defun el-search--contains-p (matcher exp)
575 "Return non-nil when tree EXP contains a match for MATCHER.
576 Recurse on all types of sequences. In the positive case the
577 return value is (t elt), where ELT is a matching element found in
579 (if (el-search--match-p matcher exp)
582 (let ((try-match (apply-partially #'el-search--contains-p matcher)))
584 (or (funcall try-match (car exp))
585 (funcall try-match (cdr exp)))
586 (cl-some try-match exp))))))
588 (el-search-defpattern contains (&rest patterns)
589 "Matches trees that contain a match for all PATTERNs.
590 Searches any tree of sequences recursively for matches. Objects
591 of any kind matched by all PATTERNs are also matched.
593 Example: (contains (string \"H\") 17) matches ((\"Hallo\") x (5 [1 17]))"
596 ((null (cdr patterns))
597 (let ((pattern (car patterns)))
598 `(app ,(apply-partially #'el-search--contains-p (el-search--matcher pattern))
599 (,'\` (t (,'\, ,pattern))))))
600 (t `(and ,@(mapcar (lambda (pattern) `(contains ,pattern)) patterns)))))
602 (el-search-defpattern not (pattern)
603 "Matches any object that is not matched by PATTERN."
604 `(app ,(apply-partially #'el-search--match-p (el-search--matcher pattern))
607 (defun el-search--match-symbol-file (regexp symbol)
608 (when-let ((symbol-file (and (symbolp symbol)
609 (symbol-file symbol))))
611 (if (symbolp regexp) (concat "\\`" (symbol-name regexp) "\\'") regexp)
612 (file-name-sans-extension (file-name-nondirectory symbol-file)))))
614 (el-search-defpattern source (regexp)
615 "Matches any symbol whose `symbol-file' is matched by REGEXP.
617 This pattern matches when the object is a symbol for that
618 `symbol-file' returns a (non-nil) FILE-NAME that fulfills
619 (string-match-p REGEXP (file-name-sans-extension
620 (file-name-nondirectory FILENAME)))
622 REGEXP can also be a symbol, in which case
624 (concat \"^\" (symbol-name regexp) \"$\")
626 is used as regular expression."
627 (el-search--check-pattern-args 'source (list regexp) #'stringp)
628 `(pred (el-search--match-symbol-file ,regexp)))
630 (defun el-search--match-key-sequence (keys expr)
631 (when-let ((expr-keys (pcase expr
632 ((or (pred stringp) (pred vectorp)) expr)
633 (`(kbd ,(and (pred stringp) string)) (ignore-errors (kbd string))))))
635 (mapcar (lambda (keys) (ignore-errors (key-description keys)))
636 (list keys expr-keys)))))
638 (el-search-defpattern keys (key-sequence)
639 "Matches descriptions of the KEY-SEQUENCE.
640 KEY-SEQUENCE is a string or vector representing a key sequence,
641 or an expression of the form (kbd STRING).
643 Match any description of the same key sequence in any of these
650 matches any of these expressions:
656 (when (eq (car-safe key-sequence) 'kbd)
657 (setq key-sequence (kbd (cadr key-sequence))))
658 (el-search--check-pattern-args 'keys (list key-sequence) (lambda (x) (or (stringp x) (vectorp x)))
659 "argument not a string or vector")
660 `(pred (el-search--match-key-sequence ,key-sequence)))
662 (defun el-search--s (expr)
664 ((symbolp expr) `(symbol ,(symbol-name expr)))
665 ((stringp expr) `(string ,expr))
668 (el-search-defpattern l (&rest lpats)
669 "Alternative pattern type for matching lists.
670 Match any list with subsequent elements matched by all LPATS in
673 The idea is to be able to search for pieces of code (i.e. lists)
674 with very brief input by using a specialized syntax.
676 An LPAT can take the following forms:
678 SYMBOL Matches any symbol matched by SYMBOL's name interpreted as
680 STRING Matches any string matched by STRING interpreted as a
682 _ Matches any list element
683 __ Matches any number of list elements (including zero)
684 ^ Matches zero elements, but only at the beginning of a list
685 $ Matches zero elements, but only at the end of a list
686 PAT Anything else is interpreted as a normal pcase pattern, and
687 matches one list element matched by it
689 ^ is only valid as the first, $ as the last of the LPATS.
691 Example: To match defuns that contain \"hl\" in their name and
692 have at least one mandatory, but also optional arguments, you
693 could use this pattern:
695 (l ^ 'defun hl (l _ &optional))"
696 (let ((match-start nil) (match-end nil))
697 (when (eq (car-safe lpats) '^)
699 (cl-callf cdr lpats))
700 (when (eq (car-safe (last lpats)) '$)
702 (cl-callf butlast lpats 1))
703 `(append ,@(if match-start '() '(_))
709 ('_? '(or '() `(,_))) ;FIXME: useful - document? or should we provide a (? PAT)
711 (_ `(,'\` ((,'\, ,(el-search--s elt)))))))
713 ,@(if match-end '() '(_)))))
718 (defvar-local el-search-hl-overlay nil)
720 (defvar el-search-keep-hl nil)
722 (defun el-search-hl-sexp (&optional bounds)
723 (let ((bounds (or bounds
724 (list (point) (el-search--end-of-sexp)))))
725 (if (overlayp el-search-hl-overlay)
726 (apply #'move-overlay el-search-hl-overlay bounds)
727 (overlay-put (setq el-search-hl-overlay (apply #'make-overlay bounds))
728 'face 'el-search-match)))
729 (add-hook 'post-command-hook #'el-search-hl-post-command-fun t t))
731 (defun el-search-hl-remove ()
732 (when (overlayp el-search-hl-overlay)
733 (delete-overlay el-search-hl-overlay)))
735 (defun el-search-hl-post-command-fun ()
736 (unless (or el-search-keep-hl
737 (eq this-command 'el-search-query-replace)
738 (eq this-command 'el-search-pattern))
739 (el-search-hl-remove)
740 (remove-hook 'post-command-hook 'el-search-hl-post-command-fun t)))
745 (defvar el-search-history '()
746 "List of input strings.")
748 (defvar el-search-success nil)
749 (defvar el-search-current-pattern nil)
752 (defun el-search-pattern (pattern)
753 "Start new or resume last elisp search.
755 Search current buffer for expressions that are matched by `pcase'
756 PATTERN. Use `read' to transform buffer contents into
760 Additional `pcase' pattern types to be used with this command can
761 be defined with `el-search-defpattern'.
763 The following additional pattern types are currently defined:"
764 (interactive (list (if (and (eq this-command last-command)
766 el-search-current-pattern
768 (el-search--read-pattern "Find pcase pattern: "
769 (car el-search-history)
771 ;; A very common mistake: input "foo" instead of "'foo"
772 (when (and (symbolp pattern)
773 (not (eq pattern '_))
774 (or (not (boundp pattern))
775 (not (eq (symbol-value pattern) pattern))))
776 (error "Please don't forget the quote when searching for a symbol"))
777 (el-search--wrap-pattern pattern)))))
778 (setq this-command 'el-search-pattern) ;in case we come from isearch
779 (setq el-search-current-pattern pattern)
780 (let ((opoint (point)))
781 (when (and (eq this-command last-command) el-search-success)
782 (el-search--skip-expression nil t))
783 (setq el-search-success nil)
784 (when (condition-case nil
785 (el-search--search-pattern pattern)
786 (end-of-buffer (message "No match")
788 (el-search-hl-remove)
791 (setq el-search-success t)
792 (el-search-hl-sexp))))
794 (defvar el-search-search-and-replace-help-string
796 y Replace this match and move to the next.
797 SPC or n Skip this match and move to the next.
798 r Replace this match but don't move.
799 ! Replace all remaining matches automatically.
800 q Quit. To resume, use e.g. `repeat-complex-command'.
802 s Toggle splicing mode. When splicing mode is
803 on (default off), the replacement expression must
804 evaluate to a list, and the result is spliced into the
805 buffer, instead of just inserted.
807 Hit any key to proceed."
808 "Help string for ? in `el-search-query-replace'.")
810 (defun el-search-search-and-replace-pattern (pattern replacement &optional mapping splice)
811 (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
812 (el-search-keep-hl t) (opoint (point))
813 (get-replacement (el-search--matcher pattern replacement)))
815 (while (and (not done) (el-search--search-pattern pattern t))
816 (setq opoint (point))
817 (unless replace-all (el-search-hl-sexp))
818 (let* ((read-mapping (el-search--create-read-map))
819 (region (list (point) (el-search--end-of-sexp)))
820 (substring (apply #'buffer-substring-no-properties region))
821 (expr (read substring))
823 (new-expr (funcall get-replacement expr))
824 (get-replacement-string
825 (lambda () (if (and splice (not (listp new-expr)))
826 (error "Expression to splice in is an atom")
827 (el-search--repair-replacement-layout
829 (mapconcat #'el-search--print new-expr " ")
830 (el-search--print new-expr))
831 (append mapping read-mapping)))))
832 (to-insert (funcall get-replacement-string))
833 (do-replace (lambda ()
835 (apply #'delete-region region)
836 (let ((inhibit-message t)
839 (indent-region opoint (point))
840 (el-search-hl-sexp (list opoint (point)))
842 (cl-incf nbr-replaced)
843 (setq replaced-this t))))
846 (while (not (pcase (if replaced-this
847 (read-char-choice "[SPC ! q] (? for help)"
850 (concat "Replace this occurrence"
851 (if (or (string-match-p "\n" to-insert)
852 (< 40 (length to-insert)))
853 "" (format " with `%s'" to-insert))
855 (if splice "{splice} " "")
856 "[y SPC r ! s q] (? for help)" )
857 '(?y ?n ?r ?\ ?! ?q ?s ??)))
858 (?r (funcall do-replace)
860 (?y (funcall do-replace)
863 (unless replaced-this (cl-incf nbr-skipped))
865 (?! (unless replaced-this
866 (funcall do-replace))
869 (?s (cl-callf not splice)
870 (setq to-insert (funcall get-replacement-string))
874 (?? (ignore (read-char el-search-search-and-replace-help-string))
876 (unless (or done (eobp)) (el-search--skip-expression nil t)))))
877 (el-search-hl-remove)
879 (message "Replaced %d matches%s"
881 (if (zerop nbr-skipped) ""
882 (format " (%d skipped)" nbr-skipped)))))
884 (defun el-search-query-replace-read-args ()
885 (barf-if-buffer-read-only)
886 (let* ((from (el-search--read-pattern "Replace from: "))
887 (to (let ((el-search--initial-mb-contents nil))
888 (el-search--read-pattern "Replace with result of evaluation of: " from))))
889 (list (el-search--wrap-pattern (read from)) (read to)
892 (el-search--create-read-map 1)))))
895 (defun el-search-query-replace (from to &optional mapping)
896 "Replace some occurrences of FROM pattern with evaluated TO."
897 (interactive (el-search-query-replace-read-args))
898 (setq this-command 'el-search-query-replace) ;in case we come from isearch
899 (setq el-search-current-pattern from)
900 (barf-if-buffer-read-only)
901 (el-search-search-and-replace-pattern from to mapping))
903 (defun el-search--take-over-from-isearch ()
904 (prog1 isearch-string (isearch-exit)))
907 (defun el-search-search-from-isearch ()
908 ;; FIXME: an interesting alternative would be to really integrate it
909 ;; with Isearch, using `isearch-search-fun-function'.
910 ;; Alas, this is not trivial if we want to transfer our optimizations.
912 (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
913 ;; use `call-interactively' so we get recorded in `extended-command-history'
914 (call-interactively #'el-search-pattern)))
917 (defun el-search-replace-from-isearch ()
919 (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
920 (call-interactively #'el-search-query-replace)))
925 ;;; el-search.el ends here