;; Created: 29 Jul 2015
;; Keywords: lisp
;; Compatibility: GNU Emacs 25
-;; Version: 0.1.3
+;; Version: 0.2.1
;; Package-Requires: ((emacs "25"))
;; 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.
: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)
(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
(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))))))
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)
((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"))))
(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
(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)
(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
(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)
(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