X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/8d7b29c99927fe1b84e60bd39c11053f9d4f2dcf..f10533854f4c7bb54247a11981191bf37b70cb36:/packages/el-search/el-search.el diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el index 2d032e622..d79af7f26 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.3 +;; Version: 0.2.1 ;; Package-Requires: ((emacs "25")) @@ -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 -;; "el-search" 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 @@ -210,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. @@ -233,12 +245,9 @@ :group 'lisp) (defcustom el-search-this-expression-identifier 'exp - "Identifier referring to the current expression in pattern input. + "Identifier ID 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 pattern actually used will be (and ID PATTERN). The default value is `exp'." :type 'symbol) @@ -303,8 +312,7 @@ 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'.") @@ -342,11 +350,27 @@ error." (defvar el-search--initial-mb-contents nil) -(defun el-search--read-pattern (prompt &optional default read histvar) +(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 histvar default read))) - (if (or read (not (string= input ""))) input (car (symbol-value histvar))))) + 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 @@ -362,7 +386,7 @@ and return it." (while not-done (let ((stop-here nil) (looking-at-from-back (lambda (regexp n) - (and (> (point) n) + (and (<= n (- (point) (point-min))) (save-excursion (backward-char n) (looking-at regexp)))))) @@ -509,6 +533,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) @@ -557,26 +620,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")))) @@ -847,25 +905,74 @@ the search pattern." (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)) +(defvar diff-hl-reference-revision) +(declare-function diff-hl-changes "diff-hl") +(defvar-local el-search--cached-changes nil) + +(defun el-search--changes-from-diff-hl (revision) + "Return a list of changed regions (as conses of positions) since REVISION. +Use variable `el-search--cached-changes' for caching." + (if (and (consp el-search--cached-changes) + (equal (car el-search--cached-changes) + revision)) + (cdr el-search--cached-changes) + (require 'diff-hl) + ;; `diff-hl-changes' returns line numbers. We must convert them into positions. + (save-restriction + (widen) + (save-excursion + (let ((diff-hl-reference-revision revision) + (current-line-nbr 1) change-beg) + (goto-char 1) + (cdr (setq el-search--cached-changes + (cons revision + (delq nil (mapcar (pcase-lambda (`(,start-line ,nbr-lines ,kind)) + (if (eq kind 'delete) nil + (forward-line (- start-line current-line-nbr)) + (setq change-beg (point)) + (forward-line (1- nbr-lines)) + (setq current-line-nbr (+ start-line nbr-lines -1)) + (cons change-beg (line-end-position)))) + (diff-hl-changes))))))))))) + +(defun el-search--change-p (posn &optional revision) + ;; Non-nil when sexp after POSN is part of a change + (when (buffer-modified-p) + (error "Buffer is modified - please save")) + (save-restriction + (widen) + (let ((changes (el-search--changes-from-diff-hl revision)) + (sexp-end (scan-sexps posn 1))) + (while (and changes (< (cdar changes) sexp-end)) + (pop changes)) + (and changes + (<= (caar changes) posn))))) + +(defun el-search--changed-p (posn &optional revision) + ;; Non-nil when sexp after POSN contains a change + (when (buffer-modified-p) + (error "Buffer is modified - please save")) + (save-restriction + (widen) + (let ((changes (el-search--changes-from-diff-hl revision))) + (while (and changes (<= (cdar changes) posn)) + (pop changes)) + (and changes + (< (caar changes) (scan-sexps posn 1)))))) + +(el-search-defpattern change (&optional revision) + "Matches the object if its text is part of a file change. + +Requires library \"diff-hl\". REVISION defaults to the file's +repository's HEAD commit." + `(guard (el-search--change-p (point) ,revision))) + +(el-search-defpattern changed (&optional revision) + "Matches the object if its text contains a file change. + +Requires library \"diff-hl\". REVISION defaults to the file's +repository's HEAD commit." + `(guard (el-search--changed-p (point) ,revision))) ;;;; Highlighting @@ -950,6 +1057,12 @@ 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'. @@ -958,16 +1071,18 @@ 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 no-error) @@ -1035,17 +1150,14 @@ Hit any key to proceed." (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) - (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)))) + (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 @@ -1108,8 +1220,12 @@ Hit any key to proceed." (defun el-search-query-replace--read-args () (barf-if-buffer-read-only) - (let ((from-input (el-search--read-pattern "Query replace pattern: " nil nil - 'el-search-query-replace-history)) + (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) @@ -1131,8 +1247,20 @@ Hit any key to proceed." (unless (and el-search-query-replace-history (not (string= from from-input)) (string= from-input (car el-search-query-replace-history))) - (push (format "%s -> %s" from to) ;FIXME: add line break when FROM or TO is multiline? + (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