From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#39121: bug#39122: 27.0.60; occur: Add bindings for next-error-no-select Date: Thu, 21 May 2020 23:05:15 +0200 Message-ID: <878shlov78.fsf@calancha-pc.dy.bbexcite.jp> References: <87a76rt70b.fsf@calancha-pc.dy.bbexcite.jp> <87d0bndk5b.fsf@mail.linkov.net> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="59407"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: 39121@debbugs.gnu.org, 39122@debbugs.gnu.org To: Juri Linkov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu May 21 23:06:21 2020 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 1jbsOS-000FJz-Nv for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 21 May 2020 23:06:20 +0200 Original-Received: from localhost ([::1]:54372 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jbsOR-0005Dz-Pc for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 21 May 2020 17:06:19 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:49902) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jbsOA-0004rV-D6 for bug-gnu-emacs@gnu.org; Thu, 21 May 2020 17:06:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:45870) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jbsOA-0004jo-3K for bug-gnu-emacs@gnu.org; Thu, 21 May 2020 17:06:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jbsO9-0007Di-TV for bug-gnu-emacs@gnu.org; Thu, 21 May 2020 17:06:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 21 May 2020 21:06:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 39121 X-GNU-PR-Package: emacs Original-Received: via spool by 39121-submit@debbugs.gnu.org id=B39121.159009514327729 (code B ref 39121); Thu, 21 May 2020 21:06:01 +0000 Original-Received: (at 39121) by debbugs.gnu.org; 21 May 2020 21:05:43 +0000 Original-Received: from localhost ([127.0.0.1]:57416 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jbsNp-0007D4-QZ for submit@debbugs.gnu.org; Thu, 21 May 2020 17:05:42 -0400 Original-Received: from mail-ed1-f49.google.com ([209.85.208.49]:43446) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jbsNg-0007Cc-0F; Thu, 21 May 2020 17:05:32 -0400 Original-Received: by mail-ed1-f49.google.com with SMTP id g9so7699653edw.10; Thu, 21 May 2020 14:05:31 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=Gh0In0Sw3/DFIHanx9EMO6T9hwLiLi7ZJlvMMAjaJOc=; b=HLoUNiQOfu1RD+ExrtKotUna+sEQAc9qYgGGHrIbZyR6+iyfhxu1eIQbbU5/Bmfotk KE2S+AiUZpCmgBlo3mIJ1hEz1Hf2jdeIsIrBHYf/UIXMajwqmo0MYOsbte/8dbOEkXxj jX88MWeXxOmaIPPBfjuN5gd+AVVxAg5xjqrkYStIqjRISw9J0ZRGi/WY1HpIOoavse1Q i8yW4LU8ptvyxl5JUmhemxouplqC9rG+6Kf/qaVOwlr0UKAA7fsMdpmJPmCnmagO7k0h B37NwPAqT4BjvuFH6vUErUTy6jxZo8sr9zdqcG5pekSH9qYQcz6CMGEXVUWbKkZO9jKJ 7YyA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=Gh0In0Sw3/DFIHanx9EMO6T9hwLiLi7ZJlvMMAjaJOc=; b=JF1xodbsdwswN3gR/F2RG0bLWdszvF6QY32mjmeBCrVS92S+rfgUbRMdKfqlu7KHVg 5pyv5dfBoJV7trIS0hzKcA3UJIX2jZ4Cacj2SY1ax8mmoOgskDwUsOJPkMaksAPWzM5C hQB8DpEths/EbS5pqY8Jxkj6Q7e0A+Jd1OPEPZ+OQwRvYZd11CM32CqXlj6jxNIhJYW7 tW+KF3mpESA+6YNoTQbHdkUVoITptd4tJEhZ1cRqisWFF4irJ4jwfU8I8mECsjQkEU66 4ZDkD/dpHG5LQpMElUOq5BWHcL+4uSw962LeulCerB6DhWnnavljquXI2Fw6IRJYSwXz nN4w== X-Gm-Message-State: AOAM532bpVBPZXhl5FRV3SpNIRjKr/2CNdrIA65F3LmucmuxY6QCYtCq DvqMjozCYusJ3eG1YLWdB58VpjOHkYA= X-Google-Smtp-Source: ABdhPJz56WPlM1t7Es9igJb0B4wt+Ogi24vacV75ZqwSBTxoUDSPPQeW0gGWkLGJYQf1GQjDH6obSA== X-Received: by 2002:aa7:d2d0:: with SMTP id k16mr548244edr.272.1590095125314; Thu, 21 May 2020 14:05:25 -0700 (PDT) Original-Received: from calancha-pc.dy.bbexcite.jp ([31.7.242.222]) by smtp.gmail.com with ESMTPSA id z23sm5837573ejx.72.2020.05.21.14.05.23 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 21 May 2020 14:05:24 -0700 (PDT) In-Reply-To: <87d0bndk5b.fsf@mail.linkov.net> (Juri Linkov's message of "Tue, 14 Jan 2020 01:14:08 +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" Xref: news.gmane.io gmane.emacs.bugs:180720 Archived-At: Juri Linkov writes: > merge 39121 39122 > thanks > >> I wish having `next-error-no-select', `previous-error-no-select' bound to `n' >> and `p' in the occur mode, as we have in *grep* buffer. > It's a good idea to make occur more consistent with grep/compile, thanks. Hi Juri, I have refined the patch so that we have visual feedback during the navigation (i.e. highligh) as `grep' does. --8<-----------------------------cut here---------------start------------->8--- commit 7d5917d0a2eda1782b9461951e40bfb837bc75ab Author: Tino Calancha Date: Thu May 21 22:36:00 2020 +0200 occur: Add bindings for next-error-no-select Make the navigation in the occur buffer closer to the navigation in the compilation buffer. Add bindings to navigate the occur matches (Bug#39121). Honor `next-error-highlight' and `next-error-highlight-no-select' when navigating the occurrences. * lisp/replace.el (occur-highlight-regexp, occur-highlight-overlay): New variables. (occur-1): Set `occur-highlight-regexp' to the searched regexp. (occur-goto-locus-delete-o, occur--highlight-occurrence): New defuns. (occur-mode-display-occurrence, occur-mode-goto-occurrence): Use `occur--highlight-occurrence'. (occur-mode-map): Bind n to `next-error-no-select' and p to `previous-error-no-select' * etc/NEWS (Changes in Sppecialized Modes and Packages in Emacs 28.1): Announce this change. * test/lisp/replace-tests.el (replace-tests-with-highlighted-occurrence): Add helper macro. (occur-highlight-occurrence): Add test. diff --git a/etc/NEWS b/etc/NEWS index 1bf1403cab..a273a06ef7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -101,6 +101,9 @@ horizontal movements now stop at the edge of the board. * Changes in Specialized Modes and Packages in Emacs 28.1 +** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and +'previous-error-no-select' bound to 'p'. + ** EIEIO: 'oset' and 'oset-default' are declared obsolete. ** New minor mode 'cl-font-lock-built-in-mode' for `lisp-mode'. diff --git a/lisp/replace.el b/lisp/replace.el index f3a71f87fe..69092c16f9 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -757,6 +757,13 @@ regexp-history Maximum length of the history list is determined by the value of `history-length', which see.") +(defvar occur-highlight-regexp t + "Regexp matching part of visited source lines to highlight temporarily. +Highlight entire line if t; don't highlight source lines if nil.") + +(defvar occur-highlight-overlay nil + "Overlay used to temporarily highlight occur matches.") + (defvar occur-collect-regexp-history '("\\1") "History of regexp for occur's collect operation") @@ -1113,6 +1120,8 @@ occur-mode-map (define-key map "\C-m" 'occur-mode-goto-occurrence) (define-key map "o" 'occur-mode-goto-occurrence-other-window) (define-key map "\C-o" 'occur-mode-display-occurrence) + (define-key map "n" 'next-error-no-select) + (define-key map "p" 'previous-error-no-select) (define-key map "\M-n" 'occur-next) (define-key map "\M-p" 'occur-prev) (define-key map "r" 'occur-rename-buffer) @@ -1261,9 +1270,12 @@ occur-mode-goto-occurrence (with-current-buffer (window-buffer (posn-window (event-end event))) (save-excursion (goto-char (posn-point (event-end event))) - (occur-mode-find-occurrence)))))) + (occur-mode-find-occurrence))))) + (regexp occur-highlight-regexp)) (pop-to-buffer (marker-buffer pos)) (goto-char pos) + (let ((end-mk (save-excursion (re-search-forward regexp nil t)))) + (occur--highlight-occurrence pos end-mk)) (when buffer (next-error-found buffer (current-buffer))) (run-hooks 'occur-mode-find-occurrence-hook))) @@ -1277,17 +1289,74 @@ occur-mode-goto-occurrence-other-window (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook))) +;; Stolen from compile.el +(defun occur-goto-locus-delete-o () + (delete-overlay occur-highlight-overlay) + ;; Get rid of timer and hook that would try to do this again. + (if (timerp next-error-highlight-timer) + (cancel-timer next-error-highlight-timer)) + (remove-hook 'pre-command-hook + #'occur-goto-locus-delete-o)) + +;; Highlight the current visited occurrence. +;; Adapted from `compilation-goto-locus'. +(defun occur--highlight-occurrence (mk end-mk) + (let ((highlight-regexp occur-highlight-regexp)) + (if (timerp next-error-highlight-timer) + (cancel-timer next-error-highlight-timer)) + (unless occur-highlight-overlay + (setq occur-highlight-overlay + (make-overlay (point-min) (point-min))) + (overlay-put occur-highlight-overlay 'face 'next-error)) + (with-current-buffer (marker-buffer mk) + (save-excursion + (if end-mk (goto-char end-mk) (end-of-line)) + (let ((end (point))) + (if mk (goto-char mk) (beginning-of-line)) + (if (and (stringp highlight-regexp) + (re-search-forward highlight-regexp end t)) + (progn + (goto-char (match-beginning 0)) + (move-overlay occur-highlight-overlay + (match-beginning 0) (match-end 0) + (current-buffer))) + (move-overlay occur-highlight-overlay + (point) end (current-buffer))) + (if (or (eq next-error-highlight t) + (numberp next-error-highlight)) + ;; We want highlighting: delete overlay on next input. + (add-hook 'pre-command-hook + #'occur-goto-locus-delete-o) + ;; We don't want highlighting: delete overlay now. + (delete-overlay occur-highlight-overlay)) + ;; We want highlighting for a limited time: + ;; set up a timer to delete it. + (when (numberp next-error-highlight) + (setq next-error-highlight-timer + (run-at-time next-error-highlight nil + 'occur-goto-locus-delete-o)))))) + (when (eq next-error-highlight 'fringe-arrow) + ;; We want a fringe arrow (instead of highlighting). + (setq next-error-overlay-arrow-position + (copy-marker (line-beginning-position)))))) + (defun occur-mode-display-occurrence () "Display in another window the occurrence the current line describes." (interactive) (let ((buffer (current-buffer)) (pos (occur-mode-find-occurrence)) + (regexp occur-highlight-regexp) + (next-error-highlight next-error-highlight-no-select) + (display-buffer-overriding-action + '(nil (inhibit-same-window . t))) window) (setq window (display-buffer (marker-buffer pos) t)) ;; This is the way to set point in the proper window. (save-selected-window (select-window window) (goto-char pos) + (let ((end-mk (save-excursion (re-search-forward regexp nil t)))) + (occur--highlight-occurrence pos end-mk)) (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook)))) @@ -1612,6 +1681,7 @@ occur-1 (buffer-undo-list t) (occur--final-pos nil)) (erase-buffer) + (set (make-local-variable 'occur-highlight-regexp) regexp) (let ((count (if (stringp nlines) ;; Treat nlines as a regexp to collect. diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index f5cff92d54..aed14c3357 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -546,4 +546,46 @@ replace-tests--query-replace-undo ?q (string= expected (buffer-string)))))) +(defmacro replace-tests-with-highlighted-occurrence (highlight-locus &rest body) + "Helper macro to test the highlight of matches when navigating occur buffer. + +Eval BODY with `next-error-highlight' and `next-error-highlight-no-select' +bound to HIGHLIGHT-LOCUS." + (declare (indent 1) (debug (form body))) + `(let ((regexp "foo") + (next-error-highlight ,highlight-locus) + (next-error-highlight-no-select ,highlight-locus) + (buffer (generate-new-buffer "test")) + (inhibit-message t)) + (unwind-protect + ;; Local bind to disable the deletion of `occur-highlight-overlay' + (cl-letf (((symbol-function 'occur-goto-locus-delete-o) (lambda ()))) + (with-current-buffer buffer (dotimes (_ 3) (insert regexp ?\n))) + (pop-to-buffer buffer) + (occur regexp) + (pop-to-buffer "*Occur*") + (occur-next) + ,@body) + (kill-buffer buffer) + (kill-buffer "*Occur*")))) + +(ert-deftest occur-highlight-occurrence () + "Test for https://debbugs.gnu.org/39121 ." + (let ((alist '((nil . nil) (0.5 . t) (t . t) (fringe-arrow . nil))) + (check-overlays + (lambda (has-ov) + (eq has-ov (not (null (overlays-in (point-min) (point-max)))))))) + (pcase-dolist (`(,highlight-locus . ,has-overlay) alist) + ;; Visiting occurrences + (replace-tests-with-highlighted-occurrence highlight-locus + (occur-mode-goto-occurrence) + (should (funcall check-overlays has-overlay))) + ;; Displaying occurrences + (replace-tests-with-highlighted-occurrence highlight-locus + (occur-mode-display-occurrence) + (with-current-buffer (marker-buffer + (get-text-property (point) 'occur-target)) + (should (funcall check-overlays has-overlay))))))) + + ;;; replace-tests.el ends here --8<-----------------------------cut here---------------end--------------->8--- In GNU Emacs 28.0.50 (build 12, x86_64-pc-linux-gnu, GTK+ Version 3.24.5, cairo version 1.16.0) of 2020-05-21 built on calancha-pc.dy.bbexcite.jp Repository revision: d714aa753b744c903d149a1f6c69262d958c313e Repository branch: master Windowing system distributor 'The X.Org Foundation', version 11.0.12004000 System Description: Debian GNU/Linux 10 (buster)