[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/el-search 70b8a75 001/332: new package el-search for se
From: |
Stefan Monnier |
Subject: |
[elpa] externals/el-search 70b8a75 001/332: new package el-search for searching elisp |
Date: |
Tue, 1 Dec 2020 15:47:58 -0500 (EST) |
branch: externals/el-search
commit 70b8a754d87f1f22f81dfb64fb9ce561bb3b0bc8
Author: Michael Heerdegen <michael_heerdegen@web.de>
Commit: Michael Heerdegen <michael_heerdegen@web.de>
new package el-search for searching elisp
---
el-search.el | 527 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 527 insertions(+)
diff --git a/el-search.el b/el-search.el
new file mode 100644
index 0000000..a8086f6
--- /dev/null
+++ b/el-search.el
@@ -0,0 +1,527 @@
+;; el-search.el --- Expression based incremental search for emacs-lisp-mode
-*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc
+
+;; Author: Michael Heerdegen <michael_heerdegen@web.de>
+;; Maintainer: Michael Heerdegen <michael_heerdegen@web.de>
+;; Created: 29 Jul 2015
+;; Keywords: lisp
+;; Compatibility: Gnu Emacs 25
+;; Version: 0.0.1
+;; Package-Requires: ((emacs "25") (cl-lib "0"))
+
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+
+;; The first version for trying! Feedback and improvement suggestions
+;; welcome.
+
+
+;; Introduction
+;; ============
+;;
+;;
+;; The main user entry point is the command `el-search-pattern'. It
+;; prompts for a `pcase' pattern and searches the current buffer for
+;; expressions that are matched by it when read. Point is put at the
+;; beginning of the expression found (unlike isearch).
+;;
+;; It doesn't matter how the code is actually formatted. Comments are
+;; ignored by the search, and strings are treated as objects, their
+;; contents are not being searched.
+;;
+;; Example 1: if you enter
+;;
+;; 97
+;;
+;; at the prompt, this will find any occurrence of the number 97 in
+;; the code, but not 977 or (+ 90 7) or "My string containing 97".
+;; But it will find anything `eq' to 97 after reading, e.g. #x61 or
+;; ?a.
+;;
+;;
+;; Example 2: If you enter the pattern
+;;
+;; `(defvar ,_)
+;;
+;; you search for all defvar forms that don't specify an init value.
+;;
+;; The following will search for defvar forms with a docstring whose
+;; first line is longer than 70 characters:
+;;
+;; `(defvar ,_ ,_
+;; ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
+;;
+;;
+;;
+;; Convenience
+;; ===========
+;;
+;; For expression input, the minibuffer prompts here uses
+;; `emacs-lisp-mode'.
+;;
+;; When reading a search pattern in the minibuffer, the input is
+;; automatically wrapped into `(and expr ,(read input)). So, if you
+;; want to search a buffer for symbols that are defined in "cl-lib",
+;; you can use this pattern
+;;
+;; (guard (and (symbolp expr)
+;; (when-let ((file (symbol-file expr)))
+;; (string-match-p "cl-lib\\.elc?$" file))))
+;;
+;; without binding the variable `expr'.
+;;
+;;
+;; Replacing
+;; =========
+;;
+;; You can replace expressions with command `el-search-query-replace'.
+;; You are queried for a (pcase) pattern and a replacement expression.
+;; For each match of the pattern, the replacement expression is
+;; evaluated with the bindings created by the pcase matching in
+;; effect, and printed to produce the replacement string.
+;;
+;; Example: In some buffer you want to swap the two expressions at the
+;; places of the first two arguments in all calls of function `foo',
+;; so that e.g.
+;;
+;; (foo 'a (* 2 (+ 3 4)) t)
+;;
+;; becomes
+;;
+;; (foo (* 2 (+ 3 4)) 'a t).
+;;
+;; This will do it:
+;;
+;; M-x el-search-query-replace RET
+;; `(foo ,a ,b . ,rest) RET
+;; `(foo ,b ,a . ,rest) RET
+;;
+;; Type y to replace a match and go to the next one, r to replace
+;; without moving, SPC to go to the next match and ! to replace all
+;; remaining matches automatically. q quits. n is like SPC, so that
+;; y and n work like in isearch (meaning "yes" and "no") if you are
+;; used to that.
+;;
+;;
+;;
+;; Suggested key bindings
+;; ======================
+;;
+;; (define-key emacs-lisp-mode-map [(control ?S)] #'el-search-pattern)
+;; (define-key emacs-lisp-mode-map [(control ?%)] #'el-search-query-replace)
+;;
+;; (define-key isearch-mode-map [(control ?S)]
#'el-search-search-from-isearch)
+;; (define-key isearch-mode-map [(control ?%)]
#'el-search-replace-from-isearch)
+;;
+;; The bindings in `isearch-mode-map' let you conveniently switch to
+;; elisp searching from isearch.
+;;
+;;
+;; Bugs, Known Limitations
+;;
+;;
+;; - Replacing: in some cases the reader syntax of forms
+;; is changing due to reading+printing. "Some" because we can treat
+;; that problem in most cases.
+;;
+;; - Similarly: Comments are normally preserved (where it makes
+;; sense). But when replacing like `(foo ,a ,b) -> `(foo ,b ,a)
+;;
+;; in a content like
+;;
+;; (foo
+;; a
+;; ;;a comment
+;; b)
+;;
+;; the comment will be lost.
+;;
+;;
+;;
+;; TODO:
+;;
+;; - improve docstrings
+;;
+;; - Implement sessions; add multi-file support based on iterators. A
+;; file list is read in (or the user can specify an iterator as a
+;; variable). The state in the current buffer is just (buffer
+;; . marker). Or should this be abstracted into an own lib? Could be
+;; named "files-session" or so.
+
+
+
+;;; Code:
+
+;;; Requirements
+
+(eval-when-compile
+ (require 'subr-x))
+
+(require 'cl-lib)
+(require 'elisp-mode)
+(require 'thingatpt)
+
+
+;;; Configuration stuff
+
+(defgroup el-search nil
+ "Expression based search and replace for `emacs-lisp-mode'."
+ :group 'lisp)
+
+(defcustom el-search-this-expression-identifier 'expr
+ "Name of the identifier referring to the whole expression.
+The default value is `expr'. You can use this variable in the
+search prompt to refer to value of the currently searched
+expression."
+ :group 'el-search :type 'symbol)
+
+(defface el-search-match '((((background dark)) (:background "#0000A0"))
+ (t (:background "DarkSlateGray1")))
+ "Face for highlighting the current match."
+ :group 'el-search)
+
+
+;;; Helpers
+
+(defun el-search--print (expr)
+ (let ((print-quoted t)
+ (print-length nil)
+ (print-level nil))
+ (prin1-to-string expr)))
+
+(defvar el-search-read-expression-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map read-expression-map)
+ (define-key map [(control ?g)] #'abort-recursive-edit)
+ (define-key map [up] nil)
+ (define-key map [down] nil)
+ (define-key map [(control meta backspace)] #'backward-kill-sexp)
+ map)
+ "Map for reading input with `el-search-read-expression'.")
+
+;; $$$$$FIXME: this should be in Emacs! There is only a helper
`read--expression'.
+(defun el-search-read-expression (prompt &optional initial-contents hist
default read)
+ "Read expression for `my-eval-expression'."
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (emacs-lisp-mode)
+ (use-local-map el-search-read-expression-map)
+ (setq font-lock-mode t)
+ (funcall font-lock-function 1)
+ (backward-sexp)
+ (indent-sexp)
+ (goto-char (point-max)))
+ (read-from-minibuffer prompt initial-contents
el-search-read-expression-map read
+ (or hist 'read-expression-history) default)))
+
+(defun el-search--read-pattern (prompt &optional default initial-contents read)
+ (el-search-read-expression
+ prompt initial-contents 'el-search-history
+ (or default (when-let ((this-sexp (sexp-at-point)))
+ (concat "'" (el-search--print this-sexp))))
+ read))
+
+(defun el-search--goto-next-sexp ()
+ "Move point to the beginning of the next sexp.
+Don't move if already at beginning of a sexp."
+ (let ((not-done t) res)
+ (while not-done
+ (let ((stop-here nil) syntax-here)
+ (while (not stop-here)
+ (cond
+ ((eobp) (signal 'end-of-buffer nil))
+ ((looking-at (rx (and (* space) ";"))) (forward-line))
+ ((looking-at (rx (+ (or space "\n")))) (goto-char (match-end 0)))
+ ((progn (setq syntax-here (syntax-ppss))
+ (or (nth 4 syntax-here) (nth 8 syntax-here)))
+ (if (nth 4 syntax-here) (forward-line) (search-forward "\"")))
+
+ ;; FIXME: can the rest be done more generically?
+ ((and (looking-at (rx (or (syntax symbol) (syntax word))))
+ (not (looking-at "\\_<"))
+ (not (looking-back ",@" 2)))
+ (forward-symbol 1))
+ ((or (and (looking-at "'") (looking-back "#" 1))
+ (and (looking-at "@") (looking-back "," 1)))
+ (forward-char))
+ (t (setq stop-here t)))))
+ (condition-case nil
+ (progn
+ (setq res (save-excursion (read (current-buffer))))
+ (setq not-done nil))
+ (error (forward-char))))
+ res))
+
+(defun el-search--match-p (pattern expression)
+ (funcall
+ `(lambda ()
+ (pcase ',expression
+ (,pattern t)
+ (_ nil)))))
+
+(defun el-search-expression-contains-match-p (pattern expression)
+ "Whether some subexp of EXPRESSION is matched by PATTERN."
+ (or (el-search--match-p pattern expression)
+ (and (consp expression)
+ (if (cdr (last expression))
+ ;; a dotted list
+ (or (el-search-expression-contains-match-p pattern (car
expression))
+ (el-search-expression-contains-match-p pattern (cdr
expression)))
+ (cl-some (lambda (subexpr) (el-search-expression-contains-match-p
pattern subexpr))
+ expression)))))
+
+(defun el-search--maybe-wrap-pattern (pattern)
+ (if (el-search-expression-contains-match-p
`',el-search-this-expression-identifier pattern)
+ `(and ,el-search-this-expression-identifier ,pattern)
+ pattern))
+
+(defun el-search--search-pattern (pattern &optional noerror)
+ "Search elisp buffer with `pcase' PATTERN.
+Set point to the beginning of the occurrence found and return
+point. Optional second argument, if non-nil, means if fail just
+return nil (no error)."
+ ;; For better performance we read complete top-level sexps and test
+ ;; for matches. We enter top-level expressions in the buffer text
+ ;; only when the test was successful.
+ (let ((match-beg nil) (opoint (point)) current-expr)
+ (if (catch 'no-match
+ (while (not match-beg)
+ (condition-case nil
+ (setq current-expr (el-search--goto-next-sexp))
+ (end-of-buffer
+ (goto-char opoint)
+ (throw 'no-match t)))
+ (if (and (zerop (car (syntax-ppss)))
+ (not (el-search-expression-contains-match-p pattern
current-expr)))
+ ;; nothing here; skip to next top level form
+ (let ((end-of-next-sexp (scan-sexps (point) 2)))
+ (if (not end-of-next-sexp)
+ (throw 'no-match t)
+ (goto-char end-of-next-sexp)
+ (backward-sexp)))
+ (if (el-search--match-p pattern current-expr)
+ (setq match-beg (point)
+ opoint (point))
+ (forward-char)))))
+ (if noerror nil (signal 'end-of-buffer nil)))
+ match-beg))
+
+(defun el-search--do-subsexps (pos do-fun &optional ret-fun bound)
+ ;; bound -> nil means till end of buffer
+ (save-excursion
+ (goto-char pos)
+ (condition-case nil
+ (while (or (not bound) (< (point) bound))
+ (let* ((this-sexp-end (save-excursion (thing-at-point--end-of-sexp)
(point)))
+ (this-sexp (buffer-substring-no-properties (point)
this-sexp-end)))
+ (funcall do-fun this-sexp this-sexp-end))
+ (forward-char)
+ (el-search--goto-next-sexp))
+ (end-of-buffer))
+ (when ret-fun (funcall ret-fun))))
+
+(defun el-search--create-read-map (&optional pos)
+ (let ((mapping '()))
+ (el-search--do-subsexps
+ (or pos (point))
+ (lambda (sexp _) (push (cons (read sexp) sexp) mapping))
+ (lambda () (nreverse mapping))
+ (save-excursion (thing-at-point--end-of-sexp) (point)))))
+
+(defun el-search--repair-replacement-layout (printed mapping)
+ (with-temp-buffer
+ (insert printed)
+ (el-search--do-subsexps
+ (point-min)
+ (lambda (sexp sexp-end)
+ (when-let ((old (cdr (assoc (read sexp) mapping))))
+ (delete-region (point) sexp-end)
+ (when (string-match-p "\n" old)
+ (unless (looking-back "^[[:space:]]*" (line-beginning-position))
+ (insert "\n"))
+ (unless (looking-at "[[:space:]\)]*$")
+ (insert "\n")
+ (backward-char)))
+ (insert old)))
+ (lambda () (buffer-substring (point-min) (point-max))))))
+
+
+;;; Highlighting
+
+(defvar-local el-search-hl-overlay nil)
+
+(defvar el-search-keep-hl nil)
+
+(defun el-search-hl-sexp ()
+ (let ((bounds (list (point) (scan-sexps (point) 1))))
+ (if (overlayp el-search-hl-overlay)
+ (apply #'move-overlay el-search-hl-overlay bounds)
+ (overlay-put (setq el-search-hl-overlay (apply #'make-overlay bounds))
+ 'face 'el-search-match)))
+ (add-hook 'post-command-hook (el-search-hl-post-command-fun
(current-buffer)) t))
+
+(defun el-search-hl-remove ()
+ (when (overlayp el-search-hl-overlay)
+ (delete-overlay el-search-hl-overlay)))
+
+(defun el-search-hl-post-command-fun (buf)
+ (lambda ()
+ (when (buffer-live-p buf)
+ (unless (or el-search-keep-hl
+ (eq this-command 'el-search-query-replace)
+ (eq this-command 'el-search-pattern))
+ (with-current-buffer buf
+ (el-search-hl-remove)
+ (remove-hook 'post-command-hook #'el-search-hl-post-command-fun
t))))))
+
+
+;;; Core functions
+
+(defvar el-search-history '()
+ "List of input strings.")
+
+(defvar el-search-success nil)
+(defvar el-search-current-pattern nil)
+
+(defun el-search-pattern (pattern)
+ "Do incremental elisp search forward."
+ (interactive (list (if (and (eq this-command last-command)
+ el-search-success)
+ el-search-current-pattern
+ (let ((pattern (el-search--read-pattern "Find pcase
pattern: " nil nil t)))
+ ;; A very common mistake: input "foo" instead of
"'foo"
+ (when (and (symbolp pattern)
+ (not (eq pattern '_))
+ (or (not (boundp pattern))
+ (not (eq (symbol-value pattern)
pattern))))
+ (error "Please don't forget the quote when
searching for a symbol"))
+ (setq el-search-current-pattern
(el-search--maybe-wrap-pattern pattern))))))
+ (setq el-search-success nil)
+ (let ((opoint (point)))
+ (when (eq this-command last-command)
+ (forward-char))
+ (when (condition-case nil
+ (el-search--search-pattern pattern)
+ (end-of-buffer (message "No match")
+ (goto-char opoint)
+ (el-search-hl-remove)
+ (ding)
+ nil))
+ (setq el-search-success t)
+ (el-search-hl-sexp)
+ (message "%s" (substitute-command-keys "Type \\[el-search-pattern] to
repeat")))))
+
+(defun el-search-search-and-replace-pattern (pattern replacement &optional
mapping)
+ (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
+ (el-search-keep-hl t) (opoint (point)))
+ (unwind-protect
+ (while (and (not done) (el-search--search-pattern pattern t))
+ (setq opoint (point))
+ (unless replace-all (el-search-hl-sexp))
+ (let* ((read-mapping (el-search--create-read-map))
+ (region (list (point) (scan-sexps (point) 1)))
+ (substring (apply #'buffer-substring-no-properties region))
+ (expr (read substring))
+ (replaced-this nil)
+ (new-expr (funcall `(lambda () (pcase ',expr (,pattern
,replacement)))))
+ (to-insert (el-search--repair-replacement-layout
+ (el-search--print new-expr) (append mapping
read-mapping)))
+ (do-replace (lambda ()
+ (atomic-change-group
+ (apply #'delete-region region)
+ (let ((inhibit-message t)
+ (opoint (point)))
+ (insert to-insert)
+ (indent-region opoint (point))
+ (goto-char opoint)
+ (el-search-hl-sexp)))
+ (cl-incf nbr-replaced)
+ (setq replaced-this t))))
+ (if replace-all
+ (funcall do-replace)
+ (while (not (pcase (if replaced-this
+ (read-char-choice "[SPC ! q]" '(?\ ?! ?q
?n))
+ (read-char-choice
+ (concat "Replace this occurence"
+ (if (or (string-match-p "\n"
to-insert)
+ (< 40 (length to-insert)))
+ "" (format " with `%s'"
to-insert))
+ "? [y SPC r ! q]" )
+ '(?y ?n ?r ?\ ?! ?q)))
+ (?r (funcall do-replace)
+ nil)
+ (?y (funcall do-replace)
+ t)
+ ((or ?\ ?n)
+ (unless replaced-this (cl-incf nbr-skipped))
+ t)
+ (?! (unless replaced-this
+ (funcall do-replace))
+ (setq replace-all t)
+ t)
+ (?q (setq done t)
+ t)))))
+ (unless (or done (eobp)) (forward-char 1)))))
+ (el-search-hl-remove)
+ (goto-char opoint)
+ (message "Replaced %d matches%s"
+ nbr-replaced
+ (if (zerop nbr-skipped) ""
+ (format " (%d skipped)" nbr-skipped)))))
+
+(defun el-search-query-replace-read-args (&optional initial-contents)
+ (barf-if-buffer-read-only)
+ (let* ((from (el-search--read-pattern "Replace from: " nil initial-contents))
+ (to (el-search--read-pattern "Replace with result of evaluation of:
" from)))
+ (list (el-search--maybe-wrap-pattern (read from)) (read to)
+ (with-temp-buffer
+ (insert to)
+ (el-search--create-read-map 1)))))
+
+(defun el-search-query-replace (from to &optional mapping)
+ "Replace some occurrences of FROM pattern with evaluated TO."
+ (interactive (el-search-query-replace-read-args))
+ (barf-if-buffer-read-only)
+ (el-search-search-and-replace-pattern from to mapping))
+
+(defun el-search--take-over-from-dired ()
+ (let ((other-end isearch-other-end)
+ (input isearch-string))
+ (isearch-exit)
+ (when (and other-end (< other-end (point)))
+ (goto-char other-end))
+ input))
+
+(defun el-search-search-from-isearch ()
+ (interactive)
+ (el-search-pattern
+ (el-search--read-pattern
+ "Find pcase pattern: " nil (concat "'" (el-search--take-over-from-dired))
t))
+ (setq this-command 'el-search-pattern))
+
+(defun el-search-replace-from-isearch ()
+ (interactive)
+ (let ((this-command 'el-search-query-replace))
+ (apply #'el-search-query-replace
+ (el-search-query-replace-read-args (concat "'"
(el-search--take-over-from-dired))))))
+
+
+
+(provide 'el-search)
- [elpa] branch externals/el-search created (now 6df1362), Stefan Monnier, 2020/12/01
- [elpa] externals/el-search 70b8a75 001/332: new package el-search for searching elisp,
Stefan Monnier <=
- [elpa] externals/el-search d65ee60 003/332: * el-search.el: Fix first line convention, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search 5399f80 002/332: el-search: some small improvements, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search 1538d15 004/332: * el-search.el: Add missing footer, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search 2e6622c 005/332: el-search: fix comment styles, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search fdb1f86 008/332: el-search: remove redundant :group specs from custom defs, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search 1ed9974 011/332: el-search: bump version, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search 41acd5d 010/332: el-search: some comment changes, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search b07d77c 019/332: avoid repeated expansion of pcase forms, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search cdd8cc1 020/332: new function el-search--end-of-sexp; use it, Stefan Monnier, 2020/12/01
- [elpa] externals/el-search 2f48cd0 024/332: call syntax functions less often for better efficiency, Stefan Monnier, 2020/12/01