]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/compile.el
Merge from emacs-24; up to 2012-12-13T09:45:54Z!lekktu@gmail.com
[gnu-emacs] / lisp / progmodes / compile.el
index fbb0c9e204a2f81186867279e4b662a231d4c09c..eb73b77bf529560aaa923a0f6167afc98cbab5e7 100644 (file)
@@ -1,7 +1,7 @@
 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages
 
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2012
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2013 Free Software
+;; Foundation, Inc.
 
 ;; Authors: Roland McGrath <roland@gnu.org>,
 ;;         Daniel Pfeiffer <occitan@esperanto.org>
@@ -134,6 +134,7 @@ and a string describing how the process finished.")
 
 ;; If you make any changes to `compilation-error-regexp-alist-alist',
 ;; be sure to run the ERT test in test/automated/compile-tests.el.
+;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
 
 (defvar compilation-error-regexp-alist-alist
   '((absoft
@@ -171,6 +172,15 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      "\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\
 \\(?: \\)\\([^\(].*\\):\\([1-9][0-9]*\\)" 1 2)
 
+    (msft
+     ;; Must be before edg-1, so that MSVC's longer messages are
+     ;; considered before EDG.
+     ;; 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))
+
     (edg-1
      "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
      1 2 nil (3 . 4))
@@ -252,11 +262,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      ;; 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]+\\)\\)?\\)?:\
+\\([0-9]+\\)\\(?:-\\(?4:[0-9]+\\)\\(?:\\.\\(?5:[0-9]+\\)\\)?\
+\\|[.:]\\(?3:[0-9]+\\)\\(?:-\\(?:\\(?4:[0-9]+\\)\\.\\)?\\(?5:[0-9]+\\)\\)?\\)?:\
 \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
  *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\|[Nn]ote\\)\\|\
- *[Ee]rror\\|\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
+ *[Ee]rror\\|[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
      1 (2 . 4) (3 . 5) (6 . 7))
 
     (lcc
@@ -488,9 +498,12 @@ What matched the HYPERLINK'th subexpression has `mouse-face' and
 `compilation-message-face' applied.  If this is nil, the text
 matched by the whole REGEXP becomes the hyperlink.
 
-Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where SUBMATCH is
-the number of a submatch that should be highlighted when it matches,
-and FACE is an expression returning the face to use for that submatch.."
+Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where
+SUBMATCH is the number of a submatch and FACE is an expression
+which evaluates to a face name (a symbol or string).
+Alternatively, FACE can evaluate to a property list of the
+form (face FACE PROP1 VAL1 PROP2 VAL2 ...), in which case all the
+listed text properties PROP# are given values VAL# as well."
   :type '(repeat (choice (symbol :tag "Predefined symbol")
                         (sexp :tag "Error specification")))
   :link `(file-link :tag "example file"
@@ -745,12 +758,10 @@ Faces `compilation-error-face', `compilation-warning-face',
 (defvar compilation-leave-directory-face 'font-lock-builtin-face
   "Face name to use for leaving directory messages.")
 
-
-
 ;; Used for compatibility with the old compile.el.
 (defvar compilation-parse-errors-function nil)
-(make-obsolete 'compilation-parse-errors-function
-               'compilation-error-regexp-alist "24.1")
+(make-obsolete-variable 'compilation-parse-errors-function
+                       'compilation-error-regexp-alist "24.1")
 
 (defcustom compilation-auto-jump-to-first-error nil
   "If non-nil, automatically jump to the first error during compilation."
@@ -1270,7 +1281,7 @@ to `compilation-error-regexp-alist' if RULES is nil."
       ;; whether or not omake's own error messages are recognized.
       (cond
        ((not (memq 'omake compilation-error-regexp-alist)) nil)
-       ((string-match "\\`\\([^^]\\|^\\( \\*\\|\\[\\)\\)" pat)
+       ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
         nil) ;; Not anchored or anchored but already allows empty spaces.
        (t (setq pat (concat "^ *" (substring pat 1)))))
 
@@ -1328,16 +1339,27 @@ to `compilation-error-regexp-alist' if RULES is nil."
             (compilation--put-prop
              end-col 'font-lock-face compilation-column-face)
 
+           ;; Obey HIGHLIGHT.
             (dolist (extra-item (nthcdr 6 item))
               (let ((mn (pop extra-item)))
                 (when (match-beginning mn)
                   (let ((face (eval (car extra-item))))
                     (cond
                      ((null face))
-                     ((symbolp face)
+                     ((or (symbolp face) (stringp face))
                       (put-text-property
                        (match-beginning mn) (match-end mn)
                        'font-lock-face face))
+                    ((and (listp face)
+                          (eq (car face) 'face)
+                          (or (symbolp (cadr face))
+                              (stringp (cadr face))))
+                      (put-text-property
+                       (match-beginning mn) (match-end mn)
+                       'font-lock-face (cadr face))
+                      (add-text-properties
+                       (match-beginning mn) (match-end mn)
+                       (nthcdr 2 face)))
                      (t
                       (error "Don't know how to handle face %S"
                              face)))))))
@@ -1406,8 +1428,9 @@ and move to the source code that caused it.
 If optional second arg COMINT is t the buffer will be in Comint mode with
 `compilation-shell-minor-mode'.
 
-Interactively, prompts for the command if `compilation-read-command' is
-non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
+Interactively, prompts for the command if the variable
+`compilation-read-command' is non-nil; otherwise uses`compile-command'.
+With prefix arg, always prompts.
 Additionally, with universal prefix arg, compilation buffer will be in
 comint mode, i.e. interactive.
 
@@ -1485,24 +1508,6 @@ Otherwise, construct a buffer name from NAME-OF-MODE."
        (t
         (concat "*" (downcase name-of-mode) "*"))))
 
-;; This is a rough emulation of the old hack, until the transition to new
-;; compile is complete.
-(defun compile-internal (command error-message
-                                &optional _name-of-mode parser
-                                error-regexp-alist name-function
-                                _enter-regexp-alist _leave-regexp-alist
-                                file-regexp-alist _nomessage-regexp-alist
-                                _no-async highlight-regexp _local-map)
-  (if parser
-      (error "Compile now works very differently, see `compilation-error-regexp-alist'"))
-  (let ((compilation-error-regexp-alist
-        (append file-regexp-alist (or error-regexp-alist
-                                      compilation-error-regexp-alist)))
-       (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?"
-                                                    "\\1" error-message)))
-    (compilation-start command nil name-function highlight-regexp)))
-(make-obsolete 'compile-internal 'compilation-start "22.1")
-
 (defcustom compilation-always-kill nil
   "If t, always kill a running compilation process before starting a new one.
 If nil, ask to kill it."
@@ -1542,20 +1547,20 @@ Returns the compilation buffer created."
              (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))
-                    compilation-always-kill
-                   (yes-or-no-p
-                    (format "A %s process is running; kill it? "
-                            name-of-mode)))
-               (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)))))
+      (if comp-proc
+          (if (or (not (eq (process-status comp-proc) 'run))
+                  (eq (process-query-on-exit-flag comp-proc) nil)
+                  (yes-or-no-p
+                   (format "A %s process is running; kill it? "
+                           name-of-mode)))
+              (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.
@@ -1565,12 +1570,20 @@ 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)
-               (if (match-end 1)
-                   (substitute-env-vars (match-string 1 command))
-                 "~")
-             default-directory))
+       (cd (cond
+             ((not (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\|'[^']*'\\|\"\\(?:[^\"`$\\]\\|\\\\.\\)*\"\\)\\)?\\s *[;&\n]"
+                                 command))
+              default-directory)
+             ((not (match-end 1)) "~")
+             ((eq (aref command (match-beginning 1)) ?\')
+              (substring command (1+ (match-beginning 1))
+                         (1- (match-end 1))))
+             ((eq (aref command (match-beginning 1)) ?\")
+              (replace-regexp-in-string
+               "\\\\\\(.\\)" "\\1"
+               (substring command (1+ (match-beginning 1))
+                          (1- (match-end 1)))))
+             (t (substitute-env-vars (match-string 1 command)))))
        (erase-buffer)
        ;; Select the desired mode.
        (if (not (eq mode t))
@@ -1600,7 +1613,11 @@ Returns the compilation buffer created."
                (format "%s started at %s\n\n"
                        mode-name
                        (substring (current-time-string) 0 19))
-               command "\n")
+               ;; The command could be split into several lines, see
+               ;; `rgrep' for example.  We want to display it as one
+               ;; line.
+               (apply 'concat (split-string command (regexp-quote "\\\n") t))
+               "\n")
        (setq thisdir default-directory))
       (set-buffer-modified-p nil))
     ;; Pop up the compilation buffer.
@@ -1610,7 +1627,7 @@ Returns the compilation buffer created."
       (let ((process-environment
             (append
              compilation-environment
-             (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
+             (if (if (boundp 'system-uses-terminfo);`If' for compiler warning.
                      system-uses-terminfo)
                  (list "TERM=dumb" "TERMCAP="
                        (format "COLUMNS=%d" (window-width)))
@@ -1660,13 +1677,20 @@ Returns the compilation buffer created."
                           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
-                   '(:propertize ":%s" face compilation-mode-line-run))
-             (set-process-sentinel proc 'compilation-sentinel)
-             (unless (eq mode t)
-               ;; Keep the comint filter, since it's needed for proper handling
-               ;; of the prompts.
+              ;; Make the buffer's mode line show process state.
+              (setq mode-line-process
+                    '(:propertize ":%s" face compilation-mode-line-run))
+
+              ;; Set the process as killable without query by default.
+              ;; This allows us to start a new compilation without
+              ;; getting prompted.
+              (when compilation-always-kill
+                (set-process-query-on-exit-flag proc nil))
+
+              (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,