Display compilation buffer only if compilation failed

Display compilation buffer only if compilation failed

[Aurélien Aptel]

Hi all,

I want Emacs to display the compilation buffer only if the compilation failed.
Here's what I have so far:

(defun my-compile-success-p (buffer)
  (with-current-buffer buffer
    (save-excursion
      (goto-char (point-max))
      (previous-line)
      (beginning-of-line)
      (when (search-forward "Compilation finished" nil t)
        t))))

(defun my-recompile-switch-if-error ()
  (interactive)
  (let ((buf (save-window-excursion ; prevent display-buffer
               (recompile)))) ; returns compilation buffer
    (when (not (my-compile-success-p buf))
      (display-buffer buf))))


But it doesn't work...
I have a file named obfu.c which compiles successfully when I run M-x
recompile.

(my-compile-success-p "*compilation*")
=> t

If I insert garbage in obfu.c, save, and recompile:

(my-compile-success-p "*compilation*")
=> nil

So my-compile-success-p seems to work.

Now if I switch back to a successful compilation:

(buffer-name (with-current-buffer "obfu.c" (recompile)))
=> "*compilation*"

(my-compile-success-p "*compilation*")
=> t

(my-compile-success-p (buffer-name
                       (with-current-buffer "obfu.c"
                         (recompile))))
=> nil

wtf?

RE: Display compilation buffer only if compilation failed

[Drew Adams]

> (defun my-recompile-switch-if-error ()
>   (interactive)
>   (let ((buf (save-window-excursion ; prevent display-buffer
>                (recompile)))) ; returns compilation buffer

After displaying it, AFAICT.

>     (when (not (my-compile-success-p buf))
>       (display-buffer buf))))
> 
> But it doesn't work...

AFAICT, `recompile' invokes `compilation-start', which calls `display-buffer' on
the output buffer.

The doc string of `compilation-start' does not explicitly say that it displays
the buffer.  It probably should.  The first line should probably state that it
runs compilation command COMMAND _and displays the output_.  Some subsequent
doc-string line can bother to mention "(low-level interface)", if that is really
helpful/important.

Consider reporting a doc bug: `M-x report-emacs-bug'.

Re: Display compilation buffer only if compilation failed

[Aurélien Aptel]

On Sat, Feb 11, 2012 at 6:29 PM, Drew Adams <drew.adams@oracle.com> wrote:
>> But it doesn't work...
>
> AFAICT, `recompile' invokes `compilation-start', which calls `display-buffer' on
> the output buffer.

save-window-excursion prevents the display-buffer call. It does work.
The real problem is after.

Consider this:

(with-current-buffer "obfu.c"
  (let ((buf "*compilation*"))
    (print buf)
    (my-compile-success-p buf)))

"*compilation*"
=> t

(with-current-buffer "obfu.c"
  (let ((buf (buffer-name (recompile))))
    (print buf)
    (my-compile-success-p buf)))

"*compilation*"
=> nil

In both case buf has the same value (both code prints "*compilation*")
but when passed to my-compile-success-p, the return value is
different.

Re: Display compilation buffer only if compilation failed

[Aurélien Aptel]

I think I understand now.

(with-current-buffer "obfu.c"
  (let ((buf (buffer-name (recompile))))
    (sit-for 1)
    (my-compile-success-p "*compilation*")))
=> t

The call to recompile is asynchronous. I have to wait until the end of
the compilation before checking the content of the buffer.

How can I do this?

RE: Display compilation buffer only if compilation failed

[Drew Adams]

> The call to recompile is asynchronous. I have to wait until the end of
> the compilation before checking the content of the buffer.
> 
> How can I do this?

Maybe `compilation-handle-exit'?
Dunno.  I just glanced at the code.

Re: Display compilation buffer only if compilation failed

[Aurélien Aptel]

Ok, here's what I have so far.

I've added a hook to compilation-finish-function to display the buffer
and redefined compilation-start which is kind of ugly...
I've basically copy-pasted compilation-start and removed the
display-buffer call and everything dealing with the new window.

; called at end of compilation
(defun my-compile-switch (buf s)
  (when (not (string= s "finished\n"))
    (display-buffer buf)))

(add-to-list 'compilation-finish-functions 'my-compile-switch)

; kill current process yes-or-no-p => t (always kill process)
; commented display-buffer call & sexp using outwin var
(defun compilation-start (command &optional mode name-function highlight-regexp)
  "Run compilation command COMMAND (low level interface).
If COMMAND starts with a cd command, that becomes the `default-directory'.
The rest of the arguments are optional; for them, nil means use the default.

MODE is the major mode to set in the compilation buffer.  Mode
may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.

If NAME-FUNCTION is non-nil, call it with one argument (the mode name)
to determine the buffer name.  Otherwise, the default is to
reuses the current buffer if it has the proper major mode,
else use or create a buffer with name based on the major mode.

If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
the matching section of the visited source line; the default is to use the
global value of `compilation-highlight-regexp'.

Returns the compilation buffer created."
  (or mode (setq mode 'compilation-mode))
  (let* ((name-of-mode
	  (if (eq mode t)
	      "compilation"
	    (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
	 (thisdir default-directory)
	 outwin outbuf)
    (with-current-buffer
	(setq outbuf
	      (get-buffer-create
               (compilation-buffer-name name-of-mode mode name-function)))
      (let ((comp-proc (get-buffer-process (current-buffer))))
	(if comp-proc
	    (if (or (not (eq (process-status comp-proc) 'run))
		    t)
		(condition-case ()
		    (progn
		      (interrupt-process comp-proc)
		      (sit-for 1)
		      (delete-process comp-proc))
		  (error nil))
	      (error "Cannot have two processes in `%s' at once"
		     (buffer-name)))))
      ;; first transfer directory from where M-x compile was called
      (setq default-directory thisdir)
      ;; Make compilation buffer read-only.  The filter can still write it.
      ;; Clear out the compilation buffer.
      (let ((inhibit-read-only t)
	    (default-directory thisdir))
	;; Then evaluate a cd command if any, but don't perform it yet, else
	;; start-command would do it again through the shell: (cd "..") AND
	;; sh -c "cd ..; make"
	(cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
		(if (match-end 1)
		    (substitute-env-vars (match-string 1 command))
		  "~")
	      default-directory))
	(erase-buffer)
	;; Select the desired mode.
	(if (not (eq mode t))
            (progn
              (buffer-disable-undo)
              (funcall mode))
	  (setq buffer-read-only nil)
	  (with-no-warnings (comint-mode))
	  (compilation-shell-minor-mode))
        ;; Remember the original dir, so we can use it when we recompile.
        ;; default-directory' can't be used reliably for that because it may be
        ;; affected by the special handling of "cd ...;".
        ;; NB: must be fone after (funcall mode) as that resets local variables
        (set (make-local-variable 'compilation-directory) thisdir)
	(if highlight-regexp
	    (set (make-local-variable 'compilation-highlight-regexp)
		 highlight-regexp))
        (if (or compilation-auto-jump-to-first-error
		(eq compilation-scroll-output 'first-error))
            (set (make-local-variable 'compilation-auto-jump-to-next) t))
	;; Output a mode setter, for saving and later reloading this buffer.
	(insert "-*- mode: " name-of-mode
		"; default-directory: " (prin1-to-string default-directory)
		" -*-\n"
		(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.
    ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
 ;   (setq outwin (display-buffer outbuf))
    (with-current-buffer outbuf
      (let ((process-environment
	     (append
	      compilation-environment
	      (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
		      system-uses-terminfo)
		  (list "TERM=dumb" "TERMCAP="
			(format "COLUMNS=%d" (window-width)))
		(list "TERM=emacs"
		      (format "TERMCAP=emacs:co#%d:tc=unknown:"
			      (window-width))))
	      ;; Set the EMACS variable, but
	      ;; don't override users' setting of $EMACS.
	      (unless (getenv "EMACS")
		(list "EMACS=t"))
	      (list "INSIDE_EMACS=t")
	      (copy-sequence process-environment))))
	(set (make-local-variable 'compilation-arguments)
	     (list command mode name-function highlight-regexp))
	(set (make-local-variable 'revert-buffer-function)
	     'compilation-revert-buffer)
;	(set-window-start outwin (point-min))

	;; Position point as the user will see it.
	(let ((desired-visible-point
	       ;; Put it at the end if `compilation-scroll-output' is set.
	       (if compilation-scroll-output
		   (point-max)
		 ;; Normally put it at the top.
		 (point-min))))
;	  (if (eq outwin (selected-window))
;	      (goto-char desired-visible-point)
;	    (set-window-point outwin desired-visible-point))
)

	;; The setup function is called before compilation-set-window-height
	;; so it can set the compilation-window-height buffer locally.
	(if compilation-process-setup-function
	    (funcall compilation-process-setup-function))
;	(compilation-set-window-height outwin)
	;; Start the compilation.
	(if (fboundp 'start-process)
	    (let ((proc
		   (if (eq mode t)
		       ;; comint uses `start-file-process'.
		       (get-buffer-process
			(with-no-warnings
			  (comint-exec
			   outbuf (downcase mode-name)
			   (if (file-remote-p default-directory)
			       "/bin/sh"
			     shell-file-name)
			   nil `("-c" ,command))))
		     (start-file-process-shell-command (downcase mode-name)
						       outbuf command))))
	      ;; Make the buffer's mode line show process state.
	      (setq mode-line-process
		    (list (propertize ":%s" 'face 'compilation-warning)))
	      (set-process-sentinel proc 'compilation-sentinel)
	      (unless (eq mode t)
		;; Keep the comint filter, since it's needed for proper handling
		;; of the prompts.
		(set-process-filter proc 'compilation-filter))
	      ;; Use (point-max) here so that output comes in
	      ;; after the initial text,
	      ;; regardless of where the user sees point.
	      (set-marker (process-mark proc) (point-max) outbuf)
	      (when compilation-disable-input
		(condition-case nil
		    (process-send-eof proc)
		  ;; The process may have exited already.
		  (error nil)))
	      (run-hook-with-args 'compilation-start-hook proc)
              (setq compilation-in-progress
		    (cons proc compilation-in-progress)))
	  ;; No asynchronous processes available.
	  (message "Executing `%s'..." command)
	  ;; Fake modeline display as if `start-process' were run.
	  (setq mode-line-process
		(list (propertize ":run" 'face 'compilation-warning)))
	  (force-mode-line-update)
	  (sit-for 0)			; Force redisplay
	  (save-excursion
	    ;; Insert the output at the end, after the initial text,
	    ;; regardless of where the user sees point.
	    (goto-char (point-max))
	    (let* ((buffer-read-only nil) ; call-process needs to modify outbuf
		   (status (call-process shell-file-name nil outbuf nil "-c"
					 command)))
	      (cond ((numberp status)
		     (compilation-handle-exit
		      'exit status
		      (if (zerop status)
			  "finished\n"
			(format "exited abnormally with code %d\n" status))))
		    ((stringp status)
		     (compilation-handle-exit 'signal status
					      (concat status "\n")))
		    (t
		     (compilation-handle-exit 'bizarre status status)))))
	  ;; Without async subprocesses, the buffer is not yet
	  ;; fontified, so fontify it now.
	  (let ((font-lock-verbose nil)) ; shut up font-lock messages
	    (font-lock-fontify-buffer))
	  (set-buffer-modified-p nil)
	  (message "Executing `%s'...done" command)))
      ;; Now finally cd to where the shell started make/grep/...
      (setq default-directory thisdir)
      ;; The following form selected outwin ever since revision 1.183,
      ;; so possibly messing up point in some other window (bug#1073).
      ;; Moved into the scope of with-current-buffer, though still with
      ;; complete disregard for the case when compilation-scroll-output
      ;; equals 'first-error (martin 2008-10-04).
      (when compilation-scroll-output
	(goto-char (point-max))))

    ;; Make it so the next C-x ` will use this buffer.
    (setq next-error-last-buffer outbuf)))