Fixes: debbugs:7806
[bpt/emacs.git] / lisp / progmodes / compile.el
index 6249f50..eabfe22 100644 (file)
@@ -1,7 +1,7 @@
 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages
 
 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;;   2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;;   2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;   Free Software Foundation, Inc.
 
 ;; Authors: Roland McGrath <roland@gnu.org>,
@@ -47,7 +47,7 @@
 ;; using the same *compilation* buffer. this necessitates re-parsing markers.
 
 ;;   FILE-STRUCTURE is a list of
-;;   ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...)
+;;   ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...)
 
 ;; FILENAME is a string parsed from an error message.  DIRECTORY is a string
 ;; obtained by following directory change messages.  DIRECTORY will be nil for
@@ -164,7 +164,7 @@ and a string describing how the process finished.")
 
 (defvar compilation-num-errors-found)
 
-(defconst compilation-error-regexp-alist-alist
+(defvar compilation-error-regexp-alist-alist
   '((absoft
      "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
 of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -196,6 +196,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
 \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
 
+    (cucumber
+     "\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\
+\\(?: \\)\\([^\(].*\\):\\([1-9][0-9]*\\)" 1 2)
+
     (edg-1
      "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
      1 2 nil (3 . 4))
@@ -233,6 +237,12 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      nil 1 nil 2 0
      (2 (compilation-face '(3))))
 
+    (gcc-include
+     "^\\(?:In file included \\|                 \\|\t\\)from \
+\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\
+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?"
+     1 2 3 (4 . 5))
+
     (gnu
      ;; The first line matches the program name for
 
@@ -255,9 +265,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      ;; The core of the regexp is the one with *?.  It says that a file name
      ;; can be composed of any non-newline char, but it also rules out some
      ;; valid but unlikely cases, such as a trailing space or a space
-     ;; followed by a -.
-     "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
-\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\
+     ;; followed by a -, or a colon followed by a space.
+
+     ;; The "in \\|from " exception was added to handle messages from Ruby.
+     "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
+\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\
 \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
 \\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\
 \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
@@ -265,12 +277,6 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
 \[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
      1 (2 . 5) (4 . 6) (7 . 8))
 
-    ;; The `gnu' style above can incorrectly match gcc's "In file
-    ;; included from" message, so we process that first. -- cyd
-    (gcc-include
-     "^\\(?:In file included\\|                \\) from \
-\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
-
     (lcc
      "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
      2 3 4 (1))
@@ -297,9 +303,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
 
     (msft
-     ;; AFAWK, The message may be a "warning", "error", or "fatal error".
-     "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
-: \\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:" 2 3 nil (4))
+     ;; The message may be a "warning", "error", or "fatal error" with
+     ;; an error code, or "see declaration of" without an error code.
+     "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
+: \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
+     2 3 nil (4))
 
     (omake
      ;; "omake -P" reports "file foo changed"
@@ -323,6 +331,9 @@ during global destruction\\.$\\)" 1 2)
      "\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)"
      2 3 nil nil)
 
+    (ruby-Test::Unit
+     "[\t ]*\\[\\([^\(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:$" 1 2)
+
     (rxp
      "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\
  \\([0-9]+\\) of file://\\(.+\\)"
@@ -348,7 +359,7 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
      "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
 
     (watcom
-     "\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
+     "^[ \t]*\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
 \\(?:\\(Error! E[0-9]+\\)\\|\\(Warning! W[0-9]+\\)\\):"
      1 2 nil (4))
 
@@ -534,7 +545,7 @@ you may also want to change `compilation-page-delimiter'.")
      ;; Command output lines.  Recognize `make[n]:' lines too.
      ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
       (1 font-lock-function-name-face) (3 compilation-line-face nil t))
-     (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1)
+     (" -\\(?:o[= ]?\\|-\\(?:outfile\\|output\\)[= ]\\)\\(\\S +\\)" . 1)
      ("^Compilation \\(finished\\).*"
       (0 '(face nil message nil help-echo nil mouse-face nil) t)
       (1 compilation-info-face))
@@ -565,7 +576,12 @@ especially the TAB character."
 
 (defcustom compilation-read-command t
   "Non-nil means \\[compile] reads the compilation command to use.
-Otherwise, \\[compile] just uses the value of `compile-command'."
+Otherwise, \\[compile] just uses the value of `compile-command'.
+
+Note that changing this to nil may be a security risk, because a
+file might define a malicious `compile-command' as a file local
+variable, and you might not notice.  Therefore, `compile-command'
+is considered unsafe if this variable is nil."
   :type 'boolean
   :group 'compilation)
 
@@ -576,6 +592,21 @@ Otherwise, it saves all modified buffers without asking."
   :type 'boolean
   :group 'compilation)
 
+(defcustom compilation-save-buffers-predicate nil
+  "The second argument (PRED) passed to `save-some-buffers' before compiling.
+E.g., one can set this to
+  (lambda ()
+    (string-prefix-p my-compilation-root (file-truename (buffer-file-name))))
+to limit saving to files located under `my-compilation-root'.
+Note, that, in general, `compilation-directory' cannot be used instead
+of `my-compilation-root' here."
+  :type '(choice
+          (const :tag "Default (save all file-visiting buffers)" nil)
+          (const :tag "Save all buffers" t)
+          function)
+  :group 'compilation
+  :version "24.1")
+
 ;;;###autoload
 (defcustom compilation-search-path '(nil)
   "List of directories to search for source files named in error messages.
@@ -586,7 +617,7 @@ The value nil as an element means to try the default directory."
   :group 'compilation)
 
 ;;;###autoload
-(defcustom compile-command "make -k "
+(defcustom compile-command (purecopy "make -k ")
   "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.
@@ -601,7 +632,7 @@ You might also use mode hooks to specify it in certain modes, like this:
                        (file-name-sans-extension buffer-file-name))))))"
   :type 'string
   :group 'compilation)
-;;;###autoload(put 'compile-command 'safe-local-variable 'stringp)
+;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command))))
 
 ;;;###autoload
 (defcustom compilation-disable-input nil
@@ -726,6 +757,9 @@ Faces `compilation-error-face', `compilation-warning-face',
   "If non-nil, automatically jump to the next error encountered.")
 (make-variable-buffer-local 'compilation-auto-jump-to-next)
 
+(defvar compilation-buffer-modtime nil
+  "The buffer modification time, for buffers not associated with files.")
+(make-variable-buffer-local 'compilation-buffer-modtime)
 
 (defvar compilation-skip-to-next-location t
   "*If non-nil, skip multiple error messages for the same source location.")
@@ -736,12 +770,27 @@ 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
 info, are considered errors."
-  :type '(choice (const :tag "Warnings and info" 2)
-                (const :tag "Info" 1)
-                (const :tag "None" 0))
+  :type '(choice (const :tag "Skip warnings and info" 2)
+                (const :tag "Skip info" 1)
+                (const :tag "No skip" 0))
   :group 'compilation
   :version "22.1")
 
+(defun compilation-set-skip-threshold (level)
+  "Switch the `compilation-skip-threshold' level."
+  (interactive
+   (list
+    (mod (if current-prefix-arg
+             (prefix-numeric-value current-prefix-arg)
+           (1+ compilation-skip-threshold))
+         3)))
+  (setq compilation-skip-threshold level)
+  (message "Skipping %s"
+           (case compilation-skip-threshold
+             (0 "Nothing")
+             (1 "Info messages")
+             (2 "Warnings and info"))))
+
 (defcustom compilation-skip-visited nil
   "Compilation motion commands skip visited messages if this is t.
 Visited messages are ones for which the file, line and column have been jumped
@@ -989,11 +1038,10 @@ FMTS is a list of format specs for transforming the file name.
           ;; another solution is to modify (some?) regexps in
           ;; `compilation-error-regexp-alist'.
           ;; note that omake usage is not limited to ocaml and C (for stubs).
-          (unless (string-match (concat "^" (regexp-quote "^ *")) pat)
-            (setq pat (concat "^ *"
-                              (if (= ?^ (aref pat 0))
-                                  (substring pat 1)
-                                  pat))))
+          (when (and (= ?^ (aref pat 0)) ; anchored: starts with "^"
+                     ;; but does not allow an arbitrary number of leading spaces
+                     (not (and (= ?  (aref pat 1)) (= ?* (aref pat 2)))))
+            (setq pat (concat "^ *" (substring pat 1))))
          (if (consp file)      (setq fmt (cdr file)      file (car file)))
          (if (consp line)      (setq end-line (cdr line) line (car line)))
          (if (consp col)       (setq end-col (cdr col)   col (car col)))
@@ -1088,7 +1136,8 @@ to a function that generates a unique name."
     (consp current-prefix-arg)))
   (unless (equal command (eval compile-command))
     (setq compile-command command))
-  (save-some-buffers (not compilation-ask-about-save) nil)
+  (save-some-buffers (not compilation-ask-about-save)
+                     compilation-save-buffers-predicate)
   (setq-default compilation-directory default-directory)
   (compilation-start command comint))
 
@@ -1099,7 +1148,8 @@ If this is run in a Compilation mode buffer, re-use the arguments from the
 original use.  Otherwise, recompile using `compile-command'.
 If the optional argument `edit-command' is non-nil, the command can be edited."
   (interactive "P")
-  (save-some-buffers (not compilation-ask-about-save) nil)
+  (save-some-buffers (not compilation-ask-about-save)
+                     compilation-save-buffers-predicate)
   (let ((default-directory (or compilation-directory default-directory)))
     (when edit-command
       (setcar compilation-arguments
@@ -1181,7 +1231,7 @@ Returns the compilation buffer created."
   (let* ((name-of-mode
          (if (eq mode t)
              "compilation"
-           (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
+           (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
         (thisdir default-directory)
         outwin outbuf)
     (with-current-buffer
@@ -1211,7 +1261,8 @@ Returns the compilation buffer created."
        ;; 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)
+       (cd (if (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]"
+                             command)
                (if (match-end 1)
                    (substitute-env-vars (match-string 1 command))
                  "~")
@@ -1238,7 +1289,8 @@ Returns the compilation buffer created."
             (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)
+               "; default-directory: "
+                (prin1-to-string (abbreviate-file-name default-directory))
                " -*-\n"
                (format "%s started at %s\n\n"
                        mode-name
@@ -1556,10 +1608,11 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
   ;; Let windows scroll along with the output.
   (set (make-local-variable 'window-point-insertion-type) t)
   (set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map)
-  (setq major-mode 'compilation-mode
+  (setq major-mode 'compilation-mode ; FIXME: Use define-derived-mode.
        mode-name (or name-of-mode "Compilation"))
   (set (make-local-variable 'page-delimiter)
        compilation-page-delimiter)
+  (set (make-local-variable 'compilation-buffer-modtime) nil)
   (compilation-setup)
   (setq buffer-read-only t)
   (run-mode-hooks 'compilation-mode-hook))
@@ -1775,6 +1828,7 @@ and runs `compilation-filter-hook'."
               (unless comint-inhibit-carriage-motion
                 (comint-carriage-motion (process-mark proc) (point)))
               (set-marker (process-mark proc) (point))
+              (set (make-local-variable 'compilation-buffer-modtime) (current-time))
               (run-hooks 'compilation-filter-hook))
          (goto-char pos)
           (narrow-to-region min max)
@@ -1944,16 +1998,11 @@ This is the value of `next-error-function' in Compilation buffers."
     ;; (`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))
-                 ;; There may be no timestamp info if the loc is a `fake-loc'.
-                 ;; So we skip the time-check here, although we should maybe
-                 ;; change `compilation-fake-loc' to add timestamp info.
-                 (or (null (nth 4 loc))
-                     (equal (nth 4 loc)
-                            (setq timestamp
-                                  (with-current-buffer
-                                      (marker-buffer (nth 3 loc))
-                                    (visited-file-modtime))))))
+    (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)) (nthcdr 4 loc)
+                 ;; There may be no timestamp info if the loc is a `fake-loc',
+                 ;; but we just checked that the file has been visited before!
+                 (equal (nth 4 loc)
+                        (setq timestamp compilation-buffer-modtime)))
       (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
                                                  (cadr (car (nth 2 loc))))
        (save-restriction
@@ -2058,7 +2107,7 @@ and overlay is highlighted between MK and END-MK."
                 pre-existing
               (let ((display-buffer-reuse-frames t)
                     (pop-up-windows t))
-               ;; Pop up a window.
+               ;; Pop up a window.
                 (display-buffer (marker-buffer msg)))))
         (highlight-regexp (with-current-buffer (marker-buffer msg)
                             ;; also do this while we change buffer
@@ -2078,10 +2127,12 @@ and overlay is highlighted between MK and END-MK."
       (if (window-dedicated-p (selected-window))
           (pop-to-buffer (marker-buffer mk))
         (switch-to-buffer (marker-buffer mk))))
-    ;; If narrowing gets in the way of going to the right place, widen.
     (unless (eq (goto-char mk) (point))
+      ;; If narrowing gets in the way of going to the right place, widen.
       (widen)
-      (goto-char mk))
+      (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)))
@@ -2341,11 +2392,11 @@ The file-structure looks like this:
   (goto-char limit)
   nil)
 
-;; Beware: this is not only compatiblity code.  New code stil uses it.  --Stef
+;; Beware: this is not only compatibility code.  New code stil uses it.  --Stef
 (defun compilation-forget-errors ()
   ;; In case we hit the same file/line specs, we want to recompute a new
   ;; marker for them, so flush our cache.
-  (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
+  (clrhash compilation-locs)
   (setq compilation-gcpro nil)
   ;; FIXME: the old code reset the directory-stack, so maybe we should
   ;; put a `directory change' marker of some sort, but where?  -stef
@@ -2376,9 +2427,6 @@ The file-structure looks like this:
        (or compilation-auto-jump-to-first-error
           (eq compilation-scroll-output 'first-error))))
 
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.gcov\\'" . compilation-mode))
-
 (provide 'compile)
 
 ;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c