[elpa] scratch/mheerdegen-preview 9805060 02/35: WIP: [el-search] Fix nested match issues in *El Occur*

[Michael Heerdegen]

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

    WIP: [el-search] Fix nested match issues in *El Occur*
    
    Fix flawed match count display and by-match moving in *El Occur*
    buffers containing nested or adjacent matches.
---
 packages/el-search/el-search.el | 138 +++++++++++++++++++++-------------------
 1 file changed, 73 insertions(+), 65 deletions(-)

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index dbcb4ab..db5117d 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -405,11 +405,6 @@
 ;;   syntax "##" (a syntax for an interned symbol whose name is the
 ;;   empty string) can lead to errors while searching.
 ;;
-;; - In *El Occur* buffers, when there are adjacent or nested matches,
-;;   the movement commands (el-search-occur-previous-match,
-;;   el-search-occur-next-match aka n and p) may skip matches, and the
-;;   shown match count can be inaccurate.
-;;
 ;;
 ;; TODO:
 ;;
@@ -2998,43 +2993,40 @@ Prompt for a new pattern and revert."
       (add-hook 'post-command-hook #'el-search-hl-post-command-fun t t)
       (when do-fun (funcall do-fun)))))
 
+(defvar el-search-match-prop 'match-data)
+
 (defun el-search-occur--next-match (&optional backward)
-  (let ((done nil) (pos (point)))
-    (when-let ((this-ov (cl-some (lambda (ov) (and (overlay-get ov 
'el-search-match) ov))
-                                 (overlays-at pos))))
-      (setq pos (funcall (if backward #'overlay-start #'overlay-end) this-ov)))
-    (while (and (not done) (setq pos (funcall (if backward 
#'previous-single-char-property-change
-                                                
#'next-single-char-property-change)
-                                              pos 'el-search-match)))
-      (setq done (or (memq pos (list (point-min) (point-max)))
-                     (cl-some (lambda (ov) (overlay-get ov 'el-search-match))
-                              (overlays-at pos)))))
-    (if (memq pos (list (point-min) (point-max)))
+  (let ((pos (point)) new-pos)
+    (cl-flet ((done (pos) (when-let ((match-nbr (get-char-property pos 
el-search-match-prop)))
+                            (and (not (= (point) (if backward (point-min) 
(point-max))))
+                                 (not (eq match-nbr
+                                          (get-char-property (1- pos) 
el-search-match-prop)))))))
+      (while (and (setq new-pos (funcall (if backward 
#'previous-single-char-property-change
+                                           #'next-single-char-property-change)
+                                         pos el-search-match-prop))
+                  (not (eq pos new-pos))
+                  (setq pos new-pos)
+                  (not (done pos)))))
+    (if (memq pos (list (point-min) (point-max) nil))
         (progn
           (el-search--message-no-log "No match %s this position" (if backward 
"before" "after"))
           (sit-for 1.5))
       (goto-char pos)
-      (save-excursion (hs-show-block))))
-  (el-search-occur--show-match-count))
+      (save-excursion (hs-show-block))
+      (redisplay)
+      (el-search--scroll-sexp-in-view (list (point) (el-search--end-of-sexp)))
+      (el-search-occur--show-match-count))))
 
 (defvar el-search-occur--total-matches nil)
 
 (defun el-search-occur--show-match-count ()
-  (while-no-input
-    (let ((nbr-match 0)
-          (pos (point))
-          (match-here-p (lambda () (get-char-property (point) 
'el-search-match))))
-      (when (funcall match-here-p)
-        (save-excursion
-          (save-restriction
-            (widen)
-            (goto-char (point-min))
-            (while (< (point) pos)
-              (goto-char (next-single-char-property-change (point) 
'el-search-match))
-              (when (funcall match-here-p)
-                (cl-incf nbr-match)))
-            (el-search--message-no-log
-             "Match %d/%d" nbr-match el-search-occur--total-matches)))))))
+  (pcase-let ((`(,_buffer ,_mb ,_file ,nbr)
+               (get-char-property (point) el-search-match-prop)))
+    (el-search--message-no-log
+     "%d/%s" nbr
+     (if el-search-occur--total-matches
+         (format "%d" el-search-occur--total-matches)
+       "???"))))
 
 (defun el-search-occur-next-match ()
   "Move point to the next match."
@@ -3167,6 +3159,7 @@ Prompt for a new pattern and revert."
                             (el-search--get-search-description-string search)))
             (condition-case-unless-debug err
                 (let ((insert-summary-position (point))
+                      (match-nbr 0)
                       (stream-of-matches
                        (stream-partition
                         (funcall (el-search-object-get-matches search))
@@ -3186,18 +3179,20 @@ Prompt for a new pattern and revert."
                       (insert (format "  (%d match%s)\n"
                                       buffer-matches
                                       (if (> buffer-matches 1) "es" "")))
-                      (let ((buffer-matches+contexts
+                      (let ((buffer-matches+counts+contexts
                              (seq-map (pcase-lambda ((and match `(,_ 
,match-beg ,_)))
                                         (with-current-buffer buffer
-                                          (cons match
-                                                (let 
((open-paren-in-column-0-is-defun-start nil))
-                                                  (save-excursion
-                                                    (funcall 
el-search-get-occur-context-function
-                                                             match-beg))))))
+                                          (list
+                                           match
+                                           (cl-incf match-nbr)
+                                           (let 
((open-paren-in-column-0-is-defun-start nil))
+                                             (save-excursion
+                                               (funcall 
el-search-get-occur-context-function
+                                                        match-beg))))))
                                       stream-of-buffer-matches)))
-                        (while (not (stream-empty-p buffer-matches+contexts))
-                          (pcase-let ((`((,_ ,match-beg ,_) . (,context-beg . 
,context-end))
-                                       (stream-first buffer-matches+contexts)))
+                        (while (not (stream-empty-p 
buffer-matches+counts+contexts))
+                          (pcase-let ((`((,_ ,match-beg ,_) ,_ (,context-beg . 
,context-end))
+                                       (stream-first 
buffer-matches+counts+contexts)))
                             (let ((insertion-point (point)) matches
                                   (end-of-defun (with-current-buffer buffer
                                                   (goto-char match-beg)
@@ -3205,53 +3200,66 @@ Prompt for a new pattern and revert."
                                                     (if (< 0 paren-depth)
                                                         (scan-lists match-beg 
1 paren-depth)
                                                       
(el-search--end-of-sexp))))))
-                              (let ((rest buffer-matches+contexts)
-                                    (remaining-buffer-matches-+contexts 
buffer-matches+contexts))
+                              (let ((rest buffer-matches+counts+contexts)
+                                    (remaining-buffer-matches+counts+contexts
+                                     buffer-matches+counts+contexts))
                                 (with-current-buffer buffer
                                   (while (pcase (stream-first rest)
-                                           (`(,_ . (,(and cbeg (pred (> 
end-of-defun))) . ,_))
+                                           (`(,_ ,_ (,(and cbeg (pred (> 
end-of-defun))) . ,_))
                                             (prog1 t
                                               (stream-pop rest)
                                               (when (< cbeg context-end)
-                                                (setq 
remaining-buffer-matches-+contexts rest)
+                                                (setq 
remaining-buffer-matches+counts+contexts rest)
                                                 (when (< cbeg context-beg)
                                                   (setq context-beg cbeg)
                                                   (setq context-end
                                                         (or 
(el-search--end-of-sexp cbeg) context-end)))))))))
                                 (setq matches
                                       (car (stream-divide-with-get-rest-fun
-                                            buffer-matches+contexts
-                                            (lambda (_) 
remaining-buffer-matches-+contexts))))
-                                (setq buffer-matches+contexts 
remaining-buffer-matches-+contexts))
+                                            buffer-matches+counts+contexts
+                                            (lambda (_) 
remaining-buffer-matches+counts+contexts))))
+                                (setq buffer-matches+counts+contexts
+                                      
remaining-buffer-matches+counts+contexts))
                               (cl-flet ((insert-match-and-advance
-                                         (match-beg)
+                                         (match-beg nbr)
                                          (let ((insertion-point (point)))
-                                           (insert (propertize
-                                                    (with-current-buffer buffer
-                                                      
(buffer-substring-no-properties
-                                                       (goto-char match-beg)
-                                                       (goto-char 
(el-search--end-of-sexp))))
-                                                    'match-data `(,buffer 
,match-beg ,file)))
+                                           (insert (with-current-buffer buffer
+                                                     
(buffer-substring-no-properties
+                                                      (goto-char match-beg)
+                                                      (goto-char 
(el-search--end-of-sexp)))))
                                            (let ((ov (make-overlay 
insertion-point (point) nil t)))
                                              (overlay-put ov 'face 
'el-search-occur-match)
+                                             ;; FIXME: I guess we don't need 
both of these
+                                             (overlay-put
+                                              ov 'el-search-match (list (or 
file buffer) match-beg))
                                              (overlay-put
-                                              ov 'el-search-match (list (or 
file buffer) match-beg)))
+                                              ov el-search-match-prop 
`(,buffer ,match-beg ,file ,nbr)))
                                            (with-current-buffer buffer 
(point)))))
                                 (insert (format "\n;;;; Line %d\n"
                                                 (with-current-buffer buffer
                                                   (line-number-at-pos 
context-beg))))
                                 (setq insertion-point (point))
-                                (let ((working-position context-beg))
+                                (let ((working-position context-beg) 
main-match-beg)
                                   (while (not (stream-empty-p matches))
-                                    (pcase-let ((`((,_ ,match-beg ,_) . ,_) 
(stream-pop matches)))
+                                    (pcase-let ((`((,_ ,match-beg ,_) ,nbr ,_) 
(stream-pop matches)))
                                       (insert-buffer-substring buffer 
working-position match-beg)
-                                      (setq working-position 
(insert-match-and-advance match-beg))
+                                      (setq
+                                       main-match-beg   (point)
+                                       working-position 
(insert-match-and-advance match-beg nbr))
                                       ;; Drop any matches inside the printed 
area.
-                                      ;; FIXME: Should we highlight matches 
inside matches specially?
-                                      ;; Should we display the number of 
matches included in a context?
-                                      (while (pcase (stream-first matches)
-                                               (`((,_ ,(pred (> 
working-position)) ,_) . ,_) t))
-                                        (stream-pop matches))))
+                                      (while
+                                          (pcase (stream-first matches)
+                                            (`((,_ ,(and (pred (> 
working-position)) mb) ,_) ,nbr ,_)
+                                             (let ((ov-start (+ main-match-beg 
(- mb match-beg))))
+                                               (overlay-put
+                                                (make-overlay
+                                                 ov-start
+                                                 (+ ov-start
+                                                    (with-current-buffer buffer
+                                                      (el-search--end-of-sexp 
mb))))
+                                                el-search-match-prop `(,buffer 
,mb ,file ,nbr)))
+                                             (stream-pop matches)
+                                             t)))))
                                   (insert
                                    (with-current-buffer buffer
                                      (buffer-substring-no-properties