bug#13594: 24.2.92; [PATCH] compilation-start doesn't consider nil OUTWIN

[Leo Liu <sdl.web@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 807 bytes --]

Hi Stefan,

On 2013-01-31 23:14 +0800, Stefan Monnier wrote:
> So maybe the best approach is to extend compile.el such that it can be
> told to do its job without displaying the compilation buffer.  If you do
> that, try to take into account that this usage pattern could be useful
> in other contexts than ggtags.el, for example users might prefer to not
> see the compilation buffer and just be moved to the first error
> automatically, and have C-x ` output the error message in the echo area
> (maybe, accompanied by the number of errors left).

The attached two patches (against emacs-24) implement:

1. A new variable compilation-dont-display-buffer to prevent calling
   display-buffer.

2. Display a message when calling compilation-next-error like this:
   Error: 2/623

Thanks for comments.

Leo


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-variable-compilation-dont-display-buffer.patch --]
[-- Type: text/x-patch, Size: 4665 bytes --]

From 021d45a602ef63bfd14a98a6d622cc107f75e2e7 Mon Sep 17 00:00:00 2001
From: Leo Liu <sdl.web@gmail.com>
Date: Tue, 5 Feb 2013 15:05:18 +0800
Subject: [PATCH 1/2] New variable compilation-dont-display-buffer

---
 lisp/progmodes/compile.el | 34 +++++++++++++++++++++++-----------
 1 file changed, 23 insertions(+), 11 deletions(-)

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index f383e02b..8b5e3a81 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -58,6 +58,12 @@ (defcustom compilation-start-hook nil
   :group 'compilation)
 
 ;;;###autoload
+(defcustom compilation-dont-display-buffer nil
+  "Non-nil to inhibit display the compilation buffer."
+  :type 'boolean
+  :group 'compilation)
+
+;;;###autoload
 (defcustom compilation-window-height nil
   "Number of lines in a compilation window.  If nil, use Emacs default."
   :type '(choice (const :tag "Default" nil)
@@ -1616,7 +1622,8 @@ (defun compilation-start (command &optional mode name-function highlight-regexp)
       (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))
+    (unless (buffer-local-value 'compilation-dont-display-buffer outbuf)
+      (setq outwin (display-buffer outbuf)))
     (with-current-buffer outbuf
       (let ((process-environment
 	     (append
@@ -1638,7 +1645,7 @@ (defun compilation-start (command &optional mode name-function highlight-regexp)
 	     (list command mode name-function highlight-regexp))
 	(set (make-local-variable 'revert-buffer-function)
 	     'compilation-revert-buffer)
-	(set-window-start outwin (point-min))
+	(and outwin (set-window-start outwin (point-min)))
 
 	;; Position point as the user will see it.
 	(let ((desired-visible-point
@@ -1647,15 +1654,16 @@ (defun compilation-start (command &optional mode name-function highlight-regexp)
 		   (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)))
+	  (when outwin
+	    (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)
+	(and outwin (compilation-set-window-height outwin))
 	;; Start the compilation.
 	(if (fboundp 'start-process)
 	    (let ((proc
@@ -1977,6 +1985,7 @@ (defmacro define-compilation-mode (mode name doc &rest body)
 		   compilation-scroll-output
 		   compilation-search-path
 		   compilation-skip-threshold
+		   compilation-dont-display-buffer
 		   compilation-window-height))
        ,@body)))
 
@@ -2487,14 +2496,16 @@ (defun compilation-goto-locus (msg mk end-mk)
                 ;; 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))))
+	      (unless compilation-dont-display-buffer
+		(display-buffer (marker-buffer msg)))))
 	 (highlight-regexp (with-current-buffer (marker-buffer msg)
 			     ;; also do this while we change buffer
-			     (compilation-set-window w 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.
-    (unless pre-existing (compilation-set-window-height w))
+    (unless pre-existing
+      (and w (compilation-set-window-height w)))
 
     (if from-compilation-buffer
         ;; If the compilation buffer window was selected,
@@ -2606,8 +2617,9 @@ (defun compilation-find-file (marker filename directory &rest formats)
       ;; The file doesn't exist.  Ask the user where to find it.
       (save-excursion            ;This save-excursion is probably not right.
         (let ((pop-up-windows t))
-          (compilation-set-window (display-buffer (marker-buffer marker))
-                                  marker)
+          (unless compilation-dont-display-buffer
+	    (compilation-set-window (display-buffer (marker-buffer marker))
+				    marker))
           (let* ((name (read-file-name
                         (format "Find this %s in (default %s): "
                                 compilation-error filename)
-- 
1.8.1.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Display-current-error-rank-total.patch --]
[-- Type: text/x-patch, Size: 2641 bytes --]

From 014240765570257fd5c8499d78d1eae8149df756 Mon Sep 17 00:00:00 2001
From: Leo Liu <sdl.web@gmail.com>
Date: Tue, 5 Feb 2013 18:48:28 +0800
Subject: [PATCH 2/2] Display current error rank/total

---
 lisp/progmodes/compile.el | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 8b5e3a81..0c3265ce 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -136,7 +136,7 @@ (defvar compilation-error "error"
 (defvar compilation-arguments nil
   "Arguments that were given to `compilation-start'.")
 
-(defvar compilation-num-errors-found)
+(defvar compilation-num-errors-found 0)
 
 ;; If you make any changes to `compilation-error-regexp-alist-alist',
 ;; be sure to run the ERT test in test/automated/compile-tests.el.
@@ -895,9 +895,9 @@ (cl-defstruct (compilation--message
             (:constructor nil)
             (:copier nil)
             ;; (:type list)                ;Old representation.
-            (:constructor compilation--make-message (loc type end-loc))
+            (:constructor compilation--make-message (loc type end-loc &optional rank))
             (:conc-name compilation--message->))
-  loc type end-loc)
+  loc type end-loc rank)
 
 (defvar compilation--previous-directory-cache nil
   "A pair (POS . RES) caching the result of previous directory search.
@@ -1181,8 +1181,11 @@ (defun compilation-internal-error-properties (file line end-line col end-col typ
                                               end-marker))))
 
     ;; Must start with face
+    (setq-local compilation-num-errors-found
+		(1+ compilation-num-errors-found))
     `(font-lock-face ,compilation-message-face
-      compilation-message ,(compilation--make-message loc type end-loc)
+      compilation-message ,(compilation--make-message
+			    loc type end-loc compilation-num-errors-found)
       help-echo ,(if col
                      "mouse-2: visit this file, line and column"
                    (if line
@@ -2281,8 +2284,12 @@ (defun compilation-next-error (n &optional different-file pt)
 	(compilation-loop < previous-single-property-change 1+
 			  "Moved back before first %s" (point-min))))
     (goto-char pt)
-    (or msg
-	(error "No %s here" compilation-error))))
+    (when msg
+      (message "%s: %s of %s"
+	       (capitalize compilation-error)
+	       (compilation--message->rank msg)
+	       compilation-num-errors-found))
+    (or msg (error "No %s here" compilation-error))))
 
 (defun compilation-previous-error (n)
   "Move point to the previous error in the compilation buffer.
-- 
1.8.1.1