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: Sat, 25 Feb 2023 09:34:56 +0100 Message-ID: <871qme5ej3.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> 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="11174"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Eli Zaretskii , stefankangas@gmail.com, 59888@debbugs.gnu.org To: Juri Linkov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Feb 25 09:36:25 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 1pVq2a-0002i7-Ja for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 25 Feb 2023 09:36:24 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pVq2H-000436-77; Sat, 25 Feb 2023 03:36:05 -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 1pVq2E-00042e-LN for bug-gnu-emacs@gnu.org; Sat, 25 Feb 2023 03:36:02 -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 1pVq2E-0003kJ-Cc for bug-gnu-emacs@gnu.org; Sat, 25 Feb 2023 03:36:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pVq2E-0004vC-72 for bug-gnu-emacs@gnu.org; Sat, 25 Feb 2023 03:36: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: Sat, 25 Feb 2023 08:36: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.167731410918847 (code B ref 59888); Sat, 25 Feb 2023 08:36:02 +0000 Original-Received: (at 59888) by debbugs.gnu.org; 25 Feb 2023 08:35:09 +0000 Original-Received: from localhost ([127.0.0.1]:38972 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pVq1M-0004tt-9M for submit@debbugs.gnu.org; Sat, 25 Feb 2023 03:35:08 -0500 Original-Received: from mail-ed1-f44.google.com ([209.85.208.44]:36514) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pVq1J-0004tH-VK for 59888@debbugs.gnu.org; Sat, 25 Feb 2023 03:35:06 -0500 Original-Received: by mail-ed1-f44.google.com with SMTP id da10so6420684edb.3 for <59888@debbugs.gnu.org>; Sat, 25 Feb 2023 00:35:05 -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=/sELHticWUnm3yn7/k7vFYFdVLR7r3ra3zdbIVM1J20=; b=nv1R05al45agmeXfZAsmLaRoPjG6buprWk7qF8zyPL76Y/S61ySyFjhF5obdXFudvl v5Bw8nI6RxysXtrFVvbUFVNS5aGEfDgobpqFDQHW59W8hbGWVdzBj6lYGAv42m9nhfRV MnqIBgw2mxyLf8xREf7QiodJi3ilqmqcPLA4SeVVLyAP/DXOpgyWcBkndW7VnOlcJ7DJ vMire6DgSgKyy+4L+l09Dx2+L+fkhmCxGaNSbUQk3V9KQ/UL1j1PFjIalaG9NZYMqfuG gYIO+NUs8WwH3Y2Epf5V6E8kL9WNvmS4GXQ03fRfIyrpafmfdgBEAsp3scXx/ienNB1D 1UMQ== 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=/sELHticWUnm3yn7/k7vFYFdVLR7r3ra3zdbIVM1J20=; b=Kp8g71dQ+jm5wE6a5VVIYtaUcZKY4pHafP8w8NUEeY4mm85zasovmpXxQ658ACobHl p1hfHiU9m0/WqCd4jvXpRF8FnbOU8/RHrfu3B/YdcoqeurAUG0YSe/SoTgwlOmgwDpg+ Nom/qgkT1Qv/sBKZHCgUa71Yw3Qpejbtc+p+xm+ljb52RnrGA9uTQQDA4R8J2GHdx3sv KhePmezakJAmkns5i8qtbKYVrzs7XEMmtY0kG/8GOH3iArw4LSaX51Jvz12IqLvy3Q6d oFvakuF0+76zBWlBklP4ismvQXe8jroAHnoafGzyPTpEe7wzPzfOImwLgS3p33rfJD1a hXcA== X-Gm-Message-State: AO0yUKWcqLeI49J0/8rUO/DDXmaOAfuWiL1STQsl/rbUBJopsfPkTT4M XD5MV1dqyOdLlPHr5s2n5dag9hoX+zVqJA== X-Google-Smtp-Source: AK7set+x3i0tlvxP6bK0jsjDCV/2Qg0oS8i5/UsWZ/N+XyvoECrfsID4goO8WYEo+BGVYPXG0Z/h5Q== X-Received: by 2002:a17:906:b84c:b0:878:7c18:8fd9 with SMTP id ga12-20020a170906b84c00b008787c188fd9mr25852839ejb.44.1677314099056; Sat, 25 Feb 2023 00:34:59 -0800 (PST) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::6fd0]) by smtp.gmail.com with ESMTPSA id rl5-20020a170907216500b008b175c46867sm596569ejb.116.2023.02.25.00.34.57 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 25 Feb 2023 00:34:57 -0800 (PST) In-Reply-To: <867cytgk0k.fsf@mail.linkov.net> (Juri Linkov's message of "Thu, 15 Dec 2022 10:05:39 +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:256701 Archived-At: --=-=-= Content-Type: text/plain I've been using the grep-use-headings locally for a long time and it works well. Should the the patches be installed? --=-=-= 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 77ea46f6dc50a8f463bd2f51ce9d0585de0bb55c 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 4b0e4e6bd46..ca2e8011510 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -95,6 +95,14 @@ 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'. + ** VC =20 --- diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 0da16b44dda..9e3cec89c01 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -30,6 +30,7 @@ ;;; Code: =20 (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'rx)) (require 'compile) =20 (defgroup grep nil @@ -457,6 +458,35 @@ 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") + +(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 ?: ?- ?=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)." + :type 'regexp + :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-find-abbreviate-properties (let ((ellipsis (if (char-displayable-p ?=E2=80=A6) "[=E2=80=A6]" "[...]= ")) (map (make-sparse-keymap))) @@ -612,6 +642,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 + (forward-line 0) + (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 +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)) =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 6d97ae3b43fe893f2ec7dab67c14f06e1eb9a3fb 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 --=-=-=--