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 ;; 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.
46 ;; Example 1: if you enter
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
56 ;; Example 2: If you enter the pattern
60 ;; you search for all defvar forms that don't specify an init value.
62 ;; The following will search for defvar forms with a docstring whose
63 ;; first line is longer than 70 characters:
66 ;; ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
69 ;; When a search pattern is processed, the searched buffer is current
70 ;; with point at the beginning of the currently tested expression.
75 ;; I can be useful to use (guard EXP) patterns for side effects.
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:
82 ;; (and (pred symbolp)
83 ;; (let file (symbol-file exp))
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 "))
91 ;; (guard (message "Line %d: %s`%S' (from \"%s\")"
92 ;; (line-number-at-pos)
97 ;; `message' never returns nil, so the last `guard' always "matches".
103 ;; For pattern input, the minibuffer is put into `emacs-lisp-mode'.
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'.
111 ;; If you want to search a buffer for symbols that are defined in
112 ;; "cl-lib", you can use this pattern
114 ;; (guard (and (symbolp exp)
115 ;; (when-let ((file (symbol-file exp)))
116 ;; (string-match-p "cl-lib\\.elc?$" file))))
119 ;; ,----------------------------------------------------------------------
120 ;; | Q: "But I hate `pcase'! Can't we just do without?" |
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 ;; `----------------------------------------------------------------------
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.
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.
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',
150 ;; (foo 'a (* 2 (+ 3 4)) t)
154 ;; (foo (* 2 (+ 3 4)) 'a t).
158 ;; M-x el-search-query-replace RET
159 ;; `(foo ,a ,b . ,rest) RET
160 ;; `(foo ,b ,a . ,rest) RET
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
169 ;; Suggested key bindings
170 ;; ======================
172 ;; (define-key emacs-lisp-mode-map [(control ?S)] #'el-search-pattern)
173 ;; (define-key emacs-lisp-mode-map [(control ?%)] #'el-search-query-replace)
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)
178 ;; The bindings in `isearch-mode-map' let you conveniently switch to
179 ;; elisp searching from isearch.
182 ;; Bugs, Known Limitations
183 ;; =======================
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.
189 ;; - Similarly: Comments are normally preserved (where it makes
190 ;; sense). But when replacing like `(foo ,a ,b) -> `(foo ,b ,a)
199 ;; the comment will be lost.
205 ;; Thanks to Stefan Monnier for corrections and advice.
210 ;; - detect infloops when replacing automatically (e.g. for 1 -> '(1))
212 ;; - highlight matches around point in a timer
214 ;; - implement backward searching
216 ;; - improve docstrings
218 ;; - handle more reader syntaxes, e.g. #n, #n#
220 ;; - Implement sessions; add multi-file support based on iterators. A
221 ;; file list is read in (or the user can specify an iterator as a
222 ;; variable). The state in the current buffer is just (buffer
223 ;; . marker). Or should this be abstracted into an own lib? Could
224 ;; be named "files-session" or so.
236 (require 'elisp-mode)
238 (require 'help-fns) ;el-search--make-docstring
241 ;;;; Configuration stuff
243 (defgroup el-search nil
244 "Expression based search and replace for `emacs-lisp-mode'."
247 (defcustom el-search-this-expression-identifier 'exp
248 "Name of the identifier referring to the current expression.
249 The default value is `exp'. You can use this name in the search
250 prompt to refer to the value of the currently tested expression."
253 (defface el-search-match '((((background dark)) (:background "#0000A0"))
254 (t (:background "DarkSlateGray1")))
255 "Face for highlighting the current match.")
260 (defun el-search--print (expr)
261 (let ((print-quoted t)
264 (prin1-to-string expr)))
266 (defvar el-search-read-expression-map
267 (let ((map (make-sparse-keymap)))
268 (set-keymap-parent map read-expression-map)
269 (define-key map [(control ?g)] #'abort-recursive-edit)
270 (define-key map [up] nil)
271 (define-key map [down] nil)
272 (define-key map [(control meta backspace)] #'backward-kill-sexp)
273 (define-key map [(control ?S)] #'exit-minibuffer)
275 "Map for reading input with `el-search-read-expression'.")
277 ;; $$$$$FIXME: this should be in Emacs! There is only a helper `read--expression'.
278 (defun el-search-read-expression (prompt &optional initial-contents hist default read)
279 "Read expression for `my-eval-expression'."
280 (minibuffer-with-setup-hook
283 (use-local-map el-search-read-expression-map)
284 (setq font-lock-mode t)
285 (funcall font-lock-function 1)
288 (goto-char (point-max)))
289 (read-from-minibuffer prompt initial-contents el-search-read-expression-map read
290 (or hist 'read-expression-history) default)))
292 (defvar el-search--initial-mb-contents nil)
294 (defun el-search--read-pattern (prompt &optional default read)
295 (let ((this-sexp (sexp-at-point)))
296 (minibuffer-with-setup-hook
299 (let ((more-defaults (list (concat "'" (el-search--print this-sexp)))))
300 (setq-local minibuffer-default-add-function
301 (lambda () (if (listp minibuffer-default)
302 (append minibuffer-default more-defaults)
303 (cons minibuffer-default more-defaults)))))))
304 (el-search-read-expression
305 prompt el-search--initial-mb-contents 'el-search-history default read))))
307 (defun el-search--end-of-sexp ()
308 ;;Point must be at sexp beginning
309 (or (scan-sexps (point) 1) (point-max)))
311 (defun el-search--ensure-sexp-start ()
312 "Move point to the beginning of the next sexp if necessary.
313 Don't move if already at beginning of a sexp.
314 Point must not be inside a string or comment."
315 (let ((not-done t) res)
317 (let ((stop-here nil)
318 (looking-at-from-back (lambda (regexp n)
321 (looking-at regexp)))))
322 (while (not stop-here)
324 ((eobp) (signal 'end-of-buffer nil))
325 ((looking-at (rx (and (* space) ";"))) (forward-line))
326 ((looking-at (rx (+ (or space "\n")))) (goto-char (match-end 0)))
328 ;; FIXME: can the rest be done more generically?
329 ((and (looking-at (rx (or (syntax symbol) (syntax word))))
330 (not (looking-at "\\_<"))
331 (not (funcall looking-at-from-back ",@" 2)))
333 ((or (and (looking-at "'") (funcall looking-at-from-back "#" 1))
334 (and (looking-at "@") (funcall looking-at-from-back "," 1)))
336 (t (setq stop-here t)))))
339 (setq res (save-excursion (read (current-buffer))))
341 (error (forward-char))))
344 (defvar el-search--pcase-macros '()
345 "List of additional \"el-search\" pcase macros.")
347 (defun el-search--make-docstring ()
348 ;; code mainly from `pcase--make-docstring'
349 (let* ((main (documentation (symbol-function 'el-search-pattern) 'raw))
350 (ud (help-split-fundoc main 'pcase)))
352 (insert (or (cdr ud) main))
354 (pcase-lambda (`(,symbol . ,fun))
355 (when-let ((doc (documentation fun)))
357 (setq doc (help-fns--signature symbol doc nil fun nil))
358 (insert "\n" (or doc "Not documented."))))
359 (reverse el-search--pcase-macros))
360 (let ((combined-doc (buffer-string)))
361 (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
363 (put 'el-search-pattern 'function-documentation '(el-search--make-docstring))
365 (defmacro el-search-defpattern (name args &rest body)
366 "Like `pcase-defmacro', but limited to el-search patterns.
367 The semantics is exactly that of `pcase-defmacro', but the scope
368 of the definitions is limited to \"el-search\"."
369 (declare (indent 2) (debug defun))
370 `(setf (alist-get ',name el-search--pcase-macros)
371 (lambda ,args ,@body)))
373 (el-search-defpattern string (&rest regexps)
374 "Matches any string that is matched by all REGEXPS."
375 (let ((string (make-symbol "string"))
376 (regexp (make-symbol "regexp")))
378 (pred (lambda (,string)
380 (lambda (,regexp) (string-match-p ,regexp ,string))
381 (list ,@regexps)))))))
383 (el-search-defpattern symbol (&rest regexps)
384 "Matches any symbol whose name is matched by all REGEXPS."
386 (app symbol-name (string ,@regexps))))
388 (defun el-search--match-symbol-file (regexp symbol)
389 (when-let ((symbol-file (and (symbolp symbol)
390 (symbol-file symbol))))
392 (if (symbolp regexp) (concat "\\`" (symbol-name regexp) "\\'") regexp)
393 (file-name-sans-extension (file-name-nondirectory symbol-file)))))
395 (el-search-defpattern source (regexp)
396 "Matches any symbol whose `symbol-file' is matched by REGEXP.
398 This pattern matches when the object is a symbol for that
399 `symbol-file' returns a (non-nil) FILE-NAME that fulfills
400 (string-match-p REGEXP (file-name-sans-extension
401 (file-name-nondirectory FILENAME)))
403 REGEXP can also be a symbol, in which case
405 (concat \"^\" (symbol-name regexp) \"$\")
407 is used as regular expression."
408 `(pred (el-search--match-symbol-file ,regexp)))
410 (defun el-search--match-key-sequence (keys expr)
411 (when-let ((expr-keys (pcase expr
412 ((or (pred stringp) (pred vectorp)) expr)
413 (`(kbd ,(and (pred stringp) string)) (ignore-errors (kbd string))))))
415 (mapcar (lambda (keys) (ignore-errors (key-description keys)))
416 (list keys expr-keys)))))
418 (el-search-defpattern keys (key-sequence)
419 "Matches any description of the KEY-SEQUENCE.
420 KEY-SEQUENCE is a key description in a format that Emacs
423 This pattern matches any description of the same key sequence.
429 matches any of these expressions:
435 Any of these could be used as equivalent KEY-SEQUENCE in terms of
437 `(pred (el-search--match-key-sequence ,key-sequence)))
439 (defmacro el-search--with-additional-pcase-macros (&rest body)
440 `(cl-letf ,(mapcar (pcase-lambda (`(,symbol . ,fun))
441 `((get ',symbol 'pcase-macroexpander) #',fun))
442 el-search--pcase-macros)
445 (defun el-search--matcher (pattern &rest body)
447 `(el-search--with-additional-pcase-macros
448 (let ((warning-suppress-log-types '((bytecomp))))
452 (,pattern ,@(or body (list t)))
455 (defun el-search--match-p (matcher expression)
456 (funcall matcher expression))
458 (defun el-search--wrap-pattern (pattern)
459 `(and ,el-search-this-expression-identifier ,pattern))
461 (defun el-search--skip-expression (expression &optional read)
462 ;; Move forward at least one character. Don't move into a string or
463 ;; comment. Don't move further than the beginning of the next sexp.
464 ;; Try to move as far as possible. Point must be at the beginning
466 ;; If there are positions where `read' would succeed, but that do
467 ;; not represent a valid sexp start, move past them (e.g. when
468 ;; before "#'" move past both characters).
470 ;; EXPRESSION must be the (read) expression at point, but when READ
471 ;; is non-nil, ignore the first argument and read the expression at
473 (when read (setq expression (save-excursion (read (current-buffer)))))
475 ((or (null expression)
476 (equal [] expression)
477 (not (or (listp expression) (vectorp expression))))
478 (goto-char (el-search--end-of-sexp)))
479 ((looking-at (rx (or ",@" "," "#'" "'")))
480 (goto-char (match-end 0)))
483 (defun el-search--search-pattern (pattern &optional noerror)
484 "Search elisp buffer with `pcase' PATTERN.
485 Set point to the beginning of the occurrence found and return
486 point. Optional second argument, if non-nil, means if fail just
487 return nil (no error)."
489 (let ((matcher (el-search--matcher pattern)) (match-beg nil) (opoint (point)) current-expr)
491 ;; when inside a string or comment, move past it
492 (let ((syntax-here (syntax-ppss)))
493 (when (nth 3 syntax-here) ;inside a string
494 (goto-char (nth 8 syntax-here))
496 (when (nth 4 syntax-here) ;inside a comment
498 (while (and (not (eobp)) (looking-at (rx (and (* space) ";"))))
502 (while (not match-beg)
504 (setq current-expr (el-search--ensure-sexp-start))
507 (throw 'no-match t)))
508 (if (el-search--match-p matcher current-expr)
509 (setq match-beg (point)
511 (el-search--skip-expression current-expr))))
512 (if noerror nil (signal 'end-of-buffer nil)))
515 (defun el-search--do-subsexps (pos do-fun &optional ret-fun bound)
516 ;; In current buffer, for any expression start between POS and BOUND
517 ;; or (point-max), in order, call two argument function DO-FUN with
518 ;; the current sexp string and the ending position of the current
519 ;; sexp. When done, with RET-FUN given, call it with no args and
520 ;; return the result; else, return nil.
524 (while (< (point) (or bound (point-max)))
525 (let* ((this-sexp-end (save-excursion (thing-at-point--end-of-sexp) (point)))
526 (this-sexp-string (buffer-substring-no-properties (point) this-sexp-end)))
527 (funcall do-fun this-sexp-string this-sexp-end)
528 (el-search--skip-expression (read this-sexp-string))
529 (el-search--ensure-sexp-start)))
531 (when ret-fun (funcall ret-fun))))
533 (defun el-search--create-read-map (&optional pos)
535 (el-search--do-subsexps
537 (lambda (sexp _) (push (cons (read sexp) sexp) mapping))
538 (lambda () (nreverse mapping))
539 (save-excursion (thing-at-point--end-of-sexp) (point)))))
541 (defun el-search--repair-replacement-layout (printed mapping)
544 (el-search--do-subsexps
546 (lambda (sexp sexp-end)
547 (when-let ((old (cdr (assoc (read sexp) mapping))))
548 (delete-region (point) sexp-end)
549 (when (string-match-p "\n" old)
550 (unless (looking-back "^[[:space:]]*" (line-beginning-position))
552 (unless (looking-at "[[:space:]\)]*$")
555 (save-excursion (insert old))))
556 (lambda () (buffer-substring (point-min) (point-max))))))
561 (defvar-local el-search-hl-overlay nil)
563 (defvar el-search-keep-hl nil)
565 (defun el-search-hl-sexp-at-point ()
566 (let ((bounds (list (point) (el-search--end-of-sexp))))
567 (if (overlayp el-search-hl-overlay)
568 (apply #'move-overlay el-search-hl-overlay bounds)
569 (overlay-put (setq el-search-hl-overlay (apply #'make-overlay bounds))
570 'face 'el-search-match)))
571 (add-hook 'post-command-hook #'el-search-hl-post-command-fun t t))
573 (defun el-search-hl-remove ()
574 (when (overlayp el-search-hl-overlay)
575 (delete-overlay el-search-hl-overlay)))
577 (defun el-search-hl-post-command-fun ()
578 (unless (or el-search-keep-hl
579 (eq this-command 'el-search-query-replace)
580 (eq this-command 'el-search-pattern))
581 (el-search-hl-remove)
582 (remove-hook 'post-command-hook 'el-search-hl-post-command-fun t)))
587 (defvar el-search-history '()
588 "List of input strings.")
590 (defvar el-search-success nil)
591 (defvar el-search-current-pattern nil)
594 (defun el-search-pattern (pattern)
595 "Start new or resume last elisp search.
597 Search current buffer for expressions that are matched by `pcase'
598 PATTERN. Use `read' to transform buffer contents into
602 Additional `pcase' pattern types to be used with this command can
603 be defined with `el-search-defpattern'.
605 The following additional pattern types are currently defined:\n"
606 (interactive (list (if (and (eq this-command last-command)
608 el-search-current-pattern
610 (el-search--read-pattern "Find pcase pattern: "
611 (car el-search-history)
613 ;; A very common mistake: input "foo" instead of "'foo"
614 (when (and (symbolp pattern)
615 (not (eq pattern '_))
616 (or (not (boundp pattern))
617 (not (eq (symbol-value pattern) pattern))))
618 (error "Please don't forget the quote when searching for a symbol"))
619 (el-search--wrap-pattern pattern)))))
620 (setq this-command 'el-search-pattern) ;in case we come from isearch
621 (setq el-search-current-pattern pattern)
622 (let ((opoint (point)))
623 (when (and (eq this-command last-command) el-search-success)
624 (el-search--skip-expression nil t))
625 (setq el-search-success nil)
626 (message "%s" (substitute-command-keys "Type \\[el-search-pattern] to repeat"))
627 (when (condition-case nil
628 (el-search--search-pattern pattern)
629 (end-of-buffer (message "No match")
631 (el-search-hl-remove)
634 (setq el-search-success t)
635 (el-search-hl-sexp-at-point))))
637 (defun el-search-search-and-replace-pattern (pattern replacement &optional mapping)
638 (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
639 (el-search-keep-hl t) (opoint (point))
640 (get-replacement (el-search--matcher pattern replacement)))
642 (while (and (not done) (el-search--search-pattern pattern t))
643 (setq opoint (point))
644 (unless replace-all (el-search-hl-sexp-at-point))
645 (let* ((read-mapping (el-search--create-read-map))
646 (region (list (point) (el-search--end-of-sexp)))
647 (substring (apply #'buffer-substring-no-properties region))
648 (expr (read substring))
650 (new-expr (funcall get-replacement expr))
651 (to-insert (el-search--repair-replacement-layout
652 (el-search--print new-expr) (append mapping read-mapping)))
653 (do-replace (lambda ()
655 (apply #'delete-region region)
656 (let ((inhibit-message t)
659 (indent-region opoint (point))
661 (el-search-hl-sexp-at-point)))
662 (cl-incf nbr-replaced)
663 (setq replaced-this t))))
666 (while (not (pcase (if replaced-this
667 (read-char-choice "[SPC ! q]" '(?\ ?! ?q ?n))
669 (concat "Replace this occurrence"
670 (if (or (string-match-p "\n" to-insert)
671 (< 40 (length to-insert)))
672 "" (format " with `%s'" to-insert))
674 '(?y ?n ?r ?\ ?! ?q)))
675 (?r (funcall do-replace)
677 (?y (funcall do-replace)
680 (unless replaced-this (cl-incf nbr-skipped))
682 (?! (unless replaced-this
683 (funcall do-replace))
688 (unless (or done (eobp)) (el-search--skip-expression nil t)))))
689 (el-search-hl-remove)
691 (message "Replaced %d matches%s"
693 (if (zerop nbr-skipped) ""
694 (format " (%d skipped)" nbr-skipped)))))
696 (defun el-search-query-replace-read-args ()
697 (barf-if-buffer-read-only)
698 (let* ((from (el-search--read-pattern "Replace from: "))
699 (to (let ((el-search--initial-mb-contents nil))
700 (el-search--read-pattern "Replace with result of evaluation of: " from))))
701 (list (el-search--wrap-pattern (read from)) (read to)
704 (el-search--create-read-map 1)))))
707 (defun el-search-query-replace (from to &optional mapping)
708 "Replace some occurrences of FROM pattern with evaluated TO."
709 (interactive (el-search-query-replace-read-args))
710 (setq this-command 'el-search-query-replace) ;in case we come from isearch
711 (setq el-search-current-pattern from)
712 (barf-if-buffer-read-only)
713 (el-search-search-and-replace-pattern from to mapping))
715 (defun el-search--take-over-from-isearch ()
716 (let ((other-end isearch-other-end)
717 (input isearch-string))
719 (when (and other-end (< other-end (point)))
720 (goto-char other-end))
724 (defun el-search-search-from-isearch ()
725 ;; FIXME: an interesting alternative would be to really integrate it
726 ;; with Isearch, using `isearch-search-fun-function'.
727 ;; Alas, this is not trivial if we want to transfer our optimizations.
729 (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
730 ;; use `call-interactively' so we get recorded in `extended-command-history'
731 (call-interactively #'el-search-pattern)))
734 (defun el-search-replace-from-isearch ()
736 (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
737 (call-interactively #'el-search-query-replace)))
742 ;;; el-search.el ends here