From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Michael Heerdegen Newsgroups: gmane.emacs.devel Subject: Search Elisp buffers with pcase patterns Date: Sat, 01 Aug 2015 17:57:55 +0200 Message-ID: <87h9ojj918.fsf@web.de> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1438444710 16743 80.91.229.3 (1 Aug 2015 15:58:30 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 1 Aug 2015 15:58:30 +0000 (UTC) To: Emacs Development Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Aug 01 17:58:22 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1ZLZAy-0002fl-Fx for ged-emacs-devel@m.gmane.org; Sat, 01 Aug 2015 17:58:20 +0200 Original-Received: from localhost ([::1]:54113 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZLZAx-0001CX-QJ for ged-emacs-devel@m.gmane.org; Sat, 01 Aug 2015 11:58:19 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56039) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZLZAj-0001CS-RL for emacs-devel@gnu.org; Sat, 01 Aug 2015 11:58:06 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZLZAg-00036J-FG for emacs-devel@gnu.org; Sat, 01 Aug 2015 11:58:05 -0400 Original-Received: from mout.web.de ([212.227.17.12]:54560) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZLZAg-00036B-1D for emacs-devel@gnu.org; Sat, 01 Aug 2015 11:58:02 -0400 Original-Received: from drachen.dragon ([90.186.24.160]) by smtp.web.de (mrweb102) with ESMTPSA (Nemesis) id 0LaTeV-1Yaucq2iCd-00mIst; Sat, 01 Aug 2015 17:58:00 +0200 User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (gnu/linux) X-Provags-ID: V03:K0:DuEXIwhCUvCE5Flmok/uuQMcfsPsXxEzQgl199/K1+eEBTAKWRF qOwm0TW4xX7LGg9EAFpzODTHngrqCturVX7M8zDHWU7COPPLK+ciQ9PbpO/R9YyYf8Ru0Di i+Tr2h8NKHq2Bxm0kYrJ3w7MxpVoKSPWBmz1h3rnkN/ilhq0ziXkDBd7STbVqbN/nzTYxaj Xo6KjPkEDVSXwFPIxlKPg== X-UI-Out-Filterresults: notjunk:1;V01:K0:HqmCI1r8fHw=:i7yo+S9JCEe7jbE6O1WtZy G8wUS7e1TVXMrhFcz416MUEgLCOAqSICOrnS0pxiZytxU0jL3wjk7Hq4Kf+H11viioBpL3eH1 YVwAmeW7zteDNdrSnD62YHCtI7HAePtJM0R5LuAe3qnUNWZm76IHUDPTxmRTZ38Xqlvq4UbhP gkAfJRhZWJ1gotxAm+wh3z/KZBE5/r7AWRmYYKExf0mVAoQ3A9iMpCTByO5iBN8OtnFfIGTNE tLJ4Ek9gO/VJHaqrrpS5UhKPeuqHyYKXUuF5xiMfuGfQsoT0KOcdU0kUs/KU/H60tKaGIik00 r/FVfOEObXB3MYSsFHfmiVzEJaFTlZS+I54v6TYg7fr15/SvNSDgqUdlLqr4lhInawpH/QIXv EMG71ZB5Zzcvvcd0YHqShp66wC0HGE2vvD2v6/3oA6Ql+xfBJx84KtT67vnNuVJ3bU/OPnSE+ 0ly/R/DpiQjM7PGA+7eruJ6wRBIzfGs49umePTdNZ5whB41Gyq91+pDP4pwwBg4nu2bsvInKx mNDwTg5N8P8mTyBIo0E5HOjBbauixlE0bWZo/yGucKKsadf5t3oT9u7b9RZlc9hjppkcBRJqQ BGpbzr/VQFa2Ae+sH+aI6qrvj44Iw/EDXCG1pp2dpNdeVSfrjHOGbIgXWfzqeiuRi8h6kpRn2 rek9u12VMIuztQwkO6G9Gs2ESUR2U1OZ6sR5Vph9Q07dFXA== X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [generic] X-Received-From: 212.227.17.12 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:188279 Archived-At: --=-=-= Content-Type: text/plain Hello, I implemented a buffer search tool for emacs-lisp buffers based on pcase patterns. I would like to add it to Gnu Elpa if it's welcome when it is completed. Here is the prototype; for instructions see the header. Comments on the realization and improvement suggestions are very welcome! --=-=-= Content-Type: application/emacs-lisp Content-Disposition: inline; filename=el-search.el Content-Transfer-Encoding: quoted-printable ;; el-search.el --- Expression based incremental search for emacs-lisp-mode= -*- lexical-binding: t -*- ;; Copyright (C) 2015 Michael Heerdegen ;; Author: Michael Heerdegen ;; Maintainer: Michael Heerdegen ;; 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 . ;;; Commentary: ;; Introduction ;; =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D ;; ;;=20 ;; 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. ;;=20 ;; 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"))))))) ;; ;; ;; Example 3: You can refer to the buffer content in your pattern. ;; This pattern for example will search for function names that are ;; quoted with "'", but not with "#'": ;; ;; (and (pred functionp) ;; (guard (and (looking-back "'" 1) ;; (not (looking-back "#'" 2))))) ;;=20 ;; ;; ;; ;; Convenience ;; =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D ;; ;; For convenience, the variable `expr' is bound to the currently read ;; expression while searching. 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 `expr'. ;; ;; By default, if matching with `pcase' gives an error, the search ;; stops. If you however set `el-search-ignore-errors' to non-nil, ;; errors are silently ignored. So, instead of the above pattern, you ;; could just go with ;; ;; (guard (string-match-p "cl-lib\\.elc?$" (symbol-file expr))) ;; ;; and expressions that are not symbols are effectively treated as ;; non-matching. ;; ;; ;; ;; Replacing ;; =3D=3D=3D=3D=3D=3D=3D=3D=3D ;; ;; 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. ;;=20 ;; (foo 'a (* 2 (+ 3 4)) t) ;;=20=20=20 ;; becomes ;;=20 ;; (foo (* 2 (+ 3 4)) 'a t). ;;=20=20=20 ;; 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. ;; ;; ;; ;; Suggested key bindings ;; =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D ;; ;; (define-key emacs-lisp-mode-map [(control ?S)] #'el-search-pattern) ;; (define-key emacs-lisp-mode-map [(control ?%)] #'el-search-query-repl= ace) ;; ;; (define-key isearch-mode-map [(control ?S)] #'el-search-search-from-i= search) ;; (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: ;; ;; - 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=20 (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-ignore-errors nil "Whether to ignore errors while matching with `pcase'." :group 'el-search :type 'boolean) (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--expr= ession'. (defun el-search-read-expression (prompt &optional initial-contents hist de= fault 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 r= ead) (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 at beginning of a sexp." ;; Note: this is slow (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 "\""))) ((and (looking-at (rx (or (syntax symbol) (syntax word)))) (not (looking-at "\\_<"))) (forward-symbol 1)) (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 () (defvar expr) (let ((expr ',expression)) (condition-case err (pcase expr (,pattern t) (_ nil)) (error (if (not el-search-ignore-errors) (signal (car err) (cdr err)) (setq el-search-last-error err) 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 expr= ession)) (el-search-expression-contains-match-p pattern (cdr expr= ession))) (cl-some (lambda (subexpr) (el-search-expression-contains-matc= h-p pattern subexpr)) expression))))) (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)." (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 cu= rrent-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-sex= p) (point))) (this-sexp (buffer-substring-no-properties (point) this-se= xp-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-buff= er)) 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-last-error nil) (defun el-search-pattern (pattern) "Do incremental elisp search forward." (interactive (list (if (and (eq this-command last-command) el-search-success) (read (car el-search-history)) (let ((expr (el-search--read-pattern "Find pcase pat= tern: " nil nil t))) ;; A very common mistake: input foo instead of 'foo (when (and (symbolp expr) (not (eq expr '_)) (or (not (boundp expr)) (not (eq (symbol-value expr) expr))= )) (error "Please don't forget the quote when searc= hing for a symbol")) expr)))) (setq el-search-success nil el-search-last-error 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 (concat "No match" (when (and (not (eq this-comman= d last-command)) el-search-last-error) (format "; %s" (error-message-string= el-search-last-error))))) (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 ,r= eplacement))))) (to-insert (el-search--repair-replacement-layout (el-search--print new-expr) (append mapping re= ad-mapping))) (do-replace (lambda () (atomic-change-group (apply #'delete-region region) (let ((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-conten= ts)) (to (el-search--read-pattern "Replace with result of evaluation = of: " from))) (list (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) --=-=-= Content-Type: text/plain Thanks, Michael. --=-=-=--