X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/bb98a1df932aa66a4364539708f32c34d832c70d..609354eb5f60172d00c6d0735a2f25d172da5030:/packages/el-search/el-search.el diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el index c7b349904..3536f4981 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: ;; @@ -162,8 +162,12 @@ ;; (define-key isearch-mode-map [(control ?S)] #'el-search-search-from-isearch) ;; (define-key isearch-mode-map [(control ?%)] #'el-search-replace-from-isearch) ;; +;; (define-key el-search-read-expression-map [(control ?S)] #'exit-minibuffer) +;; ;; The bindings in `isearch-mode-map' let you conveniently switch to -;; elisp searching from isearch. +;; "el-search" searching from isearch. The binding in +;; `el-search-read-expression-map' allows you to hit C-S twice to +;; start a search for the last search pattern. ;; ;; ;; Bugs, Known Limitations @@ -185,6 +189,8 @@ ;; ;; the comment will be lost. ;; +;; FIXME: when we have resumable sessions, pause and warn about this case. +;; ;; ;; Acknowledgments ;; =============== @@ -194,10 +200,11 @@ ;; ;; TODO: ;; -;; - 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# @@ -207,6 +214,14 @@ ;; 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. +;; +;; - Make `el-search--format-replacement' work non-heuristically. +;; Idea: When replacing, for every variable V bound by the search +;; pattern that directly corresponds to some text T, provide some +;; "match data" V -> T. Use this when formatting the replacement. +;; Maybe use a special marker to "paste" in expressions, like (paste +;; V), whereby the `paste' flag lands in the replacement and can be +;; replaced textually afterwards. @@ -289,11 +304,10 @@ error." case-fold-search))) (string-match-p regexp string))) -(defun el-search--print (expr) - (let ((print-quoted t) - (print-length nil) +(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))) @@ -301,18 +315,20 @@ error." (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) - (define-key map [(control ?S)] #'exit-minibuffer) + (define-key map [(control ?j)] #'newline) map) "Map for reading input with `el-search-read-expression'.") (defun el-search--setup-minibuffer () + (let ((inhibit-read-only t)) + (put-text-property 1 (minibuffer-prompt-end) 'font-lock-face 'minibuffer-prompt)) (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 (minibuffer-prompt-end)) + (when (looking-at ".*\n") + (indent-sexp)) (goto-char (point-max)) (when-let ((this-sexp (with-current-buffer (window-buffer (minibuffer-selected-window)) (thing-at-point 'sexp)))) @@ -329,12 +345,35 @@ error." (read-from-minibuffer prompt initial-contents el-search-read-expression-map read (or hist 'read-expression-history) default))) +(defvar el-search-history '() + "List of search input strings.") + +(defvar el-search-query-replace-history '() + "List of input strings from `el-search-query-replace'.") + (defvar el-search--initial-mb-contents nil) -(defun el-search--read-pattern (prompt &optional default read) +(defun el-search--pushnew-to-history (input histvar) + (let ((hist-head (car (symbol-value histvar)))) + (unless (or (string-match-p "\\`\\'" input) + (and (stringp hist-head) + (or (string= input hist-head) + (ignore-errors (equal (read input) (read hist-head)))))) + (push (if (string-match-p "\\`.+\n" input) + (with-temp-buffer + (emacs-lisp-mode) + (insert "\n" input) + (indent-region 1 (point)) + (buffer-string)) + input) + (symbol-value histvar))))) + +(defun el-search--read-pattern (prompt &optional default histvar) + (cl-callf or histvar 'el-search-history) (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)))) + prompt el-search--initial-mb-contents histvar default))) + (el-search--pushnew-to-history input histvar) + (if (not (string= input "")) input (car (symbol-value histvar))))) (defun el-search--end-of-sexp () ;;Point must be at sexp beginning @@ -345,13 +384,15 @@ error." 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 (<= n (- (point) (point-min))) + (save-excursion + (backward-char n) + (looking-at regexp)))))) (while (not stop-here) (cond ((eobp) (signal 'end-of-buffer nil)) @@ -495,6 +536,45 @@ 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--replace-hunk (region to-insert) + "Replace the text in REGION in current buffer with string TO-INSERT. +Add line breaks before and after TO-INSERT when appropriate and +reindent." + (atomic-change-group + (let* ((inhibit-message t) + (opoint (point)) + (original-text (prog1 (apply #'buffer-substring-no-properties region) + (goto-char (car region)) + (apply #'delete-region region))) + ;; care about other sexps in this line + (sexp-before-us (not (looking-back "\(\\|^\\s-*" (line-beginning-position)))) + (sexp-after-us (not (looking-at "\\s-*[;\)]\\|$"))) + (insert-newline-before + (or + (and (string-match-p "\n" to-insert) + (not (string-match-p "\n" original-text)) + (or (and sexp-before-us sexp-after-us) + (looking-back + (rx (or (syntax word) (syntax symbol)) + (+ blank) + (or (syntax word) (syntax symbol)) + (* any)) + (line-beginning-position)))) + ;; (and sexp-before-us + ;; (> (+ (apply #'max (mapcar #'length (split-string to-insert "\n"))) + ;; (- (point) (line-beginning-position))) + ;; fill-column)) + )) + (insert-newline-after (and insert-newline-before sexp-after-us))) + (when insert-newline-before + (when (looking-back "\\s-+" (line-beginning-position)) + (delete-region (match-beginning 0) (match-end 0))) + (insert "\n")) + (insert to-insert) + (when insert-newline-after + (insert "\n")) + (indent-region opoint (1+ (point)))))) + (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) @@ -510,8 +590,8 @@ return nil (no error)." (with-temp-buffer (emacs-lisp-mode) (insert (if splice - (mapconcat #'el-search--print replacement " ") - (el-search--print replacement))) + (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)) @@ -543,26 +623,21 @@ return nil (no error)." ((invalid-read-syntax end-of-buffer end-of-file) nil))) (setq end (point)) (setq done t))) + ;; FIXME: there could be another occurrence of THIS-SEXP in ORIG-BUFFER with more + ;; subsequent equal expressions after it (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)) + (el-search--replace-hunk + (list start end) + (with-current-buffer orig-buffer + (buffer-substring-no-properties orig-match-start orig-match-end))) (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)))) + (goto-char 1) + (forward-sexp) + (let ((result (buffer-substring 1 (point)))) (if (equal replacement (read result)) result (error "Error in `el-search--format-replacement' - please make a bug report")))) @@ -580,6 +655,10 @@ MESSAGE are used to construct the error message." type arg))) args)) +(defvar el-search-current-pattern nil) + +(defvar el-search-success nil) + ;;;; Additional pattern type definitions @@ -680,7 +759,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) @@ -744,7 +823,7 @@ matches any of these expressions: "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) `(or (symbol ,(symbol-name expr)) (,'\` (,'quote (,'\, (symbol ,(symbol-name expr))))) @@ -795,10 +874,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 @@ -874,20 +1003,20 @@ 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' PATTERN. Use `read' to transform buffer contents into expressions. +Use `emacs-lisp-mode' for reading input. Some keys in the +minibuffer have a special binding: to make it possible to edit +multi line input, C-j inserts a newline, and up and down move the +cursor vertically - see `el-search-read-expression-map' for more +details. + Additional `pcase' pattern types to be used with this command can be defined with `el-search-defpattern'. @@ -896,19 +1025,21 @@ The following additional pattern types are currently defined:" (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) - t))) + (let* ((input (el-search--read-pattern "Find pcase pattern: " + (car el-search-history))) + (pattern (read input))) ;; 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")) + ;; Make input available also in query-replace history + (el-search--pushnew-to-history input 'el-search-query-replace-history) + ;; and wrap the PATTERN (el-search--wrap-pattern pattern))))) (if (not (called-interactively-p 'any)) - (el-search--search-pattern pattern) + (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))) @@ -943,10 +1074,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 splice to-input-string) +(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)) @@ -955,29 +1087,36 @@ Hit any key to proceed." (unless (eq this-command last-command) (el-search-hl-other-matches pattern))) (let* ((region (list (point) (el-search--end-of-sexp))) - (substring (apply #'buffer-substring-no-properties region)) - (expr (read substring)) + (original-text (apply #'buffer-substring-no-properties region)) + (expr (read original-text)) (replaced-this nil) (new-expr (funcall get-replacement expr)) (get-replacement-string - (lambda () (el-search--format-replacement new-expr substring to-input-string splice))) + (lambda () (el-search--format-replacement new-expr original-text to-input-string splice))) (to-insert (funcall get-replacement-string)) - (do-replace (lambda () - (atomic-change-group - (apply #'delete-region region) - (let ((inhibit-message t) - (opoint (point))) - (insert to-insert) - (indent-region opoint (point)) - (el-search-hl-sexp (list opoint (point))) - (goto-char opoint))) - (cl-incf nbr-replaced) - (setq replaced-this t)))) + (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 () + (save-excursion + (el-search--replace-hunk (list (point) (el-search--end-of-sexp)) to-insert)) + (el-search--ensure-sexp-start) ;skip potentially newly added whitespace + (el-search-hl-sexp (list opoint (point))) + (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] (? for help)" - '(?\ ?! ?q ?n ??)) + '(?\ ?! ?q ?\C-g ?n ??)) (read-char-choice (concat "Replace this occurrence" (if (or (string-match-p "\n" to-insert) @@ -986,7 +1125,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) @@ -1001,11 +1140,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 2.))))))) (el-search-hl-remove) (goto-char opoint) (message "Replaced %d matches%s" @@ -1013,21 +1172,75 @@ 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: ")) - (to (let ((el-search--initial-mb-contents nil)) - (el-search--read-pattern "Replace with result of evaluation of: " from)))) + (let ((from-input (let ((el-search--initial-mb-contents + (or el-search--initial-mb-contents + (and (eq last-command 'el-search-pattern) + (car el-search-history))))) + (el-search--read-pattern "Query replace pattern: " nil + 'el-search-query-replace-history))) + from to) + (with-temp-buffer + (emacs-lisp-mode) + (insert from-input) + (goto-char 1) + (forward-sexp) + (skip-chars-forward " \t\n ") + ;; FIXME: maybe more sanity tests here... + (if (not (looking-at "->")) + (setq from from-input + to (let ((el-search--initial-mb-contents nil)) + (el-search--read-pattern "Replace with result of evaluation of: " from))) + (delete-char 2) + (goto-char 1) + (forward-sexp) + (setq from (buffer-substring 1 (point))) + (skip-chars-forward " \t\n ") + (setq to (buffer-substring (point) (progn (forward-sexp) (point)))))) + (unless (and el-search-query-replace-history + (not (string= from from-input)) + (string= from-input (car el-search-query-replace-history))) + (push (with-temp-buffer + (emacs-lisp-mode) + (insert (let ((newline-in-from (string-match-p "\n" from)) + (newline-in-to (string-match-p "\n" to))) + (format "%s%s%s ->%s%s" + (if (and (or newline-in-from newline-in-to) + (not (string-match-p "\\`\n" from))) "\n" "") + (if newline-in-from "\n" "" ) from + (if (and (or newline-in-from newline-in-to) + (not (string-match-p "\\`\n" to))) "\n" " ") to))) + (indent-region 1 (point-max)) + (buffer-string)) + el-search-query-replace-history)) + (el-search--pushnew-to-history from 'el-search-history) (list (el-search--wrap-pattern (read from)) (read to) to))) ;;;###autoload -(defun el-search-query-replace (from to &optional to-input-string) - "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. + +As an alternative to enter FROM-PATTERN and TO-EXPR separately, +you can also give an input of the form + + FROM-PATTERN -> TO-EXPR + +to the first prompt and specify both expressions at once. This +format is also used for history entries." + (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 nil to-input-string)) + (el-search--search-and-replace-pattern from-pattern to-expr nil textual-to)) (defun el-search--take-over-from-isearch (&optional goto-left-end) (let ((other-end (and goto-left-end isearch-other-end))