Merge from emacs--rel--22
[bpt/emacs.git] / lisp / progmodes / compile.el
index 13e4e40..ceb9a7b 100644 (file)
 ;; LINE will be nil for a message that doesn't contain them.  Then the
 ;; location refers to a indented beginning of line or beginning of file.
 ;; Once any location in some file has been jumped to, the list is extended to
-;; (COLUMN LINE FILE-STRUCTURE MARKER . VISITED) for all LOCs pertaining to
-;; that file.
+;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED)
+;; for all LOCs pertaining to that file.
 ;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
 ;; Being a marker it sticks to some text, when the buffer grows or shrinks
 ;; before that point.  VISITED is t if we have jumped there, else nil.
+;; TIMESTAMP is necessary because of "incremental compilation": `omake -P'
+;; polls filesystem for changes and recompiles when a file is modified
+;; using the same *compilation* buffer. this necessitates re-parsing markers.
 
 ;;   FILE-STRUCTURE is a list of
 ;;   ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) ...)
 
 ;;;###autoload
 (defcustom compilation-mode-hook nil
-  "*List of hook functions run by `compilation-mode' (see `run-mode-hooks')."
+  "List of hook functions run by `compilation-mode' (see `run-mode-hooks')."
   :type 'hook
   :group 'compilation)
 
 ;;;###autoload
 (defcustom compilation-window-height nil
-  "*Number of lines in a compilation window.  If nil, use Emacs default."
+  "Number of lines in a compilation window.  If nil, use Emacs default."
   :type '(choice (const :tag "Default" nil)
                 integer)
   :group 'compilation)
@@ -164,6 +167,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\
 \\( warning\\)?" 1 2 3 (4))
 
+    (maven
+     ;; Maven is a popular build tool for Java.  Maven is Free Software.
+     "\\(.*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\]" 1 2 3)
+    
     (bash
      "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
 
@@ -439,7 +446,7 @@ Highlight entire line if t; don't highlight source lines if nil.")
   "Overlay used to temporarily highlight compilation matches.")
 
 (defcustom compilation-error-screen-columns t
-  "*If non-nil, column numbers in error messages are screen columns.
+  "If non-nil, column numbers in error messages are screen columns.
 Otherwise they are interpreted as character positions, with
 each character occupying one column.
 The default is to use screen columns, which requires that the compilation
@@ -450,21 +457,21 @@ especially the TAB character."
   :version "20.4")
 
 (defcustom compilation-read-command t
-  "*Non-nil means \\[compile] reads the compilation command to use.
+  "Non-nil means \\[compile] reads the compilation command to use.
 Otherwise, \\[compile] just uses the value of `compile-command'."
   :type 'boolean
   :group 'compilation)
 
 ;;;###autoload
 (defcustom compilation-ask-about-save t
-  "*Non-nil means \\[compile] asks which buffers to save before compiling.
+  "Non-nil means \\[compile] asks which buffers to save before compiling.
 Otherwise, it saves all modified buffers without asking."
   :type 'boolean
   :group 'compilation)
 
 ;;;###autoload
 (defcustom compilation-search-path '(nil)
-  "*List of directories to search for source files named in error messages.
+  "List of directories to search for source files named in error messages.
 Elements should be directory names, not file names of directories.
 The value nil as an element means to try the default directory."
   :type '(repeat (choice (const :tag "Default" nil)
@@ -473,7 +480,7 @@ The value nil as an element means to try the default directory."
 
 ;;;###autoload
 (defcustom compile-command "make -k "
-  "*Last shell command used to do a compilation; default for next compilation.
+  "Last shell command used to do a compilation; default for next compilation.
 
 Sometimes it is useful for files to supply local values for this variable.
 You might also use mode hooks to specify it in certain modes, like this:
@@ -491,7 +498,7 @@ You might also use mode hooks to specify it in certain modes, like this:
 
 ;;;###autoload
 (defcustom compilation-disable-input nil
-  "*If non-nil, send end-of-file as compilation process input.
+  "If non-nil, send end-of-file as compilation process input.
 This only affects platforms that support asynchronous processes (see
 `start-process'); synchronous compilation processes never accept input."
   :type 'boolean
@@ -602,6 +609,16 @@ Faces `compilation-error-face', `compilation-warning-face',
 (defvar compilation-error-list nil)
 (defvar compilation-old-error-list nil)
 
+(defcustom compilation-auto-jump-to-first-error nil
+  "If non-nil, automatically jump to the first error after `compile'."
+  :type 'boolean
+  :group 'compilation
+  :version "23.1")
+
+(defvar compilation-auto-jump-to-next nil
+  "If non-nil, automatically jump to the next error encountered.")
+(make-variable-buffer-local 'compilation-auto-jump-to-next)
+
 (defun compilation-face (type)
   (or (and (car type) (match-end (car type)) compilation-warning-face)
       (and (cdr type) (match-end (cdr type)) compilation-info-face)
@@ -649,13 +666,18 @@ Faces `compilation-error-face', `compilation-warning-face',
              l2
            (setcdr l1 (cons (list ,key) l2)))))))
 
+(defun compilation-auto-jump (buffer pos)
+  (with-current-buffer buffer
+    (goto-char pos)
+    (compile-goto-error)))
 
 ;; This function is the central driver, called when font-locking to gather
 ;; all information needed to later jump to corresponding source code.
 ;; Return a property list with all meta information on this error location.
 
 (defun compilation-error-properties (file line end-line col end-col type fmt)
-  (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point))
+  (unless (< (next-single-property-change (match-beginning 0)
+                                          'directory nil (point))
             (point))
     (if file
        (if (functionp file)
@@ -707,6 +729,13 @@ Faces `compilation-error-face', `compilation-warning-face',
        (setq type (or (and (car type) (match-end (car type)) 1)
                       (and (cdr type) (match-end (cdr type)) 0)
                       2)))
+
+    (when (and compilation-auto-jump-to-next
+               (>= type compilation-skip-threshold))
+      (kill-local-variable 'compilation-auto-jump-to-next)
+      (run-with-timer 0 nil 'compilation-auto-jump
+                      (current-buffer) (match-beginning 0)))
+
     (compilation-internal-error-properties file line end-line col end-col type fmt)))
 
 (defun compilation-move-to-column (col screen)
@@ -911,7 +940,7 @@ to a function that generates a unique name."
   (unless (equal command (eval compile-command))
     (setq compile-command command))
   (save-some-buffers (not compilation-ask-about-save) nil)
-  (setq compilation-directory default-directory)
+  (setq-default compilation-directory default-directory)
   (compilation-start command comint))
 
 ;; run compile with the default command line
@@ -921,15 +950,12 @@ If this is run in a Compilation mode buffer, re-use the arguments from the
 original use.  Otherwise, recompile using `compile-command'."
   (interactive)
   (save-some-buffers (not compilation-ask-about-save) nil)
-  (let ((default-directory
-          (or (and (not (eq major-mode (nth 1 compilation-arguments)))
-                   compilation-directory)
-              default-directory)))
+  (let ((default-directory (or compilation-directory default-directory)))
     (apply 'compilation-start (or compilation-arguments
                                  `(,(eval compile-command))))))
 
 (defcustom compilation-scroll-output nil
-  "*Non-nil to scroll the *compilation* buffer window as output appears.
+  "Non-nil to scroll the *compilation* buffer window as output appears.
 
 Setting it causes the Compilation mode commands to put point at the
 end of their output window so that the end of the output is always
@@ -1019,12 +1045,17 @@ Returns the compilation buffer created."
       (buffer-disable-undo (current-buffer))
       ;; first transfer directory from where M-x compile was called
       (setq default-directory thisdir)
+      ;; 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 ...;".
+      (set (make-local-variable 'compilation-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"
+       ;; 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))
@@ -1040,6 +1071,8 @@ Returns the compilation buffer created."
        (if highlight-regexp
            (set (make-local-variable 'compilation-highlight-regexp)
                 highlight-regexp))
+        (if compilation-auto-jump-to-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)
@@ -1088,53 +1121,31 @@ Returns the compilation buffer created."
            (funcall compilation-process-setup-function))
        (compilation-set-window-height outwin)
        ;; Start the compilation.
-       (if (fboundp 'start-process)
-           (let ((proc (if (eq mode t)
-                           (get-buffer-process
-                            (with-no-warnings
-                             (comint-exec outbuf (downcase mode-name)
-                                          shell-file-name nil `("-c" ,command))))
-                         (start-process-shell-command (downcase mode-name)
-                                                      outbuf command))))
-             ;; Make the buffer's mode line show process state.
-             (setq mode-line-process '(":%s"))
-             (set-process-sentinel proc 'compilation-sentinel)
-             (set-process-filter proc 'compilation-filter)
-             (set-marker (process-mark proc) (point) outbuf)
-             (when compilation-disable-input
-                (condition-case nil
-                    (process-send-eof proc)
-                  ;; The process may have exited already.
-                  (error nil)))
-             (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 ":run")
-         (force-mode-line-update)
-         (sit-for 0)                   ; Force redisplay
-         (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)))
+       (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)
+                      `("-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 '(":%s"))
+         (set-process-sentinel proc 'compilation-sentinel)
+         (set-process-filter proc 'compilation-filter)
+         (set-marker (process-mark proc) (point) outbuf)
+         (when compilation-disable-input
+           (condition-case nil
+               (process-send-eof proc)
+             ;; The process may have exited already.
+             (error nil)))
+         (setq compilation-in-progress
+               (cons proc compilation-in-progress))))
       ;; Now finally cd to where the shell started make/grep/...
       (setq default-directory thisdir))
     (if (buffer-local-value 'compilation-scroll-output outbuf)
@@ -1255,7 +1266,7 @@ exited abnormally with code %d\n"
   "*If non-nil, skip multiple error messages for the same source location.")
 
 (defcustom compilation-skip-threshold 1
-  "*Compilation motion commands skip less important messages.
+  "Compilation motion commands skip less important messages.
 The value can be either 2 -- skip anything less than error, 1 --
 skip anything less than warning or 0 -- don't skip any messages.
 Note that all messages not positively identified as warning or
@@ -1267,7 +1278,7 @@ info, are considered errors."
   :version "22.1")
 
 (defcustom compilation-skip-visited nil
-  "*Compilation motion commands skip visited messages if this is t.
+  "Compilation motion commands skip visited messages if this is t.
 Visited messages are ones for which the file, line and column have been jumped
 to from the current content in the current compilation buffer, even if it was
 from a different message."
@@ -1368,6 +1379,8 @@ Optional argument MINOR indicates this is called from
   ;; with the next-error function in simple.el, and it's only
   ;; coincidentally named similarly to compilation-next-error.
   (setq next-error-function 'compilation-next-error-function)
+  (set (make-local-variable 'comint-file-name-prefix)
+       (or (file-remote-p default-directory) ""))
   (set (make-local-variable 'font-lock-extra-managed-props)
        '(directory message help-echo mouse-face debug))
   (set (make-local-variable 'compilation-locs)
@@ -1516,7 +1529,7 @@ Just inserts the text, but uses `insert-before-markers'."
               (eq (prog1 last (setq last (nth 2 (car msg))))
                   last))
           (if compilation-skip-visited
-              (nthcdr 4 (car msg)))
+              (nthcdr 5 (car msg)))
           (if compilation-skip-to-next-location
               (eq (car msg) loc))
           ;; count this message only if none of the above are true
@@ -1619,7 +1632,7 @@ This is the value of `next-error-function' in Compilation buffers."
   (when reset
     (setq compilation-current-error nil))
   (let* ((columns compilation-error-screen-columns) ; buffer's local value
-        (last 1)
+        (last 1) timestamp
         (loc (compilation-next-error (or n 1) nil
                                      (or compilation-current-error
                                          compilation-messages-start
@@ -1632,10 +1645,17 @@ This is the value of `next-error-function' in Compilation buffers."
                compilation-current-error
              (copy-marker (line-beginning-position)))
          loc (car loc))
-    ;; If loc contains no marker, no error in that file has been visited.  If
-    ;; the marker is invalid the buffer has been killed.  So, recalculate all
-    ;; markers for that file.
-    (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)))
+    ;; If loc contains no marker, no error in that file has been visited.
+    ;; If the marker is invalid the buffer has been killed.
+    ;; If the file is newer than the timestamp, it has been modified
+    ;; (`omake -P' polls filesystem for changes and recompiles when needed
+    ;;  in the same process and buffer).
+    ;; So, recalculate all markers for that file.
+    (unless (and (nth 3 loc) (marker-buffer (nth 3 loc))
+                 (equal (nth 4 loc)
+                        (setq timestamp
+                              (with-current-buffer (marker-buffer (nth 3 loc))
+                                (visited-file-modtime)))))
       (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
                                                  (cadr (car (nth 2 loc))))
        (save-restriction
@@ -1658,7 +1678,8 @@ This is the value of `next-error-function' in Compilation buffers."
                  (set-marker (nth 3 col) (point))
                (setcdr (nthcdr 2 col) `(,(point-marker)))))))))
     (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
-    (setcdr (nthcdr 3 loc) t)))                ; Set this one as visited.
+    (setcdr (nthcdr 3 loc) (list timestamp))
+    (setcdr (nthcdr 4 loc) t)))                ; Set this one as visited.
 
 (defvar compilation-gcpro nil
   "Internal variable used to keep some values from being GC'd.")
@@ -1861,7 +1882,24 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
           (let* ((name (read-file-name
                         (format "Find this %s in (default %s): "
                                 compilation-error filename)
-                        spec-dir filename t nil))
+                        spec-dir filename t nil
+                        ;; The predicate below is fine when called from
+                        ;; minibuffer-complete-and-exit, but it's too
+                        ;; restrictive otherwise, since it also prevents the
+                        ;; user from completing "fo" to "foo/" when she
+                        ;; wants to enter "foo/bar".
+                        ;;
+                        ;; Try to make sure the user can only select
+                        ;; a valid answer.  This predicate may be ignored,
+                        ;; tho, so we still have to double-check afterwards.
+                        ;; TODO: We should probably fix read-file-name so
+                        ;; that it never ignores this predicate, even when
+                        ;; using popup dialog boxes.
+                        ;; (lambda (name)
+                        ;;   (if (file-directory-p name)
+                        ;;       (setq name (expand-file-name filename name)))
+                        ;;   (file-exists-p name))
+                        ))
                  (origname name))
             (cond
              ((not (file-exists-p name))