-;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
+;;; compile.el --- run compiler as inferior of Emacs, parse error messages
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 1998 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@prep.ai.mit.edu>
+;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: FSF
;; Keywords: tools, processes
integer)
:group 'compilation)
-(defvar compile-auto-highlight nil
+(defcustom compile-auto-highlight nil
"*Specify how many compiler errors to highlight (and parse) initially.
\(Highlighting applies to an error message when the mouse is over it.)
If this is a number N, all compiler error messages in the first N lines
move to the error messages.
Those messages which are not parsed and highlighted initially
-will be parsed and highlighted as soon as you try to move to them.")
+will be parsed and highlighted as soon as you try to move to them."
+ :type '(choice (const :tag "All" t)
+ (const :tag "None" nil)
+ (integer :tag "First N lines"))
+ :group 'compilation)
(defvar compilation-error-list nil
"List of error message descriptors for visiting erring functions.
`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
minor-mode-alist)))
(defvar compilation-parsing-end nil
- "Position of end of buffer when last error messages were parsed.")
+ "Marker position of end of buffer when last error messages were parsed.")
(defvar compilation-error-message "No more errors"
"Message to print when no more matches are found.")
;; We'll insist that the number be followed by a colon or closing
;; paren, because otherwise this matches just about anything
;; containing a number with spaces around it.
- ("\\([a-zA-Z]+:\\)?\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\
-\\([) \t]\\|:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 2 3 6)
+
+ ;; We insist on a non-digit in the file name
+ ;; so that we don't mistake the file name for a command name
+ ;; and take the line number as the file name.
+ ("\\([a-zA-Z][-a-zA-Z._0-9]+: ?\\)?\
+\\([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
;; parens around the line number, but that caused confusion for
;; GNU-style error messages.
;; This used to reject spaces and dashes in file names,
- ;; but they are valudnow; so I made it more strict about the error
+ ;; but they are valid now; so I made it more strict about the error
;; message that follows.
("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
: \\(error\\|warning\\) C[0-9]+:" 1 3)
- ;; Borland C++:
+ ;; Borland C++, C++Builder:
;; Error ping.c 15: Unable to open include file 'sys/types.h'
;; Warning ping.c 68: Call to function 'func' with no prototype
- ("\\(Error\\|Warning\\) \\([a-zA-Z]?:?[^:( \t\n]+\\)\
- \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 2 3)
+ ;; Error E2010 ping.c 15: Unable to open include file 'sys/types.h'
+ ;; Warning W1022 ping.c 68: Call to function 'func' with no prototype
+ ("\\(Error\\|Warning\\) \\(\\([FEW][0-9]+\\) \\)?\
+\\([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)
(".*\"\\([^,\" \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)
;; E, file.cc(35,52) Illegal operation on pointers
("[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3)
-;;; This seems to be superfluous because the first pattern matches it.
-;;; ;; GNU messages with program name and optional column number.
-;;; ("[a-zA-Z]?:?[^0-9 \n\t:]+[^ \n\t:]*:[ \t]*\\([^ \n\t:]+\\):\
-;;;\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
+ ;; This seems to be superfluous because the first pattern matches it.
+ ;; ;; GNU messages with program name and optional column number.
+ ;; ("[a-zA-Z]?:?[^0-9 \n\t:]+[^ \n\t:]*:[ \t]*\\([^ \n\t:]+\\):\
+ ;;\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
;; Cray C compiler error messages
("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \
;; Perl -w:
;; syntax error at automake line 922, near "':'"
- (".* at \\([^ ]+\\) line \\([0-9]+\\)," 1 2)
+ ;; Perl debugging traces
+ ;; store::odrecall('File_A', 'x2') called at store.pm line 90
+ (".* at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 1 2)
;; Oracle pro*c:
;; Semantic error at line 528, column 5, file erosacqdb.pc:
;; Error 24 at (2:progran.f90) : syntax error
("Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1)
+ ;; SGI IRIX MipsPro 7.3 compilers:
+ ;; cc-1070 cc: ERROR File = linkl.c, Line = 38
+ (".*: ERROR File = \\(.+\\), Line = \\([0-9]+\\)" 1 2)
+ (".*: WARNING File = \\(.+\\), Line = \\([0-9]+\\)" 1 2)
+
;; Sun F90 error messages:
- ;; cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 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.
Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...])
If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and
'(
;; 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 IDX).
If REGEXP matches, the IDX'th subexpression gives the name of the directory
-being moved from. If IDX is nil, the last directory entered \(by a line
+being moved from. If IDX is nil, the last directory entered \(by a line
matching `compilation-enter-directory-regexp-alist'\) is assumed.
The default value matches lines printed by the `-w' option of GNU Make.")
"Alist specifying how to match lines that indicate a new current file.
Note that the match is done at the beginning of lines.
Each elt has the form (REGEXP IDX).
-If REGEXP matches, the IDX'th subexpression gives the file name. This is
+If REGEXP matches, the IDX'th subexpression gives the file name. This is
used with compilers that don't indicate file name in every error message.")
;; There is no generally useful regexp that will match non messages, but
)
"Alist specifying how to match lines that have no message.
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
+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
+each character occupying one column.
+The default is to use screen columns, which requires that the compilation
+program and Emacs agree about the display width of the characters,
+especially the TAB character."
+ :type 'boolean
+ :group 'compilation
+ :version "20.4")
+
(defcustom compilation-read-command t
- "*If not nil, M-x compile reads the compilation command to use.
-Otherwise, M-x compile just uses the value of `compile-command'."
+ "*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
- "*If not nil, M-x 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)
-(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'.")
-
-;; The system null device. (Should reference NULL_DEVICE from C.)
-(defvar grep-null-device "/dev/null" "The system null device.")
-
-(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" grep-null-device)
-;;; (error nil))
-;;; 1)
-;;; "zgrep"
-;;; "grep")
- "The default grep program for `grep-command' and `grep-find-command'.")
-
-;; Use -e if grep supports it,
-;; because that avoids lossage if the pattern starts with `-'.
-(defvar grep-command
- (if (equal (condition-case nil ; in case "grep" isn't in exec-path
- (call-process grep-program nil nil nil
- "-e" "foo" grep-null-device)
- (error nil))
- 1)
- (format "%s -n -e " grep-program)
- (format "%s -n " grep-program))
- "The default grep command for \\[grep].")
-
-(defvar grep-find-use-xargs
- (if (equal (call-process "find" nil nil nil
- grep-null-device "-print0")
- 0)
- 'gnu)
- "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 `compile.el' is loaded
-by influencing the default value for the variable `grep-find-command'.")
-
-(defvar grep-find-command
- (cond ((eq grep-find-use-xargs 'gnu)
- (format "find . -type f -print0 | xargs -0 -e %s" grep-command))
- (grep-find-use-xargs
- (format "find . -type f -print | xargs %s" grep-command))
- (t (cons (format "find . -type f -exec %s {} /dev/null \\;"
- grep-command)
- (+ 22 (length grep-command)))))
- "The default find command for \\[grep-find].")
-
;;;###autoload
(defcustom compilation-search-path '(nil)
"*List of directories to search for source files named in error messages.
You might also use mode hooks to specify it in certain modes, like this:
(add-hook 'c-mode-hook
- (function
(lambda ()
(unless (or (file-exists-p \"makefile\")
(file-exists-p \"Makefile\"))
- (make-local-variable 'compile-command)
- (setq compile-command
- (concat \"make -k \"
- (file-name-sans-extension buffer-file-name)))))))"
+ (set (make-local-variable 'compile-command)
+ (concat \"make -k \"
+ (file-name-sans-extension buffer-file-name))))))"
:type 'string
:group 'compilation)
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
(interactive
(if (or compilation-read-command current-prefix-arg)
(list (read-from-minibuffer "Compile command: "
- compile-command nil nil
+ (eval compile-command) nil nil
'(compile-history . 1)))
- (list compile-command)))
- (setq compile-command command)
+ (list (eval compile-command))))
+ (unless (equal command (eval compile-command))
+ (setq compile-command command))
(save-some-buffers (not compilation-ask-about-save) nil)
- (compile-internal compile-command "No more errors"))
+ (compile-internal command "No more errors"))
-;;; run compile with the default command line
+;; 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 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)))))
-
-;;;###autoload
-(defun grep (command-args)
- "Run grep, with user-specified args, and collect output in a buffer.
-While grep 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 grep command."
- (interactive
- (list (read-from-minibuffer "Run grep (like this): "
- 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 grep-null-device
- (concat command-args " " grep-null-device)
- command-args)
- "No more grep hits" "grep"
- ;; Give it a simpler regexp to match.
- nil grep-regexp-alist)))))
-
-
-;;;###autoload
-(defun grep-find (command-args)
- "Run grep via find, with user-specified args, and 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
- (list (read-from-minibuffer "Run find (like this): "
- grep-find-command nil nil 'grep-find-history)))
- (let ((grep-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.
end of their output window so that the end of the output is always
visible rather than the begining."
:type 'boolean
- :version 20.3
+ :version "20.3"
:group 'compilation)
+
+(defun compilation-buffer-name (mode-name name-function)
+ "Return the name of a compilation buffer to use.
+If NAME-FUNCTION is non-nil, call it with one argument MODE-NAME
+to determine the buffer name.
+Likewise if `compilation-buffer-name-function' is non-nil.
+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
+ (funcall name-function mode-name))
+ (compilation-buffer-name-function
+ (funcall compilation-buffer-name-function mode-name))
+ ((and (eq major-mode 'compilation-mode)
+ (equal mode-name (nth 2 compilation-arguments)))
+ (buffer-name))
+ (t
+ (concat "*" (downcase mode-name) "*"))))
+
+
(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)
+ 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 name-of-mode "Compilation"))
(setq outbuf
- (get-buffer-create
- (funcall (or name-function compilation-buffer-name-function
- (function (lambda (mode)
- (concat "*" (downcase mode) "*"))))
- name-of-mode)))
+ (get-buffer-create (compilation-buffer-name name-of-mode
+ name-function)))
(set-buffer outbuf)
(let ((comp-proc (get-buffer-process (current-buffer))))
(if comp-proc
(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)
(if (eq outbuf (current-buffer))
(goto-char (point-max)))
;; Pop up the compilation buffer.
- (setq outwin (display-buffer outbuf))
- (save-excursion
- (set-buffer outbuf)
+ (setq outwin (display-buffer outbuf nil t))
+ (with-current-buffer outbuf
(compilation-mode name-of-mode)
- ;; (setq buffer-read-only t) ;;; Non-ergonomic.
+ (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)
(set (make-local-variable 'compilation-error-message) error-message)
(set (make-local-variable 'compilation-error-regexp-alist)
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))
- (make-local-variable 'lazy-lock-defer-on-scrolling)
+ 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.
- (setq lazy-lock-defer-on-scrolling t)
+ (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)
(setq default-directory thisdir
compilation-directory-stack (list default-directory))
(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 (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
- (let ((currbuf (current-buffer)))
- (select-window outwin)
- (goto-char (point-max))
- (select-window (get-buffer-window currbuf)))))
+ (if (buffer-local-value 'compilation-scroll-output outbuf)
+ (save-selected-window
+ (select-window outwin)
+ (goto-char (point-max)))))
;; Make it so the next C-x ` will use this buffer.
(setq compilation-last-buffer outbuf)))
-;; Set the height of WINDOW according to compilation-window-height.
(defun compilation-set-window-height (window)
- (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))))
- (select-window w))))))
+ "Set the height of WINDOW according to `compilation-window-height'."
+ (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))))
-;; Prepare the buffer for the compilation parsing commands to work.
(defun compilation-setup ()
+ "Prepare the buffer for the compilation parsing commands to work."
;; Make the buffer's mode line show process state.
(setq mode-line-process '(":%s"))
(set (make-local-variable 'compilation-error-list) nil)
(set (make-local-variable 'compilation-old-error-list) nil)
- (set (make-local-variable 'compilation-parsing-end) 1)
- (set (make-local-variable 'compilation-directory-stack) nil)
+ (set (make-local-variable 'compilation-parsing-end) (copy-marker 1))
+ (set (make-local-variable 'compilation-directory-stack)
+ (list default-directory))
+ (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.
+;;;###autoload
+(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.
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)))
+collide with Shell mode. See `compilation-mode'.
+Turning the mode on runs the normal hook `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))))
-
-;; Write msg in the current buffer and hack its mode-line-process.
+ 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."
(let ((buffer-read-only nil)
(status (if compilation-exit-message-function
(funcall compilation-exit-message-function
;; later on.
(goto-char omax)
(insert ?\n mode-name " " (car status))
- (forward-char -1)
+ (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))
- (forward-char 1)
+ (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 (buffer-name (process-buffer proc))
(save-excursion
(set-buffer (process-buffer proc))
- (let ((buffer-read-only nil))
+ (let ((buffer-read-only nil)
+ (end (marker-position compilation-parsing-end)))
(save-excursion
(goto-char (process-mark proc))
(insert-before-markers string)
+ (set-marker compilation-parsing-end end) ;don't move it
(run-hooks 'compilation-filter-hook)
- (set-marker (process-mark proc) (point)))))))
+ ;; this seems redundant since we insert-before-marks -stefan
+ ;;(set-marker (process-mark proc) (point))
+ )))))
-;; Return the cdr of compilation-old-error-list for the error containing point.
(defun compile-error-at-point ()
+ "Return the cdr of `compilation-old-error-list' for error containing point."
(compile-reinitialize-errors nil (point))
(let ((errors compilation-old-error-list))
(while (and errors
(defun compilation-next-error (n)
"Move point to the next error in the compilation buffer.
+Prefix arg N says how many error messages to move forwards (or
+backwards, if negative).
Does NOT find the source line like \\[next-error]."
(interactive "p")
(or (compilation-buffer-p (current-buffer))
- (error "Not in a compilation buffer."))
+ (error "Not in a compilation buffer"))
(setq compilation-last-buffer (current-buffer))
(let ((errors (compile-error-at-point)))
(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)
(defun compilation-previous-error (n)
"Move point to the previous error in the compilation buffer.
+Prefix arg N says how many error messages to move backwards (or
+forwards, if negative).
Does NOT find the source line like \\[next-error]."
(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
"Move point to the next error for a different file than the current one."
(interactive "p")
(or (compilation-buffer-p (current-buffer))
- (error "Not in a compilation buffer."))
+ (error "Not in a compilation buffer"))
(setq compilation-last-buffer (current-buffer))
(let ((reversed (< n 0))
(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."))))
+ (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.
;; Mouse-Highlight (the first line of) each error message when the
;; mouse pointer moves over it:
(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
- (put-text-property (goto-char (car (car error-list)))
- (progn (end-of-line) (point))
- 'mouse-face 'highlight))
- (setq error-list (cdr error-list))))
+ (add-text-properties (goto-char (car (car error-list)))
+ (progn (end-of-line) (point))
+ '(mouse-face highlight help-echo "\
+mouse-2: visit this file and line")))
+ (setq error-list (cdr error-list)))
+ (set-buffer-modified-p buffer-was-modified))
)))))
(defun compile-mouse-goto-error (event)
+ "Visit the source for the error message the mouse is pointing at.
+This is like `compile-goto-error' called without prefix arg
+at the end of the line."
(interactive "e")
(save-excursion
(set-buffer (window-buffer (posn-window (event-end event))))
(goto-char (posn-point (event-end event)))
(or (compilation-buffer-p (current-buffer))
- (error "Not in a compilation buffer."))
+ (error "Not in a compilation buffer"))
(setq compilation-last-buffer (current-buffer))
;; `compile-reinitialize-errors' needs to see the complete filename
;; on the line where they clicked the mouse. Since it only looks
;; we want.
(setq compilation-error-list compilation-old-error-list)
(while (and compilation-error-list
- (> (point) (car (car compilation-error-list))))
+ ;; The marker can point nowhere if we previously
+ ;; failed to find the relevant file. See
+ ;; compilation-next-error-locus.
+ (or (null (marker-buffer (caar compilation-error-list)))
+ (and (> (point) (caar 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")))
(select-window (posn-window (event-end event)))
- ;; Move to another window, so that next-error's window changes
- ;; result in the desired setup.
- (or (one-window-p)
- (progn
- (other-window -1)
- ;; other-window changed the selected buffer,
- ;; but we didn't want to do that.
- (set-buffer compilation-last-buffer)))
(push-mark)
(next-error 1))
other kinds of prefix arguments are ignored."
(interactive "P")
(or (compilation-buffer-p (current-buffer))
- (error "Not in a compilation buffer."))
+ (error "Not in a compilation buffer"))
(setq compilation-last-buffer (current-buffer))
(compile-reinitialize-errors (consp argp) (point))
;; we want.
(setq compilation-error-list compilation-old-error-list)
(while (and compilation-error-list
- (> (point) (car (car compilation-error-list))))
+ ;; The marker can point nowhere if we previously
+ ;; failed to find the relevant file. See
+ ;; compilation-next-error-locus.
+ (or (null (marker-buffer (caar compilation-error-list)))
+ (and (> (point) (caar 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)))
- ;; Move to another window, so that next-error's window changes
- ;; result in the desired setup.
- (or (one-window-p)
- (progn
- (other-window -1)
- ;; other-window changed the selected buffer,
- ;; but we didn't want to do that.
- (set-buffer compilation-last-buffer)))
-
(push-mark)
(next-error 1))
;;;###autoload
(defun next-error (&optional argp)
"Visit next compilation error message and corresponding source code.
-This operates on the output from the \\[compile] command.
-If all preparsed error messages have been processed,
-the error message buffer is checked for new ones.
-A prefix arg specifies how many error messages to move;
+If all the error messages parsed so far have been processed already,
+the message buffer is checked for new ones.
+
+A prefix ARGP specifies how many error messages to move;
negative means move back to previous error messages.
-Just C-u as a prefix means reparse the error message buffer
+Just \\[universal-argument] as a prefix means reparse the error message buffer
and start at the first error.
-\\[next-error] normally applies to the most recent compilation started,
-but as long as you are in the middle of parsing errors from one compilation
-output buffer, you stay with that compilation output buffer.
+\\[next-error] normally uses the most recently started compilation or
+grep buffer. However, it can operate on any buffer with output from
+the \\[compile] and \\[grep] commands, or, more generally, on any
+buffer in Compilation mode or with Compilation Minor mode enabled. To
+specify use of a particular buffer for error messages, type
+\\[next-error] in that buffer.
-Use \\[next-error] in a compilation output buffer to switch to
-processing errors from that compilation.
+Once \\[next-error] has chosen the buffer for error messages,
+it stays with that buffer until you use it in some other buffer which
+uses Compilation mode or Compilation Minor mode.
See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
(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.
The current buffer should be the desired compilation output buffer."
(or move (setq move 1))
- (compile-reinitialize-errors reparse nil (and (not reparse)
- (if (< move 1) 0 (1- move))))
+ (compile-reinitialize-errors reparse nil (and (not reparse) (max 0 move)))
(let (next-errors next-error)
(catch 'no-next-error
(save-excursion
;; Look for the next error.
t)
;; We found the file. Get a marker for this error.
- ;; compilation-old-error-list is a buffer-local
- ;; variable, so we must be careful to extract its value
+ ;; compilation-old-error-list and
+ ;; compilation-error-screen-columns are buffer-local
+ ;; so we must be careful to extract their value
;; before switching to the source file buffer.
(let ((errors compilation-old-error-list)
+ (columns compilation-error-screen-columns)
(last-line (nth 1 (cdr next-error)))
(column (nth 2 (cdr next-error))))
(set-buffer buffer)
(goto-line last-line)
(if (and column (> column 0))
;; Columns in error msgs are 1-origin.
- (forward-char (1- column))
+ (if columns
+ (move-to-column (1- column))
+ (forward-char (1- column)))
(beginning-of-line))
(setcdr next-error (point-marker))
;; Make all the other error messages referring
lines))
(forward-line lines))
(if (and column (> column 1))
- (forward-char (1- column))
+ (if columns
+ (move-to-column (1- column))
+ (forward-char (1- column)))
(beginning-of-line))
(setq last-line this)
(setcdr (car errors) (point-marker))))
"Jump to an error locus returned by `compilation-next-error-locus'.
Takes one argument, a cons (ERROR . SOURCE) of two markers.
Selects a window with point at SOURCE, with another window displaying ERROR."
- (if (and (window-dedicated-p (selected-window))
- (eq (selected-window) (frame-root-window)))
- (switch-to-buffer-other-frame (marker-buffer (cdr next-error)))
- (switch-to-buffer (marker-buffer (cdr next-error))))
+ (if (eq (window-buffer (selected-window))
+ (marker-buffer (car next-error)))
+ ;; If the compilation buffer window is selected,
+ ;; keep the compilation buffer in this window;
+ ;; display the source in another window.
+ (let ((pop-up-windows t))
+ (pop-to-buffer (marker-buffer (cdr next-error))))
+ (if (window-dedicated-p (selected-window))
+ (pop-to-buffer (marker-buffer (cdr next-error)))
+ (switch-to-buffer (marker-buffer (cdr next-error)))))
(goto-char (cdr next-error))
;; If narrowing got in the way of
;; going to the right place, widen.
(progn
(widen)
(goto-char (cdr next-error))))
+ ;; If hideshow got in the way of
+ ;; seeing the right place, open permanently.
+ (mapcar (function (lambda (ov)
+ (when (eq 'hs (overlay-get ov 'invisible))
+ (delete-overlay ov)
+ (goto-char (cdr next-error)))))
+ (overlays-at (point)))
;; Show compilation buffer in other window, scrolled to this error.
(let* ((pop-up-windows t)
;; 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
-;; Find a buffer for file FILENAME.
-;; Search the directories in compilation-search-path.
-;; A nil in compilation-search-path means to try the
-;; current directory, which is passed in DIR.
-;; If FILENAME is not found at all, ask the user where to find it.
-;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
(defun compilation-find-file (marker filename dir &rest formats)
+ "Find a buffer for file FILENAME.
+Search the directories in `compilation-search-path'.
+A nil in `compilation-search-path' means to try the
+current directory, which is passed in DIR.
+If FILENAME is not found at all, ask the user where to find it.
+Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
(or formats (setq formats '("%s")))
- (let ((dirs compilation-search-path)
- buffer thisdir fmts name)
- (if (file-name-absolute-p filename)
- ;; The file name is absolute. Use its explicit directory as
- ;; the first in the search path, and strip it from FILENAME.
- (setq filename (abbreviate-file-name (expand-file-name filename))
- dirs (cons (file-name-directory filename) dirs)
- filename (file-name-nondirectory filename)))
- ;; Now search the path.
- (while (and dirs (null buffer))
- (setq thisdir (or (car dirs) dir)
- fmts formats)
- ;; For each directory, try each format string.
- (while (and fmts (null buffer))
- (setq name (expand-file-name (format (car fmts) filename) thisdir)
- buffer (and (file-exists-p name)
- (find-file-noselect name))
- fmts (cdr fmts)))
- (setq dirs (cdr dirs)))
- (or buffer
- ;; The file doesn't exist.
- ;; Ask the user where to find it.
- ;; If he hits C-g, then the next time he does
- ;; next-error, he'll skip past it.
- (let* ((pop-up-windows t)
- (w (display-buffer (marker-buffer marker))))
- (set-window-point w marker)
- (set-window-start w marker)
- (let ((name (expand-file-name
- (read-file-name
- (format "Find this error in: (default %s) "
- filename)
- dir filename t))))
- (if (file-directory-p name)
- (setq name (expand-file-name filename name)))
- (and (file-exists-p name)
- (find-file-noselect name)))))))
+ (save-excursion
+ (let ((dirs compilation-search-path)
+ buffer thisdir fmts name)
+ (if (file-name-absolute-p filename)
+ ;; The file name is absolute. Use its explicit directory as
+ ;; the first in the search path, and strip it from FILENAME.
+ (setq filename (abbreviate-file-name (expand-file-name filename))
+ dirs (cons (file-name-directory filename) dirs)
+ filename (file-name-nondirectory filename)))
+ ;; Now search the path.
+ (while (and dirs (null buffer))
+ (setq thisdir (or (car dirs) dir)
+ fmts formats)
+ ;; For each directory, try each format string.
+ (while (and fmts (null buffer))
+ (setq name (expand-file-name (format (car fmts) filename) thisdir)
+ buffer (and (file-exists-p name)
+ (find-file-noselect name))
+ fmts (cdr fmts)))
+ (setq dirs (cdr dirs)))
+ (or buffer
+ ;; The file doesn't exist.
+ ;; Ask the user where to find it.
+ ;; If he hits C-g, then the next time he does
+ ;; next-error, he'll skip past it.
+ (let* ((pop-up-windows t)
+ (w (display-buffer (marker-buffer marker))))
+ (set-window-point w marker)
+ (set-window-start w marker)
+ (let ((name (expand-file-name
+ (read-file-name
+ (format "Find this error in: (default %s) "
+ filename)
+ dir filename t))))
+ (if (file-directory-p name)
+ (setq name (expand-file-name filename name)))
+ (setq buffer (and (file-exists-p name)
+ (find-file name))))))
+ ;; Make intangible overlays tangible.
+ (mapcar (function (lambda (ov)
+ (when (overlay-get ov 'intangible)
+ (overlay-put ov 'intangible nil))))
+ (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.
(set-marker (cdr next-error) nil)))
(setq compilation-old-error-list (cdr compilation-old-error-list)))
(setq compilation-error-list nil
- compilation-directory-stack (list default-directory)
- compilation-parsing-end 1)
+ compilation-directory-stack (list default-directory))
+ (if compilation-parsing-end
+ (set-marker compilation-parsing-end 1))
;; Remove the highlighting added by compile-reinitialize-errors:
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max) '(mouse-face highlight)))
- )
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t)
+ deactivate-mark)
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face highlight help-echo nil))))
;; This function is not needed any more by compilation mode.
groupings))
(defvar compilation-current-file nil
- "Used by compilation-parse-errors to store filename for file being compiled")
+ "Used by `compilation-parse-errors' to store filename for file being compiled.")
;; This variable is not used as a global variable. It's defined here just to
;; shut up the byte compiler. It's bound and used by compilation-parse-errors
(compile-collect-regexps 'leave compilation-leave-directory-regexp-alist)
(compile-collect-regexps 'enter compilation-enter-directory-regexp-alist)
(compile-collect-regexps 'file compilation-file-regexp-alist)
- (compile-collect-regexps 'nomessage compilation-nomessage-regexp-alist)
(compile-collect-regexps 'error compilation-error-regexp-alist)
+ (compile-collect-regexps 'nomessage compilation-nomessage-regexp-alist)
;; Don't reparse messages already seen at last parse.
(goto-char compilation-parsing-end)
(when (and (bobp)
- (eq major-mode 'compilation-mode))
+ (compilation-buffer-p (current-buffer)))
(setq compilation-current-file nil) ; No current file at start.
;; Don't parse the first two lines as error messages.
;; This matters for grep.
(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
;; No file name in message, we must have seen it before
(setq filename compilation-current-file)
(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))
+An error message with no file name and no file name has been seen earlier"))
+
+ ;; Clean up the file name string in several ways.
+ (setq filename (compilation-normalize-filename filename))
(setq filename
(cons filename (cons default-directory (cdr alist))))
;; descriptor or nil (meaning no position).
(save-excursion
(funcall linenum filename column))))
-
+
;; We have an error position descriptor.
;; If we have found as many new errors as the user
;; wants, or if we are past the buffer position he
find-at-least))
(and limit-search
(>= end-of-match limit-search)))
- (not (equal ; Same filename?
- (car (cdr (car compilation-error-list)))
- (car (cdr this-error)))))
+ ;; `this-error' could contain a pair of
+ ;; markers already.
+ (let ((thispos (cdr this-error))
+ (lastpos (cdar compilation-error-list)))
+ (not (equal
+ (if (markerp thispos)
+ (marker-buffer thispos)
+ (car thispos))
+ (if (markerp lastpos)
+ (marker-buffer lastpos)
+ (car lastpos))))))
;; We are past the limits and the last error
;; parsed, didn't belong to the same source file
;; as the earlier ones i.e. we have seen all the
;; 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.
- (setq compilation-parsing-end (point))
+ (set-marker compilation-parsing-end (point))
(setq compilation-error-list (nreverse compilation-error-list))
-;;; (message "Parsing error messages...done. %d found. %.0f%% of buffer seen."
-;;; compilation-num-errors-found
-;;; (/ (* 100.0 (point)) (point-max)))
+ ;; (message "Parsing error messages...done. %d found. %.0f%% of buffer seen."
+ ;; compilation-num-errors-found
+ ;; (/ (* 100.0 (point)) (point-max)))
(message "Parsing error messages...done.")))
(defun compile-collect-regexps (type this)
;; Add elements to variable compilation-regexps that is bound in
;; compilation-parse-errors.
(and (not (eq this t))
- (while this
- (setq compilation-regexps
- (cons (cons (car (car this)) (cons type (cdr (car this))))
- compilation-regexps))
- (setq this (cdr this)))))
+ (dolist (el this)
+ (push (cons (car el) (cons type (cdr el))) compilation-regexps))))
(defun compile-buffer-substring (index)
- ;; Get substring matched by INDEXth subexpression.
+ "Get substring matched by INDEXth subexpression."
(if index
(let ((beg (match-beginning index)))
(if beg (buffer-substring beg (match-end index))))))
(substring dir (length parent-expanded)))))
dir)
+(add-to-list 'debug-ignored-errors "^No more errors\\( yet\\|\\)$")
+
(provide 'compile)
+;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
;;; compile.el ends here
HCoop / bpt / emacs.git / blobdiff