From: Augusto Stoffel <arstoffel@gmail.com>
To: Juri Linkov <juri@linkov.net>
Cc: Robert Pluim <rpluim@gmail.com>, Eli Zaretskii <eliz@gnu.org>,
59888@debbugs.gnu.org, stefankangas@gmail.com
Subject: bug#59888: [PATCH] Add 'grep-use-headings'
Date: Mon, 27 Feb 2023 20:06:07 +0100 [thread overview]
Message-ID: <87cz5vc4io.fsf@gmail.com> (raw)
In-Reply-To: <86y1oj9byf.fsf@mail.linkov.net> (Juri Linkov's message of "Mon, 27 Feb 2023 20:53:44 +0200")
[-- Attachment #1: Type: text/plain, Size: 189 bytes --]
On Mon, 27 Feb 2023 at 20:53, Juri Linkov wrote:
> I tried out your patch, and everything works nicely.
> So I guess it could be pushed when you send the final version.
There you go :-)
[-- Attachment #2: 0002-New-user-option-grep-use-headings.patch --]
[-- Type: text/x-patch, Size: 6339 bytes --]
From d141b5c31718bf312cd06cd85c2865621753ad7b 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 | 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 4b0e4e6bd46..58bbd083ef8 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 @@ 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")
+
+(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 @@ 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
+ (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 @@ 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 39307999d6d..9b7f83086bf 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.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Introduce-compilation-annotation-text-property.patch --]
[-- Type: text/x-patch, Size: 3953 bytes --]
From 8660f5cc050ecf3789574cfc11544b5950b8e949 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 ccf64fb670b..6d151db8a83 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1706,7 +1706,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)))))
@@ -1854,6 +1854,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)
@@ -1975,17 +1983,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.
@@ -2467,13 +2474,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.39.2
next prev parent reply other threads:[~2023-02-27 19:06 UTC|newest]
Thread overview: 37+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-12-07 17:57 bug#59888: [PATCH] Add 'grep-heading-mode' Augusto Stoffel
2022-12-07 18:14 ` Eli Zaretskii
2022-12-08 8:59 ` Augusto Stoffel
2022-12-08 10:57 ` Eli Zaretskii
2022-12-08 0:19 ` Stefan Kangas
2022-12-08 9:06 ` Augusto Stoffel
2022-12-09 7:23 ` Juri Linkov
2022-12-09 11:58 ` Augusto Stoffel
2022-12-09 12:18 ` bug#59888: [PATCH] Add 'grep-use-headings' Augusto Stoffel
2022-12-09 19:36 ` Eli Zaretskii
2022-12-09 20:03 ` Augusto Stoffel
2022-12-09 20:29 ` Eli Zaretskii
2022-12-10 20:08 ` Augusto Stoffel
2022-12-10 20:16 ` Eli Zaretskii
2022-12-11 11:30 ` Augusto Stoffel
2022-12-15 8:05 ` Juri Linkov
2023-02-25 8:34 ` Augusto Stoffel
2023-02-25 18:00 ` Juri Linkov
2023-02-26 13:17 ` Robert Pluim
2023-02-26 15:07 ` Augusto Stoffel
2023-02-27 6:24 ` Robert Pluim
2023-02-27 11:26 ` Augusto Stoffel
2023-02-27 16:51 ` Robert Pluim
2023-02-27 18:53 ` Juri Linkov
2023-02-27 19:06 ` Augusto Stoffel [this message]
2023-02-27 19:15 ` Juri Linkov
2023-02-28 17:24 ` Juri Linkov
2023-02-28 18:17 ` Augusto Stoffel
2023-03-01 17:52 ` Juri Linkov
2022-12-09 20:40 ` Gregory Heytings
2022-12-10 17:24 ` Juri Linkov
2022-12-08 9:57 ` bug#59888: [PATCH] Add 'grep-heading-mode' Mattias Engdegård
2022-12-08 10:28 ` Augusto Stoffel
2022-12-08 10:48 ` Mattias Engdegård
2023-02-27 14:18 ` Mattias Engdegård
2022-12-09 7:28 ` Juri Linkov
2022-12-09 11:58 ` Augusto Stoffel
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87cz5vc4io.fsf@gmail.com \
--to=arstoffel@gmail.com \
--cc=59888@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=juri@linkov.net \
--cc=rpluim@gmail.com \
--cc=stefankangas@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).