;; Maintainer: Michael Heerdegen <michael_heerdegen@web.de>
;; Created: 29 Jul 2015
;; Keywords: lisp
-;; Compatibility: Gnu Emacs 25
-;; Version: 0.0.2
-;; Package-Requires: ((emacs "25") (cl-lib "0"))
+;; Compatibility: GNU Emacs 25
+;; Version: 0.0.3
+;; Package-Requires: ((emacs "25"))
;; This file is not part of GNU Emacs.
;;; Commentary:
-;; The first version for trying! Feedback and improvement suggestions
-;; welcome.
-
-
;; Introduction
;; ============
;;
;; ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
;;
;;
-;;
;; Convenience
;; ===========
;;
;; used to that.
;;
;;
-;;
;; Suggested key bindings
;; ======================
;;
;;
;;
;; Bugs, Known Limitations
-;;
+;; =======================
;;
;; - Replacing: in some cases the reader syntax of forms
;; is changing due to reading+printing. "Some" because we can treat
;; the comment will be lost.
;;
;;
+;; Acknowledgments
+;; ===============
+;;
+;; Thanks to Stefan Monnier for corrections and advice.
+;;
;;
;; TODO:
;;
+;; - implement backward searching and wrapped searching
+;;
;; - improve docstrings
;;
+;; - add more examples
+;;
+;; - handle more reader syntaxes, e.g. #n, #n#
+;;
;; - 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
;;; Code:
-;;; Requirements
+;;;; Requirements
(eval-when-compile
(require 'subr-x))
(require 'thingatpt)
-;;; Configuration stuff
+;;;; Configuration stuff
(defgroup el-search nil
"Expression based search and replace for `emacs-lisp-mode'."
:group 'lisp)
-(defcustom el-search-this-expression-identifier 'expr
+(defcustom el-search-this-expression-identifier 'exp
"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)
+ :type 'symbol)
(defface el-search-match '((((background dark)) (:background "#0000A0"))
(t (:background "DarkSlateGray1")))
- "Face for highlighting the current match."
- :group 'el-search)
+ "Face for highlighting the current match.")
-;;; Helpers
+;;;; Helpers
(defun el-search--print (expr)
(let ((print-quoted t)
(concat "'" (el-search--print this-sexp))))
read))
+(defun el-search--end-of-sexp ()
+ ;;Point must be at sexp beginning
+ (or (scan-sexps (point) 1) (point-max)))
+
(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)
+ (let ((stop-here nil) syntax-here
+ (looking-at-from-back (lambda (regexp n)
+ (save-excursion
+ (backward-char n)
+ (looking-at regexp)))))
(while (not stop-here)
(cond
((eobp) (signal 'end-of-buffer nil))
;; FIXME: can the rest be done more generically?
((and (looking-at (rx (or (syntax symbol) (syntax word))))
(not (looking-at "\\_<"))
- (not (looking-back ",@" 2)))
+ (not (funcall looking-at-from-back ",@" 2)))
(forward-symbol 1))
- ((or (and (looking-at "'") (looking-back "#" 1))
- (and (looking-at "@") (looking-back "," 1)))
+ ((or (and (looking-at "'") (funcall looking-at-from-back "#" 1))
+ (and (looking-at "@") (funcall looking-at-from-back "," 1)))
(forward-char))
(t (setq stop-here t)))))
(condition-case 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--matcher (pattern &rest body)
+ (let ((warning-suppress-log-types '((bytecomp))))
+ (byte-compile
+ `(lambda (expression)
+ (pcase expression
+ (,pattern ,@(or body (list t)))
+ (_ nil))))))
+
+(defun el-search--match-p (matcher expression)
+ (funcall matcher expression))
+
+(defun el-search--wrap-pattern (pattern)
+ `(and ,el-search-this-expression-identifier ,pattern))
(defun el-search--search-pattern (pattern &optional noerror)
"Search elisp buffer with `pcase' PATTERN.
;; 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)
+ (let ((matcher (el-search--matcher pattern)) (match-beg nil) (opoint (point)) current-expr)
(if (catch 'no-match
(while (not match-beg)
(condition-case nil
(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)
+ (if (el-search--match-p matcher current-expr)
(setq match-beg (point)
opoint (point))
- (forward-char)))))
+ (forward-char))))
(if noerror nil (signal 'end-of-buffer nil)))
match-beg))
(save-excursion
(goto-char pos)
(condition-case nil
- (while (or (not bound) (< (point) bound))
+ (while (< (point) (or bound (point-max)))
(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))
(lambda () (buffer-substring (point-min) (point-max))))))
-;;; Highlighting
+;;;; 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))))
+(defun el-search-hl-sexp-at-point ()
+ (let ((bounds (list (point) (el-search--end-of-sexp))))
(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))
(remove-hook 'post-command-hook #'el-search-hl-post-command-fun t))))))
-;;; Core functions
+;;;; Core functions
(defvar el-search-history '()
"List of input strings.")
(defvar el-search-success nil)
(defvar el-search-current-pattern nil)
+;;;###autoload
(defun el-search-pattern (pattern)
"Do incremental elisp search forward."
(interactive (list (if (and (eq this-command last-command)
(or (not (boundp pattern))
(not (eq (symbol-value pattern) pattern))))
(error "Please don't forget the quote when searching for a symbol"))
- (el-search--maybe-wrap-pattern pattern)))))
+ (el-search--wrap-pattern pattern)))))
(setq el-search-current-pattern pattern)
(setq el-search-success nil)
(let ((opoint (point)))
(ding)
nil))
(setq el-search-success t)
- (el-search-hl-sexp)
+ (el-search-hl-sexp-at-point)
(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)))
+ (el-search-keep-hl t) (opoint (point))
+ (get-replacement (el-search--matcher pattern replacement)))
(unwind-protect
(while (and (not done) (el-search--search-pattern pattern t))
(setq opoint (point))
- (unless replace-all (el-search-hl-sexp))
+ (unless replace-all (el-search-hl-sexp-at-point))
(let* ((read-mapping (el-search--create-read-map))
- (region (list (point) (scan-sexps (point) 1)))
+ (region (list (point) (el-search--end-of-sexp)))
(substring (apply #'buffer-substring-no-properties region))
(expr (read substring))
(replaced-this nil)
- (new-expr (funcall `(lambda () (pcase ',expr (,pattern ,replacement)))))
+ (new-expr (funcall get-replacement expr))
(to-insert (el-search--repair-replacement-layout
(el-search--print new-expr) (append mapping read-mapping)))
(do-replace (lambda ()
(insert to-insert)
(indent-region opoint (point))
(goto-char opoint)
- (el-search-hl-sexp)))
+ (el-search-hl-sexp-at-point)))
(cl-incf nbr-replaced)
(setq replaced-this t))))
(if replace-all
(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)
+ (list (el-search--wrap-pattern (read from)) (read to)
(with-temp-buffer
(insert to)
(el-search--create-read-map 1)))))
+;;;###autoload
(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 ()
+(defun el-search--take-over-from-isearch ()
(let ((other-end isearch-other-end)
(input isearch-string))
(isearch-exit)
(goto-char other-end))
input))
+;;;###autoload
(defun el-search-search-from-isearch ()
+ ;; FIXME: an interesting alternative would be to really integrate it
+ ;; with Isearch, using `isearch-search-fun-function'.
+ ;; Alas, this is not trivial if we want to transfer our optimizations.
(interactive)
(el-search-pattern
(el-search--read-pattern
- "Find pcase pattern: " nil (concat "'" (el-search--take-over-from-dired)) t))
+ "Find pcase pattern: " nil (concat "'" (el-search--take-over-from-isearch)) t))
(setq this-command 'el-search-pattern))
+;;;###autoload
(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))))))
+ (el-search-query-replace-read-args (concat "'" (el-search--take-over-from-isearch))))))