master 93f557af0ef 2/2: New user option 'grep-use-headings'

[Juri Linkov]

branch: master
commit 93f557af0ef85ce301bb0780e26351eb8809e91c
Author: Augusto Stoffel <arstoffel@gmail.com>
Commit: Juri Linkov <juri@linkov.net>

    New user option 'grep-use-headings'
    
    * lisp/progmodes/grep.el (grep-heading-regexp): New user option.
    (grep-heading): New face (bug#59888).
    (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                          |  9 ++++++
 lisp/progmodes/grep.el            | 66 +++++++++++++++++++++++++++++++++++++++
 test/lisp/progmodes/grep-tests.el | 14 +++++++++
 3 files changed, 89 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index 9241598f185..31fb22fc1e2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -95,6 +95,15 @@ If you want to get back the old behavior, set the user 
option to the value
     (setopt gdb-locals-table-row-config
             `((type . 0) (name . 0) (value . ,gdb-locals-value-limit)))
 
+** 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'.  The headings are displayed using the new 'grep-heading'
+face.
+
 ** VC
 
 ---
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 0da16b44dda..82e9c5d8edf 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -457,6 +457,33 @@ buffer `default-directory'."
   :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")
+
+(defface grep-heading `((t :inherit ,grep-hit-face))
+  "Face of headings when `grep-use-headings' is non-nil."
+  :version "30.1")
+
+(defvar 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).")
+
 (defvar grep-find-abbreviate-properties
   (let ((ellipsis (if (char-displayable-p ?…) "[…]" "[...]"))
         (map (make-sparse-keymap)))
@@ -612,6 +639,40 @@ This function is called from `compilation-filter-hook'."
         (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
+                (goto-char (pos-bol))
+                (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 +967,11 @@ The value depends on `grep-command', `grep-template',
   (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 39307999d6d..9b7f83086bf 100644
--- a/test/lisp/progmodes/grep-tests.el
+++ b/test/lisp/progmodes/grep-tests.el
@@ -66,4 +66,18 @@
     (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