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

[Augusto Stoffel <arstoffel@gmail.com>]

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

Here is an updated patch for the “grep headings” feature.

As discussed before, I introduced a text property so that one can tell
without guessing which parts of the compilation buffer are not coming
from the external process.  This seems to supersede the
'compilation-header-end' property introduced by Lars in commit
07f748da43, so I replaced its uses by the new 'compilation-aside'
property.  I could easily revert that, but it seemed reasonable to
uniformize things in this case.

I've also incorporated all other suggestions from other messages.  (And
Juri, nevermind what I said about some faces, it only applies to the
Modus theme.)


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

From c593fc94f2289d4bdcb61835eaf11b0fe393a0f5 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-aside' text property

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

* lisp/progmodes/compile.el (compilation-insert-aside):  New function.
(compilation-start, compilation-handle-exit): Use it.
(compilation--ensure-parse) Rely on 'compilation-aside' 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..2d22501017 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-aside)
                           ;; 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-aside (&rest args)
+  "Insert ARGS at point, adding the `compilation-aside' 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-aside 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-aside
+           "-*- mode: " name-of-mode
+           "; default-directory: "
+           (prin1-to-string (abbreviate-file-name default-directory))
+	   " -*-\n"))
+        (compilation-insert-aside
+         (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-aside ?\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-aside " 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: 6324 bytes --]

From 549187135df21702210050e873210bd200612f96 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..4ad6e76687 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 grep output 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..d6981c5951 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-aside 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-aside)
+          (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