From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Augusto Stoffel Newsgroups: gmane.emacs.bugs Subject: bug#59888: [PATCH] Add 'grep-use-headings' Date: Mon, 27 Feb 2023 20:06:07 +0100 Message-ID: <87cz5vc4io.fsf@gmail.com> References: <87v8mndrla.fsf@gmail.com> <87ilime025.fsf@gmail.com> <86359pm55x.fsf@mail.linkov.net> <87o7scdb45.fsf_-_@gmail.com> <837cz0z7wj.fsf@gnu.org> <87k0301h16.fsf@gmail.com> <831qp8z5gp.fsf@gnu.org> <87sfhn3tui.fsf@gmail.com> <83wn6zui9n.fsf@gnu.org> <87ilii41p9.fsf@gmail.com> <867cytgk0k.fsf@mail.linkov.net> <871qme5ej3.fsf@gmail.com> <87cz5w7ehu.fsf@gmail.com> <87pm9wcvoe.fsf@gmail.com> <86y1oj9byf.fsf@mail.linkov.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="27418"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Robert Pluim , Eli Zaretskii , 59888@debbugs.gnu.org, stefankangas@gmail.com To: Juri Linkov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Feb 27 20:07:09 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pWiq4-00070g-Ls for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 27 Feb 2023 20:07:08 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pWiq0-00021w-DF; Mon, 27 Feb 2023 14:07:04 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pWipz-00021V-8m for bug-gnu-emacs@gnu.org; Mon, 27 Feb 2023 14:07:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pWipz-0005Fl-0g for bug-gnu-emacs@gnu.org; Mon, 27 Feb 2023 14:07:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pWipy-0005zm-C9 for bug-gnu-emacs@gnu.org; Mon, 27 Feb 2023 14:07:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Augusto Stoffel Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 27 Feb 2023 19:07:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 59888 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 59888-submit@debbugs.gnu.org id=B59888.167752478122987 (code B ref 59888); Mon, 27 Feb 2023 19:07:02 +0000 Original-Received: (at 59888) by debbugs.gnu.org; 27 Feb 2023 19:06:21 +0000 Original-Received: from localhost ([127.0.0.1]:48820 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pWipJ-0005yg-4p for submit@debbugs.gnu.org; Mon, 27 Feb 2023 14:06:21 -0500 Original-Received: from mail-ed1-f43.google.com ([209.85.208.43]:34690) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pWipD-0005yN-TD for 59888@debbugs.gnu.org; Mon, 27 Feb 2023 14:06:20 -0500 Original-Received: by mail-ed1-f43.google.com with SMTP id cq23so30154868edb.1 for <59888@debbugs.gnu.org>; Mon, 27 Feb 2023 11:06:15 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=l9hZd8vSpc0sEgpNKVqeufwyzTU0YesKGVE7fyTM6Ws=; b=jFIxK7MjUTtZ0wTqdwerJPewK9dcHgwdpoHHcLUjyI6m2+VOsNa/ipjjYXhYAajUvG EJaeb4qTtjD/Cr081dB49dmqDYu+44QnjiHPITP420nleXVBt9kRPAr5S9a4HR9nwtXX 1xkrgrvM1inSMXJr86hBcNzE7l/16P+ykl27ITcrGHk0DllPxzTAolGYHGwVdCquCUM9 4xtizEgwU/pwF+U9jO3PjACuzJHBmztb+66jWBkfuq4tBvCIbR845xxGGa+BpP/kMHAt TbcnXhW1pmzvuk9N3EHQS4oUXDIvEJoLtCENcPOikg1A0etnQdvGl5KrHs74nFyzIvUs +zKQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=l9hZd8vSpc0sEgpNKVqeufwyzTU0YesKGVE7fyTM6Ws=; b=MdwpKBu/LaZp2YCRWE5lbsc/mCOOZ9vwjkDOeie0xgYGIfrGADKufXIjqrrbWmOs1f 5Bgxojklfx7KMLtrEbOmO8Sc3JPK4bOayvDV/kOSblG4+65SfGV72Igyy7p5UsV01Rg9 0nurnLZFH8xP1D0/5jfMrnynbf8pmJgbYetYn2FsasWzxHGfc7PgbKjJCptfJPOJHRzu T3ddrU8jLetfpovrqeQiCxV/yIYe1RJceqrcn6MRTj4uZMPvqmfFFm0hkZQtHE8GWOwO Wosl5voynIgJTm2nK+TythHaJ7BFL3kVl3qGXS1g2G2FI/gV5a1hKG7FPghGmK/9wCRh ccYQ== X-Gm-Message-State: AO0yUKWm3/0axiy7YoGyoMH1/ex0guhXNgXT3aQbucsQ83+sNo2I13Qm B06LgzLLahca3pF3T5fM2K/WJXmBncOAQw== X-Google-Smtp-Source: AK7set9fAJu8J9ml9gEwntMue63qr8AYY9HG3dtlnIswBSvOn7q0hDzT5FM0RzkX7nl89agl/qLXuw== X-Received: by 2002:a05:6402:20a:b0:4ac:bde4:ff14 with SMTP id t10-20020a056402020a00b004acbde4ff14mr509509edv.42.1677524769406; Mon, 27 Feb 2023 11:06:09 -0800 (PST) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::8b3a]) by smtp.gmail.com with ESMTPSA id 13-20020a508e0d000000b004af6e957b22sm3520148edw.6.2023.02.27.11.06.08 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 27 Feb 2023 11:06:08 -0800 (PST) In-Reply-To: <86y1oj9byf.fsf@mail.linkov.net> (Juri Linkov's message of "Mon, 27 Feb 2023 20:53:44 +0200") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:256900 Archived-At: --=-=-= Content-Type: text/plain 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 :-) --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0002-New-user-option-grep-use-headings.patch Content-Transfer-Encoding: quoted-printable >From d141b5c31718bf312cd06cd85c2865621753ad7b 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 | 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 o= ption to the value (setopt gdb-locals-table-row-config `((type . 0) (name . 0) (value . ,gdb-locals-value-limit))) =20 +** 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 =20 --- 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")))) =20 +(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 ?: ?- ?=3D))) + (+ digit) + (any ?: ?- ?=3D)) + "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 ?=E2=80=A6) "[=E2=80=A6]" "[...]= ")) (map (make-sparse-keymap))) @@ -612,6 +639,40 @@ grep-filter (while (re-search-forward "\033\\[[0-9;]*[mK]" end 1) (replace-match "" t t)))))) =20 +(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-stat= e)))) + (save-excursion + (goto-char (pos-bol)) + (insert-before-markers (format grep--heading-format headin= g))) + (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)) =20 (defun grep--save-buffers () diff --git a/test/lisp/progmodes/grep-tests.el b/test/lisp/progmodes/grep-t= ests.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-se= mantics (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'ignore)) (grep-tests--check-rgrep-abbreviation)))) =20 +(ert-deftest grep-tests--grep-heading-regexp-without-null () + (dolist (sep '(?: ?- ?=3D)) + (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 '(?: ?- ?=3D)) + (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 --=20 2.39.2 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Introduce-compilation-annotation-text-property.patch >From 8660f5cc050ecf3789574cfc11544b5950b8e949 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel 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 --=-=-=--