-;;; 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, 98, 1999 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)
:group 'compilation)
-(defcustom compile-auto-highlight nil
+(defcustom compile-auto-highlight t
"*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
(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 '(choice string
+ (const :tag "Not Set" nil))
+ :group 'compilation)
+
+(defcustom grep-use-null-device 'auto-detect
+ "If t, 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
+ :type '(choice (const :tag "Do Not Append Null Device" nil)
+ (const :tag "Append Null Device" t)
+ (other :tag "Not Set" auto-detect))
+ :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 '(choice string
+ (const :tag "Not Set" nil))
+ :group 'compilation)
+
+(defcustom grep-tree-command nil
+ "The default find command for \\[grep-tree].
+The default value of this variable is set up by `grep-compute-defaults';
+call that function before using this variable in your program.
+The following place holders should be present in the string:
+ <D> - base directory for find
+ <X> - find options to restrict or expand the directory list
+ <F> - find options to limit the files matched
+ <C> - place to put -i if case insensitive grep
+ <R> - the regular expression searched for."
+ :type '(choice string
+ (const :tag "Not Set" nil))
+ :version "21.4"
+ :group 'compilation)
+
+(defcustom grep-tree-files-aliases '(
+ ("ch" . "*.[ch]")
+ ("c" . "*.c")
+ ("h" . "*.h")
+ ("m" . "[Mm]akefile*")
+ ("asm" . "*.[sS]")
+ ("all" . "*")
+ ("el" . "*.el")
+ )
+ "*Alist of aliases for the FILES argument to `grep-tree'."
+ :type 'alist
+ :group 'compilation)
+
+(defcustom grep-tree-ignore-case t
+ "*If non-nil, `grep-tree' ignores case in matches."
+ :type 'boolean
+ :group 'compilation)
+
+(defcustom grep-tree-ignore-CVS-directories t
+ "*If non-nil, `grep-tree' does no recurse into CVS directories."
+ :type 'boolean
+ :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.
\\([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)
;; 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 = \
;; 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.")
(defcustom compilation-error-screen-columns t
: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)
+;; 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))
+ '(("\\([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")
+ ;; (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.")
-;; Use -e if grep supports it,
-;; because that avoids lossage if the pattern starts with `-'.
-(defvar grep-command nil
- "The default grep command for \\[grep].
-The real default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable.")
+(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 nil, it uses `find -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.")
-(defvar 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.")
-
;;;###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.
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"))
+ (apply 'compile-internal (or compilation-arguments
+ `(,(eval compile-command) "No more errors"))))
(defun grep-process-setup ()
"Set up `compilation-exit-message-function' for `grep'."
(cons msg code)))))
(defun grep-compute-defaults ()
- (setq grep-command
- (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 -n -e " grep-program)
- (format "%s -n " grep-program)))
+ (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
0)
(equal (call-process "xargs" nil nil nil
"-0" "-e" "echo")
- 0))
+ 0))
'gnu)))
- (setq 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)))))))
+ (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)))))))
+ (unless grep-tree-command
+ (setq grep-tree-command
+ (let* ((glen (length grep-program))
+ (gcmd (concat grep-program " <C>" (substring grep-command glen))))
+ (cond ((eq grep-find-use-xargs 'gnu)
+ (format "%s <D> <X> -type f <F> -print0 | xargs -0 -e %s <R>"
+ find-program gcmd))
+ (grep-find-use-xargs
+ (format "%s <D> <X> -type f <F> -print | xargs %s <R>"
+ find-program gcmd))
+ (t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;"
+ find-program gcmd null-device)))))))
+
+(defun grep-default-command ()
+ (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)))
+ (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
+ (grep-default (or (car grep-history) grep-command)))
+ ;; Replace the thing matching for with that around cursor.
+ (when (or (string-match
+ (concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*"
+ sh-arg-re "\\(\\s +\\(\\S +\\)\\)?")
+ grep-default)
+ ;; If the string is not yet complete.
+ (string-match "\\(\\)\\'" grep-default))
+ (unless (or (not (stringp buffer-file-name))
+ (when (match-beginning 2)
+ (save-match-data
+ (string-match
+ (wildcard-to-regexp
+ (file-name-nondirectory
+ (match-string 3 grep-default)))
+ (file-name-nondirectory buffer-file-name)))))
+ (setq grep-default (concat (substring grep-default
+ 0 (match-beginning 2))
+ " *."
+ (file-name-extension buffer-file-name))))
+ (replace-match (or tag-default "") t t grep-default 1))))
;;;###autoload
(defun grep (command-args)
output buffer, to go to the lines
where grep found matches.
-This command uses a special history list for its arguments, so you can
+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
in the grep command history (or into `grep-command'
if that history list is empty)."
(interactive
- (let (grep-default (arg current-prefix-arg))
- (unless grep-command
+ (progn
+ (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
- (if (string-match "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)" grep-default)
- (setq grep-default (replace-match tag-default t t
- grep-default 2)))))
- (list (read-from-minibuffer "Run grep (like this): "
- (or grep-default grep-command)
- nil nil 'grep-history))))
+ (let ((default (grep-default-command)))
+ (list (read-from-minibuffer "Run grep (like this): "
+ (if current-prefix-arg
+ default grep-command)
+ nil nil 'grep-history
+ (if current-prefix-arg nil default))))))
;; 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 null-device
+ (buf (compile-internal (if (and grep-use-null-device null-device)
(concat command-args " " null-device)
command-args)
"No more grep hits" "grep"
;;;###autoload
(defun grep-find (command-args)
- "Run grep via find, with user-specified args, and collect output in a buffer.
+ "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.
(let ((null-device nil)) ; see grep
(grep command-args)))
+(defun grep-expand-command-macros (command &optional regexp files dir excl case-fold)
+ "Patch grep COMMAND replacing <D>, etc."
+ (setq command
+ (replace-regexp-in-string "<D>"
+ (or dir ".") command t t))
+ (setq command
+ (replace-regexp-in-string "<X>"
+ (or excl "") command t t))
+ (setq command
+ (replace-regexp-in-string "<F>"
+ (or files "") command t t))
+ (setq command
+ (replace-regexp-in-string "<C>"
+ (if case-fold "-i" "") command t t))
+ (setq command
+ (replace-regexp-in-string "<R>"
+ (or regexp "") command t t))
+ command)
+
+(defvar grep-tree-last-regexp "")
+(defvar grep-tree-last-files (car (car grep-tree-files-aliases)))
+
+;;;###autoload
+(defun grep-tree (regexp files dir &optional subdirs)
+ "Grep for REGEXP in FILES in directory tree rooted at DIR.
+Collect output in a buffer.
+Interactively, prompt separately for each search parameter.
+With prefix arg, reuse previous REGEXP.
+The search is limited to file names matching shell pattern FILES.
+FILES may use abbreviations defined in `grep-tree-files-aliases', e.g.
+entering `ch' is equivalent to `*.[ch]'.
+
+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.
+
+When used non-interactively, optional arg SUBDIRS limits the search to
+those sub directories of DIR."
+ (interactive
+ (let* ((regexp
+ (if current-prefix-arg
+ grep-tree-last-regexp
+ (let* ((default (current-word))
+ (spec (read-string
+ (concat "Search for"
+ (if (and default (> (length default) 0))
+ (format " (default %s): " default) ": ")))))
+ (if (equal spec "") default spec))))
+ (files
+ (read-string (concat "Search for \"" regexp "\" in files (default " grep-tree-last-files "): ")))
+ (dir
+ (read-directory-name "Base directory: " nil default-directory t)))
+ (list regexp files dir)))
+ (unless grep-tree-command
+ (grep-compute-defaults))
+ (unless (and (stringp files) (> (length files) 0))
+ (setq files grep-tree-last-files))
+ (when files
+ (setq grep-tree-last-files files)
+ (let ((mf (assoc files grep-tree-files-aliases)))
+ (if mf
+ (setq files (cdr mf)))))
+ (let ((command-args (grep-expand-command-macros
+ grep-tree-command
+ (setq grep-tree-last-regexp regexp)
+ (and files (concat "-name '" files "'"))
+ (if subdirs
+ (if (stringp subdirs)
+ subdirs
+ (mapconcat 'identity subdirs " "))
+ nil) ;; we change default-directory to dir
+ (and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ")
+ grep-tree-ignore-case))
+ (default-directory dir)
+ (null-device nil)) ; see grep
+ (grep command-args)))
+
(defcustom compilation-scroll-output nil
"*Non-nil to scroll the *compilation* buffer window as output appears.
: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)
"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.
\`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.
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
(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.
+ ;; 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)
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)
;; 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))
(if compilation-process-setup-function
(funcall compilation-process-setup-function))
;; 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)))
;; 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)
+ "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))))
- (select-window w))))))
+ ;; 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 (- compilation-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-mode-first-error]
+ '("First Error" . first-error))
+ (define-key map [compilation-mode-previous-error]
+ '("Previous Error" . previous-error))
+ (define-key map [compilation-mode-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-mode-grep]
'("Search Files (grep)" . grep))
- (define-key map [menu-bar compilation-menu compilation-mode-recompile]
+ (define-key map [menu-bar compilation compilation-mode-recompile]
'("Recompile" . recompile))
- (define-key map [menu-bar compilation-menu compilation-mode-compile]
+ (define-key map [menu-bar compilation compilation-mode-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 preserve-modes))
+ (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-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.
-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))))
-
-;; 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))
+ (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)
;;(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)))
"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.
(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)
(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
;; failed to find the relevant file. See
;; compilation-next-error-locus.
(or (null (marker-buffer (caar compilation-error-list)))
- (> (point) (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")))
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))
;; failed to find the relevant file. See
;; compilation-next-error-locus.
(or (null (marker-buffer (caar compilation-error-list)))
- (> (point) (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)))
(push-mark)
If all the error messages parsed so far have been processed already,
the message buffer is checked for new ones.
-A prefix arg specifies how many error messages to move;
+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 uses the most recently started compilation or
(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.
;; display the source in another window.
(let ((pop-up-windows t))
(pop-to-buffer (marker-buffer (cdr next-error))))
- (if (and (window-dedicated-p (selected-window))
- (eq (selected-window) (frame-root-window)))
- (switch-to-buffer-other-frame (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
(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)
(set-window-start w (car next-error))
(compilation-set-window-height w)))
\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.
(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)
deactivate-mark)
- (remove-text-properties (point-min) (point-max) '(mouse-face highlight)))
- )
+ (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.
(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