X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/6807d8ca512a3516df3e56e185204f2845bc121e..7c8379331a009a42b0758a0dd7ca805513ff0316:/lisp/progmodes/compile.el diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 6249f50cc9..eabfe22b5e 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -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 , @@ -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