mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

occur: Add bindings for next-error-no-select

Browse source 
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 Specialized 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.
This commit is contained in:
Tino Calancha 2020-05-31 12:31:27 +02:00
parent 780f674a82
commit abe7c22da9
3 changed files with 116 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

3
etc/NEWS
View file

@ -109,6 +109,9 @@ setting the variable 'auto-save-visited-mode' buffer-locally to nil.
* 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'.

72
lisp/replace.el
View file

@ -757,6 +757,13 @@ which will run faster and will not set the mark or print anything."
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 @@ a previously found match."
(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 @@ If not invoked by a mouse click, go to occurrence on the current line."
(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 @@ If not invoked by a mouse click, go to occurrence on the current line."
(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 @@ See also `multi-occur'."
(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.

42
test/lisp/replace-tests.el
View file

@ -546,4 +546,46 @@ Return the last evalled form in BODY."
?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