From 549187135df21702210050e873210bd200612f96 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel 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. * 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