[elpa] scratch/mheerdegen-preview 3aa418f 20/32: WIP: Improvements for change and changed

[Michael Heerdegen]

branch: scratch/mheerdegen-preview
commit 3aa418fc196d55118802d90746cb0c361cd91c6c
Author: Michael Heerdegen <address@hidden>
Commit: Michael Heerdegen <address@hidden>

    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'