X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/a0561bff0dfcf267ee1796924f5aad904c377ee9..bace971d3cff75963ee52d0157c091caaba857ac:/packages/el-search/el-search.el diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el index e1baf6d33..764d77eb9 100644 --- a/packages/el-search/el-search.el +++ b/packages/el-search/el-search.el @@ -7,7 +7,7 @@ ;; Created: 29 Jul 2015 ;; Keywords: lisp ;; Compatibility: GNU Emacs 25 -;; Version: 0.1.1 +;; Version: 0.1.3 ;; Package-Requires: ((emacs "25")) @@ -39,10 +39,17 @@ ;; any match, point is put at the beginning of the expression found ;; (unlike isearch which puts point at the end of matches). ;; +;; Why is it based on `pcase'? Because pattern matching (and the +;; ability to combine destructuring and condition testing) is well +;; suited for this task. In addition, pcase allows to add specialized +;; pattern types and to combine them with other patterns in a natural +;; and transparent way out of the box. +;; ;; It doesn't matter how the code is actually formatted. Comments are ;; ignored, and strings are treated as atomic objects, their contents ;; are not being searched. ;; +;; ;; Example 1: if you enter ;; ;; 97 @@ -70,33 +77,6 @@ ;; 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 ;; =========== ;; @@ -106,7 +86,8 @@ ;; so that you can always refer to the whole currently tested ;; expression via the variable `exp'. ;; -;; Example 4: +;; +;; Example 3: ;; ;; If you want to search a buffer for symbols that are defined in ;; "cl-lib", you can use this pattern @@ -213,12 +194,14 @@ ;; ;; TODO: ;; -;; - change replace interface to include toggle(s) +;; - When replacing like (progn A B C) -> A B C, the layout of the +;; whole "group" A B C as a unit is lost. Instead of restoring layout +;; as we do now (via "read mappings"), we could just make a backup of +;; the original expression as a string, and use our search machinery +;; to find occurrences in the replacement recursively. ;; ;; - detect infloops when replacing automatically (e.g. for 1 -> '(1)) ;; -;; - highlight matches around point in a timer -;; ;; - implement backward searching ;; ;; - improve docstrings @@ -253,18 +236,65 @@ :group 'lisp) (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." + "Identifier referring to the current expression in pattern input. +When entering a PATTERN in an interactive \"el-search\" command, +the pattern actually used will be + + `(and ,el-search-this-expression-identifier ,pattern) + +The default value is `exp'." :type 'symbol) (defface el-search-match '((((background dark)) (:background "#0000A0")) - (t (:background "DarkSlateGray1"))) + (t (:background "DarkSlateGray3"))) "Face for highlighting the current match.") +(defface el-search-other-match '((((background dark)) (:background "#202060")) + (t (:background "DarkSlateGray1"))) + "Face for highlighting the other matches.") + +(defcustom el-search-smart-case-fold-search t + "Whether to use smart case folding in pattern matching. +When an \"el-search\" pattern involves regexp matching (like for +\"string\" or \"source\") and this option is non-nil, +case-fold-search will be temporarily bound to t if the according +regexp contains any upper case letter, and nil else. This is +done independently for every single matching operation. + +If nil, the value of `case-fold-search' is decisive." + :type 'boolean) + +(defcustom el-search-use-sloppy-strings nil + "Whether to allow the usage of \"sloppy strings\". +When this option is turned on, for faster typing you are allowed +to specify symbols instead of strings as arguments to an +\"el-search\" pattern type that would otherwise accept only +strings, and their names will be used as input (with other words, +this spares you to type the string delimiters in many cases). + +For example, + + \(source ^cl\) + +is then equivalent to + + \(source \"^cl\"\) + +When this option is off, the first form would just signal an +error." + :type 'boolean) + ;;;; Helpers +(defun el-search--smart-string-match-p (regexp string) + "`string-match-p' taking `el-search-smart-case-fold-search' into account." + (let ((case-fold-search (if el-search-smart-case-fold-search + (not (let ((case-fold-search nil)) + (string-match-p "[[:upper:]]" regexp))) + case-fold-search))) + (string-match-p regexp string))) + (defun el-search--print (expr) (let ((print-quoted t) (print-length nil) @@ -282,44 +312,45 @@ prompt to refer to the value of the currently tested expression." map) "Map for reading input with `el-search-read-expression'.") +(defun el-search--setup-minibuffer () + (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)) + (when-let ((this-sexp (with-current-buffer (window-buffer (minibuffer-selected-window)) + (thing-at-point 'sexp)))) + (let ((more-defaults (list (concat "'" this-sexp)))) + (setq-local minibuffer-default-add-function + (lambda () (if (listp minibuffer-default) + (append minibuffer-default more-defaults) + (cons minibuffer-default more-defaults))))))) + ;; $$$$$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))) + (minibuffer-with-setup-hook #'el-search--setup-minibuffer (read-from-minibuffer prompt initial-contents el-search-read-expression-map read (or hist 'read-expression-history) default))) (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)))) + (let ((input (el-search-read-expression + prompt el-search--initial-mb-contents 'el-search-history default read))) + (if (or read (not (string= input ""))) input (car el-search-history)))) (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." + "Move point to the next sexp beginning position. +Don't move if already at beginning of a sexp. Point must not be +inside a string or comment. `read' the expression at that point +and return it." (let ((not-done t) res) (while not-done (let ((stop-here nil) @@ -361,8 +392,8 @@ Point must not be inside a string or comment." (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\n\n-- ") + (setq doc (help-fns--signature symbol doc fun fun nil)) (insert "\n" (or doc "Not documented.")))) (reverse el-search--pcase-macros)) (let ((combined-doc (buffer-string))) @@ -378,71 +409,17 @@ of the definitions is limited to \"el-search\"." `(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. +(defun el-search--macroexpand-1 (pattern) + "Expand \"el-search\" PATTERN. +This is like `pcase--macroexpand', but expands only patterns +defined with `el-search-defpattern' and performs only one +expansion step. -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))) +Return PATTERN if this pattern type was not defined with +`el-search-defpattern'." + (if-let ((expander (alist-get (car-safe pattern) el-search--pcase-macros))) + (apply expander (cdr pattern)) + pattern)) (defmacro el-search--with-additional-pcase-macros (&rest body) `(cl-letf ,(mapcar (pcase-lambda (`(,symbol . ,fun)) @@ -451,14 +428,16 @@ this pattern type." ,@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)))))))) + (eval ;use `eval' to allow for user defined pattern types at run time + (let ((expression (make-symbol "expression"))) + `(el-search--with-additional-pcase-macros + (let ((byte-compile-debug t) ;make undefined pattern types raise an error + (warning-suppress-log-types '((bytecomp))) + (pcase--dontwarn-upats (cons '_ pcase--dontwarn-upats))) + (byte-compile (lambda (,expression) + (pcase ,expression + (,pattern ,@(or body (list t))) + (_ nil))))))))) (defun el-search--match-p (matcher expression) (funcall matcher expression)) @@ -488,13 +467,8 @@ this pattern type." (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)." - - (let ((matcher (el-search--matcher pattern)) (match-beg nil) (opoint (point)) current-expr) +(defun el-search--search-pattern-1 (matcher &optional noerror) + (let ((match-beg nil) (opoint (point)) current-expr) ;; when inside a string or comment, move past it (let ((syntax-here (syntax-ppss))) @@ -520,6 +494,13 @@ return nil (no error)." (if noerror nil (signal 'end-of-buffer nil))) match-beg)) +(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)." + (el-search--search-pattern-1 (el-search--matcher pattern) noerror)) + (defun el-search--do-subsexps (pos do-fun &optional ret-fun bound) ;; In current buffer, for any expression start between POS and BOUND ;; or (point-max), in order, call two argument function DO-FUN with @@ -563,11 +544,244 @@ return nil (no error)." (save-excursion (insert old)))) (lambda () (buffer-substring (point-min) (point-max)))))) +(defun el-search--check-pattern-args (type args predicate &optional message) + "Check whether all ARGS fulfill PREDICATE. +Raise an error if not. TYPE and optional argument MESSAGE are +used to construct the error message." + (mapc (lambda (arg) + (unless (funcall predicate arg) + (error (concat "Pattern `%S': " + (or message (format "argument doesn't fulfill %S" predicate)) + ": %S") + type arg))) + args)) + + +;;;; Additional pattern type definitions + +(defun el-search--split (matcher1 matcher2 list) + "Helper for the append pattern type. + +When a splitting of LIST into two lists L1, L2 exist so that Li +is matched by MATCHERi, return (L1 L2) for such Li, else return +nil." + (let ((try-match (lambda (list1 list2) + (when (and (el-search--match-p matcher1 list1) + (el-search--match-p matcher2 list2)) + (list list1 list2)))) + (list1 list) (list2 '()) (match nil)) + ;; don't use recursion, this could hit `max-lisp-eval-depth' + (while (and (not (setq match (funcall try-match list1 list2))) + (consp list1)) + (let ((last-list1 (last list1))) + (if-let ((cdr-last-list1 (cdr last-list1))) + ;; list1 is a dotted list. Then list2 must be empty. + (progn (setcdr last-list1 nil) + (setq list2 cdr-last-list1)) + (setq list1 (butlast list1 1) + list2 (cons (car last-list1) list2))))) + match)) + +(el-search-defpattern append (&rest patterns) + "Matches any list factorable into lists matched by PATTERNS in order. + +PATTERNS is a list of patterns P1..Pn. Match any list L for that +lists L1..Ln exist that are matched by P1..Pn in order and L is +equal to the concatenation of L1..Ln. Ln is allowed to be no +list. + +When different ways of matching are possible, it is unspecified +which one is chosen. + +Example: the pattern + + (append '(1 2 3) x (app car-safe 7)) + +matches the list (1 2 3 4 5 6 7 8 9) and binds `x' to (4 5 6)." + (if (null patterns) + '(pred null) + (pcase-let ((`(,pattern . ,more-patterns) patterns)) + (cond + ((null more-patterns) pattern) + ((null (cdr more-patterns)) + `(and (pred listp) + (app ,(apply-partially #'el-search--split + (el-search--matcher pattern) + (el-search--matcher (car more-patterns))) + (,'\` ((,'\, ,pattern) + (,'\, ,(car more-patterns))))))) + (t `(append ,pattern (append ,@more-patterns))))))) + +(defun el-search--stringish-p (thing) + (or (stringp thing) (and el-search-use-sloppy-strings (symbolp thing)))) + +(el-search-defpattern string (&rest regexps) + "Matches any string that is matched by all REGEXPS." + (el-search--check-pattern-args 'string regexps #'el-search--stringish-p + "Argument not a string") + `(and (pred stringp) + ,@(mapcar (lambda (thing) `(pred (el-search--smart-string-match-p + ,(if (symbolp thing) (symbol-name thing) thing)))) + regexps))) + +(el-search-defpattern symbol (&rest regexps) + "Matches any symbol whose name is matched by all REGEXPS." + (el-search--check-pattern-args 'symbol regexps #'el-search--stringish-p + "Argument not a string") + `(and (pred symbolp) + (app symbol-name (string ,@regexps)))) + +(defun el-search--contains-p (matcher exp) + "Return non-nil when tree EXP contains a match for MATCHER. +Recurse on all types of sequences. In the positive case the +return value is (t elt), where ELT is a matching element found in +EXP." + (if (el-search--match-p matcher exp) + (list t exp) + (and (sequencep exp) + (let ((try-match (apply-partially #'el-search--contains-p matcher))) + (if (consp exp) + (or (funcall try-match (car exp)) + (funcall try-match (cdr exp))) + (cl-some try-match exp)))))) + +(el-search-defpattern contains (&rest patterns) + "Matches trees that contain a match for all PATTERNs. +Searches any tree of sequences recursively for matches. Objects +of any kind matched by all PATTERNs are also matched. + + Example: (contains (string \"H\") 17) matches ((\"Hallo\") x (5 [1 17]))" + (cond + ((null patterns) '_) + ((null (cdr patterns)) + (let ((pattern (car patterns))) + `(app ,(apply-partially #'el-search--contains-p (el-search--matcher pattern)) + (,'\` (t (,'\, ,pattern)))))) + (t `(and ,@(mapcar (lambda (pattern) `(contains ,pattern)) patterns))))) + +(el-search-defpattern not (pattern) + "Matches any object that is not matched by PATTERN." + `(app ,(apply-partially #'el-search--match-p (el-search--matcher pattern)) + (pred not))) + +(defun el-search--match-symbol-file (regexp symbol) + (when-let ((symbol-file (and (symbolp symbol) + (symbol-file symbol)))) + (el-search--smart-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." + (el-search--check-pattern-args 'source (list regexp) #'el-search--stringish-p + "Argument not a string") + `(pred (el-search--match-symbol-file ,(if (symbolp regexp) (symbol-name regexp) 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 descriptions of the KEY-SEQUENCE. +KEY-SEQUENCE is a string or vector representing a key sequence, +or an expression of the form (kbd STRING). + +Match any description of the same key sequence in any of these +formats. + +Example: the pattern + + (keys (kbd \"C-s\")) + +matches any of these expressions: + + \"\\C-s\" + \"\C-s\" + (kbd \"C-s\") + [(control ?s)]" + (when (eq (car-safe key-sequence) 'kbd) + (setq key-sequence (kbd (cadr key-sequence)))) + (el-search--check-pattern-args 'keys (list key-sequence) (lambda (x) (or (stringp x) (vectorp x))) + "argument not a string or vector") + `(pred (el-search--match-key-sequence ,key-sequence))) + +(defun el-search--s (expr) + (cond + ((symbolp expr) `(or (symbol ,(symbol-name expr)) + (,'\` (,'quote (,'\, (symbol ,(symbol-name expr))))) + (,'\` (,'function (,'\, (symbol ,(symbol-name expr))))))) + ((stringp expr) `(string ,expr)) + (t expr))) + +(el-search-defpattern l (&rest lpats) + "Alternative pattern type for matching lists. +Match any list with subsequent elements matched by all LPATS in +order. + +The idea is to be able to search for pieces of code (i.e. lists) +with very brief input by using a specialized syntax. + +An LPAT can take the following forms: + +SYMBOL Matches any symbol S matched by SYMBOL's name interpreted + as a regexp. Matches also 'S and #'S for any such S. +STRING Matches any string matched by STRING interpreted as a + regexp +_ Matches any list element +__ Matches any number of list elements (including zero) +^ Matches zero elements, but only at the beginning of a list +$ Matches zero elements, but only at the end of a list +PAT Anything else is interpreted as a normal pcase pattern, and + matches one list element matched by it + +^ is only valid as the first, $ as the last of the LPATS. + +Example: To match defuns that contain \"hl\" in their name and +have at least one mandatory, but also optional arguments, you +could use this pattern: + + (l ^ 'defun hl (l _ &optional))" + (let ((match-start nil) (match-end nil)) + (when (eq (car-safe lpats) '^) + (setq match-start t) + (cl-callf cdr lpats)) + (when (eq (car-safe (last lpats)) '$) + (setq match-end t) + (cl-callf butlast lpats 1)) + `(append ,@(if match-start '() '(_)) + ,@(mapcar + (lambda (elt) + (pcase elt + ('__ '_) + ('_ '`(,_)) + ('_? '(or '() `(,_))) ;FIXME: useful - document? or should we provide a (? PAT) + ;thing? + (_ `(,'\` ((,'\, ,(el-search--s elt))))))) + lpats) + ,@(if match-end '() '(_))))) + ;;;; Highlighting (defvar-local el-search-hl-overlay nil) +(defvar-local el-search-hl-other-overlays '()) + (defvar el-search-keep-hl nil) (defun el-search-hl-sexp (&optional bounds) @@ -576,12 +790,55 @@ return nil (no error)." (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))) + 'face 'el-search-match)) + (overlay-put el-search-hl-overlay 'priority 1002)) (add-hook 'post-command-hook #'el-search-hl-post-command-fun t t)) +(defun el-search--hl-other-matches-1 (pattern from to) + (mapc #'delete-overlay el-search-hl-other-overlays) + (setq el-search-hl-other-overlays '()) + (let ((matcher (el-search--matcher pattern)) + this-match-beg this-match-end + (done nil)) + (save-excursion + (goto-char from) + (while (not done) + (setq this-match-beg (el-search--search-pattern-1 matcher t)) + (if (not this-match-beg) + (setq done t) + (goto-char this-match-beg) + (setq this-match-end (el-search--end-of-sexp)) + (let ((ov (make-overlay this-match-beg this-match-end))) + (overlay-put ov 'face 'el-search-other-match) + (overlay-put ov 'priority 1001) + (push ov el-search-hl-other-overlays) + (goto-char this-match-end) + (when (>= (point) to) (setq done t)))))))) + +(defun el-search-hl-other-matches (pattern) + "Highlight all matches visible in the selected window." + (el-search--hl-other-matches-1 pattern + (save-excursion + (goto-char (window-start)) + (beginning-of-defun-raw) + (point)) + (window-end)) + (add-hook 'window-scroll-functions #'el-search--after-scroll t t)) + +(defun el-search--after-scroll (_win start) + (el-search--hl-other-matches-1 el-search-current-pattern + (save-excursion + (goto-char start) + (beginning-of-defun-raw) + (point)) + (window-end nil t))) + (defun el-search-hl-remove () (when (overlayp el-search-hl-overlay) - (delete-overlay el-search-hl-overlay))) + (delete-overlay el-search-hl-overlay)) + (remove-hook 'window-scroll-functions #'el-search--after-scroll t) + (mapc #'delete-overlay el-search-hl-other-overlays) + (setq el-search-hl-other-overlays '())) (defun el-search-hl-post-command-fun () (unless (or el-search-keep-hl @@ -611,7 +868,7 @@ 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" +The following additional pattern types are currently defined:" (interactive (list (if (and (eq this-command last-command) el-search-success) el-search-current-pattern @@ -626,22 +883,25 @@ The following additional pattern types are currently defined:\n" (not (eq (symbol-value pattern) pattern)))) (error "Please don't forget the quote when searching for a symbol")) (el-search--wrap-pattern pattern))))) - (setq this-command 'el-search-pattern) ;in case we come from isearch - (setq el-search-current-pattern pattern) - (let ((opoint (point))) - (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") - (goto-char opoint) - (el-search-hl-remove) - (ding) - nil)) - (setq el-search-success t) - (el-search-hl-sexp)))) + (if (not (called-interactively-p 'any)) + (el-search--search-pattern pattern) + (setq this-command 'el-search-pattern) ;in case we come from isearch + (setq el-search-current-pattern pattern) + (let ((opoint (point))) + (when (and (eq this-command last-command) el-search-success) + (el-search--skip-expression nil t)) + (setq el-search-success nil) + (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) + (unless (eq this-command last-command) + (el-search-hl-other-matches pattern)))))) (defvar el-search-search-and-replace-help-string "\ @@ -666,7 +926,10 @@ Hit any key to proceed." (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) + (unless (eq this-command last-command) + (el-search-hl-other-matches pattern))) (let* ((read-mapping (el-search--create-read-map)) (region (list (point) (el-search--end-of-sexp))) (substring (apply #'buffer-substring-no-properties region)) @@ -752,8 +1015,8 @@ Hit any key to proceed." (barf-if-buffer-read-only) (el-search-search-and-replace-pattern from to mapping)) -(defun el-search--take-over-from-isearch () - (let ((other-end isearch-other-end) +(defun el-search--take-over-from-isearch (&optional goto-left-end) + (let ((other-end (and goto-left-end isearch-other-end)) (input isearch-string)) (isearch-exit) (when (and other-end (< other-end (point))) @@ -773,7 +1036,7 @@ Hit any key to proceed." ;;;###autoload (defun el-search-replace-from-isearch () (interactive) - (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch)))) + (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch t)))) (call-interactively #'el-search-query-replace)))