branch: scratch/mheerdegen-preview commit 3aa418fc196d55118802d90746cb0c361cd91c6c Author: Michael Heerdegen <michael_heerde...@web.de> Commit: Michael Heerdegen <michael_heerde...@web.de>
WIP: Improvements for change and changed squash! WIP: change, changed: only user-error in interactive case --- packages/el-search/el-search-x.el | 72 ++++++++++++++++++++++----------------- 1 file changed, 41 insertions(+), 31 deletions(-) diff --git a/packages/el-search/el-search-x.el b/packages/el-search/el-search-x.el index 30190c1..1a40322 100644 --- a/packages/el-search/el-search-x.el +++ b/packages/el-search/el-search-x.el @@ -307,37 +307,41 @@ Uses variable `el-search--cached-changes' for caching." (defun el-search--change-p (posn revision) ;; Non-nil when sexp after POSN is part of a change - (when (buffer-modified-p) - (user-error "Buffer is modified - please save")) - (save-restriction - (widen) - (let ((changes (el-search--changes-from-diff-hl revision)) - (sexp-end (el-search--end-of-sexp posn)) - (atomic? (thunk-delay (el-search--atomic-p - (save-excursion (goto-char posn) - (el-search-read (current-buffer))))))) - (while (and changes (or (< (cdar changes) posn) - (and - ;; a string spanning multiple lines is a change even when not all - ;; lines are changed - (< (cdar changes) sexp-end) - (not (thunk-force atomic?))))) - (pop changes)) - (and changes (or (<= (caar changes) posn) - (and (thunk-force atomic?) - (<= (caar changes) sexp-end))))))) + (if (buffer-modified-p) + (if (eq this-command 'el-search-pattern) + (user-error "Buffer is modified - please save") + nil) + (save-restriction + (widen) + (let ((changes (el-search--changes-from-diff-hl revision)) + (sexp-end (el-search--end-of-sexp posn)) + (atomic? (thunk-delay (el-search--atomic-p + (save-excursion (goto-char posn) + (el-search-read (current-buffer))))))) + (while (and changes (or (< (cdar changes) posn) + (and + ;; a string spanning multiple lines is a change even when not all + ;; lines are changed + (< (cdar changes) sexp-end) + (not (thunk-force atomic?))))) + (pop changes)) + (and changes (or (<= (caar changes) posn) + (and (thunk-force atomic?) + (<= (caar changes) sexp-end)))))))) (defun el-search--changed-p (posn revision) ;; Non-nil when sexp after POSN contains a change - (when (buffer-modified-p) - (user-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) (el-search--end-of-sexp posn)))))) + (if (buffer-modified-p) + (if (eq this-command 'el-search-pattern) + (user-error "Buffer is modified - please save") + nil) + (save-restriction + (widen) + (let ((changes (el-search--changes-from-diff-hl revision))) + (while (and changes (<= (cdar changes) posn)) + (pop changes)) + (and changes + (< (caar changes) (el-search--end-of-sexp posn))))))) (defun el-search-change--heuristic-matcher (&optional revision) (let* ((revision (or revision "HEAD")) @@ -369,6 +373,10 @@ Uses variable `el-search--cached-changes' for caching." revision file)))))))))) (lambda (file-name-or-buffer _) (funcall file-changed-p file-name-or-buffer)))) +(el-search-defpattern change--1 (&optional revision) + (declare (heuristic-matcher #'el-search-change--heuristic-matcher)) + `(guard (el-search--change-p (point) ,(or revision "HEAD")))) + (el-search-defpattern change (&optional revision) "Matches the object if its text is part of a file change. @@ -379,8 +387,11 @@ REVISION is interpreted. This pattern-type does currently only work for git versioned files." + `(and (filename) (change--1 ,revision))) + +(el-search-defpattern changed--1 (&optional revision) (declare (heuristic-matcher #'el-search-change--heuristic-matcher)) - `(guard (el-search--change-p (point) ,(or revision "HEAD")))) + `(guard (el-search--changed-p (point) ,(or revision "HEAD")))) (el-search-defpattern changed (&optional revision) "Matches the object if its text contains a file change. @@ -392,8 +403,7 @@ REVISION is interpreted. This pattern-type does currently only work for git versioned files." - (declare (heuristic-matcher #'el-search-change--heuristic-matcher)) - `(guard (el-search--changed-p (point) ,(or revision "HEAD")))) + `(and (filename) (changed--1 ,revision))) ;;;; `outermost' and `top-level'