emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master b0d33d4: Don't squash markers in occur-edit-mode


From: Mattias Engdegård
Subject: master b0d33d4: Don't squash markers in occur-edit-mode
Date: Sun, 25 Jul 2021 06:03:43 -0400 (EDT)

branch: master
commit b0d33d42535cc6aef2c518eba373332de59f210f
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Don't squash markers in occur-edit-mode
    
    * lisp/replace.el (occur-after-change-function): Instead of replacing
    the whole line being edited, use shrink-wrapping to replace the
    smallest interval encompassing the change.  That way, we avoid
    disturbing markers (such as occur highlighting locations) in the line;
    they would otherwise all be forced to the beginning.
---
 lisp/replace.el | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

diff --git a/lisp/replace.el b/lisp/replace.el
index 24befed..09bdf28 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1398,8 +1398,27 @@ To return to ordinary Occur mode, use 
\\[occur-cease-edit]."
            (recenter line)
            (if readonly
                (message "Buffer `%s' is read only." buf)
-             (delete-region (line-beginning-position) (line-end-position))
-             (insert text))
+              ;; Replace the line, but make the change as small as
+              ;; possible by shrink-wrapping.  That way, we avoid
+              ;; disturbing markers unnecessarily.
+              (let* ((beg-pos (line-beginning-position))
+                     (end-pos (line-end-position))
+                     (buf-str (buffer-substring-no-properties beg-pos end-pos))
+                     (common-prefix
+                      (lambda (s1 s2)
+                        (let ((c (compare-strings s1 nil nil s2 nil nil)))
+                          (if (zerop c)
+                              (length s1)
+                            (1- (abs c))))))
+                     (prefix-len (funcall common-prefix buf-str text))
+                     (suffix-len (funcall common-prefix
+                                          (reverse buf-str) (reverse text))))
+                (setq beg-pos (+ beg-pos prefix-len))
+                (setq end-pos (- end-pos suffix-len))
+                (setq text (substring text prefix-len (- suffix-len)))
+                (delete-region beg-pos end-pos)
+                (goto-char beg-pos)
+                (insert text)))
            (move-to-column col)))))))
 
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]