Subject: bug#70820: [PATCH] Editable grep buffers

From: Visuwesh <[email-masked]>
Date: Sun, 28 Jul 2024 14:03:32 +0530

[சனி மே 18, 2024] Eli Zaretskii wrote:

>> From: Stefan Monnier <[email-masked]>
>> Cc: [email-masked],  [email-masked]
>> Date: Sat, 18 May 2024 12:27:06 -0400
>> 
>> >> These are properties which the major mode (unconditionally) added, so it
>> >> doesn't seem unfriendly to remove them unconditionally when switching to
>> >> an unrelated major mode.
>> > Yes, but how does compilation-mode know the other major-mode is
>> > "unrelated"?  It could be very related, as this discussion
>> > demonstrates.
>> 
>> If it's related it has access to internals, so it can so things like
>> disabling `compilation--remoave-properties`.
>
> OK, so my suggestion to Visuwesh is the best way of dealing with this.
> Fine by me.

Sorry for the long delay.  I finally got the time to work on this
properly.  The attached patch uses a major-mode, akin to wdired-mode
like Stefan suggested in another message.  This side-steps previous
issues with buffer-local variables and compilation--remove-properties.
If this approach is okay, I will work on updating the documentation,
etc.

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index b18eb81fee1..867ebc92d75 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2829,6 +2829,53 @@ compilation-find-buffer
       (current-buffer)
     (next-error-find-buffer avoid-current 'compilation-buffer-internal-p)))

+(defun compilation--update-markers (loc marker screen-columns first-column)
+  "Update markers in LOC, and set MARKER to location pointed by LOC.
+SCREEN-COLUMNS and FIRST-COLUMN are the value of
+`compilation-error-screen-columns' and `compilation-first-column' to use
+if they are not set buffer-locally in the target buffer."
+  (with-current-buffer
+      (if (bufferp (caar (compilation--loc->file-struct loc)))
+          (caar (compilation--loc->file-struct loc))
+        (apply #'compilation-find-file
+               marker
+               (caar (compilation--loc->file-struct loc))
+               (cadr (car (compilation--loc->file-struct loc)))
+               (compilation--file-struct->formats
+                (compilation--loc->file-struct loc))))
+    (let ((screen-columns
+           ;; Obey the compilation-error-screen-columns of the target
+           ;; buffer if its major mode set it buffer-locally.
+           (if (local-variable-p 'compilation-error-screen-columns)
+               compilation-error-screen-columns screen-columns))
+          (compilation-first-column
+           (if (local-variable-p 'compilation-first-column)
+               compilation-first-column first-column))
+          (last 1))
+      (save-restriction
+        (widen)
+        (goto-char (point-min))
+        ;; Treat file's found lines in forward order, 1 by 1.
+        (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
+          (when (car line)     ; else this is a filename without a line#
+            (compilation-beginning-of-line (- (car line) last -1))
+            (setq last (car line)))
+          ;; Treat line's found columns and store/update a marker for each.
+          (dolist (col (cdr line))
+            (if (compilation--loc->col col)
+                (if (eq (compilation--loc->col col) -1)
+                    ;; Special case for range end.
+                    (end-of-line)
+                  (compilation-move-to-column (compilation--loc->col col)
+                                              screen-columns))
+              (beginning-of-line)
+              (skip-chars-forward " \t"))
+            (if (compilation--loc->marker col)
+                (set-marker (compilation--loc->marker col) (point))
+              (setf (compilation--loc->marker col) (point-marker)))
+            ;; (setf (compilation--loc->timestamp col) timestamp)
+            ))))))
+
 ;;;###autoload
 (defun compilation-next-error-function (n &optional reset)
   "Advance to the next error message and visit the file where the error was.
@@ -2838,7 +2885,6 @@ compilation-next-error-function
     (setq compilation-current-error nil))
   (let* ((screen-columns compilation-error-screen-columns)
 	 (first-column compilation-first-column)
-	 (last 1)
 	 (msg (compilation-next-error (or n 1) nil
 				      (or compilation-current-error
 					  compilation-messages-start
@@ -2850,9 +2896,9 @@ compilation-next-error-function
       (user-error "No next error"))
     (setq compilation-current-error (point-marker)
 	  overlay-arrow-position
-	    (if (bolp)
-		compilation-current-error
-	      (copy-marker (line-beginning-position))))
+	  (if (bolp)
+	      compilation-current-error
+	    (copy-marker (line-beginning-position))))
     ;; If loc contains no marker, no error in that file has been visited.
     ;; If the marker is invalid the buffer has been killed.
     ;; So, recalculate all markers for that file.
@@ -2869,46 +2915,7 @@ compilation-next-error-function
                  ;;     (equal (compilation--loc->timestamp loc)
                  ;;            (setq timestamp compilation-buffer-modtime)))
                  )
-      (with-current-buffer
-          (if (bufferp (caar (compilation--loc->file-struct loc)))
-              (caar (compilation--loc->file-struct loc))
-            (apply #'compilation-find-file
-                   marker
-                   (caar (compilation--loc->file-struct loc))
-                   (cadr (car (compilation--loc->file-struct loc)))
-                   (compilation--file-struct->formats
-                    (compilation--loc->file-struct loc))))
-        (let ((screen-columns
-               ;; Obey the compilation-error-screen-columns of the target
-               ;; buffer if its major mode set it buffer-locally.
-               (if (local-variable-p 'compilation-error-screen-columns)
-                   compilation-error-screen-columns screen-columns))
-              (compilation-first-column
-               (if (local-variable-p 'compilation-first-column)
-                   compilation-first-column first-column)))
-          (save-restriction
-            (widen)
-            (goto-char (point-min))
-            ;; Treat file's found lines in forward order, 1 by 1.
-            (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
-              (when (car line)		; else this is a filename without a line#
-                (compilation-beginning-of-line (- (car line) last -1))
-                (setq last (car line)))
-              ;; Treat line's found columns and store/update a marker for each.
-              (dolist (col (cdr line))
-                (if (compilation--loc->col col)
-                    (if (eq (compilation--loc->col col) -1)
-                        ;; Special case for range end.
-                        (end-of-line)
-                      (compilation-move-to-column (compilation--loc->col col)
-                                                  screen-columns))
-                  (beginning-of-line)
-                  (skip-chars-forward " \t"))
-                (if (compilation--loc->marker col)
-                    (set-marker (compilation--loc->marker col) (point))
-                  (setf (compilation--loc->marker col) (point-marker)))
-                ;; (setf (compilation--loc->timestamp col) timestamp)
-                ))))))
+      (compilation--update-markers loc marker screen-columns first-column))
     (compilation-goto-locus marker (compilation--loc->marker loc)
                             (compilation--loc->marker end-loc))
     (setf (compilation--loc->visited loc) t)))
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 657349cbdff..605e763b444 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -295,6 +295,8 @@ grep-mode-map
     (define-key map "}" #'compilation-next-file)
     (define-key map "\t" #'compilation-next-error)
     (define-key map [backtab] #'compilation-previous-error)
+
+    (define-key map "e" #'grep-change-to-grep-edit-mode)
     map)
   "Keymap for grep buffers.
 `compilation-minor-mode-map' is a cdr of this.")
@@ -1029,6 +1031,90 @@ grep
 		       command-args)
 		     #'grep-mode))

+(defun grep-edit--prepare-buffer ()
+  "Mark relevant regions read-only, and add relevant occur text-properties."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((inhibit-read-only t)
+          (dummy (make-marker))
+          match)
+      (while (setq match (text-property-search-forward 'compilation-annotation))
+        (add-text-properties (prop-match-beginning match) (prop-match-end match)
+                             '(read-only t)))
+      (goto-char (point-min))
+      (while (setq match (text-property-search-forward 'compilation-message))
+        (add-text-properties (prop-match-beginning match) (prop-match-end match)
+                             '(read-only t occur-prefix t))
+        (let ((loc (compilation--message->loc (prop-match-value match)))
+              m)
+          ;; Update the markers if necessary.
+          (unless (and (compilation--loc->marker loc)
+                       (marker-buffer (compilation--loc->marker loc)))
+            (compilation--update-markers loc dummy compilation-error-screen-columns compilation-first-column))
+          (setq m (compilation--loc->marker loc))
+          (add-text-properties (prop-match-beginning match)
+                               (or (next-single-property-change
+                                    (prop-match-end match)
+                                    'compilation-message)
+                                   (1+ (pos-eol)))
+                               `(occur-target ((,m . ,m)))))))))
+
+(defvar grep-edit-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map text-mode-map)
+    (define-key map (kbd "C-c C-c") #'grep-edit-save-changes)
+    map)
+  "Keymap for `grep-edit-mode'.")
+
+(defvar grep-edit-mode-hook nil
+  "Hooks run when changing to Grep-Edit mode.")
+
+(defun grep-edit-mode ()
+  "Major mode for editing *grep* buffers.
+In this mode, changes to the *grep* buffer are applied to the
+originating files.
+\\<grep-edit-mode-map>
+Type \\[grep-edit-save-changes] to exit Grep-Edit mode, return to Grep
+mode.
+
+The only editable texts in a Grep-Edit buffer are the match results."
+  (interactive)
+  (error "This mode can be enabled only by `grep-change-to-grep-edit-mode'"))
+(put 'grep-edit-mode 'mode-class 'special)
+
+(defun grep-change-to-grep-edit-mode ()
+  "Switch to `grep-edit-mode' to edit *grep* buffer."
+  (interactive)
+  (unless (derived-mode-p 'grep-mode)
+    (error "Not a Grep buffer"))
+  (when (get-buffer-process (current-buffer))
+    (error "Cannot switch when grep is running"))
+  (use-local-map grep-edit-mode-map)
+  (grep-edit--prepare-buffer)
+  (setq buffer-read-only nil)
+  (setq major-mode 'grep-edit-mode)
+  (setq mode-name "Grep-Edit")
+  (buffer-enable-undo)
+  (set-buffer-modified-p nil)
+  (setq buffer-undo-list nil)
+  (add-hook 'after-change-functions #'occur-after-change-function nil t)
+  (run-mode-hooks 'grep-edit-mode-hook)
+  (message "Editing: \\[grep-edit-save-changes] to return to Grep mode"))
+
+(defun grep-edit-save-changes ()
+  "Switch back to Grep mode."
+  (interactive)
+  (unless (derived-mode-p 'grep-edit-mode)
+    (error "Not a Grep-Edit buffer"))
+  (remove-hook 'after-change-functions #'occur-after-change-function t)
+  (use-local-map grep-mode-map)
+  (setq buffer-read-only t)
+  (setq major-mode 'grep-mode)
+  (setq mode-name "Grep")
+  (force-mode-line-update)
+  (buffer-disable-undo)
+  (setq buffer-undo-list t)
+  (message "Switching to Grep mode"))

 ;;;###autoload
 (defun grep-find (command-args)