;; 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.1
+;; Package-Requires: ((emacs "25"))
;; This file is not part of GNU Emacs.
;;; Commentary:
-;; The first version for trying! Feedback and improvement suggestions
-;; welcome.
-
-
;; Introduction
;; ============
;;
-;;
-;; The main user entry point is the command `el-search-pattern'. It
+;;
+;; The main user entry point is `el-search-pattern'. This command
;; 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).
+;; matching expressions by iteratively `read'ing buffer contents. For
+;; any match, point is put at the beginning of the expression found
+;; (unlike isearch which puts point at the end of matches).
;;
;; 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.
+;; ignored, and strings are treated as atomic objects, their contents
+;; are not being searched.
;;
;; Example 1: if you enter
;;
;; ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
;;
;;
+;; When a search pattern is processed, the searched buffer is current
+;; with point at the beginning of the currently tested expression.
+;;
+;;
+;; Example 3:
+;;
+;; I can be useful to use (guard EXP) patterns for side effects.
+;;
+;; The following pattern will search for symbols defined in any
+;; library whose name starts with "cl". As a side effect, it prints
+;; the current line number, whether we have a macro or a function, and
+;; the defining file in the echo area for each match:
+;;
+;; (and (pred symbolp)
+;; (let file (symbol-file exp))
+;; (guard file)
+;; (let lib-name (file-name-sans-extension
+;; (file-name-nondirectory file)))
+;; (guard (string-match-p "^cl" lib-name))
+;; (or (and (pred macrop) (let type "macro "))
+;; (and (pred functionp) (let type "function "))
+;; (let type ""))
+;; (guard (message "Line %d: %s`%S' (from \"%s\")"
+;; (line-number-at-pos)
+;; type
+;; exp
+;; lib-name)))
+;;
+;; `message' never returns nil, so the last `guard' always "matches".
+;;
;;
;; Convenience
;; ===========
;;
-;; For expression input, the minibuffer prompts here uses
-;; `emacs-lisp-mode'.
+;; For pattern input, the minibuffer is put into `emacs-lisp-mode'.
+;;
+;; Any input PATTERN is silently transformed into (and exp PATTERN)
+;; so that you can always refer to the whole currently tested
+;; expression via the variable `exp'.
+;;
+;; Example 4:
;;
-;; 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
+;; 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)))
+;; (guard (and (symbolp exp)
+;; (when-let ((file (symbol-file exp)))
;; (string-match-p "cl-lib\\.elc?$" file))))
;;
-;; without binding the variable `expr'.
+;;
+;; ,----------------------------------------------------------------------
+;; | Q: "But I hate `pcase'! Can't we just do without?" |
+;; | |
+;; | A: Respect that you kept up until here! Just use (guard CODE), where|
+;; | CODE is any normal Elisp expression that returns non-nil when and |
+;; | only when you have a match. Use the variable `exp' to refer to |
+;; | the currently tested expression. Just like in the last example! |
+;; `----------------------------------------------------------------------
+;;
+;;
+;; It's cumbersome to write out the same complicated pattern
+;; constructs in the minibuffer again and again. You can define your
+;; own pcase pattern types for the purpose of el-search with
+;; `el-search-defpattern'. It is just like `pcase-defmacro', but the
+;; effect is limited to this package. See C-h f `el-search-pattern'
+;; for a list of predefined additional pattern forms.
;;
;;
;; Replacing
;; 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
;; 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:
;;
+;; - change replace interface to include toggle(s)
+;;
+;; - detect infloops when replacing automatically (e.g. for 1 -> '(1))
+;;
+;; - highlight matches around point in a timer
+;;
+;; - implement backward searching
+;;
;; - improve docstrings
;;
+;; - 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
-;; . marker). Or should this be abstracted into an own lib? Could be
-;; named "files-session" or so.
+;; 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
+;;;; Requirements
(eval-when-compile
(require 'subr-x))
(require 'cl-lib)
(require 'elisp-mode)
(require 'thingatpt)
+(require 'help-fns) ;el-search--make-docstring
-;;; 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
- "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)
+(defcustom el-search-this-expression-identifier 'exp
+ "Name of the identifier referring to the current expression.
+The default value is `exp'. You can use this name in the search
+prompt to refer to the value of the currently tested expression."
+ :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)
(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."
+(defvar el-search--initial-mb-contents nil)
+
+(defun el-search--read-pattern (prompt &optional default read)
+ (let ((this-sexp (sexp-at-point)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (when this-sexp
+ (let ((more-defaults (list (concat "'" (el-search--print this-sexp)))))
+ (setq-local minibuffer-default-add-function
+ (lambda () (if (listp minibuffer-default)
+ (append minibuffer-default more-defaults)
+ (cons minibuffer-default more-defaults)))))))
+ (el-search-read-expression
+ prompt el-search--initial-mb-contents 'el-search-history default read))))
+
+(defun el-search--end-of-sexp ()
+ ;;Point must be at sexp beginning
+ (or (scan-sexps (point) 1) (point-max)))
+
+(defun el-search--ensure-sexp-start ()
+ "Move point to the beginning of the next sexp if necessary.
+Don't move if already at beginning of a sexp.
+Point must not be inside a string or comment."
(let ((not-done t) res)
(while not-done
- (let ((stop-here nil) syntax-here)
+ (let ((stop-here nil)
+ (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))
((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)))
+ (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))
+(defvar el-search--pcase-macros '()
+ "List of additional \"el-search\" pcase macros.")
+
+(defun el-search--make-docstring ()
+ ;; code mainly from `pcase--make-docstring'
+ (let* ((main (documentation (symbol-function 'el-search-pattern) 'raw))
+ (ud (help-split-fundoc main 'pcase)))
+ (with-temp-buffer
+ (insert (or (cdr ud) main))
+ (mapc
+ (pcase-lambda (`(,symbol . ,fun))
+ (when-let ((doc (documentation fun)))
+ (insert "\n\n-- ")
+ (setq doc (help-fns--signature symbol doc nil fun nil))
+ (insert "\n" (or doc "Not documented."))))
+ (reverse el-search--pcase-macros))
+ (let ((combined-doc (buffer-string)))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
+
+(put 'el-search-pattern 'function-documentation '(el-search--make-docstring))
+
+(defmacro el-search-defpattern (name args &rest body)
+ "Like `pcase-defmacro', but limited to el-search patterns.
+The semantics is exactly that of `pcase-defmacro', but the scope
+of the definitions is limited to \"el-search\"."
+ (declare (indent 2) (debug defun))
+ `(setf (alist-get ',name el-search--pcase-macros)
+ (lambda ,args ,@body)))
+
+(el-search-defpattern string (&rest regexps)
+ "Matches any string that is matched by all REGEXPS."
+ (let ((string (make-symbol "string"))
+ (regexp (make-symbol "regexp")))
+ `(and (pred stringp)
+ (pred (lambda (,string)
+ (cl-every
+ (lambda (,regexp) (string-match-p ,regexp ,string))
+ (list ,@regexps)))))))
+
+(el-search-defpattern symbol (&rest regexps)
+ "Matches any symbol whose name is matched by all REGEXPS."
+ `(and (pred symbolp)
+ (app symbol-name (string ,@regexps))))
+
+(defun el-search--match-symbol-file (regexp symbol)
+ (when-let ((symbol-file (and (symbolp symbol)
+ (symbol-file symbol))))
+ (string-match-p
+ (if (symbolp regexp) (concat "\\`" (symbol-name regexp) "\\'") regexp)
+ (file-name-sans-extension (file-name-nondirectory symbol-file)))))
+
+(el-search-defpattern source (regexp)
+ "Matches any symbol whose `symbol-file' is matched by REGEXP.
+
+This pattern matches when the object is a symbol for that
+`symbol-file' returns a (non-nil) FILE-NAME that fulfills
+ (string-match-p REGEXP (file-name-sans-extension
+ (file-name-nondirectory FILENAME)))
+
+REGEXP can also be a symbol, in which case
+
+ (concat \"^\" (symbol-name regexp) \"$\")
+
+is used as regular expression."
+ `(pred (el-search--match-symbol-file ,regexp)))
+
+(defun el-search--match-key-sequence (keys expr)
+ (when-let ((expr-keys (pcase expr
+ ((or (pred stringp) (pred vectorp)) expr)
+ (`(kbd ,(and (pred stringp) string)) (ignore-errors (kbd string))))))
+ (apply #'equal
+ (mapcar (lambda (keys) (ignore-errors (key-description keys)))
+ (list keys expr-keys)))))
+
+(el-search-defpattern keys (key-sequence)
+ "Matches any description of the KEY-SEQUENCE.
+KEY-SEQUENCE is a key description in a format that Emacs
+understands.
+
+This pattern matches any description of the same key sequence.
+
+Example: the pattern
+
+ (keys (kbd \"C-s\"))
+
+matches any of these expressions:
+
+ (kbd \"C-s\")
+ [(control ?s)]
+ \"\\C-s\"
+
+Any of these could be used as equivalent KEY-SEQUENCE in terms of
+this pattern type."
+ `(pred (el-search--match-key-sequence ,key-sequence)))
+
+(defmacro el-search--with-additional-pcase-macros (&rest body)
+ `(cl-letf ,(mapcar (pcase-lambda (`(,symbol . ,fun))
+ `((get ',symbol 'pcase-macroexpander) #',fun))
+ el-search--pcase-macros)
+ ,@body))
+
+(defun el-search--matcher (pattern &rest body)
+ (eval
+ `(el-search--with-additional-pcase-macros
+ (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--skip-expression (expression &optional read)
+ ;; Move forward at least one character. Don't move into a string or
+ ;; comment. Don't move further than the beginning of the next sexp.
+ ;; Try to move as far as possible. Point must be at the beginning
+ ;; of an expression.
+ ;; If there are positions where `read' would succeed, but that do
+ ;; not represent a valid sexp start, move past them (e.g. when
+ ;; before "#'" move past both characters).
+ ;;
+ ;; EXPRESSION must be the (read) expression at point, but when READ
+ ;; is non-nil, ignore the first argument and read the expression at
+ ;; point instead.
+ (when read (setq expression (save-excursion (read (current-buffer)))))
+ (cond
+ ((or (null expression)
+ (equal [] expression)
+ (not (or (listp expression) (vectorp expression))))
+ (goto-char (el-search--end-of-sexp)))
+ ((looking-at (rx (or ",@" "," "#'" "'")))
+ (goto-char (match-end 0)))
+ (t (forward-char))))
(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)
+
+ (let ((matcher (el-search--matcher pattern)) (match-beg nil) (opoint (point)) current-expr)
+
+ ;; when inside a string or comment, move past it
+ (let ((syntax-here (syntax-ppss)))
+ (when (nth 3 syntax-here) ;inside a string
+ (goto-char (nth 8 syntax-here))
+ (forward-sexp))
+ (when (nth 4 syntax-here) ;inside a comment
+ (forward-line 1)
+ (while (and (not (eobp)) (looking-at (rx (and (* space) ";"))))
+ (forward-line 1))))
+
(if (catch 'no-match
(while (not match-beg)
(condition-case nil
- (setq current-expr (el-search--goto-next-sexp))
+ (setq current-expr (el-search--ensure-sexp-start))
(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)))))
+ (el-search--skip-expression current-expr))))
(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
+ ;; In current buffer, for any expression start between POS and BOUND
+ ;; or (point-max), in order, call two argument function DO-FUN with
+ ;; the current sexp string and the ending position of the current
+ ;; sexp. When done, with RET-FUN given, call it with no args and
+ ;; return the result; else, return nil.
(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))
- (forward-char)
- (el-search--goto-next-sexp))
+ (this-sexp-string (buffer-substring-no-properties (point) this-sexp-end)))
+ (funcall do-fun this-sexp-string this-sexp-end)
+ (el-search--skip-expression (read this-sexp-string))
+ (el-search--ensure-sexp-start)))
(end-of-buffer))
(when ret-fun (funcall ret-fun))))
(unless (looking-at "[[:space:]\)]*$")
(insert "\n")
(backward-char)))
- (insert old)))
+ (save-excursion (insert old))))
(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 (&optional bounds)
+ (let ((bounds (or 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))
'face 'el-search-match)))
- (add-hook 'post-command-hook (el-search-hl-post-command-fun (current-buffer)) t))
+ (add-hook 'post-command-hook #'el-search-hl-post-command-fun t 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))))))
+(defun el-search-hl-post-command-fun ()
+ (unless (or el-search-keep-hl
+ (eq this-command 'el-search-query-replace)
+ (eq this-command 'el-search-pattern))
+ (el-search-hl-remove)
+ (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."
+ "Start new or resume last elisp search.
+
+Search current buffer for expressions that are matched by `pcase'
+PATTERN. Use `read' to transform buffer contents into
+expressions.
+
+
+Additional `pcase' pattern types to be used with this command can
+be defined with `el-search-defpattern'.
+
+The following additional pattern types are currently defined:\n"
(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: "
(car el-search-history)
- nil t)))
+ 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"))
- (el-search--maybe-wrap-pattern pattern)))))
+ (el-search--wrap-pattern pattern)))))
+ (setq this-command 'el-search-pattern) ;in case we come from isearch
(setq el-search-current-pattern pattern)
- (setq el-search-success nil)
(let ((opoint (point)))
- (when (eq this-command last-command)
- (forward-char))
+ (when (and (eq this-command last-command) el-search-success)
+ (el-search--skip-expression nil t))
+ (setq el-search-success nil)
+ (message "%s" (substitute-command-keys "Type \\[el-search-pattern] to repeat"))
(when (condition-case nil
(el-search--search-pattern pattern)
(end-of-buffer (message "No match")
(ding)
nil))
(setq el-search-success t)
- (el-search-hl-sexp)
- (message "%s" (substitute-command-keys "Type \\[el-search-pattern] to repeat")))))
+ (el-search-hl-sexp))))
-(defun el-search-search-and-replace-pattern (pattern replacement &optional mapping)
+(defun el-search-search-and-replace-pattern (pattern replacement &optional mapping splice)
(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))
(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)))))
- (to-insert (el-search--repair-replacement-layout
- (el-search--print new-expr) (append mapping read-mapping)))
+ (new-expr (funcall get-replacement expr))
+ (get-replacement-string
+ (lambda () (if (and splice (not (listp new-expr)))
+ (error "Expression to splice in is an atom")
+ (el-search--repair-replacement-layout
+ (if splice
+ (mapconcat #'el-search--print new-expr " ")
+ (el-search--print new-expr))
+ (append mapping read-mapping)))))
+ (to-insert (funcall get-replacement-string))
(do-replace (lambda ()
(atomic-change-group
(apply #'delete-region region)
(opoint (point)))
(insert to-insert)
(indent-region opoint (point))
- (goto-char opoint)
- (el-search-hl-sexp)))
+ (el-search-hl-sexp (list opoint (point)))
+ (goto-char opoint)))
(cl-incf nbr-replaced)
(setq replaced-this t))))
(if replace-all
(while (not (pcase (if replaced-this
(read-char-choice "[SPC ! q]" '(?\ ?! ?q ?n))
(read-char-choice
- (concat "Replace this occurence"
+ (concat "Replace this occurrence"
(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)))
+ "? "
+ (if splice "{splice} " "")
+ "[y SPC r ! q]" )
+ '(?y ?n ?r ?\ ?! ?q ?s)))
(?r (funcall do-replace)
nil)
(?y (funcall do-replace)
(funcall do-replace))
(setq replace-all t)
t)
+ (?s (cl-callf not splice)
+ (setq to-insert (funcall get-replacement-string))
+ nil)
(?q (setq done t)
t)))))
- (unless (or done (eobp)) (forward-char 1)))))
+ (unless (or done (eobp)) (el-search--skip-expression nil t)))))
(el-search-hl-remove)
(goto-char opoint)
(message "Replaced %d matches%s"
(if (zerop nbr-skipped) ""
(format " (%d skipped)" nbr-skipped)))))
-(defun el-search-query-replace-read-args (&optional initial-contents)
+(defun el-search-query-replace-read-args ()
(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)
+ (let* ((from (el-search--read-pattern "Replace from: "))
+ (to (let ((el-search--initial-mb-contents nil))
+ (el-search--read-pattern "Replace with result of evaluation of: " from))))
+ (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))
+ (setq this-command 'el-search-query-replace) ;in case we come from isearch
(setq el-search-current-pattern from)
(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))
- (setq this-command 'el-search-pattern))
+ (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
+ ;; use `call-interactively' so we get recorded in `extended-command-history'
+ (call-interactively #'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))))))
+ (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
+ (call-interactively #'el-search-query-replace)))