3

I don't like the behavior of compilation-goto-locus (bound to Enter in a *compilation* or *grep* buffer), where it splits the window and jumps to the line in a new window. I prefer the *compilation*/*grep* buffer to be entirely replaced. I've accomplished this by copy-pasting the whole definition of compilation-goto-locus into my init.el from compile.el, and commenting out the behavior I don't like. It looks like this

(require 'compile) (defun compilation-goto-locus (msg mk end-mk) "Jump to an error corresponding to MSG at MK. All arguments are markers. If END-MK is non-nil, mark is set there and overlay is highlighted between MK and END-MK." ;; Show compilation buffer in other window, scrolled to this error. (let* ((from-compilation-buffer (eq (window-buffer) (marker-buffer msg))) ;; Use an existing window if it is in a visible frame. (pre-existing (get-buffer-window (marker-buffer msg) 0)) (w (if (and from-compilation-buffer pre-existing) ;; Calling display-buffer here may end up (partly) hiding ;; the error location if the two buffers are in two ;; different frames. So don't do it if it's not necessary. pre-existing (display-buffer (marker-buffer msg) '(nil (allow-no-window . t))))) (highlight-regexp (with-current-buffer (marker-buffer msg) ;; also do this while we change buffer (goto-char (marker-position msg)) (and w (compilation-set-window w msg)) compilation-highlight-regexp))) ;; Ideally, the window-size should be passed to `display-buffer' ;; so it's only used when creating a new window. (when (and (not pre-existing) w) (compilation-set-window-height w)) ;; I commented out this code ;; (if from-compilation-buffer ;; ;; If the compilation buffer window was selected, ;; ;; keep the compilation buffer in this window; ;; ;; display the source in another window. ;; (let ((pop-up-windows t)) ;; (pop-to-buffer (marker-buffer mk) 'other-window)) ;; (switch-to-buffer (marker-buffer mk))) ;; and replaced it with this line (switch-to-buffer (marker-buffer mk)) (unless (eq (goto-char mk) (point)) ;; If narrowing gets in the way of going to the right place, widen. (widen) (if next-error-move-function (funcall next-error-move-function msg mk) (goto-char mk))) (if end-mk (push-mark end-mk t) (if mark-active (setq mark-active))) ;; If hideshow got in the way of ;; seeing the right place, open permanently. (dolist (ov (overlays-at (point))) (when (eq 'hs (overlay-get ov 'invisible)) (delete-overlay ov) (goto-char mk))) (when highlight-regexp (if (timerp next-error-highlight-timer) (cancel-timer next-error-highlight-timer)) (unless compilation-highlight-overlay (setq compilation-highlight-overlay (make-overlay (point-min) (point-min))) (overlay-put compilation-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 compilation-highlight-overlay (match-beginning 0) (match-end 0) (current-buffer))) (move-overlay compilation-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 'compilation-goto-locus-delete-o) ;; We don't want highlighting: delete overlay now. (delete-overlay compilation-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 'compilation-goto-locus-delete-o))))))) (when (and (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))))))

my question is: is there a better way to accomplish this? It seems tricky, because the behavior is controlled by the pop-up-windows variable, which the commented out code is explicitly resetting.

Improve this question
1
  • Maybe let-bind display-buffer-overriding-action? Commented Jul 12, 2016 at 20:21

2 Answers 2

Reset to default
5

You could use display-buffer-alist and dispatch on the executed command, like this.

(defvar display-buffer-same-window-commands '(occur-mode-goto-occurrence compile-goto-error)) (add-to-list 'display-buffer-alist '((lambda (&rest _) (memq this-command display-buffer-same-window-commands)) (display-buffer-reuse-window display-buffer-same-window) (inhibit-same-window . nil)))
Improve this answer
0

I've developed some machinery using temporary advice that should accomplish what you want. Notice that if you replace pop-to-buffer in the code you commented out with pop-to-buffer-same-window, everything should work like you want it to.

I think this should do what you want, but be aware that I've done only the most cursory testing.

(defun my/compilation-goto-locus (msg mk end-mk) "As `compilation-goto-locus', but open in same window." (my/with-advice ((:once #'pop-to-buffer :override (lambda (buffer &optional action norecord) (pop-to-buffer-same-window buffer norecord)))) (compilation-goto-locus msg mk end-mk)))

This is the macro doing the heavy lifting:

(require 'cl-lib) ; For `cl-destructuring-bind', `cl-gensym' (defmacro my/with-advice (adlist &rest body) "Execute BODY with temporary advice in ADLIST. Each element of ADLIST should be a list of the form ([OPTION] SYMBOL WHERE FUNCTION [PROPS]). Here SYMBOL, WHERE, FUNCTION, and PROPS are as in `advice-add', and OPTION is a keyword modifying how the advice should be handled. At present, the following keywords are recognized, with the specified effects: :once This keyword indicates that the advice should be applied using `my/advice-once' so that it is executed at most once. The BODY is wrapped in an `unwind-protect' form, so the advice will be removed even in the event of an error or nonlocal exit." (declare (debug ((&rest (&rest form)) body)) (indent 1)) (let ((removal-list nil)) `(progn ,@(mapcar (lambda (adform) (let ((option (if (keywordp (car adform)) (pop adform) nil))) (cl-destructuring-bind (symbol where function &optional props) adform (cond ((null option) (push `(advice-remove ,symbol ,function) removal-list) (cons 'advice-add adform)) ((eq option :once) (push `(advice-remove ,symbol ,function) removal-list) (cons 'my/advice-once adform)))))) adlist) (unwind-protect (progn ,@body) ,@removal-list)))) (defun my/advice-once (symbol where function &optional props) "As `advice-add', but remove advice after first call. This can be useful to avoid infinite recursion, in the event that FUNCTION calls the function named by SYMBOL directly." (let* ((id (cl-gensym "my/advice-once:cleanup-")) (cleanup (lambda (&rest args) (advice-remove symbol function) (advice-remove symbol id)))) (advice-add symbol where function props) (advice-add symbol :before cleanup `((name . ,id)))))

Notice that we need to use the :once keyword here because pop-to-buffer-same-window calls pop-to-buffer, and if we don't replace only the first pop-to-buffer call, we go into infinite recursion.

Improve this answer

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.