X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/7e7d7bbea8bbe625bb38e29502c47b42245fcbd7..b09bb1b61d57fee70a6b83f576ead0fee0f329bd:/packages/el-search/el-search.el diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el index f6c8c48e0..eba4a5df1 100644 --- a/packages/el-search/el-search.el +++ b/packages/el-search/el-search.el @@ -65,7 +65,7 @@ ;; `(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: ;; @@ -163,7 +163,7 @@ ;; (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. +;; "el-search" searching from isearch. ;; ;; ;; Bugs, Known Limitations @@ -185,6 +185,8 @@ ;; ;; the comment will be lost. ;; +;; FIXME: when we have resumable sessions, pause and warn about this case. +;; ;; ;; Acknowledgments ;; =============== @@ -194,16 +196,11 @@ ;; ;; TODO: ;; -;; - 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)) -;; ;; - implement backward searching ;; +;; - Make `el-search-pattern' accept an &optional limit, at least for +;; the non-interactive use case? +;; ;; - improve docstrings ;; ;; - handle more reader syntaxes, e.g. #n, #n# @@ -236,9 +233,13 @@ :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")) @@ -249,14 +250,52 @@ prompt to refer to the value of the currently tested expression." (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--print (expr) - (let ((print-quoted t) - (print-length nil) +(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--pp-to-string (expr) + (let ((print-length nil) (print-level nil)) - (prin1-to-string expr))) + (pp-to-string expr))) (defvar el-search-read-expression-map (let ((map (make-sparse-keymap))) @@ -269,51 +308,57 @@ 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-history '() + "List of input strings.") + (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." + ;; This doesn't catch end-of-buffer to keep the return value non-ambiguous (let ((not-done t) res) (while not-done (let ((stop-here nil) (looking-at-from-back (lambda (regexp n) - (save-excursion - (backward-char n) - (looking-at regexp))))) + (and (> (point) n) + (save-excursion + (backward-char n) + (looking-at regexp)))))) (while (not stop-here) (cond ((eobp) (signal 'end-of-buffer nil)) @@ -365,6 +410,17 @@ of the definitions is limited to \"el-search\"." `(setf (alist-get ',name el-search--pcase-macros) (lambda ,args ,@body))) +(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. + +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)) @@ -374,14 +430,15 @@ of the definitions is limited to \"el-search\"." (defun el-search--matcher (pattern &rest body) (eval ;use `eval' to allow for user defined pattern types at run time - `(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)))))))) + (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)) @@ -445,61 +502,95 @@ 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 - ;; 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 (< (point) (or bound (point-max))) - (let* ((this-sexp-end (save-excursion (thing-at-point--end-of-sexp) (point))) - (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)))) - -(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))) - (save-excursion (insert old)))) - (lambda () (buffer-substring (point-min) (point-max)))))) +(defun el-search--format-replacement (replacement original replace-expr-input splice) + ;; Return a printed representation of REPLACEMENT. Try to reuse the + ;; layout of subexpressions shared with the original (replaced) + ;; expression and the replace expression. + (if (and splice (not (listp replacement))) + (error "Expression to splice in is an atom") + (let ((orig-buffer (generate-new-buffer "orig-expr"))) + (with-current-buffer orig-buffer + (emacs-lisp-mode) + (insert original) + (when replace-expr-input (insert "\n\n" replace-expr-input))) + (unwind-protect + (with-temp-buffer + (emacs-lisp-mode) + (insert (if splice + (mapconcat #'el-search--pp-to-string replacement " ") + (el-search--pp-to-string replacement))) + (goto-char 1) + (let (start this-sexp end orig-match-start orig-match-end done) + (while (and (< (point) (point-max)) + (condition-case nil + (progn + (setq start (point) + this-sexp (read (current-buffer)) + end (point)) + t) + (end-of-buffer nil))) + (setq done nil orig-match-start nil) + (with-current-buffer orig-buffer + (goto-char 1) + (if (el-search--search-pattern `',this-sexp t) + (setq orig-match-start (point) + orig-match-end (progn (forward-sexp) (point))) + (setq done t))) + ;; find out whether we have a sequence of equal expressions + (while (and (not done) + (condition-case nil + (progn (setq this-sexp (read (current-buffer))) t) + ((invalid-read-syntax end-of-buffer end-of-file) nil))) + (if (with-current-buffer orig-buffer + (condition-case nil + (if (not (equal this-sexp (read (current-buffer)))) + nil + (setq orig-match-end (point)) + t) + ((invalid-read-syntax end-of-buffer end-of-file) nil))) + (setq end (point)) + (setq done t))) + (if orig-match-start + (let ((match (with-current-buffer orig-buffer + (buffer-substring-no-properties orig-match-start + orig-match-end)))) + (delete-region start end) + (goto-char start) + (when (string-match-p "\n" match) + (unless (looking-back "^[[:space:]\(]*" (line-beginning-position)) + (insert "\n")) + (unless (looking-at "[[:space:]\)]*$") + (insert "\n") + (backward-char))) + (insert match)) + (goto-char start) + (el-search--skip-expression nil t)) + (condition-case nil + (el-search--ensure-sexp-start) + (end-of-buffer (goto-char (point-max)))))) + (delete-trailing-whitespace (point-min) (point-max)) ;FIXME: this should not be necessary + (let ((result (buffer-substring (point-min) (point-max)))) + (if (equal replacement (read result)) + result + (error "Error in `el-search--format-replacement' - please make a bug report")))) + (kill-buffer orig-buffer))))) (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." +Raise an error if not. The string arguments TYPE and optional +MESSAGE are used to construct the error message." (mapc (lambda (arg) (unless (funcall predicate arg) - (error (concat "Pattern `%S': " + (error (concat "Pattern `%s': " (or message (format "argument doesn't fulfill %S" predicate)) ": %S") type arg))) args)) +(defvar el-search-current-pattern nil) + +(defvar el-search-success nil) + ;;;; Additional pattern type definitions @@ -556,20 +647,22 @@ matches the list (1 2 3 4 5 6 7 8 9) and binds `x' to (4 5 6)." (,'\, ,(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 #'stringp) - (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--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 #'stringp) + (el-search--check-pattern-args "symbol" regexps #'el-search--stringish-p + "Argument not a string") `(and (pred symbolp) (app symbol-name (string ,@regexps)))) @@ -598,7 +691,7 @@ of any kind matched by all PATTERNs are also matched. ((null (cdr patterns)) (let ((pattern (car patterns))) `(app ,(apply-partially #'el-search--contains-p (el-search--matcher pattern)) - (,'\` (t (,'\, ,pattern)))))) + (,'\` (t (,'\, ,pattern)))))) (t `(and ,@(mapcar (lambda (pattern) `(contains ,pattern)) patterns))))) (el-search-defpattern not (pattern) @@ -609,7 +702,7 @@ of any kind matched by all PATTERNs are also matched. (defun el-search--match-symbol-file (regexp symbol) (when-let ((symbol-file (and (symbolp symbol) (symbol-file symbol)))) - (string-match-p + (el-search--smart-string-match-p (if (symbolp regexp) (concat "\\`" (symbol-name regexp) "\\'") regexp) (file-name-sans-extension (file-name-nondirectory symbol-file))))) @@ -626,8 +719,9 @@ 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) #'stringp) - `(pred (el-search--match-symbol-file ,regexp))) + (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 @@ -657,13 +751,15 @@ matches any of these expressions: [(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))) + (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) +(defun el-search--transform-nontrivial-lpat (expr) (cond - ((symbolp expr) `(symbol ,(symbol-name expr))) + ((symbolp expr) `(or (symbol ,(symbol-name expr)) + (,'\` (,'quote (,'\, (symbol ,(symbol-name expr))))) + (,'\` (,'function (,'\, (symbol ,(symbol-name expr))))))) ((stringp expr) `(string ,expr)) (t expr))) @@ -677,8 +773,8 @@ with very brief input by using a specialized syntax. An LPAT can take the following forms: -SYMBOL Matches any symbol matched by SYMBOL's name interpreted as - a regexp +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 @@ -710,10 +806,60 @@ could use this pattern: ('_ '`(,_)) ('_? '(or '() `(,_))) ;FIXME: useful - document? or should we provide a (? PAT) ;thing? - (_ `(,'\` ((,'\, ,(el-search--s elt))))))) + (_ `(,'\` ((,'\, ,(el-search--transform-nontrivial-lpat elt))))))) lpats) ,@(if match-end '() '(_))))) +(el-search-defpattern char-prop (property) + "Matches the object if completely covered with PROPERTY. +This pattern matches the object if its representation in the +search buffer is completely covered with the character property +PROPERTY. + +This pattern always tests the complete expression in the search +buffer, it is not possible to test subexpressions calculated in +the search pattern." + `(guard (and (get-char-property (point) ',property) + ,(macroexp-let2 nil limit '(scan-sexps (point) 1) + `(= (next-single-char-property-change + (point) ',property nil ,limit) + ,limit))))) + +(el-search-defpattern includes-prop (property) + "Matches the object if partly covered with PROPERTY. +This pattern matches the object if its representation in the +search buffer is partly covered with the character property +PROPERTY. + +This pattern always tests the complete expression in the search +buffer, it is not possible to test subexpressions calculated in +the search pattern." + `(guard (or (get-char-property (point) ',property) + ,(macroexp-let2 nil limit '(scan-sexps (point) 1) + `(not (= (next-single-char-property-change + (point) ',property nil ,limit) + ,limit)))))) + +(el-search-defpattern change () + "Matches the object if it is part of a change. +This is equivalent to (char-prop diff-hl-hunk). + +You need `diff-hl-mode' turned on, provided by the library +\"diff-hl\" available in Gnu Elpa." + (or (bound-and-true-p diff-hl-mode) + (error "diff-hl-mode not enabled")) + '(char-prop diff-hl-hunk)) + +(el-search-defpattern changed () + "Matches the object if it contains a change. +This is equivalent to (includes-prop diff-hl-hunk). + +You need `diff-hl-mode' turned on, provided by the library +\"diff-hl\" available in Gnu Elpa." + (or (bound-and-true-p diff-hl-mode) + (error "diff-hl-mode not enabled")) + '(includes-prop diff-hl-hunk)) + ;;;; Highlighting @@ -789,14 +935,8 @@ could use this pattern: ;;;; 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) +(defun el-search-pattern (pattern &optional no-error) "Start new or resume last elisp search. Search current buffer for expressions that are matched by `pcase' @@ -822,23 +962,25 @@ The following additional pattern types are currently defined:" (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) - (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))))) + (if (not (called-interactively-p 'any)) + (el-search--search-pattern pattern no-error) + (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 "\ @@ -856,10 +998,11 @@ s Toggle splicing mode. When splicing mode is Hit any key to proceed." "Help string for ? in `el-search-query-replace'.") -(defun el-search-search-and-replace-pattern (pattern replacement &optional mapping splice) +(defun el-search--search-and-replace-pattern (pattern replacement &optional splice to-input-string) (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil) (el-search-keep-hl t) (opoint (point)) - (get-replacement (el-search--matcher pattern replacement))) + (get-replacement (el-search--matcher pattern replacement)) + (skip-matches-in-replacement 'ask)) (unwind-protect (while (and (not done) (el-search--search-pattern pattern t)) (setq opoint (point)) @@ -867,21 +1010,24 @@ Hit any key to proceed." (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))) + (let* ((region (list (point) (el-search--end-of-sexp))) (substring (apply #'buffer-substring-no-properties region)) (expr (read substring)) (replaced-this nil) (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))))) + (lambda () (el-search--format-replacement new-expr substring to-input-string splice))) (to-insert (funcall get-replacement-string)) + (replacement-contains-another-match + (with-temp-buffer + (emacs-lisp-mode) + (insert to-insert) + (goto-char 1) + (el-search--skip-expression new-expr) + (condition-case nil + (progn (el-search--ensure-sexp-start) + (el-search--search-pattern pattern t)) + (end-of-buffer nil)))) (do-replace (lambda () (atomic-change-group (apply #'delete-region region) @@ -897,7 +1043,7 @@ Hit any key to proceed." (funcall do-replace) (while (not (pcase (if replaced-this (read-char-choice "[SPC ! q] (? for help)" - '(?\ ?! ?q ?n ??)) + '(?\ ?! ?q ?\C-g ?n ??)) (read-char-choice (concat "Replace this occurrence" (if (or (string-match-p "\n" to-insert) @@ -906,7 +1052,7 @@ Hit any key to proceed." "? " (if splice "{splice} " "") "[y SPC r ! s q] (? for help)" ) - '(?y ?n ?r ?\ ?! ?q ?s ??))) + '(?y ?n ?r ?\ ?! ?q ?\C-g ?s ??))) (?r (funcall do-replace) nil) (?y (funcall do-replace) @@ -921,11 +1067,31 @@ Hit any key to proceed." (?s (cl-callf not splice) (setq to-insert (funcall get-replacement-string)) nil) - (?q (setq done t) - t) + ((or ?q ?\C-g) + (setq done t) + t) (?? (ignore (read-char el-search-search-and-replace-help-string)) nil))))) - (unless (or done (eobp)) (el-search--skip-expression nil t))))) + (unless (or done (eobp)) + (cond + ((not (and replaced-this replacement-contains-another-match)) + (el-search--skip-expression nil t)) + ((eq skip-matches-in-replacement 'ask) + (if (setq skip-matches-in-replacement + (yes-or-no-p "Match in replacement - always skip? ")) + (forward-sexp) + (el-search--skip-expression nil t) + (when replace-all + (setq replace-all nil) + (message "Falling back to interactive mode") + (sit-for 3.)))) + (skip-matches-in-replacement (forward-sexp)) + (t + (el-search--skip-expression nil t) + (message "Replacement contains another match%s" + (if replace-all " - falling back to interactive mode" "")) + (setq replace-all nil) + (sit-for 3.))))))) (el-search-hl-remove) (goto-char opoint) (message "Replaced %d matches%s" @@ -933,27 +1099,37 @@ Hit any key to proceed." (if (zerop nbr-skipped) "" (format " (%d skipped)" nbr-skipped))))) -(defun el-search-query-replace-read-args () +(defun el-search-query-replace--read-args () (barf-if-buffer-read-only) - (let* ((from (el-search--read-pattern "Replace from: ")) + (let* ((from (el-search--read-pattern "Query replace pattern: ")) (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))))) + (list (el-search--wrap-pattern (read from)) (read to) to))) ;;;###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)) +(defun el-search-query-replace (from-pattern to-expr &optional textual-to) + "Replace some matches of \"el-search\" pattern FROM-PATTERN. + +TO-EXPR is an Elisp expression that is evaluated repeatedly for +each match with bindings created in FROM-PATTERN in effect to +produce a replacement expression. Operate from point +to (point-max). + +As each match is found, the user must type a character saying +what to do with it. For directions, type ? at that time." + (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) + (setq el-search-current-pattern from-pattern) (barf-if-buffer-read-only) - (el-search-search-and-replace-pattern from to mapping)) + (el-search--search-and-replace-pattern from-pattern to-expr nil textual-to)) -(defun el-search--take-over-from-isearch () - (prog1 isearch-string (isearch-exit))) +(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))) + (goto-char other-end)) + input)) ;;;###autoload (defun el-search-search-from-isearch () @@ -968,7 +1144,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)))