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: Fri, 09 Dec 2022 13:18:02 +0100 Message-ID: <87o7scdb45.fsf_-_@gmail.com> References: <87v8mndrla.fsf@gmail.com> <87ilime025.fsf@gmail.com> <86359pm55x.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="31343"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Lars Ingebrigtsen , Eli Zaretskii , Stefan Kangas , 59888@debbugs.gnu.org To: Juri Linkov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Dec 09 13:19:57 2022 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 1p3cM8-0007vl-Am for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 09 Dec 2022 13:19:56 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1p3cLI-0004N2-BP; Fri, 09 Dec 2022 07:19: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 1p3cLG-0004Mo-AR for bug-gnu-emacs@gnu.org; Fri, 09 Dec 2022 07:19: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 1p3cLG-00058L-18 for bug-gnu-emacs@gnu.org; Fri, 09 Dec 2022 07:19:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1p3cLF-00077B-Sl for bug-gnu-emacs@gnu.org; Fri, 09 Dec 2022 07:19:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Augusto Stoffel Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 09 Dec 2022 12:19:01 +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.167058829327096 (code B ref 59888); Fri, 09 Dec 2022 12:19:01 +0000 Original-Received: (at 59888) by debbugs.gnu.org; 9 Dec 2022 12:18:13 +0000 Original-Received: from localhost ([127.0.0.1]:35699 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1p3cKS-00072y-MG for submit@debbugs.gnu.org; Fri, 09 Dec 2022 07:18:13 -0500 Original-Received: from mail-ed1-f43.google.com ([209.85.208.43]:43713) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1p3cKR-00072s-5Y for 59888@debbugs.gnu.org; Fri, 09 Dec 2022 07:18:11 -0500 Original-Received: by mail-ed1-f43.google.com with SMTP id r26so2826021edc.10 for <59888@debbugs.gnu.org>; Fri, 09 Dec 2022 04:18:11 -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=wys6ypfiGBSSkiwBnVRf/QJhWbJHBqE3Rj5pkWBIrH4=; b=k7aE3HSsvmiYa3fMg3M4p9Z6XlBZD1eAs2niRU/vcF88Ch9jFWEZrG92AbN6CHEjSw ePSwG1tacPqBTAFq85x29hyf6VEC0cxjFDZRJQdyf5djK9l+ZrQUUzVg554QXT4cBx68 J+fp2LF3cvhpaSiT0aolF5D5shBPrKUxAuUv5AamzhgGSTBcVzCD7RmAY5KctBTPA2ts vEO53yAq5ONb2uak9ioCml6NAHlAQmZKDdNBl+K8zgjhlAuz/XErpe/wyg2n353bpCsz ZvZiHVs9HF8XrkoAAMh4gltPiC3JA+s0f+a1Ba3Jec0J0WpaekTChArDPXy6DVZes3Ij oGCw== 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=wys6ypfiGBSSkiwBnVRf/QJhWbJHBqE3Rj5pkWBIrH4=; b=TG/zuQOvUurhdZpOily2nfkzVhPOCrvmA817EXHnu2boM0bLmd8clSDRh8cuOH3zG2 74+ZVQBZW3QBdLByKegcDLJSnR+wH6N2Uu7zKjyIgarUFNi+02a1Yc6hdQQUOFxgEPRp RhGixJN287ggM3TMMOfC9t6FRHPjwgNMo1L2Ml6fSW33e6uXRA9K+g195I4/ltKRVNtq 0cDjQg4m9HNDEXI7w1fojpAYH5yel+K9W4LhRA6yOZhx9TIIq6M8+ro+hetcfvovmh9X E6VwZAqn5hLmKhgWUOjKY6RdxJVSN2e3jgwVEkfvqtOJWVCCejMlZytB/l9Ua4fh+5/x k7dw== X-Gm-Message-State: ANoB5pmocnko6p54K2WCV2K/KzPEa5Gluq785RKk4PUYxomY4/CODrJL PraIhORiTzJ9y5FnovHtQ9Q= X-Google-Smtp-Source: AA0mqf7c5PYtNvAf34h6u0hVRoZ/fk3uEqTSefCcEuOybAf/1xwFAAP0zdqtCCISNJ3zgzvSN31hBg== X-Received: by 2002:a05:6402:4486:b0:46d:53d7:d21e with SMTP id er6-20020a056402448600b0046d53d7d21emr5149630edb.27.1670588285192; Fri, 09 Dec 2022 04:18:05 -0800 (PST) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::a4bf]) by smtp.gmail.com with ESMTPSA id s25-20020aa7d799000000b0045b910b0542sm573558edq.15.2022.12.09.04.18.03 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 09 Dec 2022 04:18:03 -0800 (PST) In-Reply-To: <86359pm55x.fsf@mail.linkov.net> (Juri Linkov's message of "Fri, 09 Dec 2022 09:23:46 +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:250385 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Here is an updated patch for the =E2=80=9Cgrep headings=E2=80=9D feature. As discussed before, I introduced a text property so that one can tell without guessing which parts of the compilation buffer are not coming from the external process. This seems to supersede the 'compilation-header-end' property introduced by Lars in commit 07f748da43, so I replaced its uses by the new 'compilation-aside' property. I could easily revert that, but it seemed reasonable to uniformize things in this case. I've also incorporated all other suggestions from other messages. (And Juri, nevermind what I said about some faces, it only applies to the Modus theme.) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Introduce-compilation-aside-text-property.patch >From c593fc94f2289d4bdcb61835eaf11b0fe393a0f5 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-aside' text property It is meant to mark parts of compilation buffers which do not correspond to process output. * lisp/progmodes/compile.el (compilation-insert-aside): New function. (compilation-start, compilation-handle-exit): Use it. (compilation--ensure-parse) Rely on 'compilation-aside' 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 e8ada9388e..2d22501017 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1675,7 +1675,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-aside) ;; If we have no end marker, this will be ;; `point-min' still. (point))))) @@ -1823,6 +1823,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-aside (&rest args) + "Insert ARGS at point, adding the `compilation-aside' 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-aside t))) + ;;;###autoload (defun compilation-start (command &optional mode name-function highlight-regexp continue) @@ -1944,17 +1952,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-aside + "-*- mode: " name-of-mode + "; default-directory: " + (prin1-to-string (abbreviate-file-name default-directory)) + " -*-\n")) + (compilation-insert-aside + (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. @@ -2436,13 +2443,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-aside ?\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-aside " 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.38.1 --=-=-= 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 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 =20 +** 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 =20 --- 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: =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 using `grep-heading-mode'." + :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-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-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 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-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.38.1 --=-=-=--