code.delx.au - gnu-emacs-elpa/blob - 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.0.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 the command `el-search-pattern'.  It
  37 ;; prompts for a `pcase' pattern and searches the current buffer for
  38 ;; expressions that are matched by it when read.  Point is put at the
  39 ;; beginning of the expression found (unlike isearch).
  40 ;;
  41 ;; It doesn't matter how the code is actually formatted.  Comments are
  42 ;; ignored by the search, and strings are treated as objects, their
  43 ;; contents are not being searched.
  44 ;;
  45 ;; Example 1: if you enter
  46 ;;
  47 ;;    97
  48 ;;
  49 ;; at the prompt, this will find any occurrence of the number 97 in
  50 ;; the code, but not 977 or (+ 90 7) or "My string containing 97".
  51 ;; But it will find anything `eq' to 97 after reading, e.g. #x61 or
  52 ;; ?a.
  53 ;;
  54 ;;
  55 ;; Example 2: If you enter the pattern
  56 ;;
  57 ;;   `(defvar ,_)
  58 ;;
  59 ;; you search for all defvar forms that don't specify an init value.
  60 ;;
  61 ;; The following will search for defvar forms with a docstring whose
  62 ;; first line is longer than 70 characters:
  63 ;;
  64 ;;   `(defvar ,_ ,_
  65 ;;      ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
  66 ;;
  67 ;;
  68 ;; Convenience
  69 ;; ===========
  70 ;;
  71 ;; For expression input, the minibuffer prompts here uses
  72 ;; `emacs-lisp-mode'.
  73 ;;
  74 ;; When reading a search pattern in the minibuffer, the input is
  75 ;; automatically wrapped into `(and expr ,(read input)).  So, if you
  76 ;; want to search a buffer for symbols that are defined in "cl-lib",
  77 ;; you can use this pattern
  78 ;;
  79 ;;   (guard (and (symbolp expr)
  80 ;;               (when-let ((file (symbol-file expr)))
  81 ;;                 (string-match-p "cl-lib\\.elc?$" file))))
  82 ;;
  83 ;; without binding the variable `expr'.
  84 ;;
  85 ;;
  86 ;; Replacing
  87 ;; =========
  88 ;;
  89 ;; You can replace expressions with command `el-search-query-replace'.
  90 ;; You are queried for a (pcase) pattern and a replacement expression.
  91 ;; For each match of the pattern, the replacement expression is
  92 ;; evaluated with the bindings created by the pcase matching in
  93 ;; effect, and printed to produce the replacement string.
  94 ;;
  95 ;; Example: In some buffer you want to swap the two expressions at the
  96 ;; places of the first two arguments in all calls of function `foo',
  97 ;; so that e.g.
  98 ;;
  99 ;;   (foo 'a (* 2 (+ 3 4)) t)
 100 ;;
 101 ;; becomes
 102 ;;
 103 ;;   (foo (* 2 (+ 3 4)) 'a t).
 104 ;;
 105 ;; This will do it:
 106 ;;
 107 ;;    M-x el-search-query-replace RET
 108 ;;    `(foo ,a ,b . ,rest) RET
 109 ;;    `(foo ,b ,a . ,rest) RET
 110 ;;
 111 ;; Type y to replace a match and go to the next one, r to replace
 112 ;; without moving, SPC to go to the next match and ! to replace all
 113 ;; remaining matches automatically.  q quits.  n is like SPC, so that
 114 ;; y and n work like in isearch (meaning "yes" and "no") if you are
 115 ;; used to that.
 116 ;;
 117 ;;
 118 ;; Suggested key bindings
 119 ;; ======================
 120 ;;
 121 ;;    (define-key emacs-lisp-mode-map [(control ?S)] #'el-search-pattern)
 122 ;;    (define-key emacs-lisp-mode-map [(control ?%)] #'el-search-query-replace)
 123 ;;
 124 ;;    (define-key isearch-mode-map [(control ?S)] #'el-search-search-from-isearch)
 125 ;;    (define-key isearch-mode-map [(control ?%)] #'el-search-replace-from-isearch)
 126 ;;
 127 ;; The bindings in `isearch-mode-map' let you conveniently switch to
 128 ;; elisp searching from isearch.
 129 ;;
 130 ;;
 131 ;; Bugs, Known Limitations
 132 ;; =======================
 133 ;;
 134 ;; - Replacing: in some cases the reader syntax of forms
 135 ;; is changing due to reading+printing.  "Some" because we can treat
 136 ;; that problem in most cases.
 137 ;;
 138 ;; - Similarly: Comments are normally preserved (where it makes
 139 ;; sense).  But when replacing like `(foo ,a ,b) -> `(foo ,b ,a)
 140 ;;
 141 ;; in a content like
 142 ;;
 143 ;;   (foo
 144 ;;     a
 145 ;;     ;;a comment
 146 ;;     b)
 147 ;;
 148 ;; the comment will be lost.
 149 ;;
 150 ;;
 151 ;;  Acknowledgments
 152 ;;  ===============
 153 ;;
 154 ;; Thanks to Stefan Monnier for corrections and advice.
 155 ;;
 156 ;;
 157 ;; TODO:
 158 ;;
 159 ;; - improve docstrings
 160 ;;
 161 ;; - add more examples
 162 ;;
 163 ;; - Implement sessions; add multi-file support based on iterators.  A
 164 ;; file list is read in (or the user can specify an iterator as a
 165 ;; variable).  The state in the current buffer is just (buffer
 166 ;; . marker).  Or should this be abstracted into an own lib?  Could be
 167 ;; named "files-session" or so.
 168
 169
 170
 171 ;;; Code:
 172
 173 ;;;; Requirements
 174
 175 (eval-when-compile
 176   (require 'subr-x))
 177
 178 (require 'cl-lib)
 179 (require 'elisp-mode)
 180 (require 'thingatpt)
 181
 182
 183 ;;;; Configuration stuff
 184
 185 (defgroup el-search nil
 186   "Expression based search and replace for `emacs-lisp-mode'."
 187   :group 'lisp)
 188
 189 (defcustom el-search-this-expression-identifier 'exp
 190   "Name of the identifier referring to the whole expression.
 191 The default value is `expr'.  You can use this variable in the
 192 search prompt to refer to value of the currently searched
 193 expression."
 194   :type 'symbol)
 195
 196 (defface el-search-match '((((background dark)) (:background "#0000A0"))
 197                            (t                   (:background "DarkSlateGray1")))
 198   "Face for highlighting the current match.")
 199
 200
 201 ;;;; Helpers
 202
 203 (defun el-search--print (expr)
 204   (let ((print-quoted t)
 205         (print-length nil)
 206         (print-level nil))
 207     (prin1-to-string expr)))
 208
 209 (defvar el-search-read-expression-map
 210   (let ((map (make-sparse-keymap)))
 211     (set-keymap-parent map read-expression-map)
 212     (define-key map [(control ?g)] #'abort-recursive-edit)
 213     (define-key map [up]   nil)
 214     (define-key map [down] nil)
 215     (define-key map [(control meta backspace)] #'backward-kill-sexp)
 216     (define-key map [(control ?S)] #'exit-minibuffer)
 217     map)
 218   "Map for reading input with `el-search-read-expression'.")
 219
 220 ;; $$$$$FIXME: this should be in Emacs!  There is only a helper `read--expression'.
 221 (defun el-search-read-expression (prompt &optional initial-contents hist default read)
 222   "Read expression for `my-eval-expression'."
 223   (minibuffer-with-setup-hook
 224       (lambda ()
 225         (emacs-lisp-mode)
 226         (use-local-map el-search-read-expression-map)
 227         (setq font-lock-mode t)
 228         (funcall font-lock-function 1)
 229         (backward-sexp)
 230         (indent-sexp)
 231         (goto-char (point-max)))
 232     (read-from-minibuffer prompt initial-contents el-search-read-expression-map read
 233                           (or hist 'read-expression-history) default)))
 234
 235 (defun el-search--read-pattern (prompt &optional default initial-contents read)
 236   (el-search-read-expression
 237    prompt initial-contents 'el-search-history
 238    (or default (when-let ((this-sexp (sexp-at-point)))
 239                  (concat "'" (el-search--print this-sexp))))
 240    read))
 241
 242 (defun el-search--goto-next-sexp ()
 243   "Move point to the beginning of the next sexp.
 244 Don't move if already at beginning of a sexp."
 245   (let ((not-done t) res)
 246     (while not-done
 247       (let ((stop-here nil) syntax-here
 248             (looking-at-from-back (lambda (regexp n)
 249                                     (save-excursion
 250                                       (backward-char n)
 251                                       (looking-at regexp)))))
 252         (while (not stop-here)
 253           (cond
 254            ((eobp) (signal 'end-of-buffer nil))
 255            ((looking-at (rx (and (* space) ";"))) (forward-line))
 256            ((looking-at (rx (+ (or space "\n")))) (goto-char (match-end 0)))
 257            ((progn (setq syntax-here (syntax-ppss))
 258                    (or (nth 4 syntax-here) (nth 8 syntax-here)))
 259             (if (nth 4 syntax-here) (forward-line) (search-forward "\"")))
 260
 261            ;; FIXME: can the rest be done more generically?
 262            ((and (looking-at (rx (or (syntax symbol) (syntax word))))
 263                  (not (looking-at "\\_<"))
 264                  (not (funcall looking-at-from-back ",@" 2)))
 265             (forward-symbol 1))
 266            ((or (and (looking-at "'") (funcall looking-at-from-back "#" 1))
 267                 (and (looking-at "@") (funcall looking-at-from-back "," 1)))
 268             (forward-char))
 269            (t (setq stop-here t)))))
 270       (condition-case nil
 271           (progn
 272             (setq res (save-excursion (read (current-buffer))))
 273             (setq not-done nil))
 274         (error (forward-char))))
 275     res))
 276
 277 (defun el-search--match-p (pattern expression)
 278   (funcall
 279    `(lambda ()
 280       (pcase ',expression
 281         (,pattern t)
 282         (_        nil)))))
 283
 284 (defun el-search-expression-contains-match-p (pattern expression)
 285   "Whether some subexp of EXPRESSION is matched by PATTERN."
 286   (or (el-search--match-p pattern expression)
 287       (and (consp expression)
 288            (if (cdr (last expression))
 289                ;; a dotted list
 290                (or (el-search-expression-contains-match-p pattern (car expression))
 291                    (el-search-expression-contains-match-p pattern (cdr expression)))
 292              (cl-some (lambda (subexpr) (el-search-expression-contains-match-p pattern subexpr))
 293                       expression)))))
 294
 295 (defun el-search--maybe-wrap-pattern (pattern)
 296   (if (el-search-expression-contains-match-p `',el-search-this-expression-identifier pattern)
 297       `(and ,el-search-this-expression-identifier ,pattern)
 298     pattern))
 299
 300 (defun el-search--search-pattern (pattern &optional noerror)
 301   "Search elisp buffer with `pcase' PATTERN.
 302 Set point to the beginning of the occurrence found and return
 303 point.  Optional second argument, if non-nil, means if fail just
 304 return nil (no error)."
 305   ;; For better performance we read complete top-level sexps and test
 306   ;; for matches.  We enter top-level expressions in the buffer text
 307   ;; only when the test was successful.
 308   (let ((match-beg nil) (opoint (point)) current-expr)
 309     (if (catch 'no-match
 310           (while (not match-beg)
 311             (condition-case nil
 312                 (setq current-expr (el-search--goto-next-sexp))
 313               (end-of-buffer
 314                (goto-char opoint)
 315                (throw 'no-match t)))
 316             (if (and (zerop (car (syntax-ppss)))
 317                      (not (el-search-expression-contains-match-p pattern current-expr)))
 318                 ;; nothing here; skip to next top level form
 319                 (let ((end-of-next-sexp (scan-sexps (point) 2)))
 320                   (if (not end-of-next-sexp)
 321                       (throw 'no-match t)
 322                     (goto-char end-of-next-sexp)
 323                     (backward-sexp)))
 324               (if (el-search--match-p pattern current-expr)
 325                 (setq match-beg (point)
 326                       opoint (point))
 327                 (forward-char)))))
 328         (if noerror nil (signal 'end-of-buffer nil)))
 329     match-beg))
 330
 331 (defun el-search--do-subsexps (pos do-fun &optional ret-fun bound)
 332   ;; bound -> nil means till end of buffer
 333   (save-excursion
 334     (goto-char pos)
 335     (condition-case nil
 336         (while (or (not bound) (< (point) bound))
 337           (let* ((this-sexp-end (save-excursion (thing-at-point--end-of-sexp) (point)))
 338                  (this-sexp (buffer-substring-no-properties (point) this-sexp-end)))
 339             (funcall do-fun this-sexp this-sexp-end))
 340           (forward-char)
 341           (el-search--goto-next-sexp))
 342       (end-of-buffer))
 343     (when ret-fun (funcall ret-fun))))
 344
 345 (defun el-search--create-read-map (&optional pos)
 346   (let ((mapping '()))
 347     (el-search--do-subsexps
 348      (or pos (point))
 349      (lambda (sexp _) (push (cons (read sexp) sexp) mapping))
 350      (lambda () (nreverse mapping))
 351      (save-excursion (thing-at-point--end-of-sexp) (point)))))
 352
 353 (defun el-search--repair-replacement-layout (printed mapping)
 354   (with-temp-buffer
 355     (insert printed)
 356     (el-search--do-subsexps
 357      (point-min)
 358      (lambda (sexp sexp-end)
 359        (when-let ((old (cdr (assoc (read sexp) mapping))))
 360          (delete-region (point) sexp-end)
 361          (when (string-match-p "\n" old)
 362            (unless (looking-back "^[[:space:]]*" (line-beginning-position))
 363              (insert "\n"))
 364            (unless (looking-at "[[:space:]\)]*$")
 365              (insert "\n")
 366              (backward-char)))
 367          (insert old)))
 368      (lambda () (buffer-substring (point-min) (point-max))))))
 369
 370
 371 ;;;; Highlighting
 372
 373 (defvar-local el-search-hl-overlay nil)
 374
 375 (defvar el-search-keep-hl nil)
 376
 377 (defun el-search-hl-sexp-at-point ()
 378   (let ((bounds (list (point) (scan-sexps (point) 1))))
 379     (if (overlayp el-search-hl-overlay)
 380         (apply #'move-overlay el-search-hl-overlay bounds)
 381       (overlay-put (setq el-search-hl-overlay (apply #'make-overlay bounds))
 382                    'face 'el-search-match)))
 383   (add-hook 'post-command-hook (el-search-hl-post-command-fun (current-buffer)) t))
 384
 385 (defun el-search-hl-remove ()
 386   (when (overlayp el-search-hl-overlay)
 387     (delete-overlay el-search-hl-overlay)))
 388
 389 (defun el-search-hl-post-command-fun (buf)
 390   (lambda ()
 391     (when (buffer-live-p buf)
 392       (unless (or el-search-keep-hl
 393                   (eq this-command 'el-search-query-replace)
 394                   (eq this-command 'el-search-pattern))
 395         (with-current-buffer buf
 396           (el-search-hl-remove)
 397           (remove-hook 'post-command-hook #'el-search-hl-post-command-fun t))))))
 398
 399
 400 ;;;; Core functions
 401
 402 (defvar el-search-history '()
 403   "List of input strings.")
 404
 405 (defvar el-search-success nil)
 406 (defvar el-search-current-pattern nil)
 407
 408 ;;;###autoload
 409 (defun el-search-pattern (pattern)
 410   "Do incremental elisp search forward."
 411   (interactive (list (if (and (eq this-command last-command)
 412                               el-search-success)
 413                          el-search-current-pattern
 414                        (let ((pattern
 415                               (el-search--read-pattern "Find pcase pattern: "
 416                                                        (car el-search-history)
 417                                                        nil t)))
 418                          ;; A very common mistake: input "foo" instead of "'foo"
 419                          (when (and (symbolp pattern)
 420                                     (not (eq pattern '_))
 421                                     (or (not (boundp pattern))
 422                                         (not (eq (symbol-value pattern) pattern))))
 423                            (error "Please don't forget the quote when searching for a symbol"))
 424                          (el-search--maybe-wrap-pattern pattern)))))
 425   (setq el-search-current-pattern pattern)
 426   (setq el-search-success nil)
 427   (let ((opoint (point)))
 428     (when (eq this-command last-command)
 429       (forward-char))
 430     (when (condition-case nil
 431               (el-search--search-pattern pattern)
 432             (end-of-buffer (message "No match")
 433                            (goto-char opoint)
 434                            (el-search-hl-remove)
 435                            (ding)
 436                            nil))
 437       (setq el-search-success t)
 438       (el-search-hl-sexp-at-point)
 439       (message "%s" (substitute-command-keys "Type \\[el-search-pattern] to repeat")))))
 440
 441 (defun el-search-search-and-replace-pattern (pattern replacement &optional mapping)
 442   (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
 443         (el-search-keep-hl t) (opoint (point)))
 444     (unwind-protect
 445         (while (and (not done) (el-search--search-pattern pattern t))
 446           (setq opoint (point))
 447           (unless replace-all (el-search-hl-sexp-at-point))
 448           (let* ((read-mapping (el-search--create-read-map))
 449                  (region (list (point)  (scan-sexps (point) 1)))
 450                  (substring (apply #'buffer-substring-no-properties region))
 451                  (expr      (read substring))
 452                  (replaced-this nil)
 453                  (new-expr  (funcall `(lambda () (pcase ',expr (,pattern ,replacement)))))
 454                  (to-insert (el-search--repair-replacement-layout
 455                              (el-search--print new-expr) (append mapping read-mapping)))
 456                  (do-replace (lambda ()
 457                                (atomic-change-group
 458                                  (apply #'delete-region region)
 459                                  (let ((inhibit-message t)
 460                                        (opoint (point)))
 461                                    (insert to-insert)
 462                                    (indent-region opoint (point))
 463                                    (goto-char opoint)
 464                                    (el-search-hl-sexp-at-point)))
 465                                (cl-incf nbr-replaced)
 466                                (setq replaced-this t))))
 467             (if replace-all
 468                 (funcall do-replace)
 469               (while (not (pcase (if replaced-this
 470                                      (read-char-choice "[SPC ! q]" '(?\ ?! ?q ?n))
 471                                    (read-char-choice
 472                                     (concat "Replace this occurence"
 473                                             (if (or (string-match-p "\n" to-insert)
 474                                                     (< 40 (length to-insert)))
 475                                                 "" (format " with `%s'" to-insert))
 476                                             "? [y SPC r ! q]" )
 477                                     '(?y ?n ?r ?\ ?! ?q)))
 478                             (?r (funcall do-replace)
 479                                 nil)
 480                             (?y (funcall do-replace)
 481                                 t)
 482                             ((or ?\ ?n)
 483                              (unless replaced-this (cl-incf nbr-skipped))
 484                              t)
 485                             (?! (unless replaced-this
 486                                   (funcall do-replace))
 487                                 (setq replace-all t)
 488                                 t)
 489                             (?q (setq done t)
 490                                 t)))))
 491             (unless (or done (eobp)) (forward-char 1)))))
 492     (el-search-hl-remove)
 493     (goto-char opoint)
 494     (message "Replaced %d matches%s"
 495              nbr-replaced
 496              (if (zerop nbr-skipped)  ""
 497                (format "   (%d skipped)" nbr-skipped)))))
 498
 499 (defun el-search-query-replace-read-args (&optional initial-contents)
 500   (barf-if-buffer-read-only)
 501   (let* ((from (el-search--read-pattern "Replace from: " nil initial-contents))
 502          (to   (el-search--read-pattern "Replace with result of evaluation of: " from)))
 503     (list (el-search--maybe-wrap-pattern (read from)) (read to)
 504           (with-temp-buffer
 505             (insert to)
 506             (el-search--create-read-map 1)))))
 507
 508 ;;;###autoload
 509 (defun el-search-query-replace (from to &optional mapping)
 510   "Replace some occurrences of FROM pattern with evaluated TO."
 511   (interactive (el-search-query-replace-read-args))
 512   (setq el-search-current-pattern from)
 513   (barf-if-buffer-read-only)
 514   (el-search-search-and-replace-pattern from to mapping))
 515
 516 (defun el-search--take-over-from-isearch ()
 517   (let ((other-end isearch-other-end)
 518         (input isearch-string))
 519     (isearch-exit)
 520     (when (and other-end (< other-end (point)))
 521       (goto-char other-end))
 522     input))
 523
 524 ;;;###autoload
 525 (defun el-search-search-from-isearch ()
 526   ;; FIXME: an interesting alternative would be to really integrate it with
 527   ;; Isearch, using `isearch-search-fun'.
 528   (interactive)
 529   (el-search-pattern
 530    (el-search--read-pattern
 531     "Find pcase pattern: " nil (concat "'" (el-search--take-over-from-isearch)) t))
 532   (setq this-command 'el-search-pattern))
 533
 534 ;;;###autoload
 535 (defun el-search-replace-from-isearch ()
 536   (interactive)
 537   (let ((this-command 'el-search-query-replace))
 538     (apply #'el-search-query-replace
 539            (el-search-query-replace-read-args (concat "'" (el-search--take-over-from-isearch))))))
 540
 541
 542
 543 (provide 'el-search)
 544 ;;; el-search.el ends here