comparison lisp/progmodes/compile.el @ 53140:00845c3bc4e4

(grep-command, grep-use-null-device) (grep-find-command, grep-tree-command, grep-tree-files-aliases) (grep-tree-ignore-case, grep-tree-ignore-CVS-directories) (grep-regexp-alist, grep-program, find-program) (grep-find-use-xargs, grep-history, grep-find-history) (grep-process-setup, grep-compute-defaults) (grep-default-command, grep, grep-tag-default, grep-find) (grep-expand-command-macros, grep-tree-last-regexp) (grep-tree-last-files, grep-tree): Move grep variables, functions and commands to new file grep.el. (compilation-mode-map): Remove grep commands from Compile sub-menu. (compilation-process-setup-function): Doc fix. (compilation-highlight-regexp, compilation-highlight-overlay): New defvars used for highlighting current compile error in source buffer. (compile-internal): New optional args HIGHLIGHT-REGEXP and LOCAL-MAP which overrides compilation-highlight-regexp and compilation-mode-map for this compilation. Delay calling compilation-set-window-height until after running compilation-process-setup-function so it can buffer-local override compilation-window-height. Check buffer-local value of compilation-scroll-output. (compilation-set-window-height): Use buffer-local value of compilation-window-height. (compilation-revert-buffer): Don't pass (undefined) preserve-modes arg to revert-buffer. (next-error-no-select, previous-error-no-select): New commands. (compilation-goto-locus): Temporarily highlight current match in source buffer using compilation-highlight-regexp.

53139:df3033332097

Those messages which are not parsed and highlighted initially
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)

(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

;;;###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.")

;;;###autoload
(defvar compilation-buffer-name-function nil
  "Function to compute the name of a compilation buffer.
The function receives one argument, the name of the major mode of the

  "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
you have some good regexps here, the parsing of messages will be faster.")

(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

  "*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))
  "Regexp used to match grep hits.  See `compilation-error-regexp-alist'.")

(defvar grep-program
  ;; Currently zgrep has trouble.  It runs egrep instead of grep,
  ;; and it doesn't pass along long options right.
  "grep"
  ;; (if (equal (condition-case nil	; in case "zgrep" isn't in exec-path
  ;; 		 (call-process "zgrep" nil nil nil
  ;; 			       "foo" null-device)
  ;; 	       (error nil))
  ;; 	     1)
  ;;     "zgrep"
  ;;   "grep")
  "The default grep program for `grep-command' and `grep-find-command'.
This variable's value takes effect when `grep-compute-defaults' is called.")

(defvar find-program "find"
  "The default find program for `grep-find-command'.
This variable's value takes effect when `grep-compute-defaults' is called.")

(defvar grep-find-use-xargs nil
  "Whether \\[grep-find] uses the `xargs' utility by default.

If nil, it uses `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.")

;;;###autoload
(defcustom compilation-search-path '(nil)
  "*List of directories to search for source files named in error messages.
Elements should be directory names, not file names of directories.
nil as an element means to try the default directory."

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."
  (nconc
   ;;

  (interactive)
  (save-some-buffers (not compilation-ask-about-save) nil)
  (apply 'compile-internal (or compilation-arguments
			      `(,(eval compile-command) "No more errors"))))

(defun grep-process-setup ()
  "Set up `compilation-exit-message-function' for `grep'."
  (set (make-local-variable 'compilation-exit-message-function)
       (lambda (status code msg)
	 (if (eq status 'exit)
	     (cond ((zerop code)
		    '("finished (matches found)\n" . "matched"))
		   ((= code 1)
		    '("finished with no matches found\n" . "no match"))
		   (t
		    (cons msg code)))
	   (cons msg code)))))

(defun grep-compute-defaults ()
  (unless (or (not grep-use-null-device) (eq grep-use-null-device t))
    (setq grep-use-null-device
	  (with-temp-buffer
	    (let ((hello-file (expand-file-name "HELLO" data-directory)))
	      (not
	       (and (equal (condition-case nil
			       (if grep-command
				   ;; `grep-command' is already set, so
				   ;; use that for testing.
				   (call-process-shell-command
				    grep-command nil t nil
				    "^English" hello-file)
				 ;; otherwise use `grep-program'
				 (call-process grep-program nil t nil
					       "-nH" "^English" hello-file))
			     (error nil))
			   0)
		    (progn
		      (goto-char (point-min))
		      (looking-at
		       (concat (regexp-quote hello-file)
			       ":[0-9]+:English")))))))))
  (unless grep-command
    (setq grep-command
	  (let ((required-options (if grep-use-null-device "-n" "-nH")))
	    (if (equal (condition-case nil ; in case "grep" isn't in exec-path
			   (call-process grep-program nil nil nil
					 "-e" "foo" null-device)
			 (error nil))
		       1)
		(format "%s %s -e " grep-program required-options)
	      (format "%s %s " grep-program required-options)))))
  (unless grep-find-use-xargs
    (setq grep-find-use-xargs
	  (if (and
               (equal (call-process "find" nil nil nil
                                    null-device "-print0")
                      0)
               (equal (call-process "xargs" nil nil nil
                                    "-0" "-e" "echo")
		      0))
	      'gnu)))
  (unless grep-find-command
    (setq grep-find-command
	  (cond ((eq grep-find-use-xargs 'gnu)
		 (format "%s . -type f -print0 | xargs -0 -e %s"
			 find-program grep-command))
		(grep-find-use-xargs
		 (format "%s . -type f -print | xargs %s"
                         find-program grep-command))
		(t (cons (format "%s . -type f -exec %s {} %s \\;"
				 find-program grep-command null-device)
			 (+ 22 (length grep-command)))))))
  (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)
  "Run grep, with user-specified args, and collect output in a buffer.
While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \
output buffer, to go to the lines
where grep found matches.

This command uses a special history list for its COMMAND-ARGS, so you can
easily repeat a grep command.

A prefix argument says to default the argument based upon the current
tag the cursor is over, substituting it into the last grep command
in the grep command history (or into `grep-command'
if that history list is empty)."
  (interactive
   (progn
     (unless (and grep-command
		  (or (not grep-use-null-device) (eq grep-use-null-device t)))
       (grep-compute-defaults))
     (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 (and grep-use-null-device null-device)
				    (concat command-args " " null-device)
				  command-args)
				"No more grep hits" "grep"
				;; Give it a simpler regexp to match.
				nil grep-regexp-alist)))))

;; This is a copy of find-tag-default from etags.el.
(defun grep-tag-default ()
  (save-excursion
    (while (looking-at "\\sw\\|\\s_")
      (forward-char 1))
    (when (or (re-search-backward "\\sw\\|\\s_"
				  (save-excursion (beginning-of-line) (point))
				  t)
	      (re-search-forward "\\(\\sw\\|\\s_\\)+"
				 (save-excursion (end-of-line) (point))
				 t))
      (goto-char (match-end 0))
      (buffer-substring (point)
			(progn (forward-sexp -1)
			       (while (looking-at "\\s'")
				 (forward-char 1))
			       (point))))))

;;;###autoload
(defun grep-find (command-args)
  "Run grep via find, with user-specified args COMMAND-ARGS.
Collect output in a buffer.
While find runs asynchronously, you can use the \\[next-error] command
to find the text that grep hits refer to.

This command uses a special history list for its arguments, so you can
easily repeat a find command."
  (interactive
   (progn
     (unless grep-find-command
       (grep-compute-defaults))
     (list (read-from-minibuffer "Run find (like this): "
				 grep-find-command nil nil
				 'grep-find-history))))
  (let ((null-device nil))		; see grep
    (grep command-args)))

(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.

Setting it causes the compilation-mode commands to put point at the
end of their output window so that the end of the output is always

(defun compile-internal (command error-message
				 &optional name-of-mode parser
				 error-regexp-alist name-function
				 enter-regexp-alist leave-regexp-alist
				 file-regexp-alist nomessage-regexp-alist
				 no-async)
  "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.
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.
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.
  The defaults for these variables are the global values of
\`compilation-parse-errors-function', `compilation-error-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.

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)

	(setq leave-regexp-alist compilation-leave-directory-regexp-alist))
    (or file-regexp-alist
	(setq file-regexp-alist compilation-file-regexp-alist))
    (or nomessage-regexp-alist
	(setq nomessage-regexp-alist compilation-nomessage-regexp-alist))
    (or parser (setq parser compilation-parse-errors-function))
    (let ((thisdir default-directory)
	  outwin)
      (save-excursion
	;; Clear out the compilation buffer and make it writable.

	  (goto-char (point-max)))
      ;; Pop up the compilation buffer.
      (setq outwin (display-buffer outbuf nil t))
      (with-current-buffer outbuf
	(compilation-mode name-of-mode)
	;; 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)

	     leave-regexp-alist)
	(set (make-local-variable 'compilation-file-regexp-alist)
	     file-regexp-alist)
	(set (make-local-variable 'compilation-nomessage-regexp-alist)
	     nomessage-regexp-alist)
	(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))
        ;; This proves a good idea if the buffer's going to scroll
        ;; with lazy-lock on.
        (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)
	(setq default-directory thisdir
	      compilation-directory-stack (list default-directory))
	(compilation-set-window-height outwin)
	(set-window-start outwin (point-min))
	(or (eq outwin (selected-window))
	    (set-window-point outwin (point-min)))
	(if compilation-process-setup-function
	    (funcall compilation-process-setup-function))
	;; Start the compilation.
	(if (not no-async)
 	    (let* ((process-environment
		    (append
		     compilation-environment

		   (compilation-handle-exit 'signal status
					    (concat status "\n")))
		  (t
		   (compilation-handle-exit 'bizarre status status))))
	  (message "Executing `%s'...done" command)))
      (if compilation-scroll-output
	  (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)))

(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-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)))

(defvar compilation-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]
      (cons "Compile" (make-sparse-keymap "Compile")))
    (define-key map [menu-bar compilation compilation-separator2]
      '("----" . nil))
    (define-key map [menu-bar compilation compilation-mode-grep]
      '("Search Files (grep)" . grep))
    (define-key map [menu-bar compilation compilation-mode-recompile]
      '("Recompile" . recompile))
    (define-key map [menu-bar compilation compilation-mode-compile]
      '("Compile..." . compile))
    map)
  "Keymap for compilation log buffers.
`compilation-minor-mode-map' is a parent of this.")

  (run-hooks 'compilation-mode-hook))

(defun compilation-revert-buffer (ignore-auto noconfirm)
  (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))))

(defun compilation-setup ()
  "Prepare the buffer for the compilation parsing commands to work."

forwards, if negative).
Does NOT find the source line like \\[next-error]."
  (interactive "p")
  (compilation-next-error (- n)))


;; Given an elt of `compilation-error-list', return an object representing
;; the referenced file which is equal to (but not necessarily eq to) what
;; this function would return for another error in the same file.
(defsubst compilation-error-filedata (data)

  ;; 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))))))
    (set-window-point w (car next-error))
    (set-window-start w (car next-error))
    (compilation-set-window-height w)))

(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

53140:00845c3bc4e4

Those messages which are not parsed and highlighted initially
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.
Each error descriptor is a cons (or nil).  Its car is a marker pointing to

;;;###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.  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
  "Function to compute the name of a compilation buffer.
The function receives one argument, the name of the major mode of the

  "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
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

  "*Non-nil means \\[compile] asks which buffers to save before compiling.
Otherwise, it saves all modified buffers without asking."
  :type 'boolean
  :group 'compilation)

;;;###autoload
(defcustom compilation-search-path '(nil)
  "*List of directories to search for source files named in error messages.
Elements should be directory names, not file names of directories.
nil as an element means to try the default directory."

This list is temporarily prepended to `process-environment' prior to
starting the compilation process.")

;; History of compile commands.
(defvar compile-history nil)

(defun compilation-mode-font-lock-keywords ()
  "Return expressions to highlight in Compilation mode."
  (nconc
   ;;

  (interactive)
  (save-some-buffers (not compilation-ask-about-save) nil)
  (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.

Setting it causes the compilation-mode commands to put point at the
end of their output window so that the end of the output is always

(defun compile-internal (command error-message
				 &optional name-of-mode parser
				 error-regexp-alist name-function
				 enter-regexp-alist leave-regexp-alist
				 file-regexp-alist nomessage-regexp-alist
				 no-async highlight-regexp local-map)
  "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 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.
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.
  The defaults for these variables are the global values of
\`compilation-parse-errors-function', `compilation-error-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.

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)

	(setq leave-regexp-alist compilation-leave-directory-regexp-alist))
    (or file-regexp-alist
	(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)
      (save-excursion
	;; Clear out the compilation buffer and make it writable.

	  (goto-char (point-max)))
      ;; Pop up the compilation buffer.
      (setq outwin (display-buffer outbuf nil t))
      (with-current-buffer outbuf
	(compilation-mode name-of-mode)
	(if local-map
	    (use-local-map local-map))
	;; In what way is it non-ergonomic ?  -stef
	;; (toggle-read-only 1) ;;; Non-ergonomic.
	(set (make-local-variable 'compilation-parse-errors-function) parser)
	(set (make-local-variable 'compilation-error-message) error-message)
	(set (make-local-variable 'compilation-error-regexp-alist)

	     leave-regexp-alist)
	(set (make-local-variable 'compilation-file-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
		   nil  ; or no-async ??
		   highlight-regexp local-map))
        ;; This proves a good idea if the buffer's going to scroll
        ;; with lazy-lock on.
        (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)
	(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)))
	;; 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 (not no-async)
 	    (let* ((process-environment
		    (append
		     compilation-environment

		   (compilation-handle-exit 'signal status
					    (concat status "\n")))
		  (t
		   (compilation-handle-exit 'bizarre status status))))
	  (message "Executing `%s'...done" command)))
      (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)))

(defun compilation-set-window-height (window)
  "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)))

(defvar compilation-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]
      (cons "Compile" (make-sparse-keymap "Compile")))
    (define-key map [menu-bar compilation compilation-separator2]
      '("----" . nil))
    (define-key map [menu-bar compilation compilation-grep]
      '("Search Files (grep)" . grep))
    (define-key map [menu-bar compilation compilation-recompile]
      '("Recompile" . recompile))
    (define-key map [menu-bar compilation compilation-compile]
      '("Compile..." . compile))
    map)
  "Keymap for compilation log buffers.
`compilation-minor-mode-map' is a parent of this.")

  (run-hooks 'compilation-mode-hook))

(defun compilation-revert-buffer (ignore-auto noconfirm)
  (if buffer-file-name
      (let (revert-buffer-function)
	(revert-buffer ignore-auto noconfirm))
    (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
	(apply 'compile-internal compilation-arguments))))

(defun compilation-setup ()
  "Prepare the buffer for the compilation parsing commands to work."

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
;; this function would return for another error in the same file.
(defsubst compilation-error-filedata (data)

  ;; 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)))))
	 (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)

    (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)))))))


(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