;;; compile.el --- run compiler as inferior of Emacs, parse error messages
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 2003
+;; Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: FSF
(integer :tag "First N lines"))
:group 'compilation)
-(defcustom grep-command nil
- "The default grep command for \\[grep].
-If the grep program used supports an option to always include file names
-in its output (such as the `-H' option to GNU grep), it's a good idea to
-include it when specifying `grep-command'.
-
-The default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable in your program."
- :type 'string
- :get '(lambda (symbol)
- (or grep-command
- (progn (grep-compute-defaults) grep-command)))
- :group 'compilation)
-
-(defcustom grep-use-null-device 'auto-detect
- "If non-nil, append the value of `null-device' to grep commands.
-This is done to ensure that the output of grep includes the filename of
-any match in the case where only a single file is searched, and is not
-necessary if the grep program used supports the `-H' option.
-
-The default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable in your program."
- :type 'boolean
- :get '(lambda (symbol)
- (if (and grep-use-null-device (not (eq grep-use-null-device t)))
- (progn (grep-compute-defaults) grep-use-null-device)
- grep-use-null-device))
- :group 'compilation)
-
-(defcustom grep-find-command nil
- "The default find command for \\[grep-find].
-The default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable in your program."
- :type 'string
- :get (lambda (symbol)
- (or grep-find-command
- (progn (grep-compute-defaults) grep-find-command)))
- :group 'compilation)
-
(defvar compilation-error-list nil
"List of error message descriptors for visiting erring functions.
Each error descriptor is a cons (or nil). Its car is a marker pointing to
`compilation-error-list' to a list with an element for each error message
found. See that variable for more info.")
+(defvar compilation-parse-errors-filename-function nil
+ "Function to call to post-process filenames while parsing error messages.
+It takes one arg FILENAME which is the name of a file as found
+in the compilation output, and should return a transformed file name.")
+
;;;###autoload
(defvar compilation-process-setup-function nil
"*Function to call to customize the compilation process.
This functions is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
-while processing the output of the compilation process.")
+while processing the output of the compilation process. The function
+is called with variables `compilation-buffer' and `compilation-window'
+bound to the compilation buffer and window, respectively.")
;;;###autoload
(defvar compilation-buffer-name-function nil
\\([a-zA-Z]?:?[^:( \t\n]*[^:( \t\n0-9][^:( \t\n]*\\)[:(][ \t]*\\([0-9]+\\)\
\\([) \t]\\|:\\(\\([0-9]+:\\)\\|[0-9]*[^:0-9]\\)\\)" 2 3 6)
+ ;; GNU utilities with precise locations (line and columns),
+ ;; possibly ranges:
+ ;; foo.c:8.23-9.1: error message
+ ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\\.\\([0-9]+\\)\
+-\\([0-9]+\\)\\.\\([0-9]+\\)\
+:" 1 2 3) ;; When ending points are supported, add line = 4 and col = 5.
+ ;; foo.c:8.23-45: error message
+ ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\\.\\([0-9]+\\)\
+-\\([0-9]+\\)\
+:" 1 2 3) ;; When ending points are supported, add line = 2 and col = 4.
+ ;; foo.c:8-45.3: error message
+ ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\
+-\\([0-9]+\\)\\.\\([0-9]+\\)\
+:" 1 2 nil) ;; When ending points are supported, add line = 2 and col = 4.
+ ;; foo.c:8.23: error message
+ ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\\.\\([0-9]+\\)\
+:" 1 2 3)
+ ;; foo.c:8-23: error message
+ ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\
+-\\([0-9]+\\)\
+:" 1 2 nil);; When ending points are supported, add line = 3.
+
;; Microsoft C/C++:
;; keyboard.c(537) : warning C4005: 'min' : macro redefinition
;; d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
\\([a-zA-Z]?:?[^:( \t\n]+\\)\
\\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 4 5)
+ ;; Valgrind (memory debugger for x86 GNU/Linux):
+ ;; ==1332== at 0x8008621: main (vtest.c:180)
+ ;; Currently this regexp only matches the first error.
+ ;; Thanks to Hans Petter Jansson <hpj@ximian.com> for his regexp wisdom.
+ ("^==[0-9]+==[^(]+\(([^:]+):([0-9]+)" 1 2)
+
;; 4.3BSD lint pass 2
;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)
(".*[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$"
(".*\"\\([^,\" \n\t]+\\)\", lines? \
\\([0-9]+\\)\\([\(.]\\([0-9]+\\)\)?\\)?[:., (-]" 1 2 4)
+ ;; Python:
+ ;; File "foobar.py", line 5, blah blah
+ ("^File \"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)," 1 2)
+
;; Caml compiler:
;; File "foobar.ml", lines 5-8, characters 20-155: blah blah
("^File \"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[-0-9]*, characters? \\([0-9]+\\)" 1 2 3)
;; cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3
(".* ERROR [a-zA-Z0-9 ]+, File = \\(.+\\), Line = \\([0-9]+\\), Column = \\([0-9]+\\)"
1 2 3)
+
+ ;; RXP - GPL XML validator at http://www.cogsci.ed.ac.uk/~richard/rxp.html:
+ ;; Error: Mismatched end tag: expected </geroup>, got </group>
+ ;; in unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml
+ ("Error:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)"
+ 3 1 2)
+ ;; Warning: Start tag for undeclared element geroup
+ ;; in unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml
+ ("Warning:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)"
+ 3 1 2)
+
+ ;; See http://ant.apache.org/faq.html
+ ;; Ant Java: works for jikes
+ ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:" 1 2 3)
+
+ ;; Ant Java: works for javac
+ ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):" 1 2)
+
)
"Alist that specifies how to match errors in compiler output.
'(
;; Matches lines printed by the `-w' option of GNU Make.
(".*: Entering directory `\\(.*\\)'$" 1)
+ ;; Matches lines made by Emacs byte compiler.
+ ("^Entering directory `\\(.*\\)'$" 1)
)
"Alist specifying how to match lines that indicate a new current directory.
Note that the match is done at the beginning of lines.
'(
;; Matches lines printed by the `-w' option of GNU Make.
(".*: Leaving directory `\\(.*\\)'$" 1)
+ ;; Matches lines made by Emacs byte compiler.
+ ("^Leaving directory `\\(.*\\)'$" 1)
)
"Alist specifying how to match lines that indicate restoring current directory.
Note that the match is done at the beginning of lines.
Each elt has the form (REGEXP). This alist is by default empty, but if
you have some good regexps here, the parsing of messages will be faster.")
+(defvar compilation-highlight-regexp t
+ "Regexp matching part of visited source lines to highlight temporarily.
+Highlight entire line if t; don't highlight source lines if nil.")
+
+(defvar compilation-highlight-overlay 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.
Otherwise they are interpreted as character positions, with
:type 'boolean
:group 'compilation)
-;; Note: the character class after the optional drive letter does not
-;; include a space to support file names with blanks.
-(defvar grep-regexp-alist
- '(("\\([a-zA-Z]?:?[^:(\t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
- "Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
-
-(defvar grep-program
- ;; Currently zgrep has trouble. It runs egrep instead of grep,
- ;; and it doesn't pass along long options right.
- "grep"
- ;; (if (equal (condition-case nil ; in case "zgrep" isn't in exec-path
- ;; (call-process "zgrep" nil nil nil
- ;; "foo" null-device)
- ;; (error nil))
- ;; 1)
- ;; "zgrep"
- ;; "grep")
- "The default grep program for `grep-command' and `grep-find-command'.
-This variable's value takes effect when `grep-compute-defaults' is called.")
-
-(defvar find-program "find"
- "The default find program for `grep-find-command'.
-This variable's value takes effect when `grep-compute-defaults' is called.")
-
-(defvar grep-find-use-xargs nil
- "Whether \\[grep-find] uses the `xargs' utility by default.
-
-If nil, it uses `grep -exec'; if `gnu', it uses `find -print0' and `xargs -0';
-if not nil and not `gnu', it uses `find -print' and `xargs'.
-
-This variable's value takes effect when `grep-compute-defaults' is called.")
-
;;;###autoload
(defcustom compilation-search-path '(nil)
"*List of directories to search for source files named in error messages.
and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
write into the compilation buffer, and to put in its mode line.")
+(defvar compilation-environment nil
+ "*List of environment variables for compilation to inherit.
+Each element should be a string of the form ENVVARNAME=VALUE.
+This list is temporarily prepended to `process-environment' prior to
+starting the compilation process.")
+
;; History of compile commands.
(defvar compile-history nil)
-;; History of grep commands.
-(defvar grep-history nil)
-(defvar grep-find-history nil)
(defun compilation-mode-font-lock-keywords ()
"Return expressions to highlight in Compilation mode."
Interactively, prompts for the command if `compilation-read-command' is
non-nil; otherwise uses `compile-command'. With prefix arg, always prompts.
-To run more than one compilation at once, start one and rename the
-\`*compilation*' buffer to some other name with \\[rename-buffer].
-Then start the next one.
+To run more than one compilation at once, start one and rename
+the \`*compilation*' buffer to some other name with
+\\[rename-buffer]. Then start the next one. On most systems,
+termination of the main compilation process kills its
+subprocesses.
The name used for the buffer is actually whatever is returned by
the function in `compilation-buffer-name-function', so you can set that
;; run compile with the default command line
(defun recompile ()
- "Re-compile the program including the current buffer."
+ "Re-compile the program including the current buffer.
+If this is run in a compilation-mode buffer, re-use the arguments from the
+original use. Otherwise, it recompiles using `compile-command'."
(interactive)
(save-some-buffers (not compilation-ask-about-save) nil)
- (compile-internal (eval compile-command) "No more errors"))
-
-(defun grep-process-setup ()
- "Set up `compilation-exit-message-function' for `grep'."
- (set (make-local-variable 'compilation-exit-message-function)
- (lambda (status code msg)
- (if (eq status 'exit)
- (cond ((zerop code)
- '("finished (matches found)\n" . "matched"))
- ((= code 1)
- '("finished with no matches found\n" . "no match"))
- (t
- (cons msg code)))
- (cons msg code)))))
-
-(defun grep-compute-defaults ()
- (unless (or (not grep-use-null-device) (eq grep-use-null-device t))
- (setq grep-use-null-device
- (with-temp-buffer
- (let ((hello-file (expand-file-name "HELLO" data-directory)))
- (not
- (and (equal (condition-case nil
- (if grep-command
- ;; `grep-command' is already set, so
- ;; use that for testing.
- (call-process-shell-command
- grep-command nil t nil
- "^English" hello-file)
- ;; otherwise use `grep-program'
- (call-process grep-program nil t nil
- "-nH" "^English" hello-file))
- (error nil))
- 0)
- (progn
- (goto-char (point-min))
- (looking-at
- (concat (regexp-quote hello-file)
- ":[0-9]+:English")))))))))
- (unless grep-command
- (setq grep-command
- (let ((required-options (if grep-use-null-device "-n" "-nH")))
- (if (equal (condition-case nil ; in case "grep" isn't in exec-path
- (call-process grep-program nil nil nil
- "-e" "foo" null-device)
- (error nil))
- 1)
- (format "%s %s -e " grep-program required-options)
- (format "%s %s " grep-program required-options)))))
- (unless grep-find-use-xargs
- (setq grep-find-use-xargs
- (if (and
- (equal (call-process "find" nil nil nil
- null-device "-print0")
- 0)
- (equal (call-process "xargs" nil nil nil
- "-0" "-e" "echo")
- 0))
- 'gnu)))
- (unless grep-find-command
- (setq grep-find-command
- (cond ((eq grep-find-use-xargs 'gnu)
- (format "%s . -type f -print0 | xargs -0 -e %s"
- find-program grep-command))
- (grep-find-use-xargs
- (format "%s . -type f -print | xargs %s"
- find-program grep-command))
- (t (cons (format "%s . -type f -exec %s {} %s \\;"
- find-program grep-command null-device)
- (+ 22 (length grep-command))))))))
-
-;;;###autoload
-(defun grep (command-args)
- "Run grep, with user-specified args, and collect output in a buffer.
-While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
-or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \
-output buffer, to go to the lines
-where grep found matches.
-
-This command uses a special history list for its COMMAND-ARGS, so you can
-easily repeat a grep command.
-
-A prefix argument says to default the argument based upon the current
-tag the cursor is over, substituting it into the last grep command
-in the grep command history (or into `grep-command'
-if that history list is empty)."
- (interactive
- (let (grep-default (arg current-prefix-arg))
- (unless (and grep-command
- (or (not grep-use-null-device) (eq grep-use-null-device t)))
- (grep-compute-defaults))
- (when arg
- (let ((tag-default
- (funcall (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- ;; We use grep-tag-default instead of
- ;; find-tag-default, to avoid loading etags.
- 'grep-tag-default))))
- (setq grep-default (or (car grep-history) grep-command))
- ;; Replace the thing matching for with that around cursor
- (when (string-match "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)\\(\\s-+\\S-+\\)?" grep-default)
- (unless (or (match-beginning 3) (not (stringp buffer-file-name)))
- (setq grep-default (concat grep-default "*."
- (file-name-extension buffer-file-name))))
- (setq grep-default (replace-match (or tag-default "")
- t t grep-default 2)))))
- (list (read-from-minibuffer "Run grep (like this): "
- (or grep-default grep-command)
- nil nil 'grep-history))))
-
- ;; Setting process-setup-function makes exit-message-function work
- ;; even when async processes aren't supported.
- (let* ((compilation-process-setup-function 'grep-process-setup)
- (buf (compile-internal (if (and grep-use-null-device null-device)
- (concat command-args " " null-device)
- command-args)
- "No more grep hits" "grep"
- ;; Give it a simpler regexp to match.
- nil grep-regexp-alist)))))
-
-;; This is a copy of find-tag-default from etags.el.
-(defun grep-tag-default ()
- (save-excursion
- (while (looking-at "\\sw\\|\\s_")
- (forward-char 1))
- (when (or (re-search-backward "\\sw\\|\\s_"
- (save-excursion (beginning-of-line) (point))
- t)
- (re-search-forward "\\(\\sw\\|\\s_\\)+"
- (save-excursion (end-of-line) (point))
- t))
- (goto-char (match-end 0))
- (buffer-substring (point)
- (progn (forward-sexp -1)
- (while (looking-at "\\s'")
- (forward-char 1))
- (point))))))
-
-;;;###autoload
-(defun grep-find (command-args)
- "Run grep via find, with user-specified args COMMAND-ARGS.
-Collect output in a buffer.
-While find runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a find command."
- (interactive
- (progn
- (unless grep-find-command
- (grep-compute-defaults))
- (list (read-from-minibuffer "Run find (like this): "
- grep-find-command nil nil
- 'grep-find-history))))
- (let ((null-device nil)) ; see grep
- (grep command-args)))
+ (apply 'compile-internal (or compilation-arguments
+ `(,(eval compile-command) "No more errors"))))
(defcustom compilation-scroll-output nil
"*Non-nil to scroll the *compilation* buffer window as output appears.
If current buffer is in Compilation mode for the same mode name
return the name of the current buffer, so that it gets reused.
Otherwise, construct a buffer name from MODE-NAME."
- (cond (name-function
+ (cond (name-function
(funcall name-function mode-name))
- (compilation-buffer-name-function
+ (compilation-buffer-name-function
(funcall compilation-buffer-name-function mode-name))
((and (eq major-mode 'compilation-mode)
(equal mode-name (nth 2 compilation-arguments)))
&optional name-of-mode parser
error-regexp-alist name-function
enter-regexp-alist leave-regexp-alist
- file-regexp-alist nomessage-regexp-alist)
+ file-regexp-alist nomessage-regexp-alist
+ no-async highlight-regexp local-map)
"Run compilation command COMMAND (low level interface).
ERROR-MESSAGE is a string to print if the user asks to see another error
-and there are no more errors. The rest of the arguments, 3-10 are optional.
-For them nil means use the default.
+and there are no more errors.
+
+The rest of the arguments are optional; for them, nil means use the default.
+
NAME-OF-MODE is the name to display as the major mode in the compilation
-buffer. PARSER is the error parser function. ERROR-REGEXP-ALIST is the error
-message regexp alist to use. NAME-FUNCTION is a function called to name the
-buffer. ENTER-REGEXP-ALIST is the enter directory message regexp alist to use.
+buffer.
+
+PARSER is the error parser function.
+ERROR-REGEXP-ALIST is the error message regexp alist to use.
+NAME-FUNCTION is a function called to name the buffer.
+ENTER-REGEXP-ALIST is the enter directory message regexp alist to use.
LEAVE-REGEXP-ALIST is the leave directory message regexp alist to use.
FILE-REGEXP-ALIST is the change current file message regexp alist to use.
NOMESSAGE-REGEXP-ALIST is the nomessage regexp alist to use.
\`compilation-buffer-name-function', `compilation-enter-directory-regexp-alist',
\`compilation-leave-directory-regexp-alist', `compilation-file-regexp-alist',
\ and `compilation-nomessage-regexp-alist', respectively.
-For arg 7-10 a value `t' means an empty alist.
+For arg 7-10 a value t means an empty alist.
+
+If NO-ASYNC is non-nil, start the compilation process synchronously.
+
+If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
+matching section of the visited source line; the default is to use the
+global value of `compilation-highlight-regexp'.
+
+If LOCAL-MAP is non-nil, use the given keymap instead of `compilation-mode-map'.
Returns the compilation buffer created."
+ (unless no-async
+ (setq no-async (not (fboundp 'start-process))))
(let (outbuf)
(save-excursion
(or name-of-mode
(setq file-regexp-alist compilation-file-regexp-alist))
(or nomessage-regexp-alist
(setq nomessage-regexp-alist compilation-nomessage-regexp-alist))
+ (or highlight-regexp
+ (setq highlight-regexp compilation-highlight-regexp))
(or parser (setq parser compilation-parse-errors-function))
(let ((thisdir default-directory)
outwin)
(goto-char (point-max)))
;; Pop up the compilation buffer.
(setq outwin (display-buffer outbuf nil t))
- (save-excursion
- (set-buffer outbuf)
+ (with-current-buffer outbuf
(compilation-mode name-of-mode)
+ (if local-map
+ (use-local-map local-map))
;; In what way is it non-ergonomic ? -stef
;; (toggle-read-only 1) ;;; Non-ergonomic.
(set (make-local-variable 'compilation-parse-errors-function) parser)
file-regexp-alist)
(set (make-local-variable 'compilation-nomessage-regexp-alist)
nomessage-regexp-alist)
+ (set (make-local-variable 'compilation-highlight-regexp)
+ highlight-regexp)
(set (make-local-variable 'compilation-arguments)
(list command error-message
name-of-mode parser
error-regexp-alist name-function
enter-regexp-alist leave-regexp-alist
- file-regexp-alist nomessage-regexp-alist))
+ file-regexp-alist nomessage-regexp-alist
+ nil ; or no-async ??
+ highlight-regexp local-map))
;; This proves a good idea if the buffer's going to scroll
;; with lazy-lock on.
(set (make-local-variable 'lazy-lock-defer-on-scrolling) t)
(set-window-start outwin (point-min))
(or (eq outwin (selected-window))
(set-window-point outwin (point-min)))
- (compilation-set-window-height outwin)
+ ;; 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)
;; Start the compilation.
- (if (fboundp 'start-process)
- (let* ((process-environment
- ;; Don't override users' setting of $EMACS.
- (if (getenv "EMACS")
- process-environment
- (cons "EMACS=t" process-environment)))
+ (if (not no-async)
+ (let* ((process-environment
+ (append
+ compilation-environment
+ (if (and (boundp 'system-uses-terminfo)
+ system-uses-terminfo)
+ (list "TERM=dumb" "TERMCAP="
+ (format "COLUMNS=%d" (window-width)))
+ (list "TERM=emacs"
+ (format "TERMCAP=emacs:co#%d:tc=unknown:"
+ (window-width))))
+ ;; Set the EMACS variable, but
+ ;; don't override users' setting of $EMACS.
+ (if (getenv "EMACS")
+ process-environment
+ (cons "EMACS=t" process-environment))))
(proc (start-process-shell-command (downcase mode-name)
outbuf
command)))
(t
(compilation-handle-exit 'bizarre status status))))
(message "Executing `%s'...done" command)))
- (if compilation-scroll-output
+ (if (buffer-local-value 'compilation-scroll-output outbuf)
(save-selected-window
- (select-window outwin)
- (goto-char (point-max)))))
+ (select-window outwin)
+ (goto-char (point-max)))))
;; Make it so the next C-x ` will use this buffer.
(setq compilation-last-buffer outbuf)))
(defun compilation-set-window-height (window)
"Set the height of WINDOW according to `compilation-window-height'."
- (and compilation-window-height
- (= (window-width window) (frame-width (window-frame window)))
- ;; If window is alone in its frame, aside from a minibuffer,
- ;; don't change its height.
- (not (eq window (frame-root-window (window-frame window))))
- ;; This save-excursion prevents us from changing the current buffer,
- ;; which might not be the same as the selected window's buffer.
- (save-excursion
- (let ((w (selected-window)))
- (unwind-protect
- (progn
- (select-window window)
- (enlarge-window (- compilation-window-height
- (window-height))))
- ;; The enlarge-window above may have deleted W, if
- ;; compilation-window-height is large enough.
- (when (window-live-p w)
- (select-window w)))))))
+ (let ((height (buffer-local-value 'compilation-window-height (window-buffer window))))
+ (and height
+ (= (window-width window) (frame-width (window-frame window)))
+ ;; If window is alone in its frame, aside from a minibuffer,
+ ;; don't change its height.
+ (not (eq window (frame-root-window (window-frame window))))
+ ;; This save-current-buffer prevents us from changing the current
+ ;; buffer, which might not be the same as the selected window's buffer.
+ (save-current-buffer
+ (save-selected-window
+ (select-window window)
+ (enlarge-window (- height (window-height))))))))
+
+(defvar compilation-menu-map
+ (let ((map (make-sparse-keymap "Errors")))
+ (define-key map [stop-subjob]
+ '("Stop Compilation" . kill-compilation))
+ (define-key map [compilation-mode-separator2]
+ '("----" . nil))
+ (define-key map [compilation-first-error]
+ '("First Error" . first-error))
+ (define-key map [compilation-previous-error]
+ '("Previous Error" . previous-error))
+ (define-key map [compilation-next-error]
+ '("Next Error" . next-error))
+ map))
(defvar compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\M-p" 'compilation-previous-error)
(define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file)
+ ;; Set up the menu-bar
+ (define-key map [menu-bar compilation]
+ (cons "Errors" compilation-menu-map))
map)
"Keymap for `compilation-minor-mode'.")
(define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file)
;; Set up the menu-bar
- (define-key map [menu-bar errors-menu]
- (cons "Errors" (make-sparse-keymap "Errors")))
- (define-key map [menu-bar errors-menu stop-subjob]
- '("Stop" . comint-interrupt-subjob))
- (define-key map [menu-bar errors-menu compilation-mode-separator2]
- '("----" . nil))
- (define-key map [menu-bar errors-menu compilation-mode-first-error]
- '("First Error" . first-error))
- (define-key map [menu-bar errors-menu compilation-mode-previous-error]
- '("Previous Error" . previous-error))
- (define-key map [menu-bar errors-menu compilation-mode-next-error]
- '("Next Error" . next-error))
+ (define-key map [menu-bar compilation]
+ (cons "Errors" compilation-menu-map))
map)
"Keymap for `compilation-shell-minor-mode'.")
(defvar compilation-mode-map
- (let ((map (cons 'keymap compilation-minor-mode-map)))
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map compilation-minor-mode-map)
(define-key map " " 'scroll-up)
(define-key map "\^?" 'scroll-down)
+
;; Set up the menu-bar
- (define-key map [menu-bar compilation-menu]
+ (define-key map [menu-bar compilation]
(cons "Compile" (make-sparse-keymap "Compile")))
-
- (define-key map [menu-bar compilation-menu compilation-mode-kill-compilation]
- '("Stop Compilation" . kill-compilation))
- (define-key map [menu-bar compilation-menu compilation-mode-separator2]
- '("----" . nil))
- (define-key map [menu-bar compilation-menu compilation-mode-first-error]
- '("First Error" . first-error))
- (define-key map [menu-bar compilation-menu compilation-mode-previous-error]
- '("Previous Error" . previous-error))
- (define-key map [menu-bar compilation-menu compilation-mode-next-error]
- '("Next Error" . next-error))
- (define-key map [menu-bar compilation-menu compilation-separator2]
+ (define-key map [menu-bar compilation compilation-separator2]
'("----" . nil))
- (define-key map [menu-bar compilation-menu compilation-mode-grep]
+ (define-key map [menu-bar compilation compilation-grep]
'("Search Files (grep)" . grep))
- (define-key map [menu-bar compilation-menu compilation-mode-recompile]
+ (define-key map [menu-bar compilation compilation-recompile]
'("Recompile" . recompile))
- (define-key map [menu-bar compilation-menu compilation-mode-compile]
+ (define-key map [menu-bar compilation compilation-compile]
'("Compile..." . compile))
map)
"Keymap for compilation log buffers.
-`compilation-minor-mode-map' is a cdr of this.")
+`compilation-minor-mode-map' is a parent of this.")
(put 'compilation-mode 'mode-class 'special)
(run-hooks 'compilation-mode-hook))
(defun compilation-revert-buffer (ignore-auto noconfirm)
- (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
- (apply 'compile-internal compilation-arguments)))
+ (if buffer-file-name
+ (let (revert-buffer-function)
+ (revert-buffer ignore-auto noconfirm))
+ (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
+ (apply 'compile-internal compilation-arguments))))
(defun compilation-setup ()
"Prepare the buffer for the compilation parsing commands to work."
(make-local-variable 'compilation-error-screen-columns)
(setq compilation-last-buffer (current-buffer)))
-(defvar compilation-shell-minor-mode nil
- "Non-nil when in `compilation-shell-minor-mode'.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available but bound to keys that don't
-collide with Shell mode.")
-(make-variable-buffer-local 'compilation-shell-minor-mode)
-
-(or (assq 'compilation-shell-minor-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons '(compilation-shell-minor-mode " Shell-Compile")
- minor-mode-alist)))
-(or (assq 'compilation-shell-minor-mode minor-mode-map-alist)
- (setq minor-mode-map-alist (cons (cons 'compilation-shell-minor-mode
- compilation-shell-minor-mode-map)
- minor-mode-map-alist)))
-
-(defvar compilation-minor-mode nil
- "Non-nil when in `compilation-minor-mode'.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available.")
-(make-variable-buffer-local 'compilation-minor-mode)
-
-(or (assq 'compilation-minor-mode minor-mode-alist)
- (setq minor-mode-alist (cons '(compilation-minor-mode " Compilation")
- minor-mode-alist)))
-(or (assq 'compilation-minor-mode minor-mode-map-alist)
- (setq minor-mode-map-alist (cons (cons 'compilation-minor-mode
- compilation-minor-mode-map)
- minor-mode-map-alist)))
-
;;;###autoload
-(defun compilation-shell-minor-mode (&optional arg)
+(define-minor-mode compilation-shell-minor-mode
"Toggle compilation shell minor mode.
With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available but bound to keys that don't
+collide with Shell mode. See `compilation-mode'.
Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
- (interactive "P")
- (if (setq compilation-shell-minor-mode (if (null arg)
- (null compilation-shell-minor-mode)
- (> (prefix-numeric-value arg) 0)))
- (let ((mode-line-process))
- (compilation-setup)
- (run-hooks 'compilation-shell-minor-mode-hook))))
+ nil " Shell-Compile" nil
+ :group 'compilation
+ (let (mode-line-process)
+ (compilation-setup)))
;;;###autoload
-(defun compilation-minor-mode (&optional arg)
+(define-minor-mode compilation-minor-mode
"Toggle compilation minor mode.
With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available. See `compilation-mode'.
Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
- (interactive "P")
- (if (setq compilation-minor-mode (if (null arg)
- (null compilation-minor-mode)
- (> (prefix-numeric-value arg) 0)))
- (let ((mode-line-process))
- (compilation-setup)
- (run-hooks 'compilation-minor-mode-hook))))
+ nil " Compilation" nil
+ :group 'compilation
+ (let ((mode-line-process))
+ (compilation-setup)))
(defun compilation-handle-exit (process-status exit-status msg)
"Write msg in the current buffer and hack its mode-line-process."
;; later on.
(goto-char omax)
(insert ?\n mode-name " " (car status))
+ (if (and (numberp compilation-window-height)
+ (zerop compilation-window-height))
+ (message "%s" (cdr status)))
(if (bolp)
(forward-char -1))
(insert " at " (substring (current-time-string) 0 19))
(goto-char (point-max))
+ ;; Prevent that message from being recognized as a compilation error.
+ (add-text-properties omax (point)
+ (append '(compilation-handle-exit t) nil))
(setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
;; Force mode line redisplay soon.
(force-mode-line-update)
(if (> (- n) i)
(error "Moved back past first error")
(nth (+ i n) compilation-old-error-list)))
- (let ((compilation-error-list (cdr errors)))
+ (save-excursion
+ (while (and (> n 0) errors)
+ ;; Discard the current error and any previous.
+ (while (and errors (>= (point) (car (car errors))))
+ (setq errors (cdr errors)))
+ ;; Now (car errors) is the next error.
+ ;; If we want to move down more errors,
+ ;; put point at this one and start again.
+ (setq n (1- n))
+ (if (and errors (> n 0))
+ (goto-char (car (car errors))))))
+ (let ((compilation-error-list errors))
(compile-reinitialize-errors nil nil n)
(if compilation-error-list
(nth (1- n) compilation-error-list)
(interactive "p")
(compilation-next-error (- n)))
+(defun next-error-no-select (n)
+ "Move point to the next error in the compilation buffer and highlight match.
+Prefix arg N says how many error messages to move forwards.
+Finds and highlights the source line like \\[next-error], but does not
+select the source buffer."
+ (interactive "p")
+ (next-error n)
+ (pop-to-buffer compilation-last-buffer))
+
+(defun previous-error-no-select (n)
+ "Move point to the previous error in the compilation buffer and highlight match.
+Prefix arg N says how many error messages to move forwards.
+Finds and highlights the source line like \\[next-error], but does not
+select the source buffer."
+ (interactive "p")
+ (next-error (- n))
+ (pop-to-buffer compilation-last-buffer))
;; Given an elt of `compilation-error-list', return an object representing
;; the referenced file which is equal to (but not necessarily eq to) what
(interactive "p")
(compilation-next-file (- n)))
-
(defun kill-compilation ()
- "Kill the process made by the \\[compile] command."
+ "Kill the process made by the \\[compile] or \\[grep] commands."
(interactive)
(let ((buffer (compilation-find-buffer)))
(if (get-buffer-process buffer)
(interrupt-process (get-buffer-process buffer))
(error "The compilation process is not running"))))
+(defalias 'kill-grep 'kill-compilation)
;; Parse any new errors in the compilation buffer,
;; or reparse from the beginning if the user has asked for that.
(let ((inhibit-read-only t)
(buffer-undo-list t)
deactivate-mark
+ (buffer-was-modified (buffer-modified-p))
(error-list compilation-error-list))
(while error-list
(save-excursion
(progn (end-of-line) (point))
'(mouse-face highlight help-echo "\
mouse-2: visit this file and line")))
- (setq error-list (cdr error-list))))
+ (setq error-list (cdr error-list)))
+ (set-buffer-modified-p buffer-was-modified))
)))))
(defun compile-mouse-goto-error (event)
;; compilation-next-error-locus.
(or (null (marker-buffer (caar compilation-error-list)))
(and (> (point) (caar compilation-error-list))
- (cdr compilation-error-list)
- ;; Don't skip too far: the text between two errors
- ;; belongs to the first. Especially since this
- ;; in-between text might be other errors on the same
- ;; line (see compilation-skip-to-next-location).
- (>= (point) (caar (cdr compilation-error-list))))))
+ (>= (point)
+ ;; Don't skip too far: the text between
+ ;; two errors belongs to the first. This
+ ;; in-between text might be other errors
+ ;; on the same line (see
+ ;; compilation-skip-to-next-location).
+ (if (null (cdr compilation-error-list))
+ compilation-parsing-end
+ (caar (cdr compilation-error-list)))))))
(setq compilation-error-list (cdr compilation-error-list)))
(or compilation-error-list
(error "No error to go to")))
;; compilation-next-error-locus.
(or (null (marker-buffer (caar compilation-error-list)))
(and (> (point) (caar compilation-error-list))
- (cdr compilation-error-list)
- (>= (point) (caar (cdr compilation-error-list))))))
+ (>= (point)
+ ;; Don't skip too far: the text between
+ ;; two errors belongs to the first. This
+ ;; in-between text might be other errors
+ ;; on the same line (see
+ ;; compilation-skip-to-next-location).
+ (if (null (cdr compilation-error-list))
+ compilation-parsing-end
+ (caar (cdr compilation-error-list)))))))
(setq compilation-error-list (cdr compilation-error-list)))
(push-mark)
(consp argp))))
;;;###autoload (define-key ctl-x-map "`" 'next-error)
-(defun previous-error ()
+(defun previous-error (argp)
"Visit previous compilation error message and corresponding source code.
-This operates on the output from the \\[compile] command."
- (interactive)
- (next-error -1))
+
+A prefix ARGP specifies how many error messages to move;
+negative means move forward to next error messages.
+
+This operates on the output from the \\[compile] and \\[grep] commands."
+ (interactive "P")
+ (next-error (- (prefix-numeric-value argp))))
(defun first-error ()
"Reparse the error message buffer and start at the first error.
;; Use an existing window if it is in a visible frame.
(w (or (get-buffer-window (marker-buffer (car next-error)) 'visible)
;; Pop up a window.
- (display-buffer (marker-buffer (car next-error))))))
+ (display-buffer (marker-buffer (car next-error)))))
+ (highlight-regexp (with-current-buffer (marker-buffer (car next-error))
+ compilation-highlight-regexp)))
(set-window-point w (car next-error))
(set-window-start w (car next-error))
- (compilation-set-window-height w)))
+ (compilation-set-window-height w)
+
+ (when highlight-regexp
+ (unless compilation-highlight-overlay
+ (setq compilation-highlight-overlay (make-overlay 1 1))
+ (overlay-put compilation-highlight-overlay 'face 'region))
+ (with-current-buffer (marker-buffer (cdr next-error))
+ (save-excursion
+ (end-of-line)
+ (let ((end (point)) olay)
+ (beginning-of-line)
+ (if (and (stringp highlight-regexp)
+ (re-search-forward highlight-regexp end t))
+ (progn
+ (goto-char (match-beginning 0))
+ (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0)))
+ (move-overlay compilation-highlight-overlay (point) end))
+ (sit-for 0 500)
+ (delete-overlay compilation-highlight-overlay)))))))
+
\f
(defun compilation-find-file (marker filename dir &rest formats)
"Find a buffer for file FILENAME.
(overlays-in (point-min) (point-max)))
buffer)))
+(defun compilation-normalize-filename (filename)
+ "Convert a filename string found in an error message to make it usable."
+
+ ;; Check for a comint-file-name-prefix and prepend it if
+ ;; appropriate. (This is very useful for
+ ;; compilation-minor-mode in an rlogin-mode buffer.)
+ (and (boundp 'comint-file-name-prefix)
+ ;; If file name is relative, default-directory will
+ ;; already contain the comint-file-name-prefix (done
+ ;; by compile-abbreviate-directory).
+ (file-name-absolute-p filename)
+ (setq filename
+ (concat comint-file-name-prefix filename)))
+
+ ;; If compilation-parse-errors-filename-function is
+ ;; defined, use it to process the filename.
+ (when compilation-parse-errors-filename-function
+ (setq filename
+ (funcall compilation-parse-errors-filename-function
+ filename)))
+
+ ;; Some compilers (e.g. Sun's java compiler, reportedly)
+ ;; produce bogus file names like "./bar//foo.c" for file
+ ;; "bar/foo.c"; expand-file-name will collapse these into
+ ;; "/foo.c" and fail to find the appropriate file. So we
+ ;; look for doubled slashes in the file name and fix them
+ ;; up in the buffer.
+ (setq filename (command-line-normalize-file-name filename)))
;; Set compilation-error-list to nil, and unchain the markers that point to the
;; error messages and their text, so that they no longer slow down gap motion.
(setq compilation-old-error-list (cdr compilation-old-error-list)))
(setq compilation-error-list nil
compilation-directory-stack (list default-directory))
- (set-marker compilation-parsing-end 1)
+ (if compilation-parsing-end
+ (set-marker compilation-parsing-end 1))
;; Remove the highlighting added by compile-reinitialize-errors:
(let ((inhibit-read-only t)
(buffer-undo-list t)
(forward-line 2))
;; Parse messages.
- (while (not (or found-desired (eobp)))
+ (while (not (or found-desired (eobp)
+ ;; Don't parse the "compilation finished" message
+ ;; as a compilation error.
+ (get-text-property (point) 'compilation-handle-exit)))
(let ((this compilation-regexps) (prev nil) (alist nil) type)
;; Go through the regular expressions. If a match is found,
;; variable alist is set to the corresponding alist and the
(error "\
An error message with no file name and no file name has been seen earlier"))
- ;; Check for a comint-file-name-prefix and prepend it if
- ;; appropriate. (This is very useful for
- ;; compilation-minor-mode in an rlogin-mode buffer.)
- (and (boundp 'comint-file-name-prefix)
- ;; If file name is relative, default-directory will
- ;; already contain the comint-file-name-prefix (done
- ;; by compile-abbreviate-directory).
- (file-name-absolute-p filename)
- (setq filename
- (concat comint-file-name-prefix filename)))
-
- ;; Some compilers (e.g. Sun's java compiler, reportedly)
- ;; produce bogus file names like "./bar//foo.c" for file
- ;; "bar/foo.c"; expand-file-name will collapse these into
- ;; "/foo.c" and fail to find the appropriate file. So we
- ;; look for doubled slashes in the file name and fix them
- ;; up in the buffer.
- (setq filename (command-line-normalize-file-name filename))
+ ;; Clean up the file name string in several ways.
+ (setq filename (compilation-normalize-filename filename))
(setq filename
(cons filename (cons default-directory (cdr alist))))
;; Not an error message.
(if (eq type `file) ; Change current file.
- (and filename (setq compilation-current-file filename))
+ (when filename
+ (setq compilation-current-file
+ ;; Clean up the file name string in several ways.
+ (compilation-normalize-filename filename)))
;; Enter or leave directory.
(setq stack compilation-directory-stack)
- (and filename
- (file-directory-p
- (setq filename
- ;; The directory name in the message
- ;; is a truename. Try to convert it to a form
- ;; like what the user typed in.
- (compile-abbreviate-directory
- (file-name-as-directory
- (expand-file-name filename))
- orig orig-expanded parent-expanded)))
- (if (eq type 'leave)
- (while (and stack
- (not (string-equal (car stack)
- filename)))
- (setq stack (cdr stack)))
- (setq compilation-directory-stack
- (cons filename compilation-directory-stack)
- default-directory filename)))
+ ;; Don't check if it is really a directory.
+ ;; Let the code to search and clean up file names
+ ;; try to use it in any case.
+ (when filename
+ ;; Clean up the directory name string in several ways.
+ (setq filename (compilation-normalize-filename filename))
+ (setq filename
+ ;; The directory name in the message
+ ;; is a truename. Try to convert it to a form
+ ;; like what the user typed in.
+ (compile-abbreviate-directory
+ (file-name-as-directory
+ (expand-file-name filename))
+ orig orig-expanded parent-expanded))
+ (if (eq type 'leave)
+ ;; If we are leaving a specific directory,
+ ;; as preparation, pop out of all other directories
+ ;; that we entered nested within it.
+ (while (and stack
+ (not (string-equal (car stack)
+ filename)))
+ (setq stack (cdr stack)))
+ (setq compilation-directory-stack
+ (cons filename compilation-directory-stack)
+ default-directory filename)))
(and (eq type 'leave)
stack
(setq compilation-directory-stack (cdr stack))
;; Use floating-point because (* 100 (point)) frequently
;; exceeds the range of Emacs Lisp integers.
(/ (* 100.0 (point)) (point-max)))
- ))
+ )))
- (forward-line 1))) ; End of while loop. Look at next line.
+ (forward-line 1)) ; End of while loop. Look at next line.
(set-marker compilation-parsing-end (point))
(setq compilation-error-list (nreverse compilation-error-list))
(provide 'compile)
+;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
;;; compile.el ends here
HCoop / bpt / emacs.git / blobdiff