bug#59888: [PATCH] Add 'grep-use-headings'

[Augusto Stoffel <arstoffel@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 80 bytes --]

I've attached a new version of the patch incorporating the latest
discussions.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Introduce-compilation-annotation-text-property.patch --]
[-- Type: text/x-patch, Size: 3951 bytes --]

From 8aa2bebbe1b12094963fdeb3251f3ef3c22ea5e9 Mon Sep 17 00:00:00 2001
From: Augusto Stoffel <arstoffel@gmail.com>
Date: Thu, 8 Dec 2022 21:05:10 +0100
Subject: [PATCH 1/2] Introduce 'compilation-annotation' text property

It is meant to mark parts of compilation buffers which do not
correspond to process output.

* lisp/progmodes/compile.el (compilation-insert-annotation): New
function.
(compilation-start, compilation-handle-exit): Use it.
(compilation--ensure-parse) Rely on 'compilation-annotation' property
instead of 'compilation-header-end'.
---
 lisp/progmodes/compile.el | 35 +++++++++++++++++++++--------------
 1 file changed, 21 insertions(+), 14 deletions(-)

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index e8ada9388e..3aa6867533 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1675,7 +1675,7 @@ compilation--ensure-parse
             (set-marker (make-marker)
                         (save-excursion
                           (goto-char (point-min))
-                          (text-property-search-forward 'compilation-header-end)
+                          (text-property-search-forward 'compilation-annotation)
                           ;; If we have no end marker, this will be
                           ;; `point-min' still.
                           (point)))))
@@ -1823,6 +1823,14 @@ compilation--update-in-progress-mode-line
   ;; buffers when it changes from nil to non-nil or vice-versa.
   (unless compilation-in-progress (force-mode-line-update t)))
 
+(defun compilation-insert-annotation (&rest args)
+  "Insert ARGS at point, adding the `compilation-annotation' text property.
+This property is used to distinguish output of the compilation
+process from additional information inserted by Emacs."
+  (let ((start (point)))
+    (apply #'insert args)
+    (put-text-property start (point) 'compilation-annotation t)))
+
 ;;;###autoload
 (defun compilation-start (command &optional mode name-function highlight-regexp
                                   continue)
@@ -1944,17 +1952,16 @@ compilation-start
             (setq-local compilation-auto-jump-to-next t))
         (when (zerop (buffer-size))
 	  ;; Output a mode setter, for saving and later reloading this buffer.
-	  (insert "-*- mode: " name-of-mode
-		  "; default-directory: "
-                  (prin1-to-string (abbreviate-file-name default-directory))
-		  " -*-\n"))
-        (insert (format "%s started at %s\n\n"
-			mode-name
-			(substring (current-time-string) 0 19))
-		command "\n")
-        ;; Mark the end of the header so that we don't interpret
-        ;; anything in it as an error.
-        (put-text-property (1- (point)) (point) 'compilation-header-end t)
+	  (compilation-insert-annotation
+           "-*- mode: " name-of-mode
+           "; default-directory: "
+           (prin1-to-string (abbreviate-file-name default-directory))
+	   " -*-\n"))
+        (compilation-insert-annotation
+         (format "%s started at %s\n\n"
+                 mode-name
+		 (substring (current-time-string) 0 19))
+	 command "\n")
 	(setq thisdir default-directory))
       (set-buffer-modified-p nil))
     ;; Pop up the compilation buffer.
@@ -2436,13 +2443,13 @@ compilation-handle-exit
 	(cur-buffer (current-buffer)))
     ;; Record where we put the message, so we can ignore it later on.
     (goto-char omax)
-    (insert ?\n mode-name " " (car status))
+    (compilation-insert-annotation ?\n mode-name " " (car status))
     (if (and (numberp compilation-window-height)
 	     (zerop compilation-window-height))
 	(message "%s" (cdr status)))
     (if (bolp)
 	(forward-char -1))
-    (insert " at " (substring (current-time-string) 0 19))
+    (compilation-insert-annotation " at " (substring (current-time-string) 0 19))
     (goto-char (point-max))
     ;; Prevent that message from being recognized as a compilation error.
     (add-text-properties omax (point)
-- 
2.38.1


[-- Attachment #3: 0002-New-user-option-grep-use-headings.patch --]
[-- Type: text/x-patch, Size: 6338 bytes --]

From e1209a93e09792cbb61bde9ae3ac8838c76861a5 Mon Sep 17 00:00:00 2001
From: Augusto Stoffel <arstoffel@gmail.com>
Date: Wed, 7 Dec 2022 18:44:07 +0100
Subject: [PATCH 2/2] New user option 'grep-use-headings'

* lisp/progmodes/grep.el (grep-heading-regexp): New user option.
(grep-heading): New face.
(grep--heading-format, grep--heading-state, grep--heading-filter):
Filter function for grep processes and supporting variables.
(grep-use-headings): New user option.
(grep-mode): Use the above, if applicable.
---
 etc/NEWS                          |  8 ++++
 lisp/progmodes/grep.el            | 69 +++++++++++++++++++++++++++++++
 test/lisp/progmodes/grep-tests.el | 14 +++++++
 3 files changed, 91 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index 3eeef0ab4c..ac5ed7cbf3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -41,6 +41,14 @@ connection.
 \f
 * Changes in Specialized Modes and Packages in Emacs 30.1
 
+** Compile
+
+*** New user option 'grep-use-headings'.
+When non-nil, the output of Grep is split into sections, one for each
+file, instead of having file names prefixed to each line.  It is
+equivalent to the --heading option of some tools such as 'git grep'
+and 'rg'.
+
 ** VC
 
 ---
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 2446e86abb..c6be39fbb7 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -30,6 +30,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'rx))
 (require 'compile)
 
 (defgroup grep nil
@@ -457,6 +458,35 @@ grep-search-path
   :type '(repeat (choice (const :tag "Default" nil)
 			 (string :tag "Directory"))))
 
+(defcustom grep-use-headings nil
+  "If non-nil, subdivide grep output into sections, one per file."
+  :type 'boolean
+  :version "30.1")
+
+(defcustom grep-heading-regexp
+  (rx bol
+      (or
+       (group-n 2
+         (group-n 1 (+ (not (any 0 ?\n))))
+         0)
+       (group-n 2
+        (group-n 1 (+? nonl))
+        (any ?: ?- ?=)))
+      (+ digit)
+      (any ?: ?- ?=))
+  "Regexp used to create headings from grep output lines.
+It should be anchored at beginning of line.  The first capture
+group, if present, should match the heading associated to the
+line.  The buffer range of the second capture, if present, is
+made invisible (presumably because displaying it would be
+redundant)."
+  :type 'regexp
+  :version "30.1")
+
+(defface grep-heading `((t :inherit ,grep-hit-face))
+  "Face of headings when using `grep-heading-mode'."
+  :version "30.1")
+
 (defvar grep-find-abbreviate-properties
   (let ((ellipsis (if (char-displayable-p ?…) "[…]" "[...]"))
         (map (make-sparse-keymap)))
@@ -612,6 +642,40 @@ grep-filter
         (while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
           (replace-match "" t t))))))
 
+(defvar grep--heading-format
+  (eval-when-compile
+    (let ((title (propertize "%s"
+                             'font-lock-face 'grep-heading
+                             'outline-level 1)))
+      (propertize (concat title "\n") 'compilation-annotation t)))
+  "Format string of grep headings.
+This is passed to `format' with one argument, the text of the
+first capture group of `grep-heading-regexp'.")
+
+(defvar-local grep--heading-state nil
+  "Variable to keep track of the `grep--heading-filter' state.")
+
+(defun grep--heading-filter ()
+  "Filter function to add headings to output of a grep process."
+  (unless grep--heading-state
+    (setq grep--heading-state (cons (point-min-marker) nil)))
+  (save-excursion
+    (let ((limit (car grep--heading-state)))
+      ;; Move point to the old limit and update limit marker.
+      (move-marker limit (prog1 (pos-bol) (goto-char limit)))
+      (while (re-search-forward grep-heading-regexp limit t)
+        (unless (get-text-property (point) 'compilation-annotation)
+          (let ((heading (match-string-no-properties 1))
+                (start (match-beginning 2))
+                (end (match-end 2)))
+            (when start
+              (put-text-property start end 'invisible t))
+            (when (and heading (not (equal heading (cdr grep--heading-state))))
+              (save-excursion
+                (forward-line 0)
+                (insert-before-markers (format grep--heading-format heading)))
+              (setf (cdr grep--heading-state) heading))))))))
+
 (defun grep-probe (command args &optional func result)
   (let (process-file-side-effects)
     (equal (condition-case nil
@@ -906,6 +970,11 @@ grep-mode
   (add-function :filter-return (local 'kill-transform-function)
                 (lambda (string)
                   (string-replace "\0" ":" string)))
+  (when grep-use-headings
+    (add-hook 'compilation-filter-hook #'grep--heading-filter 80 t)
+    (setq-local outline-search-function #'outline-search-level
+                outline-level (lambda () (get-text-property
+                                          (point) 'outline-level))))
   (add-hook 'compilation-filter-hook #'grep-filter nil t))
 
 (defun grep--save-buffers ()
diff --git a/test/lisp/progmodes/grep-tests.el b/test/lisp/progmodes/grep-tests.el
index 101052c5ad..51f4606639 100644
--- a/test/lisp/progmodes/grep-tests.el
+++ b/test/lisp/progmodes/grep-tests.el
@@ -66,4 +66,18 @@ grep-tests--rgrep-abbreviate-properties-windows-nt-sh-semantics
     (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'ignore))
       (grep-tests--check-rgrep-abbreviation))))
 
+(ert-deftest grep-tests--grep-heading-regexp-without-null ()
+  (dolist (sep '(?: ?- ?=))
+    (let ((string (format "filename%c123%ctext" sep sep)))
+      (should (string-match grep-heading-regexp string))
+      (should (equal (match-string 1 string) "filename"))
+      (should (equal (match-string 2 string) (format "filename%c" sep))))))
+
+(ert-deftest grep-tests--grep-heading-regexp-with-null ()
+  (dolist (sep '(?: ?- ?=))
+    (let ((string (format "funny:0:filename%c123%ctext" 0 sep)))
+      (should (string-match grep-heading-regexp string))
+      (should (equal (match-string 1 string) "funny:0:filename"))
+      (should (equal (match-string 2 string) "funny:0:filename\0")))))
+
 ;;; grep-tests.el ends here
-- 
2.38.1


[-- Attachment #4: Type: text/plain, Size: 535 bytes --]


There is still an issue I'm aware of: if one saves a grep buffer to a
file and later opens the file, the headings are inserted a second time.
I've tried a bit to display the headings only using text display
properties (instead of inserting the actual text into the buffer), but
wasn't successful so far.  Other, less elegant solutions are possible
(e.g. deleting all headings either when saving or when reading again the
file).

We could install this change now and polish it later or continue this
discussion -- both are fine by me.