-;;; 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.
-
-;; Author: Roland McGrath <roland@gnu.org>
-;; Maintainer: FSF
-;; Keywords: tools, processes
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package provides the compile and grep facilities documented in
-;; the Emacs user's manual.
-
-;;; Code:
-
-(defgroup compilation nil
- "Run compiler as inferior of Emacs, parse error messages."
- :group 'tools
- :group 'processes)
-
-
-;;;###autoload
-(defcustom compilation-mode-hook nil
- "*List of hook functions run by `compilation-mode' (see `run-hooks')."
- :type 'hook
- :group 'compilation)
-
-;;;###autoload
-(defcustom compilation-window-height nil
- "*Number of lines in a compilation window. If nil, use Emacs default."
- :type '(choice (const :tag "Default" nil)
- integer)
- :group 'compilation)
-
-(defcustom compile-auto-highlight nil
- "*Specify how many compiler errors to highlight (and parse) initially.
-\(Highlighting applies to an error message when the mouse is over it.)
-If this is a number N, all compiler error messages in the first N lines
-are highlighted and parsed as soon as they arrive in Emacs.
-If t, highlight and parse the whole compilation output as soon as it arrives.
-If nil, don't highlight or parse any of the buffer until you try to
-move to the error messages.
-
-Those messages which are not parsed and highlighted initially
-will be parsed and highlighted as soon as you try to move to them."
- :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
-an error message. If its cdr is a marker, it points to the text of the
-line the message is about. If its cdr is a cons, it is a list
-\(\(DIRECTORY . FILE\) LINE [COLUMN]\). Or its cdr may be nil if that
-error is not interesting.
-
-The value may be t instead of a list; this means that the buffer of
-error messages should be reparsed the next time the list of errors is wanted.
-
-Some other commands (like `diff') use this list to control the error
-message tracking facilities; if you change its structure, you should make
-sure you also change those packages. Perhaps it is better not to change
-it at all.")
-
-(defvar compilation-old-error-list nil
- "Value of `compilation-error-list' after errors were parsed.")
-
-(defvar compilation-parse-errors-function 'compilation-parse-errors
- "Function to call to parse error messages from a compilation.
-It takes args LIMIT-SEARCH and FIND-AT-LEAST.
-If LIMIT-SEARCH is non-nil, don't bother parsing past that location.
-If FIND-AT-LEAST is non-nil, don't bother parsing after finding that
-many new errors.
-It should read in the source files which have errors and set
-`compilation-error-list' to a list with an element for each error message
-found. See that variable for more info.")
-
-;;;###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
-compilation buffer. It should return a string.
-nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
-
-;;;###autoload
-(defvar compilation-finish-function nil
- "Function to call when a compilation process finishes.
-It is called with two arguments: the compilation buffer, and a string
-describing how the process finished.")
-
-;;;###autoload
-(defvar compilation-finish-functions nil
- "Functions to call when a compilation process finishes.
-Each function is called with two arguments: the compilation buffer,
-and a string describing how the process finished.")
-
-(defvar compilation-last-buffer nil
- "The most recent compilation buffer.
-A buffer becomes most recent when its compilation is started
-or when it is used with \\[next-error] or \\[compile-goto-error].")
-
-(defvar compilation-in-progress nil
- "List of compilation processes now running.")
-(or (assq 'compilation-in-progress minor-mode-alist)
- (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
- minor-mode-alist)))
-
-(defvar compilation-parsing-end nil
- "Marker position of end of buffer when last error messages were parsed.")
-
-(defvar compilation-error-message "No more errors"
- "Message to print when no more matches are found.")
-
-(defvar compilation-arguments nil
- "Arguments that were given to `compile-internal'.")
-
-(defvar compilation-num-errors-found)
-
-(defvar compilation-error-regexp-alist
- '(
- ;; NOTE! See also grep-regexp-alist, below.
-
- ;; 4.3BSD grep, cc, lint pass 1:
- ;; /usr/src/foo/foo.c(8): warning: w may be used before set
- ;; or GNU utilities:
- ;; foo.c:8: error message
- ;; or HP-UX 7.0 fc:
- ;; foo.f :16 some horrible error message
- ;; or GNU utilities with column (GNAT 1.82):
- ;; foo.adb:2:1: Unit name does not match file name
- ;; or with column and program name:
- ;; jade:dbcommon.dsl:133:17:E: missing argument for function call
- ;;
- ;; We'll insist that the number be followed by a colon or closing
- ;; paren, because otherwise this matches just about anything
- ;; containing a number with spaces around it.
-
- ;; We insist on a non-digit in the file name
- ;; so that we don't mistake the file name for a command name
- ;; and take the line number as the file name.
- ("\\([a-zA-Z][-a-zA-Z._0-9]+: ?\\)?\
-\\([a-zA-Z]?:?[^:( \t\n]*[^:( \t\n0-9][^:( \t\n]*\\)[:(][ \t]*\\([0-9]+\\)\
-\\([) \t]\\|:\\(\\([0-9]+:\\)\\|[0-9]*[^:0-9]\\)\\)" 2 3 6)
-
- ;; Microsoft C/C++:
- ;; keyboard.c(537) : warning C4005: 'min' : macro redefinition
- ;; d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
- ;; This used to be less selective and allow characters other than
- ;; parens around the line number, but that caused confusion for
- ;; GNU-style error messages.
- ;; This used to reject spaces and dashes in file names,
- ;; but they are valid now; so I made it more strict about the error
- ;; message that follows.
- ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
-: \\(error\\|warning\\) C[0-9]+:" 1 3)
-
- ;; Borland C++, C++Builder:
- ;; Error ping.c 15: Unable to open include file 'sys/types.h'
- ;; Warning ping.c 68: Call to function 'func' with no prototype
- ;; Error E2010 ping.c 15: Unable to open include file 'sys/types.h'
- ;; Warning W1022 ping.c 68: Call to function 'func' with no prototype
- ("\\(Error\\|Warning\\) \\(\\([FEW][0-9]+\\) \\)?\
-\\([a-zA-Z]?:?[^:( \t\n]+\\)\
- \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 4 5)
-
- ;; 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]*$"
- 1 2)
-
- ;; 4.3BSD lint pass 3
- ;; bloofle defined( /users/wolfgang/foo.c(4) ), but never used
- ;; This used to be
- ;; ("[ \t(]+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
- ;; which is regexp Impressionism - it matches almost anything!
- (".*([ \t]*\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2)
-
- ;; MIPS lint pass<n>; looks good for SunPro lint also
- ;; TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomon.c due to truncation
- ("[^\n ]+ (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
- ;; name defined but never used: LinInt in cmap_calc.c(199)
- (".*in \\([^(\n]+\\)(\\([0-9]+\\))$" 1 2)
-
- ;; Ultrix 3.0 f77:
- ;; fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol
- ;; Some SGI cc version:
- ;; cfe: Warning 835: foo.c, line 2: something
- ("\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3)
- ;; Error on line 3 of t.f: Execution error unclassifiable statement
- ;; Unknown who does this:
- ;; Line 45 of "foo.c": bloofle undefined
- ;; Absoft FORTRAN 77 Compiler 3.1.3
- ;; error on line 19 of fplot.f: spelling error?
- ;; warning on line 17 of fplot.f: data type is undefined for variable d
- ("\\(.* on \\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
-of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
-
- ;; Apollo cc, 4.3BSD fc:
- ;; "foo.f", line 3: Error: syntax error near end of statement
- ;; IBM RS6000:
- ;; "vvouch.c", line 19.5: 1506-046 (S) Syntax error.
- ;; Microtec mcc68k:
- ;; "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage"
- ;; GNAT (as of July 94):
- ;; "foo.adb", line 2(11): warning: file name does not match ...
- ;; IBM AIX xlc compiler:
- ;; "src/swapping.c", line 30.34: 1506-342 (W) "/*" detected in comment.
- (".*\"\\([^,\" \n\t]+\\)\", lines? \
-\\([0-9]+\\)\\([\(.]\\([0-9]+\\)\)?\\)?[:., (-]" 1 2 4)
-
- ;; 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)
-
- ;; MIPS RISC CC - the one distributed with Ultrix:
- ;; ccom: Error: foo.c, line 2: syntax error
- ;; DEC AXP OSF/1 cc
- ;; /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah
- ("[a-z0-9/]+: \\([eE]rror\\|[wW]arning\\): \\([^,\" \n\t]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 2 4)
-
- ;; IBM AIX PS/2 C version 1.1:
- ;; ****** Error number 140 in line 8 of file errors.c ******
- (".*in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
- ;; IBM AIX lint is too painful to do right this way. File name
- ;; prefixes entire sections rather than being on each line.
-
- ;; SPARCcompiler Pascal:
- ;; 20 linjer : array[1..4] of linje;
- ;; e 18480-----------^--- Inserted ';'
- ;; and
- ;; E 18520 line 61 - 0 is undefined
- ;; These messages don't contain a file name. Instead the compiler gives
- ;; a message whenever the file being compiled is changed.
- (" +\\([0-9]+\\) +.*\n[ew] [0-9]+-+" nil 1)
- ("[Ew] +[0-9]+ line \\([0-9]+\\) - " nil 1)
-
- ;; Lucid Compiler, lcc 3.x
- ;; 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)
-
- ;; Cray C compiler error messages
- ("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \
-\\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5)
-
- ;; IBM C/C++ Tools 2.01:
- ;; foo.c(2:0) : informational EDC0804: Function foo is not referenced.
- ;; foo.c(3:8) : warning EDC0833: Implicit return statement encountered.
- ;; foo.c(5:5) : error EDC0350: Syntax error.
- ("\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) : " 1 2 3)
-
- ;; IAR Systems C Compiler:
- ;; "foo.c",3 Error[32]: Error message
- ;; "foo.c",3 Warning[32]: Error message
- ("\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(Error\\|Warning\\)\\[[0-9]+\\]:" 1 2)
-
- ;; Sun ada (VADS, Solaris):
- ;; /home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: "," inserted
- ("\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
-
- ;; Perl -w:
- ;; syntax error at automake line 922, near "':'"
- ;; Perl debugging traces
- ;; store::odrecall('File_A', 'x2') called at store.pm line 90
- (".* at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 1 2)
-
- ;; Oracle pro*c:
- ;; Semantic error at line 528, column 5, file erosacqdb.pc:
- ("Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):"
- 3 1 2)
-
- ;; EPC F90 compiler:
- ;; 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
- (".* ERROR [a-zA-Z0-9 ]+, File = \\(.+\\), Line = \\([0-9]+\\), Column = \\([0-9]+\\)"
- 1 2 3)
- )
-
- "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
-the LINE-IDX'th subexpression gives the line number. If COLUMN-IDX is
-given, the COLUMN-IDX'th subexpression gives the column number on that line.
-If any FILE-FORMAT is given, each is a format string to produce a file name to
-try; %s in the string is replaced by the text matching the FILE-IDX'th
-subexpression.")
-
-(defvar compilation-enter-directory-regexp-alist
- '(
- ;; Matches lines printed by the `-w' option of GNU Make.
- (".*: 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.
-Each elt has the form (REGEXP IDX).
-If REGEXP matches, the IDX'th subexpression gives the directory name.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
-(defvar compilation-leave-directory-regexp-alist
- '(
- ;; Matches lines printed by the `-w' option of GNU Make.
- (".*: 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
-matching `compilation-enter-directory-regexp-alist'\) is assumed.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
-(defvar compilation-file-regexp-alist
- '(
- ;; This matches entries with date time year file-name: like
- ;; Thu May 14 10:46:12 1992 mom3.p:
- ("\\w\\w\\w \\w\\w\\w +[0-9]+ [0-9][0-9]:[0-9][0-9]:[0-9][0-9] [0-9][0-9][0-9][0-9] \\(.*\\):$" 1)
- )
- "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
-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
-;; in special cases there might be one. The lines that are not matched by
-;; a regexp take much longer time than the ones that are recognized so if
-;; you have same regexeps here, parsing is faster.
-(defvar compilation-nomessage-regexp-alist
- '(
- )
- "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
-program and Emacs agree about the display width of the characters,
-especially the TAB character."
- :type 'boolean
- :group 'compilation
- :version "20.4")
-
-(defcustom compilation-read-command t
- "*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
- "*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.")
-
-;; 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 grep-find-use-xargs nil
- "Whether \\[grep-find] uses the `xargs' utility by default.
-
-If nil, it uses `grep -exec'; if `gnu', it uses `find -print0' and `xargs -0';
-if not nil and not `gnu', it uses `find -print' and `xargs'.
-
-This variable's value takes effect when `grep-compute-defaults' is called.")
-
-(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.
-Elements should be directory names, not file names of directories.
-nil as an element means to try the default directory."
- :type '(repeat (choice (const :tag "Default" nil)
- (string :tag "Directory")))
- :group 'compilation)
-
-(defcustom compile-command "make -k "
- "*Last shell command used to do a compilation; default for next compilation.
-
-Sometimes it is useful for files to supply local values for this variable.
-You might also use mode hooks to specify it in certain modes, like this:
-
- (add-hook 'c-mode-hook
- (lambda ()
- (unless (or (file-exists-p \"makefile\")
- (file-exists-p \"Makefile\"))
- (set (make-local-variable 'compile-command)
- (concat \"make -k \"
- (file-name-sans-extension buffer-file-name))))))"
- :type 'string
- :group 'compilation)
-
-(defvar compilation-directory-stack nil
- "Stack of previous directories for `compilation-leave-directory-regexp'.
-The last element is the directory the compilation was started in.")
-
-(defvar compilation-exit-message-function nil "\
-If non-nil, called when a compilation process dies to return a status message.
-This should be a function of three arguments: process status, exit status,
-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.")
-
-;; 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
- ;;
- ;; Compiler warning/error lines.
- (mapcar (function
- (lambda (item)
- ;; Prepend "^", adjusting FILE-IDX and LINE-IDX accordingly.
- (let ((file-idx (nth 1 item))
- (line-idx (nth 2 item))
- (col-idx (nth 3 item))
- keyword)
- (when (numberp col-idx)
- (setq keyword
- (cons (list (1+ col-idx) 'font-lock-type-face nil t)
- keyword)))
- (when (numberp line-idx)
- (setq keyword
- (cons (list (1+ line-idx) 'font-lock-variable-name-face)
- keyword)))
- (when (numberp file-idx)
- (setq keyword
- (cons (list (1+ file-idx) 'font-lock-warning-face)
- keyword)))
- (cons (concat "^\\(" (nth 0 item) "\\)") keyword))))
- compilation-error-regexp-alist)
- (list
- ;;
- ;; Compiler output lines. Recognize `make[n]:' lines too.
- '("^\\([A-Za-z_0-9/\.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
- (1 font-lock-function-name-face) (3 font-lock-comment-face nil t)))
- ))
-\f
-;;;###autoload
-(defun compile (command)
- "Compile the program including the current buffer. Default: run `make'.
-Runs COMMAND, a shell command, in a separate process asynchronously
-with output going to the buffer `*compilation*'.
-
-You can then use the command \\[next-error] to find the next error message
-and move to the source code that caused it.
-
-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.
-
-The name used for the buffer is actually whatever is returned by
-the function in `compilation-buffer-name-function', so you can set that
-to a function that generates a unique name."
- (interactive
- (if (or compilation-read-command current-prefix-arg)
- (list (read-from-minibuffer "Compile command: "
- (eval compile-command) nil nil
- '(compile-history . 1)))
- (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 command "No more errors"))
-
-;; run compile with the default command line
-(defun recompile ()
- "Re-compile the program including the current buffer."
- (interactive)
- (save-some-buffers (not compilation-ask-about-save) nil)
- (compile-internal (eval compile-command) "No more errors"))
-
-(defun grep-process-setup ()
- "Set up `compilation-exit-message-function' for `grep'."
- (set (make-local-variable 'compilation-exit-message-function)
- (lambda (status code msg)
- (if (eq status 'exit)
- (cond ((zerop code)
- '("finished (matches found)\n" . "matched"))
- ((= code 1)
- '("finished with no matches found\n" . "no match"))
- (t
- (cons msg code)))
- (cons msg code)))))
-
-(defun grep-compute-defaults ()
- (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 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)))
- (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 {} %s \\;"
- grep-command null-device)
- (+ 22 (length grep-command)))))))
-
-;;;###autoload
-(defun grep (command-args)
- "Run grep, with user-specified args, and collect output in a buffer.
-While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
-or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \
-output buffer, to go to the lines
-where grep found matches.
-
-This command uses a special history list for its COMMAND-ARGS, so you can
-easily repeat a grep command.
-
-A prefix argument says to default the argument based upon the current
-tag the cursor is over, substituting it into the last grep command
-in the grep command history (or into `grep-command'
-if that history list is empty)."
- (interactive
- (let (grep-default (arg current-prefix-arg))
- (unless grep-command
- (grep-compute-defaults))
- (when arg
- (let ((tag-default
- (funcall (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- ;; We use grep-tag-default instead of
- ;; find-tag-default, to avoid loading etags.
- 'grep-tag-default))))
- (setq grep-default (or (car grep-history) grep-command))
- ;; Replace the thing matching for with that around cursor
- (when (string-match "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)\\(\\s-+\\S-+\\)?" grep-default)
- (unless (or (match-beginning 3) (not (stringp buffer-file-name)))
- (setq grep-default (concat grep-default "*."
- (file-name-extension buffer-file-name))))
- (setq grep-default (replace-match (or tag-default "")
- t t grep-default 2)))))
- (list (read-from-minibuffer "Run grep (like this): "
- (or grep-default grep-command)
- nil nil 'grep-history))))
-
- ;; Setting process-setup-function makes exit-message-function work
- ;; even when async processes aren't supported.
- (let* ((compilation-process-setup-function 'grep-process-setup)
- (buf (compile-internal (if 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)))
-
-(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
-visible rather than the begining."
- :type 'boolean
- :version "20.3"
- :group 'compilation)
-
-(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)
- "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-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.
-
-Returns the compilation buffer created."
- (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)))
- (set-buffer outbuf)
- (let ((comp-proc (get-buffer-process (current-buffer))))
- (if comp-proc
- (if (or (not (eq (process-status comp-proc) 'run))
- (yes-or-no-p
- (format "A %s process is running; kill it? "
- name-of-mode)))
- (condition-case ()
- (progn
- (interrupt-process comp-proc)
- (sit-for 1)
- (delete-process comp-proc))
- (error nil))
- (error "Cannot have two processes in `%s' at once"
- (buffer-name))
- )))
- ;; In case the compilation buffer is current, make sure we get the global
- ;; values of compilation-error-regexp-alist, etc.
- (kill-all-local-variables))
- (or error-regexp-alist
- (setq error-regexp-alist compilation-error-regexp-alist))
- (or enter-regexp-alist
- (setq enter-regexp-alist compilation-enter-directory-regexp-alist))
- (or leave-regexp-alist
- (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.
- ;; Change its default-directory to the directory where the compilation
- ;; will happen, and insert a `cd' command to indicate this.
- (set-buffer outbuf)
- (setq buffer-read-only nil)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (buffer-enable-undo (current-buffer))
- (setq default-directory thisdir)
- (insert "cd " thisdir "\n" command "\n")
- (set-buffer-modified-p nil))
- ;; If we're already in the compilation buffer, go to the end
- ;; of the buffer, so point will track the compilation output.
- (if (eq outbuf (current-buffer))
- (goto-char (point-max)))
- ;; Pop up the compilation buffer.
- (setq outwin (display-buffer outbuf nil t))
- (save-excursion
- (set-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)
- error-regexp-alist)
- (set (make-local-variable 'compilation-enter-directory-regexp-alist)
- enter-regexp-alist)
- (set (make-local-variable 'compilation-leave-directory-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))
- (set-window-start outwin (point-min))
- (or (eq outwin (selected-window))
- (set-window-point outwin (point-min)))
- (compilation-set-window-height outwin)
- (if compilation-process-setup-function
- (funcall compilation-process-setup-function))
- ;; Start the compilation.
- (if (fboundp 'start-process)
- (let* ((process-environment
- ;; Don't override users' setting of $EMACS.
- (if (getenv "EMACS")
- process-environment
- (cons "EMACS=t" process-environment)))
- (proc (start-process-shell-command (downcase mode-name)
- outbuf
- command)))
- (set-process-sentinel proc 'compilation-sentinel)
- (set-process-filter proc 'compilation-filter)
- (set-marker (process-mark proc) (point) outbuf)
- (setq compilation-in-progress
- (cons proc compilation-in-progress)))
- ;; No asynchronous processes available.
- (message "Executing `%s'..." command)
- ;; Fake modeline display as if `start-process' were run.
- (setq mode-line-process ":run")
- (force-mode-line-update)
- (sit-for 0) ; Force redisplay
- (let ((status (call-process shell-file-name nil outbuf nil "-c"
- command)))
- (cond ((numberp status)
- (compilation-handle-exit 'exit status
- (if (zerop status)
- "finished\n"
- (format "\
-exited abnormally with code %d\n"
- status))))
- ((stringp status)
- (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-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))))))
-
-(defvar compilation-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'compile-mouse-goto-error)
- (define-key map "\C-c\C-c" 'compile-goto-error)
- (define-key map "\C-m" 'compile-goto-error)
- (define-key map "\C-c\C-k" 'kill-compilation)
- (define-key map "\M-n" 'compilation-next-error)
- (define-key map "\M-p" 'compilation-previous-error)
- (define-key map "\M-{" 'compilation-previous-file)
- (define-key map "\M-}" 'compilation-next-file)
- map)
- "Keymap for `compilation-minor-mode'.")
-
-(defvar compilation-shell-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'compile-mouse-goto-error)
- (define-key map "\M-\C-m" 'compile-goto-error)
- (define-key map "\M-\C-n" 'compilation-next-error)
- (define-key map "\M-\C-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 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))
- map)
- "Keymap for `compilation-shell-minor-mode'.")
-
-(defvar compilation-mode-map
- (let ((map (cons 'keymap 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]
- (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]
- '("----" . nil))
- (define-key map [menu-bar compilation-menu compilation-mode-grep]
- '("Search Files (grep)" . grep))
- (define-key map [menu-bar compilation-menu compilation-mode-recompile]
- '("Recompile" . recompile))
- (define-key map [menu-bar compilation-menu compilation-mode-compile]
- '("Compile..." . compile))
- map)
- "Keymap for compilation log buffers.
-`compilation-minor-mode-map' is a cdr of this.")
-
-(put 'compilation-mode 'mode-class 'special)
-
-;;;###autoload
-(defun compilation-mode (&optional name-of-mode)
- "Major mode for compilation log buffers.
-\\<compilation-mode-map>To visit the source for a line-numbered error,
-move point to the error message line and type \\[compile-goto-error].
-To kill the compilation, type \\[kill-compilation].
-
-Runs `compilation-mode-hook' with `run-hooks' (which see)."
- (interactive)
- (kill-all-local-variables)
- (use-local-map compilation-mode-map)
- (setq major-mode 'compilation-mode
- mode-name (or name-of-mode "Compilation"))
- (compilation-setup)
- (set (make-local-variable 'font-lock-defaults)
- '(compilation-mode-font-lock-keywords t))
- (set (make-local-variable 'revert-buffer-function)
- 'compilation-revert-buffer)
- (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)))
-
-(defun compilation-setup ()
- "Prepare the buffer for the compilation parsing commands to work."
- ;; Make the buffer's mode line show process state.
- (setq mode-line-process '(":%s"))
- (set (make-local-variable 'compilation-error-list) nil)
- (set (make-local-variable 'compilation-old-error-list) nil)
- (set (make-local-variable 'compilation-parsing-end) (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)
- "Toggle compilation shell minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-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))))
-
-;;;###autoload
-(defun compilation-minor-mode (&optional arg)
- "Toggle compilation minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-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))))
-
-(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
- process-status exit-status msg)
- (cons msg exit-status)))
- (omax (point-max))
- (opoint (point)))
- ;; Record where we put the message, so we can ignore it
- ;; later on.
- (goto-char omax)
- (insert ?\n mode-name " " (car status))
- (if (bolp)
- (forward-char -1))
- (insert " at " (substring (current-time-string) 0 19))
- (goto-char (point-max))
- (setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
- ;; Force mode line redisplay soon.
- (force-mode-line-update)
- (if (and opoint (< opoint omax))
- (goto-char opoint))
- ;; Automatically parse (and mouse-highlight) error messages:
- (cond ((eq compile-auto-highlight t)
- (compile-reinitialize-errors nil (point-max)))
- ((numberp compile-auto-highlight)
- (compile-reinitialize-errors nil
- (save-excursion
- (goto-line compile-auto-highlight)
- (point)))))
- (if compilation-finish-function
- (funcall compilation-finish-function (current-buffer) msg))
- (let ((functions compilation-finish-functions))
- (while functions
- (funcall (car functions) (current-buffer) msg)
- (setq functions (cdr functions))))))
-
-;; Called when compilation process changes state.
-(defun compilation-sentinel (proc msg)
- "Sentinel for compilation buffers."
- (let ((buffer (process-buffer proc)))
- (if (memq (process-status proc) '(signal exit))
- (progn
- (if (null (buffer-name buffer))
- ;; buffer killed
- (set-process-buffer proc nil)
- (let ((obuf (current-buffer)))
- ;; save-excursion isn't the right thing if
- ;; process-buffer is current-buffer
- (unwind-protect
- (progn
- ;; Write something in the compilation buffer
- ;; and hack its mode line.
- (set-buffer buffer)
- (compilation-handle-exit (process-status proc)
- (process-exit-status proc)
- msg)
- ;; Since the buffer and mode line will show that the
- ;; process is dead, we can delete it now. Otherwise it
- ;; will stay around until M-x list-processes.
- (delete-process proc))
- (set-buffer obuf))))
- (setq compilation-in-progress (delq proc compilation-in-progress))
- ))))
-
-(defun compilation-filter (proc string)
- "Process filter for compilation buffers.
-Just inserts the text, but uses `insert-before-markers'."
- (if (buffer-name (process-buffer proc))
- (save-excursion
- (set-buffer (process-buffer proc))
- (let ((buffer-read-only nil)
- (end (marker-position compilation-parsing-end)))
- (save-excursion
- (goto-char (process-mark proc))
- (insert-before-markers string)
- (set-marker compilation-parsing-end end) ;don't move it
- (run-hooks 'compilation-filter-hook)
- ;; this seems redundant since we insert-before-marks -stefan
- ;;(set-marker (process-mark proc) (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
- (> (point) (car (car errors))))
- (setq errors (cdr errors)))
- errors))
-
-(defsubst compilation-buffer-p (buffer)
- (save-excursion
- (set-buffer buffer)
- (or compilation-shell-minor-mode compilation-minor-mode
- (eq major-mode 'compilation-mode))))
-
-(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"))
- (setq compilation-last-buffer (current-buffer))
-
- (let ((errors (compile-error-at-point)))
-
- ;; Move to the error after the one containing point.
- (goto-char (car (if (< n 0)
- (let ((i 0)
- (e compilation-old-error-list))
- ;; See how many cdrs away ERRORS is from the start.
- (while (not (eq e errors))
- (setq i (1+ i)
- e (cdr e)))
- (if (> (- n) i)
- (error "Moved back past first error")
- (nth (+ i n) compilation-old-error-list)))
- (let ((compilation-error-list (cdr errors)))
- (compile-reinitialize-errors nil nil n)
- (if compilation-error-list
- (nth (1- n) compilation-error-list)
- (error "Moved past last error"))))))))
-
-(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)))
-
-
-;; 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)
- (setq data (cdr data))
- (if (markerp data)
- (marker-buffer data)
- (car data)))
-
-;; Return a string describing a value from compilation-error-filedata.
-;; This value is not necessarily useful as a file name, but should be
-;; indicative to the user of what file's errors are being referred to.
-(defsubst compilation-error-filedata-file-name (filedata)
- (if (bufferp filedata)
- (buffer-file-name filedata)
- (car filedata)))
-
-(defun compilation-next-file (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"))
- (setq compilation-last-buffer (current-buffer))
-
- (let ((reversed (< n 0))
- errors filedata)
-
- (if (not reversed)
- (setq errors (or (compile-error-at-point)
- (error "Moved past last error")))
-
- ;; Get a reversed list of the errors up through the one containing point.
- (compile-reinitialize-errors nil (point))
- (setq errors (reverse compilation-old-error-list)
- n (- n))
-
- ;; Ignore errors after point. (car ERRORS) will be the error
- ;; containing point, (cadr ERRORS) the one before it.
- (while (and errors
- (< (point) (car (car errors))))
- (setq errors (cdr errors))))
-
- (while (> n 0)
- (setq filedata (compilation-error-filedata (car errors)))
-
- ;; Skip past the following errors for this file.
- (while (equal filedata
- (compilation-error-filedata
- (car (or errors
- (if reversed
- (error "%s the first erring file"
- (compilation-error-filedata-file-name
- filedata))
- (let ((compilation-error-list nil))
- ;; Parse some more.
- (compile-reinitialize-errors nil nil 2)
- (setq errors compilation-error-list)))
- (error "%s is the last erring file"
- (compilation-error-filedata-file-name
- filedata))))))
- (setq errors (cdr errors)))
-
- (setq n (1- n)))
-
- ;; Move to the following error.
- (goto-char (car (car (or errors
- (if reversed
- (error "This is the first erring file")
- (let ((compilation-error-list nil))
- ;; Parse the last one.
- (compile-reinitialize-errors nil nil 1)
- compilation-error-list))))))))
-
-(defun compilation-previous-file (n)
- "Move point to the previous error for a different file than the current one."
- (interactive "p")
- (compilation-next-file (- n)))
-
-
-(defun kill-compilation ()
- "Kill the process made by the \\[compile] command."
- (interactive)
- (let ((buffer (compilation-find-buffer)))
- (if (get-buffer-process buffer)
- (interrupt-process (get-buffer-process buffer))
- (error "The compilation process is not running"))))
-
-
-;; Parse any new errors in the compilation buffer,
-;; or reparse from the beginning if the user has asked for that.
-(defun compile-reinitialize-errors (reparse
- &optional limit-search find-at-least)
- (save-excursion
- (set-buffer compilation-last-buffer)
- ;; If we are out of errors, or if user says "reparse",
- ;; discard the info we have, to force reparsing.
- (if (or (eq compilation-error-list t)
- reparse)
- (compilation-forget-errors))
- (if (and compilation-error-list
- (or (not limit-search)
- (> compilation-parsing-end limit-search))
- (or (not find-at-least)
- (>= (length compilation-error-list) find-at-least)))
- ;; Since compilation-error-list is non-nil, it points to a specific
- ;; error the user wanted. So don't move it around.
- nil
- ;; This was here for a long time (before my rewrite); why? --roland
- ;;(switch-to-buffer compilation-last-buffer)
- (set-buffer-modified-p nil)
- (if (< compilation-parsing-end (point-max))
- ;; compilation-error-list might be non-nil if we have a non-nil
- ;; LIMIT-SEARCH or FIND-AT-LEAST arg. In that case its value
- ;; records the current position in the error list, and we must
- ;; preserve that after reparsing.
- (let ((error-list-pos compilation-error-list))
- (funcall compilation-parse-errors-function
- limit-search
- (and find-at-least
- ;; We only need enough new parsed errors to reach
- ;; FIND-AT-LEAST errors past the current
- ;; position.
- (- find-at-least (length compilation-error-list))))
- ;; Remember the entire list for compilation-forget-errors. If
- ;; this is an incremental parse, append to previous list. If
- ;; we are parsing anew, compilation-forget-errors cleared
- ;; compilation-old-error-list above.
- (setq compilation-old-error-list
- (nconc compilation-old-error-list compilation-error-list))
- (if error-list-pos
- ;; We started in the middle of an existing list of parsed
- ;; errors before parsing more; restore that position.
- (setq compilation-error-list error-list-pos))
- ;; Mouse-Highlight (the first line of) each error message when the
- ;; mouse pointer moves over it:
- (let ((inhibit-read-only t)
- (buffer-undo-list t)
- deactivate-mark
- (error-list compilation-error-list))
- (while error-list
- (save-excursion
- (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))))
- )))))
-
-(defun compile-mouse-goto-error (event)
- "Visit the source for the error message the mouse is pointing at.
-This is like `compile-goto-error' called without prefix arg
-at the end of the line."
- (interactive "e")
- (save-excursion
- (set-buffer (window-buffer (posn-window (event-end event))))
- (goto-char (posn-point (event-end event)))
-
- (or (compilation-buffer-p (current-buffer))
- (error "Not in a compilation buffer"))
- (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
- ;; up to point, moving point to eol makes sure the filename is
- ;; visible to `compile-reinitialize-errors'.
- (end-of-line)
- (compile-reinitialize-errors nil (point))
-
- ;; Move to bol; the marker for the error on this line will point there.
- (beginning-of-line)
-
- ;; Move compilation-error-list to the elt of compilation-old-error-list
- ;; we want.
- (setq compilation-error-list compilation-old-error-list)
- (while (and compilation-error-list
- ;; The marker can point nowhere if we previously
- ;; failed to find the relevant file. See
- ;; compilation-next-error-locus.
- (or (null (marker-buffer (caar compilation-error-list)))
- (> (point) (caar compilation-error-list))))
- (setq compilation-error-list (cdr compilation-error-list)))
- (or compilation-error-list
- (error "No error to go to")))
- (select-window (posn-window (event-end event)))
-
- (push-mark)
- (next-error 1))
-
-(defun compile-goto-error (&optional argp)
- "Visit the source for the error message point is on.
-Use this command in a compilation log buffer. Sets the mark at point there.
-\\[universal-argument] as a prefix arg means to reparse the buffer's error messages first;
-other kinds of prefix arguments are ignored."
- (interactive "P")
- (or (compilation-buffer-p (current-buffer))
- (error "Not in a compilation buffer"))
- (setq compilation-last-buffer (current-buffer))
- (compile-reinitialize-errors (consp argp) (point))
-
- ;; Move to bol; the marker for the error on this line will point there.
- (beginning-of-line)
-
- ;; Move compilation-error-list to the elt of compilation-old-error-list
- ;; we want.
- (setq compilation-error-list compilation-old-error-list)
- (while (and compilation-error-list
- ;; The marker can point nowhere if we previously
- ;; failed to find the relevant file. See
- ;; compilation-next-error-locus.
- (or (null (marker-buffer (caar compilation-error-list)))
- (> (point) (caar compilation-error-list))))
- (setq compilation-error-list (cdr compilation-error-list)))
-
- (push-mark)
- (next-error 1))
-
-;; Return a compilation buffer.
-;; If the current buffer is a compilation buffer, return it.
-;; If compilation-last-buffer is set to a live buffer, use that.
-;; Otherwise, look for a compilation buffer and signal an error
-;; if there are none.
-(defun compilation-find-buffer (&optional other-buffer)
- (if (and (not other-buffer)
- (compilation-buffer-p (current-buffer)))
- ;; The current buffer is a compilation buffer.
- (current-buffer)
- (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
- (compilation-buffer-p compilation-last-buffer)
- (or (not other-buffer) (not (eq compilation-last-buffer
- (current-buffer)))))
- compilation-last-buffer
- (let ((buffers (buffer-list)))
- (while (and buffers (or (not (compilation-buffer-p (car buffers)))
- (and other-buffer
- (eq (car buffers) (current-buffer)))))
- (setq buffers (cdr buffers)))
- (if buffers
- (car buffers)
- (or (and other-buffer
- (compilation-buffer-p (current-buffer))
- ;; The current buffer is a compilation buffer.
- (progn
- (if other-buffer
- (message "This is the only compilation buffer."))
- (current-buffer)))
- (error "No compilation started!")))))))
-
-;;;###autoload
-(defun next-error (&optional argp)
- "Visit next compilation error message and corresponding source code.
-
-If all the error messages parsed so far have been processed already,
-the message buffer is checked for new ones.
-
-A prefix ARGP specifies how many error messages to move;
-negative means move back to previous error messages.
-Just \\[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
-grep buffer. However, it can operate on any buffer with output from
-the \\[compile] and \\[grep] commands, or, more generally, on any
-buffer in Compilation mode or with Compilation Minor mode enabled. To
-specify use of a particular buffer for error messages, type
-\\[next-error] in that buffer.
-
-Once \\[next-error] has chosen the buffer for error messages,
-it stays with that buffer until you use it in some other buffer which
-uses Compilation mode or Compilation Minor mode.
-
-See variables `compilation-parse-errors-function' and
-\`compilation-error-regexp-alist' for customization ideas."
- (interactive "P")
- (setq compilation-last-buffer (compilation-find-buffer))
- (compilation-goto-locus (compilation-next-error-locus
- ;; We want to pass a number here only if
- ;; we got a numeric prefix arg, not just C-u.
- (and (not (consp argp))
- (prefix-numeric-value argp))
- (consp argp))))
-;;;###autoload (define-key ctl-x-map "`" 'next-error)
-
-(defun previous-error ()
- "Visit previous compilation error message and corresponding source code.
-This operates on the output from the \\[compile] command."
- (interactive)
- (next-error -1))
-
-(defun first-error ()
- "Reparse the error message buffer and start at the first error.
-Visit corresponding source code.
-This operates on the output from the \\[compile] command."
- (interactive)
- (next-error '(4)))
-
-(defvar compilation-skip-to-next-location nil
- "*If non-nil, skip multiple error messages for the same source location.")
-
-(defun compilation-next-error-locus (&optional move reparse silent)
- "Visit next compilation error and return locus in corresponding source code.
-This operates on the output from the \\[compile] command.
-If all preparsed error messages have been processed,
-the error message buffer is checked for new ones.
-
-Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the
-location of the error message in the compilation buffer, and SOURCE is a
-marker at the location in the source code indicated by the error message.
-
-Optional first arg MOVE says how many error messages to move forwards (or
-backwards, if negative); default is 1. Optional second arg REPARSE, if
-non-nil, says to reparse the error message buffer and reset to the first
-error (plus MOVE - 1). If optional third argument SILENT is non-nil, return
-nil instead of raising an error if there are no more errors.
-
-The current buffer should be the desired compilation output buffer."
- (or move (setq move 1))
- (compile-reinitialize-errors reparse nil (and (not reparse) (max 0 move)))
- (let (next-errors next-error)
- (catch 'no-next-error
- (save-excursion
- (set-buffer compilation-last-buffer)
- ;; compilation-error-list points to the "current" error.
- (setq next-errors
- (if (> move 0)
- (nthcdr (1- move)
- compilation-error-list)
- ;; Zero or negative arg; we need to move back in the list.
- (let ((n (1- move))
- (i 0)
- (e compilation-old-error-list))
- ;; See how many cdrs away the current error is from the start.
- (while (not (eq e compilation-error-list))
- (setq i (1+ i)
- e (cdr e)))
- (if (> (- n) i)
- (error "Moved back past first error")
- (nthcdr (+ i n) compilation-old-error-list))))
- next-error (car next-errors))
- (while
- (if (null next-error)
- (progn
- (and move (/= move 1)
- (error (if (> move 0)
- "Moved past last error")
- "Moved back past first error"))
- ;; Forget existing error messages if compilation has finished.
- (if (not (and (get-buffer-process (current-buffer))
- (eq (process-status
- (get-buffer-process
- (current-buffer)))
- 'run)))
- (compilation-forget-errors))
- (if silent
- (throw 'no-next-error nil)
- (error (concat compilation-error-message
- (and (get-buffer-process (current-buffer))
- (eq (process-status
- (get-buffer-process
- (current-buffer)))
- 'run)
- " yet")))))
- (setq compilation-error-list (cdr next-errors))
- (if (null (cdr next-error))
- ;; This error is boring. Go to the next.
- t
- (or (markerp (cdr next-error))
- ;; This error has a filename/lineno pair.
- ;; Find the file and turn it into a marker.
- (let* ((fileinfo (car (cdr next-error)))
- (buffer (apply 'compilation-find-file
- (car next-error) fileinfo)))
- (if (null buffer)
- ;; We can't find this error's file.
- ;; Remove all errors in the same file.
- (progn
- (setq next-errors compilation-old-error-list)
- (while next-errors
- (and (consp (cdr (car next-errors)))
- (equal (car (cdr (car next-errors)))
- fileinfo)
- (progn
- (set-marker (car (car next-errors)) nil)
- (setcdr (car next-errors) nil)))
- (setq next-errors (cdr next-errors)))
- ;; Look for the next error.
- t)
- ;; We found the file. Get a marker for this error.
- ;; compilation-old-error-list and
- ;; compilation-error-screen-columns are buffer-local
- ;; so we must be careful to extract their value
- ;; before switching to the source file buffer.
- (let ((errors compilation-old-error-list)
- (columns compilation-error-screen-columns)
- (last-line (nth 1 (cdr next-error)))
- (column (nth 2 (cdr next-error))))
- (set-buffer buffer)
- (save-excursion
- (save-restriction
- (widen)
- (goto-line last-line)
- (if (and column (> column 0))
- ;; Columns in error msgs are 1-origin.
- (if columns
- (move-to-column (1- column))
- (forward-char (1- column)))
- (beginning-of-line))
- (setcdr next-error (point-marker))
- ;; Make all the other error messages referring
- ;; to the same file have markers into the buffer.
- (while errors
- (and (consp (cdr (car errors)))
- (equal (car (cdr (car errors))) fileinfo)
- (let* ((this (nth 1 (cdr (car errors))))
- (column (nth 2 (cdr (car errors))))
- (lines (- this last-line)))
- (if (eq selective-display t)
- ;; When selective-display is t,
- ;; each C-m is a line boundary,
- ;; as well as each newline.
- (if (< lines 0)
- (re-search-backward "[\n\C-m]"
- nil 'end
- (- lines))
- (re-search-forward "[\n\C-m]"
- nil 'end
- lines))
- (forward-line lines))
- (if (and column (> column 1))
- (if columns
- (move-to-column (1- column))
- (forward-char (1- column)))
- (beginning-of-line))
- (setq last-line this)
- (setcdr (car errors) (point-marker))))
- (setq errors (cdr errors)))))))))
- ;; If we didn't get a marker for this error, or this
- ;; marker's buffer was killed, go on to the next one.
- (or (not (markerp (cdr next-error)))
- (not (marker-buffer (cdr next-error))))))
- (setq next-errors compilation-error-list
- next-error (car next-errors)))))
-
- (if compilation-skip-to-next-location
- ;; Skip over multiple error messages for the same source location,
- ;; so the next C-x ` won't go to an error in the same place.
- (while (and compilation-error-list
- (equal (cdr (car compilation-error-list))
- (cdr next-error)))
- (setq compilation-error-list (cdr compilation-error-list))))
-
- ;; We now have a marker for the position of the error source code.
- ;; NEXT-ERROR is a cons (ERROR . SOURCE) of two markers.
- next-error))
-
-(defun compilation-goto-locus (next-error)
- "Jump to an error locus returned by `compilation-next-error-locus'.
-Takes one argument, a cons (ERROR . SOURCE) of two markers.
-Selects a window with point at SOURCE, with another window displaying ERROR."
- (if (eq (window-buffer (selected-window))
- (marker-buffer (car next-error)))
- ;; If the compilation buffer window is selected,
- ;; keep the compilation buffer in this window;
- ;; display the source in another window.
- (let ((pop-up-windows t))
- (pop-to-buffer (marker-buffer (cdr next-error))))
- (if (and (window-dedicated-p (selected-window))
- (eq (selected-window) (frame-root-window)))
- (switch-to-buffer-other-frame (marker-buffer (cdr next-error)))
- (switch-to-buffer (marker-buffer (cdr next-error)))))
- (goto-char (cdr next-error))
- ;; If narrowing got in the way of
- ;; going to the right place, widen.
- (or (= (point) (marker-position (cdr next-error)))
- (progn
- (widen)
- (goto-char (cdr next-error))))
- ;; If hideshow got in the way of
- ;; seeing the right place, open permanently.
- (mapcar (function (lambda (ov)
- (when (eq 'hs (overlay-get ov 'invisible))
- (delete-overlay ov)
- (goto-char (cdr next-error)))))
- (overlays-at (point)))
-
- ;; Show compilation buffer in other window, scrolled to this error.
- (let* ((pop-up-windows t)
- ;; Use an existing window if it is in a visible frame.
- (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible)
- ;; Pop up a window.
- (display-buffer (marker-buffer (car next-error))))))
- (set-window-point w (car next-error))
- (set-window-start w (car next-error))
- (compilation-set-window-height w)))
-\f
-(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")))
- (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)))
-
-
-;; 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.
-;; This would happen anyway at the next garbage collection, but it is better to
-;; do it right away.
-(defun compilation-forget-errors ()
- (while compilation-old-error-list
- (let ((next-error (car compilation-old-error-list)))
- (set-marker (car next-error) nil)
- (if (markerp (cdr next-error))
- (set-marker (cdr next-error) nil)))
- (setq compilation-old-error-list (cdr compilation-old-error-list)))
- (setq compilation-error-list nil
- compilation-directory-stack (list default-directory))
- (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 help-echo nil))))
-
-
-;; This function is not needed any more by compilation mode.
-;; Does anyone else need it or can it be deleted?
-(defun count-regexp-groupings (regexp)
- "Return the number of \\( ... \\) groupings in REGEXP (a string)."
- (let ((groupings 0)
- (len (length regexp))
- (i 0)
- c)
- (while (< i len)
- (setq c (aref regexp i)
- i (1+ i))
- (cond ((= c ?\[)
- ;; Find the end of this [...].
- (while (and (< i len)
- (not (= (aref regexp i) ?\])))
- (setq i (1+ i))))
- ((= c ?\\)
- (if (< i len)
- (progn
- (setq c (aref regexp i)
- i (1+ i))
- (if (= c ?\))
- ;; We found the end of a grouping,
- ;; so bump our counter.
- (setq groupings (1+ groupings))))))))
- groupings))
-
-(defvar compilation-current-file nil
- "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
-;; and set by compile-collect-regexps.
-(defvar compilation-regexps nil)
-
-(defun compilation-parse-errors (limit-search find-at-least)
- "Parse the current buffer as grep, cc, lint or other error messages.
-See variable `compilation-parse-errors-function' for the interface it uses."
- (setq compilation-error-list nil)
- (message "Parsing error messages...")
- (if (null compilation-error-regexp-alist)
- (error "compilation-error-regexp-alist is empty!"))
- (let* ((compilation-regexps nil) ; Variable set by compile-collect-regexps.
- (default-directory (car compilation-directory-stack))
- (found-desired nil)
- (compilation-num-errors-found 0)
- ;; Set up now the expanded, abbreviated directory variables
- ;; that compile-abbreviate-directory will need, so we can
- ;; compute them just once here.
- (orig (abbreviate-file-name default-directory))
- (orig-expanded (abbreviate-file-name
- (file-truename default-directory)))
- (parent-expanded (abbreviate-file-name
- (expand-file-name "../" orig-expanded))))
-
- ;; Make a list of all the regexps. Each element has the form
- ;; (REGEXP TYPE IDX1 IDX2 ...)
- ;; where TYPE is one of leave, enter, file, error or nomessage.
- (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 '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)
- (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)))
- (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
- ;; matching regexp is moved to the front of compilation-regexps
- ;; to make it match faster next time.
- (while (and this (null alist))
- (if (not (looking-at (car (car this))))
- (progn (setq prev this) ; No match, go to next.
- (setq this (cdr this)))
- (setq alist (cdr (car this))) ; Got a match.
-;;; (if prev ; If not the first regexp,
-;;; (progn ; move it to the front.
-;;; (setcdr prev (cdr this))
-;;; (setcdr this compilation-regexps)
-;;; (setq compilation-regexps this)))
- ))
- (if (and alist ; Seen a match and not to
- (not (eq (setq type (car alist)) 'nomessage))) ; be ignored.
- (let* ((end-of-match (match-end 0))
- (filename
- (compile-buffer-substring (car (setq alist (cdr alist)))))
- stack)
- (if (eq type 'error) ; error message
- (let* ((linenum (if (numberp (car (setq alist (cdr alist))))
- (string-to-int
- (compile-buffer-substring (car alist)))
- ;; (car alist) is not a number, must be a
- ;; function that is called below to return
- ;; an error position descriptor.
- (car alist)))
- ;; Convert to integer later if linenum not a function.
- (column (compile-buffer-substring
- (car (setq alist (cdr alist)))))
- this-error)
-
- ;; Check that we have a file name.
- (or filename
- ;; 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))
-
- (setq filename
- (cons filename (cons default-directory (cdr alist))))
-
- ;; Locate the erring file and line.
- ;; Make this-error a new elt for compilation-error-list,
- ;; giving a marker for the current compilation buffer
- ;; location, and the file and line number of the error.
- ;; Save, as the start of the error, the beginning of the
- ;; line containing the match.
- (setq this-error
- (if (numberp linenum)
- (list (point-marker) filename linenum
- (and column (string-to-int column)))
- ;; If linenum is not a number then it must be
- ;; a function returning an error position
- ;; 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
- ;; indicated, then we continue to parse until we have
- ;; seen all consecutive errors in the same file. This
- ;; means that all the errors of a source file will be
- ;; seen in one parsing run, so that the error positions
- ;; will be recorded as markers in the source file
- ;; buffer that will move when the buffer is changed.
- (if (and this-error
- compilation-error-list ; At least one previous.
- (or (and find-at-least
- (>= compilation-num-errors-found
- find-at-least))
- (and limit-search
- (>= end-of-match limit-search)))
- ;; `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
- ;; errors belonging to the earlier file. We don't
- ;; add the error just parsed so that the next
- ;; parsing run can get it and the following errors
- ;; in the same file all at once.
- (setq found-desired t)
-
- (goto-char end-of-match) ; Prepare for next message.
- ;; Don't add the same source line more than once.
- (and this-error
- (not (and
- compilation-error-list
- (equal (cdr (car compilation-error-list))
- (cdr this-error))))
- (setq compilation-error-list
- (cons this-error compilation-error-list)
- compilation-num-errors-found
- (1+ compilation-num-errors-found)))))
-
- ;; Not an error message.
- (if (eq type `file) ; Change current file.
- (and filename (setq compilation-current-file 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)))
- (and (eq type 'leave)
- stack
- (setq compilation-directory-stack (cdr stack))
- (setq stack (car compilation-directory-stack))
- (setq default-directory stack)))
- (goto-char end-of-match) ; Prepare to look at next message.
- (and limit-search (>= end-of-match limit-search)
- ;; The user wanted a specific error, and we're past it.
- ;; We do this check here rather than at the end of the
- ;; loop because if the last thing seen is an error
- ;; message, we must carefully discard the last error
- ;; when it is the first in a new file (see above in
- ;; the error-message case)
- (setq found-desired t)))
-
- ;; Go to before the last character in the message so that we will
- ;; see the next line also when the message ended at end of line.
- ;; When we ignore the last error message above, this will
- ;; cancel the effect of forward-line below so that point
- ;; doesn't move.
- (forward-char -1)
-
- ;; Is this message necessary any more? Parsing is now so fast
- ;; that you might not need to know how it proceeds.
- (message
- "Parsing error messages...%d found. %.0f%% of buffer seen."
- compilation-num-errors-found
- ;; 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.
-
- (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.")))
-
-(defun compile-collect-regexps (type this)
- ;; Add elements to variable compilation-regexps that is bound in
- ;; compilation-parse-errors.
- (and (not (eq this t))
- (dolist (el this)
- (push (cons (car el) (cons type (cdr el))) compilation-regexps))))
-
-(defun compile-buffer-substring (index)
- "Get substring matched by INDEXth subexpression."
- (if index
- (let ((beg (match-beginning index)))
- (if beg (buffer-substring beg (match-end index))))))
-
-;; If directory DIR is a subdir of ORIG or of ORIG's parent,
-;; return a relative name for it starting from ORIG or its parent.
-;; ORIG-EXPANDED is an expanded version of ORIG.
-;; PARENT-EXPANDED is an expanded version of ORIG's parent.
-;; Those two args could be computed here, but we run faster by
-;; having the caller compute them just once.
-(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)
- ;; Apply canonical abbreviations to DIR first thing.
- ;; Those abbreviations are already done in the other arguments passed.
- (setq dir (abbreviate-file-name dir))
-
- ;; 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.)
- (if (boundp 'comint-file-name-prefix)
- (setq dir (concat comint-file-name-prefix dir)))
-
- (if (and (> (length dir) (length orig-expanded))
- (string= orig-expanded
- (substring dir 0 (length orig-expanded))))
- (setq dir
- (concat orig
- (substring dir (length orig-expanded)))))
- (if (and (> (length dir) (length parent-expanded))
- (string= parent-expanded
- (substring dir 0 (length parent-expanded))))
- (setq dir
- (concat (file-name-directory
- (directory-file-name orig))
- (substring dir (length parent-expanded)))))
- dir)
-
-(add-to-list 'debug-ignored-errors "^No more errors\\( yet\\|\\)$")
-
-(provide 'compile)
-
-;;; compile.el ends here
+;;; compile.el --- run compiler as inferior of Emacs, parse error messages
+
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 03, 2004
+;; Free Software Foundation, Inc.
+
+;; Authors: Roland McGrath <roland@gnu.org>,
+;; Daniel Pfeiffer <occitan@esperanto.org>
+;; Maintainer: FSF
+;; Keywords: tools, processes
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package provides the compile facilities documented in the Emacs user's
+;; manual.
+
+;; This mode uses some complex data-structures:
+
+;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE)
+
+;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe
+;; LINE will be nil for a message that doesn't contain them. Then the
+;; location refers to a indented beginning of line or beginning of file.
+;; Once any location in some file has been jumped to, the list is extended to
+;; (COLUMN LINE FILE-STRUCTURE MARKER . VISITED) for all LOCs pertaining to
+;; that file.
+;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
+;; Being a marker it sticks to some text, when the buffer grows or shrinks
+;; before that point. VISITED is t if we have jumped there, else nil.
+
+;; FILE-STRUCTURE is a list of
+;; ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) ...)
+
+;; FILENAME is a string parsed from an error message. DIRECTORY is a string
+;; obtained by following directory change messages. DIRECTORY will be nil for
+;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if
+;; a file of that name can't be found.
+;; The rest of the list is an alist of elements with LINE as key. The keys
+;; are either nil or line numbers. If present, nil comes first, followed by
+;; the numbers in decreasing order. The LOCs for each line are again an alist
+;; ordered the same way. Note that the whole file structure is referenced in
+;; every LOC.
+
+;; MESSAGE is a list of (LOC TYPE END-LOC)
+
+;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
+;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the
+;; other end, if the parsed message contained a range. If the end of the
+;; range didn't specify a COLUMN, it defaults to -1, meaning end of line.
+;; These are the value of the `message' text-properties in the compilation
+;; buffer.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defgroup compilation nil
+ "Run compiler as inferior of Emacs, parse error messages."
+ :group 'tools
+ :group 'processes)
+
+
+;;;###autoload
+(defcustom compilation-mode-hook nil
+ "*List of hook functions run by `compilation-mode' (see `run-hooks')."
+ :type 'hook
+ :group 'compilation)
+
+;;;###autoload
+(defcustom compilation-window-height nil
+ "*Number of lines in a compilation window. If nil, use Emacs default."
+ :type '(choice (const :tag "Default" nil)
+ integer)
+ :group 'compilation)
+
+(defvar compilation-first-column 1
+ "*This is how compilers number the first column, usually 1 or 0.")
+
+(defvar compilation-parse-errors-filename-function nil
+ "Function to call to post-process filenames while parsing error messages.
+It takes one arg FILENAME which is the name of a file as found
+in the compilation output, and should return a transformed file name.")
+
+;;;###autoload
+(defvar compilation-process-setup-function nil
+ "*Function to call to customize the compilation process.
+This function 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
+compilation buffer. It should return a string.
+nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
+
+;;;###autoload
+(defvar compilation-finish-function nil
+ "Function to call when a compilation process finishes.
+It is called with two arguments: the compilation buffer, and a string
+describing how the process finished.")
+
+;;;###autoload
+(defvar compilation-finish-functions nil
+ "Functions to call when a compilation process finishes.
+Each function is called with two arguments: the compilation buffer,
+and a string describing how the process finished.")
+
+(defvar compilation-in-progress nil
+ "List of compilation processes now running.")
+(or (assq 'compilation-in-progress minor-mode-alist)
+ (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
+ minor-mode-alist)))
+
+(defvar compilation-error "error"
+ "Stem of message to print when no matches are found.")
+
+(defvar compilation-arguments nil
+ "Arguments that were given to `compilation-start'.")
+
+(defvar compilation-num-errors-found)
+
+(defconst compilation-error-regexp-alist-alist
+ '((absoft
+ "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
+of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
+
+ (ada
+ "\\(warning: .*\\)? at \\([^ \n]+\\):\\([0-9]+\\)$" 2 3 nil (1))
+
+ (aix
+ " in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
+
+ (ant
+ "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\
+\\( warning\\)?" 1 2 3 (4))
+
+ (bash
+ "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
+
+ (borland
+ "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\
+\\([a-zA-Z]?:?[^:( \t\n]+\\)\
+ \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
+
+ (caml
+ "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
+\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
+ 2 (3 . 4) (5 . 6) (7))
+
+ (comma
+ "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
+\\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
+
+ (edg-1
+ "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
+ 1 2 nil (3 . 4))
+ (edg-2
+ "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$"
+ 2 1 nil 0)
+
+ (epc
+ "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
+
+ (iar
+ "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
+ 1 2 nil (3))
+
+ (ibm
+ "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
+ \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))
+
+ ;; fixme: should be `mips'
+ (irix
+ "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
+ \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
+
+ (java
+ "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
+
+ (jikes-file
+ "^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0)
+ (jikes-line
+ "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
+ nil 1 nil 2 0
+ (2 (compilation-face '(3))))
+
+ (gcc-include
+ "^\\(?:In file included\\| \\) from \
+\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
+
+ (gnu
+ "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
+\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
+\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
+\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
+\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
+ *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\)\\)?"
+ 1 (2 . 5) (4 . 6) (7 . 8))
+
+ (lcc
+ "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
+ 2 3 4 (1))
+
+ (makepp
+ "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\) \\|.*?\\)\
+`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'\\)"
+ 4 5 nil (1 . 2) 3
+ ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'" nil nil
+ (2 compilation-info-face)
+ (3 compilation-line-face nil t)
+ (1 (compilation-error-properties 2 3 nil nil nil 0 nil)
+ append)))
+
+ ;; Should be lint-1, lint-2 (SysV lint)
+ (mips-1
+ " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
+ (mips-2
+ " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
+
+ (msft
+ "^\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
+: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))
+
+ (oracle
+ "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
+\\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
+\\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
+ 3 1 2)
+
+ (perl
+ " at \\([^ \n]+\\) line \\([0-9]+\\)\\(?:[,.]\\|$\\)" 1 2)
+
+ (rxp
+ "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\
+ \\([0-9]+\\) of file://\\(.+\\)"
+ 4 2 3 (1))
+
+ (sparc-pascal-file
+ "^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\
+ [12][09][0-9][0-9] +\\(.*\\):$"
+ 1 nil nil 0)
+ (sparc-pascal-line
+ "^\\(\\(?:E\\|\\(w\\)\\) +[0-9]+\\) line \\([0-9]+\\) - "
+ nil 3 nil (2) nil (1 (compilation-face '(2))))
+ (sparc-pascal-example
+ "^ +\\([0-9]+\\) +.*\n\\(\\(?:e\\|\\(w\\)\\) [0-9]+\\)-+"
+ nil 1 nil (3) nil (2 (compilation-face '(3))))
+
+ (sun
+ ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\
+File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
+ 3 4 5 (1 . 2))
+
+ (sun-ada
+ "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
+
+ (4bsd
+ "\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
+\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)))
+ "Alist of values for `compilation-error-regexp-alist'.")
+
+(defcustom compilation-error-regexp-alist
+ (mapcar 'car compilation-error-regexp-alist-alist)
+ "Alist that specifies how to match errors in compiler output.
+Note that on Unix everything is a valid filename, so these
+matchers must make some common sense assumptions, which catch
+normal cases. A shorter list will be lighter on resource usage.
+
+Instead of an alist element, you can use a symbol, which is
+looked up in `compilation-error-regexp-alist-alist'. You can see
+the predefined symbols and their effects in the file
+`etc/compilation.txt' (linked below if you are customizing this).
+
+Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK
+HIGHLIGHT...]). If REGEXP matches, the FILE'th subexpression
+gives the file name, and the LINE'th subexpression gives the line
+number. The COLUMN'th subexpression gives the column number on
+that line.
+
+If FILE, LINE or COLUMN are nil or that index didn't match, that
+information is not present on the matched line. In that case the
+file name is assumed to be the same as the previous one in the
+buffer, line number defaults to 1 and column defaults to
+beginning of line's indentation.
+
+FILE can also have the form (FILE FORMAT...), where the FORMATs
+\(e.g. \"%s.c\") will be applied in turn to the recognized file
+name, until a file of that name is found. Or FILE can also be a
+function to return the filename.
+
+LINE can also be of the form (LINE . END-LINE) meaning a range
+of lines. COLUMN can also be of the form (COLUMN . END-COLUMN)
+meaning a range of columns starting on LINE and ending on
+END-LINE, if that matched.
+
+TYPE is 2 or nil for a real error or 1 for warning or 0 for info.
+TYPE can also be of the form (WARNING . INFO). In that case this
+will be equivalent to 1 if the WARNING'th subexpression matched
+or else equivalent to 0 if the INFO'th subexpression matched.
+See `compilation-error-face', `compilation-warning-face',
+`compilation-info-face' and `compilation-skip-threshold'.
+
+What matched the HYPERLINK'th subexpression has `mouse-face' and
+`compilation-message-face' applied. If this is nil, the text
+matched by the whole REGEXP becomes the hyperlink.
+
+Additional HIGHLIGHTs as described under `font-lock-keywords' can
+be added."
+ :type `(set :menu-tag "Pick"
+ ,@(mapcar (lambda (elt)
+ (list 'const (car elt)))
+ compilation-error-regexp-alist-alist))
+ :link `(file-link :tag "example file"
+ ,(expand-file-name "compilation.txt" data-directory))
+ :group 'compilation)
+
+(defvar compilation-directory nil
+ "Directory to restore to when doing `recompile'.")
+
+(defvar compilation-directory-matcher
+ '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1))
+ "A list for tracking when directories are entered or left.
+Nil means not to track directories, e.g. if all file names are absolute. The
+first element is the REGEXP matching these messages. It can match any number
+of variants, e.g. different languages. The remaining elements are all of the
+form (DIR . LEAVE). If for any one of these the DIR'th subexpression
+matches, that is a directory name. If LEAVE is nil or the corresponding
+LEAVE'th subexpression doesn't match, this message is about going into another
+directory. If it does match anything, this message is about going back to the
+directory we were in before the last entering message. If you change this,
+you may also want to change `compilation-page-delimiter'.")
+
+(defvar compilation-page-delimiter
+ "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory `.+'\n\\)+"
+ "Value of `page-delimiter' in Compilation mode.")
+
+(defvar compilation-mode-font-lock-keywords
+ '(;; configure output lines.
+ ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$"
+ (1 font-lock-variable-name-face)
+ (2 (compilation-face '(4 . 3))))
+ ;; Command output lines. Recognize `make[n]:' lines too.
+ ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
+ (1 font-lock-function-name-face) (3 compilation-line-face nil t))
+ (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1)
+ ("^Compilation finished" . compilation-info-face)
+ ("^Compilation exited abnormally" . compilation-error-face))
+ "Additional things to highlight in Compilation mode.
+This gets tacked on the end of the generated expressions.")
+
+(defvar compilation-highlight-regexp t
+ "Regexp matching part of visited source lines to highlight temporarily.
+Highlight entire line if t; don't highlight source lines if nil.")
+
+(defvar compilation-highlight-overlay nil
+ "Overlay used to temporarily highlight compilation matches.")
+
+(defcustom compilation-error-screen-columns t
+ "*If non-nil, column numbers in error messages are screen columns.
+Otherwise they are interpreted as character positions, with
+each character occupying one column.
+The default is to use screen columns, which requires that the compilation
+program and Emacs agree about the display width of the characters,
+especially the TAB character."
+ :type 'boolean
+ :group 'compilation
+ :version "20.4")
+
+(defcustom compilation-read-command t
+ "*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
+ "*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."
+ :type '(repeat (choice (const :tag "Default" nil)
+ (string :tag "Directory")))
+ :group 'compilation)
+
+(defcustom compile-command "make -k "
+ "*Last shell command used to do a compilation; default for next compilation.
+
+Sometimes it is useful for files to supply local values for this variable.
+You might also use mode hooks to specify it in certain modes, like this:
+
+ (add-hook 'c-mode-hook
+ (lambda ()
+ (unless (or (file-exists-p \"makefile\")
+ (file-exists-p \"Makefile\"))
+ (set (make-local-variable 'compile-command)
+ (concat \"make -k \"
+ (file-name-sans-extension buffer-file-name))))))"
+ :type 'string
+ :group 'compilation)
+
+;; A weak per-compilation-buffer hash indexed by (FILENAME . DIRECTORY). Each
+;; value is a FILE-STRUCTURE as described above, with the car eq to the hash
+;; key. This holds the tree seen from root, for storing new nodes.
+(defvar compilation-locs ())
+
+(defvar compilation-debug nil
+ "*Set this to t before creating a *compilation* buffer.
+Then every error line will have a debug text property with the matcher that
+fit this line and the match data. Use `describe-text-properties'.")
+
+(defvar compilation-exit-message-function nil "\
+If non-nil, called when a compilation process dies to return a status message.
+This should be a function of three arguments: process status, exit status,
+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)
+
+(defface compilation-warning-face
+ '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold))
+ (((class color)) (:foreground "cyan" :weight bold))
+ (t (:weight bold)))
+ "Face used to highlight compiler warnings."
+ :group 'font-lock-highlighting-faces
+ :version "21.4")
+
+(defface compilation-info-face
+ '((((class color) (min-colors 16) (background light))
+ (:foreground "Green3" :weight bold))
+ (((class color) (min-colors 16) (background dark))
+ (:foreground "Green" :weight bold))
+ (((class color)) (:foreground "green" :weight bold))
+ (t (:weight bold)))
+ "Face used to highlight compiler warnings."
+ :group 'font-lock-highlighting-faces
+ :version "21.4")
+
+(defvar compilation-message-face nil
+ "Face name to use for whole messages.
+Faces `compilation-error-face', `compilation-warning-face',
+`compilation-info-face', `compilation-line-face' and
+`compilation-column-face' get prepended to this, when applicable.")
+
+(defvar compilation-error-face 'font-lock-warning-face
+ "Face name to use for file name in error messages.")
+
+(defvar compilation-warning-face 'compilation-warning-face
+ "Face name to use for file name in warning messages.")
+
+(defvar compilation-info-face 'compilation-info-face
+ "Face name to use for file name in informational messages.")
+
+(defvar compilation-line-face 'font-lock-variable-name-face
+ "Face name to use for line number in message.")
+
+(defvar compilation-column-face 'font-lock-type-face
+ "Face name to use for column number in message.")
+
+;; same faces as dired uses
+(defvar compilation-enter-directory-face 'font-lock-function-name-face
+ "Face name to use for column number in message.")
+
+(defvar compilation-leave-directory-face 'font-lock-type-face
+ "Face name to use for column number in message.")
+
+
+
+;; Used for compatibility with the old compile.el.
+(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
+(defvar compilation-parsing-end (make-marker))
+(defvar compilation-parse-errors-function nil)
+(defvar compilation-error-list nil)
+(defvar compilation-old-error-list nil)
+
+(defun compilation-face (type)
+ (or (and (car type) (match-end (car type)) compilation-warning-face)
+ (and (cdr type) (match-end (cdr type)) compilation-info-face)
+ compilation-error-face))
+
+(defun compilation-directory-properties (idx leave)
+ (if leave (setq leave (match-end leave)))
+ ;; find previous stack, and push onto it, or if `leave' pop it
+ (let ((dir (previous-single-property-change (point) 'directory)))
+ (setq dir (if dir (or (get-text-property (1- dir) 'directory)
+ (get-text-property dir 'directory))))
+ `(face ,(if leave
+ compilation-leave-directory-face
+ compilation-enter-directory-face)
+ directory ,(if leave
+ (or (cdr dir)
+ '(nil)) ; nil only isn't a property-change
+ (cons (match-string-no-properties idx) dir))
+ mouse-face highlight
+ keymap compilation-button-map
+ help-echo "mouse-2: visit current directory")))
+
+;; Data type `reverse-ordered-alist' retriever. This function retrieves the
+;; KEY element from the ALIST, creating it in the right position if not already
+;; present. ALIST structure is
+;; '(ANCHOR (KEY1 ...) (KEY2 ...)... (KEYn ALIST ...))
+;; ANCHOR is ignored, but necessary so that elements can be inserted. KEY1
+;; may be nil. The other KEYs are ordered backwards so that growing line
+;; numbers can be inserted in front and searching can abort after half the
+;; list on average.
+(eval-when-compile ;Don't keep it at runtime if not needed.
+(defmacro compilation-assq (key alist)
+ `(let* ((l1 ,alist)
+ (l2 (cdr l1)))
+ (car (if (if (null ,key)
+ (if l2 (null (caar l2)))
+ (while (if l2 (if (caar l2) (< ,key (caar l2)) t))
+ (setq l1 l2
+ l2 (cdr l1)))
+ (if l2 (eq ,key (caar l2))))
+ l2
+ (setcdr l1 (cons (list ,key) l2)))))))
+
+
+;; This function is the central driver, called when font-locking to gather
+;; all information needed to later jump to corresponding source code.
+;; Return a property list with all meta information on this error location.
+(defun compilation-error-properties (file line end-line col end-col type fmt)
+ (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point))
+ (point))
+ (if file
+ (if (functionp file)
+ (setq file (funcall file))
+ (let (dir)
+ (setq file (match-string-no-properties file))
+ (unless (file-name-absolute-p file)
+ (setq dir (previous-single-property-change (point) 'directory)
+ dir (if dir (or (get-text-property (1- dir) 'directory)
+ (get-text-property dir 'directory)))))
+ (setq file (cons file (car dir)))))
+ ;; This message didn't mention one, get it from previous
+ (setq file (previous-single-property-change (point) 'message)
+ file (or (if file
+ (car (nth 2 (car (or (get-text-property (1- file) 'message)
+ (get-text-property file 'message))))))
+ '("*unknown*"))))
+ ;; All of these fields are optional, get them only if we have an index, and
+ ;; it matched some part of the message.
+ (and line
+ (setq line (match-string-no-properties line))
+ (setq line (string-to-number line)))
+ (and end-line
+ (setq end-line (match-string-no-properties end-line))
+ (setq end-line (string-to-number end-line)))
+ (and col
+ (setq col (match-string-no-properties col))
+ (setq col (- (string-to-number col) compilation-first-column)))
+ (if (and end-col (setq end-col (match-string-no-properties end-col)))
+ (setq end-col (- (string-to-number end-col) compilation-first-column))
+ (if end-line (setq end-col -1)))
+ (if (consp type) ; not a static type, check what it is.
+ (setq type (or (and (car type) (match-end (car type)) 1)
+ (and (cdr type) (match-end (cdr type)) 0)
+ 2)))
+ (compilation-internal-error-properties file line end-line col end-col type fmt)))
+
+(defun compilation-internal-error-properties (file line end-line col end-col type fmt)
+ "Get the meta-info that will be added as text-properties.
+LINE, END-LINE, COL, END-COL are integers or nil.
+TYPE can be 0, 1, or 2.
+FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
+ (unless file (setq file '("*unknown*")))
+ (setq file (compilation-get-file-structure file fmt))
+ ;; Get first already existing marker (if any has one, all have one).
+ ;; Do this first, as the compilation-assq`s may create new nodes.
+ (let* ((marker-line (car (cddr file))) ; a line structure
+ (marker (nth 3 (cadr marker-line))) ; its marker
+ (compilation-error-screen-columns compilation-error-screen-columns)
+ end-marker loc end-loc)
+ (if (not (and marker (marker-buffer marker)))
+ (setq marker) ; no valid marker for this file
+ (setq loc (or line 1)) ; normalize no linenumber to line 1
+ (catch 'marker ; find nearest loc, at least one exists
+ (dolist (x (nthcdr 3 file)) ; loop over remaining lines
+ (if (> (car x) loc) ; still bigger
+ (setq marker-line x)
+ (if (> (- (or (car marker-line) 1) loc)
+ (- loc (car x))) ; current line is nearer
+ (setq marker-line x))
+ (throw 'marker t))))
+ (setq marker (nth 3 (cadr marker-line))
+ marker-line (or (car marker-line) 1))
+ (with-current-buffer (marker-buffer marker)
+ (save-restriction
+ (widen)
+ (goto-char (marker-position marker))
+ (when (or end-col end-line)
+ (beginning-of-line (- (or end-line line) marker-line -1))
+ (if (< end-col 0)
+ (end-of-line)
+ (if compilation-error-screen-columns
+ (move-to-column end-col)
+ (forward-char end-col)))
+ (setq end-marker (list (point-marker))))
+ (beginning-of-line (if end-line
+ (- end-line line -1)
+ (- loc marker-line -1)))
+ (if col
+ (if compilation-error-screen-columns
+ (move-to-column col)
+ (forward-char col))
+ (forward-to-indentation 0))
+ (setq marker (list (point-marker))))))
+
+ (setq loc (compilation-assq line (cdr file)))
+ (if end-line
+ (setq end-loc (compilation-assq end-line (cdr file))
+ end-loc (compilation-assq end-col end-loc))
+ (if end-col ; use same line element
+ (setq end-loc (compilation-assq end-col loc))))
+ (setq loc (compilation-assq col loc))
+ ;; If they are new, make the loc(s) reference the file they point to.
+ (or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
+ (if end-loc
+ (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
+
+ ;; Must start with face
+ `(face ,compilation-message-face
+ message (,loc ,type ,end-loc)
+ ,@(if compilation-debug
+ `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
+ ,@(match-data))))
+ help-echo ,(if col
+ "mouse-2: visit this file, line and column"
+ (if line
+ "mouse-2: visit this file and line"
+ "mouse-2: visit this file"))
+ keymap compilation-button-map
+ mouse-face highlight)))
+
+(defun compilation-mode-font-lock-keywords ()
+ "Return expressions to highlight in Compilation mode."
+ (if compilation-parse-errors-function
+ ;; An old package! Try the compatibility code.
+ '((compilation-compat-parse-errors))
+ (append
+ ;; make directory tracking
+ (if compilation-directory-matcher
+ `((,(car compilation-directory-matcher)
+ ,@(mapcar (lambda (elt)
+ `(,(car elt)
+ (compilation-directory-properties
+ ,(car elt) ,(cdr elt))
+ t))
+ (cdr compilation-directory-matcher)))))
+
+ ;; Compiler warning/error lines.
+ (mapcar
+ (lambda (item)
+ (if (symbolp item)
+ (setq item (cdr (assq item
+ compilation-error-regexp-alist-alist))))
+ (let ((file (nth 1 item))
+ (line (nth 2 item))
+ (col (nth 3 item))
+ (type (nth 4 item))
+ end-line end-col fmt)
+ (if (consp file) (setq fmt (cdr file) file (car file)))
+ (if (consp line) (setq end-line (cdr line) line (car line)))
+ (if (consp col) (setq end-col (cdr col) col (car col)))
+
+ (if (functionp line)
+ ;; The old compile.el had here an undocumented hook that
+ ;; allowed `line' to be a function that computed the actual
+ ;; error location. Let's do our best.
+ `(,(car item)
+ (0 (compilation-compat-error-properties
+ (funcall ',line (cons (match-string ,file)
+ (cons default-directory
+ ',(nthcdr 4 item)))
+ ,(if col `(match-string ,col)))))
+ (,file compilation-error-face t))
+
+ (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
+ (error "HYPERLINK should be an integer: %s" (nth 5 item)))
+
+ `(,(nth 0 item)
+
+ ,@(when (integerp file)
+ `((,file ,(if (consp type)
+ `(compilation-face ',type)
+ (aref [compilation-info-face
+ compilation-warning-face
+ compilation-error-face]
+ (or type 2))))))
+
+ ,@(when line
+ `((,line compilation-line-face nil t)))
+ ,@(when end-line
+ `((,end-line compilation-line-face nil t)))
+
+ ,@(when col
+ `((,col compilation-column-face nil t)))
+ ,@(when end-col
+ `((,end-col compilation-column-face nil t)))
+
+ ,@(nthcdr 6 item)
+ (,(or (nth 5 item) 0)
+ (compilation-error-properties ',file ,line ,end-line
+ ,col ,end-col ',(or type 2)
+ ',fmt)
+ append))))) ; for compilation-message-face
+ compilation-error-regexp-alist)
+
+ compilation-mode-font-lock-keywords)))
+
+\f
+;;;###autoload
+(defun compile (command &optional comint)
+ "Compile the program including the current buffer. Default: run `make'.
+Runs COMMAND, a shell command, in a separate process asynchronously
+with output going to the buffer `*compilation*'.
+
+If optional second arg COMINT is t the buffer will be in Comint mode with
+`compilation-shell-minor-mode'.
+
+You can then use the command \\[next-error] to find the next error message
+and move to the source code that caused it.
+
+Interactively, prompts for the command if `compilation-read-command' is
+non-nil; otherwise uses `compile-command'. With prefix arg, always prompts.
+Additionally, with universal prefix arg, compilation buffer will be in
+comint mode, i.e. interactive.
+
+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
+to a function that generates a unique name."
+ (interactive
+ (list
+ (if (or compilation-read-command current-prefix-arg)
+ (read-from-minibuffer "Compile command: "
+ (eval compile-command) nil nil
+ '(compile-history . 1))
+ (eval compile-command))
+ (consp current-prefix-arg)))
+ (unless (equal command (eval compile-command))
+ (setq compile-command command))
+ (save-some-buffers (not compilation-ask-about-save) nil)
+ (setq compilation-directory default-directory)
+ (compilation-start command comint))
+
+;; run compile with the default command line
+(defun recompile ()
+ "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, recompile using `compile-command'."
+ (interactive)
+ (save-some-buffers (not compilation-ask-about-save) nil)
+ (let ((default-directory (or compilation-directory default-directory)))
+ (apply 'compilation-start (or compilation-arguments
+ `(,(eval compile-command))))))
+
+(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
+visible rather than the beginning."
+ :type 'boolean
+ :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) "*"))))
+
+;; This is a rough emulation of the old hack, until the transition to new
+;; compile is complete.
+(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)
+ (if parser
+ (error "Compile now works very differently, see `compilation-error-regexp-alist'"))
+ (let ((compilation-error-regexp-alist
+ (append file-regexp-alist (or error-regexp-alist
+ compilation-error-regexp-alist)))
+ (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?"
+ "\\1" error-message)))
+ (compilation-start command nil name-function highlight-regexp)))
+(make-obsolete 'compile-internal 'compilation-start)
+
+(defun compilation-start (command &optional mode name-function highlight-regexp)
+ "Run compilation command COMMAND (low level interface).
+The rest of the arguments are optional; for them, nil means use the default.
+
+MODE is the major mode to set in the compilation buffer. Mode
+may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.
+NAME-FUNCTION is a function called to name the buffer.
+
+If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
+the matching section of the visited source line; the default is to use the
+global value of `compilation-highlight-regexp'.
+
+Returns the compilation buffer created."
+ (or mode (setq mode 'compilation-mode))
+ (let ((name-of-mode
+ (if (eq mode t)
+ (prog1 "compilation" (require 'comint))
+ (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
+ (process-environment
+ (append
+ compilation-environment
+ (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
+ 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.
+ (unless (getenv "EMACS") '("EMACS=t"))
+ process-environment))
+ (thisdir default-directory)
+ outwin outbuf)
+ (with-current-buffer
+ (setq outbuf
+ (get-buffer-create
+ (compilation-buffer-name name-of-mode name-function)))
+ (let ((comp-proc (get-buffer-process (current-buffer))))
+ (if comp-proc
+ (if (or (not (eq (process-status comp-proc) 'run))
+ (yes-or-no-p
+ (format "A %s process is running; kill it? "
+ name-of-mode)))
+ (condition-case ()
+ (progn
+ (interrupt-process comp-proc)
+ (sit-for 1)
+ (delete-process comp-proc))
+ (error nil))
+ (error "Cannot have two processes in `%s' at once"
+ (buffer-name)))))
+ ;; Clear out the compilation buffer and make it writable.
+ ;; Change its default-directory to the directory where the compilation
+ ;; will happen, and insert a `cd' command to indicate this.
+ (setq buffer-read-only nil)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (buffer-enable-undo (current-buffer))
+ (setq default-directory thisdir)
+ ;; output a mode setter, for saving and later reloading this buffer
+ (insert "cd " thisdir " # -*-" name-of-mode
+ "-*-\nEntering directory `" thisdir "'\n" command "\n")
+ (set-buffer-modified-p nil))
+ ;; If we're already in the compilation buffer, go to the end
+ ;; of the buffer, so point will track the compilation output.
+ (if (eq outbuf (current-buffer))
+ (goto-char (point-max)))
+ ;; Pop up the compilation buffer.
+ (setq outwin (display-buffer outbuf nil t))
+ (with-current-buffer outbuf
+ (if (not (eq mode t))
+ (funcall mode)
+ (with-no-warnings (comint-mode))
+ (compilation-shell-minor-mode))
+ ;; In what way is it non-ergonomic ? -stef
+ ;; (toggle-read-only 1) ;;; Non-ergonomic.
+ (if highlight-regexp
+ (set (make-local-variable 'compilation-highlight-regexp)
+ highlight-regexp))
+ (set (make-local-variable 'compilation-arguments)
+ (list command mode name-function highlight-regexp))
+ (set (make-local-variable 'revert-buffer-function)
+ 'compilation-revert-buffer)
+ (set-window-start outwin (point-min))
+ (or (eq outwin (selected-window))
+ (set-window-point outwin (if compilation-scroll-output
+ (point)
+ (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 (fboundp 'start-process)
+ (let ((proc (if (eq mode t)
+ (get-buffer-process
+ (with-no-warnings
+ (comint-exec outbuf (downcase mode-name)
+ shell-file-name nil `("-c" ,command))))
+ (start-process-shell-command (downcase mode-name)
+ outbuf command))))
+ ;; Make the buffer's mode line show process state.
+ (setq mode-line-process '(":%s"))
+ (set-process-sentinel proc 'compilation-sentinel)
+ (set-process-filter proc 'compilation-filter)
+ (set-marker (process-mark proc) (point) outbuf)
+ (setq compilation-in-progress
+ (cons proc compilation-in-progress)))
+ ;; No asynchronous processes available.
+ (message "Executing `%s'..." command)
+ ;; Fake modeline display as if `start-process' were run.
+ (setq mode-line-process ":run")
+ (force-mode-line-update)
+ (sit-for 0) ; Force redisplay
+ (let ((status (call-process shell-file-name nil outbuf nil "-c"
+ command)))
+ (cond ((numberp status)
+ (compilation-handle-exit 'exit status
+ (if (zerop status)
+ "finished\n"
+ (format "\
+exited abnormally with code %d\n"
+ status))))
+ ((stringp status)
+ (compilation-handle-exit 'signal status
+ (concat status "\n")))
+ (t
+ (compilation-handle-exit 'bizarre status status))))
+ ;; Without async subprocesses, the buffer is not yet
+ ;; fontified, so fontify it now.
+ (let ((font-lock-verbose nil)) ; shut up font-lock messages
+ (font-lock-fontify-buffer))
+ (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 next-error-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))))
+ ;; Stef said that doing the saves in this order is safer:
+ (save-excursion
+ (save-selected-window
+ (select-window window)
+ (enlarge-window (- height (window-height))))))))
+
+(defvar compilation-menu-map
+ (let ((map (make-sparse-keymap "Errors")))
+ (define-key map [stop-subjob]
+ '("Stop Compilation" . kill-compilation))
+ (define-key map [compilation-mode-separator2]
+ '("----" . nil))
+ (define-key map [compilation-first-error]
+ '("First Error" . first-error))
+ (define-key map [compilation-previous-error]
+ '("Previous Error" . previous-error))
+ (define-key map [compilation-next-error]
+ '("Next Error" . next-error))
+ map))
+
+(defvar compilation-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'compile-goto-error)
+ (define-key map "\C-c\C-c" 'compile-goto-error)
+ (define-key map "\C-m" 'compile-goto-error)
+ (define-key map "\C-c\C-k" 'kill-compilation)
+ (define-key map "\M-n" 'compilation-next-error)
+ (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'.")
+
+(defvar compilation-shell-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\M-\C-m" 'compile-goto-error)
+ (define-key map "\M-\C-n" 'compilation-next-error)
+ (define-key map "\M-\C-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-shell-minor-mode'.")
+
+(defvar compilation-button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'compile-goto-error)
+ (define-key map "\C-m" 'compile-goto-error)
+ map)
+ "Keymap for compilation-message buttons.")
+(fset 'compilation-button-map compilation-button-map)
+
+(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.")
+
+(put 'compilation-mode 'mode-class 'special)
+
+(defvar compilation-skip-to-next-location t
+ "*If non-nil, skip multiple error messages for the same source location.")
+
+(defcustom compilation-skip-threshold 1
+ "*Compilation motion commands skip less important messages.
+The value can be either 2 -- skip anything less than error, 1 --
+skip anything less than warning or 0 -- don't skip any messages.
+Note that all messages not positively identified as warning or
+info, are considered errors."
+ :type '(choice (const :tag "Warnings and info" 2)
+ (const :tag "Info" 1)
+ (const :tag "None" 0))
+ :group 'compilation
+ :version "21.4")
+
+(defcustom compilation-skip-visited nil
+ "*Compilation motion commands skip visited messages if this is t.
+Visited messages are ones for which the file, line and column have been jumped
+to from the current content in the current compilation buffer, even if it was
+from a different message."
+ :type 'boolean
+ :group 'compilation
+ :version "21.4")
+
+;;;###autoload
+(defun compilation-mode ()
+ "Major mode for compilation log buffers.
+\\<compilation-mode-map>To visit the source for a line-numbered error,
+move point to the error message line and type \\[compile-goto-error].
+To kill the compilation, type \\[kill-compilation].
+
+Runs `compilation-mode-hook' with `run-hooks' (which see)."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map compilation-mode-map)
+ (setq major-mode 'compilation-mode
+ mode-name "Compilation")
+ (set (make-local-variable 'page-delimiter)
+ compilation-page-delimiter)
+ (compilation-setup)
+ (run-mode-hooks 'compilation-mode-hook))
+
+(defmacro define-compilation-mode (mode name doc &rest body)
+ "This is like `define-derived-mode' without the PARENT argument.
+The parent is always `compilation-mode' and the customizable `compilation-...'
+variables are also set from the name of the mode you have chosen, by replacing
+the fist word, e.g `compilation-scroll-output' from `grep-scroll-output' if that
+variable exists."
+ (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
+ `(define-derived-mode ,mode compilation-mode ,name
+ ,doc
+ ,@(mapcar (lambda (v)
+ (setq v (cons v
+ (intern-soft (replace-regexp-in-string
+ "^compilation" mode-name
+ (symbol-name v)))))
+ (and (cdr v)
+ (or (boundp (cdr v))
+ (if (boundp 'byte-compile-bound-variables)
+ (memq (cdr v) byte-compile-bound-variables)))
+ `(set (make-local-variable ',(car v)) ,(cdr v))))
+ '(compilation-buffer-name-function
+ compilation-directory-matcher
+ compilation-error
+ compilation-error-regexp-alist
+ compilation-error-regexp-alist-alist
+ compilation-error-screen-columns
+ compilation-finish-function
+ compilation-finish-functions
+ compilation-first-column
+ compilation-mode-font-lock-keywords
+ compilation-page-delimiter
+ compilation-parse-errors-filename-function
+ compilation-process-setup-function
+ compilation-scroll-output
+ compilation-search-path
+ compilation-skip-threshold
+ compilation-window-height))
+ ,@body)))
+
+(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 'compilation-start compilation-arguments))))
+
+(defvar compilation-current-error nil
+ "Marker to the location from where the next error will be found.
+The global commands next/previous/first-error/goto-error use this.")
+
+(defvar compilation-messages-start nil
+ "Buffer position of the beginning of the compilation messages.
+If nil, use the beginning of buffer.")
+
+;; A function name can't be a hook, must be something with a value.
+(defconst compilation-turn-on-font-lock 'turn-on-font-lock)
+
+(defun compilation-setup (&optional minor)
+ "Prepare the buffer for the compilation parsing commands to work.
+Optional argument MINOR indicates this is called from
+`compilation-minor-mode'."
+ (make-local-variable 'compilation-current-error)
+ (make-local-variable 'compilation-messages-start)
+ (make-local-variable 'compilation-error-screen-columns)
+ (make-local-variable 'overlay-arrow-position)
+ ;; Note that compilation-next-error-function is for interfacing
+ ;; with the next-error function in simple.el, and it's only
+ ;; coincidentally named similarly to compilation-next-error.
+ (setq next-error-function 'compilation-next-error-function)
+ (set (make-local-variable 'font-lock-extra-managed-props)
+ '(directory message help-echo mouse-face debug))
+ (set (make-local-variable 'compilation-locs)
+ (make-hash-table :test 'equal :weakness 'value))
+ ;; lazy-lock would never find the message unless it's scrolled to.
+ ;; jit-lock might fontify some things too late.
+ (set (make-local-variable 'font-lock-support-mode) nil)
+ (set (make-local-variable 'font-lock-maximum-size) nil)
+ (let ((fld font-lock-defaults))
+ (if (and minor fld)
+ (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
+ (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))
+ (if minor
+ (if font-lock-mode
+ (if fld
+ (font-lock-fontify-buffer)
+ (font-lock-change-mode)
+ (turn-on-font-lock))
+ (turn-on-font-lock))
+ ;; maybe defer font-lock till after derived mode is set up
+ (run-mode-hooks 'compilation-turn-on-font-lock))))
+
+;;;###autoload
+(define-minor-mode compilation-shell-minor-mode
+ "Toggle compilation shell minor mode.
+With arg, turn compilation mode on if and only if arg is positive.
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available but bound to keys that don't
+collide with Shell mode. See `compilation-mode'.
+Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
+ nil " Shell-Compile"
+ :group 'compilation
+ (if compilation-shell-minor-mode
+ (compilation-setup t)
+ (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
+ (font-lock-fontify-buffer)))
+
+;;;###autoload
+(define-minor-mode compilation-minor-mode
+ "Toggle compilation minor mode.
+With arg, turn compilation mode on if and only if arg is positive.
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available. See `compilation-mode'.
+Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
+ nil " Compilation"
+ :group 'compilation
+ (if compilation-minor-mode
+ (compilation-setup t)
+ (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
+ (font-lock-fontify-buffer)))
+
+(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
+ process-status exit-status msg)
+ (cons msg exit-status)))
+ (omax (point-max))
+ (opoint (point)))
+ ;; Record where we put the message, so we can ignore it later on.
+ (goto-char omax)
+ (insert ?\n mode-name " " (car status))
+ (if (and (numberp compilation-window-height)
+ (zerop compilation-window-height))
+ (message "%s" (cdr status)))
+ (if (bolp)
+ (forward-char -1))
+ (insert " at " (substring (current-time-string) 0 19))
+ (goto-char (point-max))
+ ;; Prevent that message from being recognized as a compilation error.
+ (add-text-properties omax (point)
+ (append '(compilation-handle-exit t) nil))
+ (setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
+ ;; Force mode line redisplay soon.
+ (force-mode-line-update)
+ (if (and opoint (< opoint omax))
+ (goto-char opoint))
+ (if compilation-finish-function
+ (funcall compilation-finish-function (current-buffer) msg))
+ (let ((functions compilation-finish-functions))
+ (while functions
+ (funcall (car functions) (current-buffer) msg)
+ (setq functions (cdr functions))))))
+
+;; Called when compilation process changes state.
+(defun compilation-sentinel (proc msg)
+ "Sentinel for compilation buffers."
+ (if (memq (process-status proc) '(exit signal))
+ (let ((buffer (process-buffer proc)))
+ (if (null (buffer-name buffer))
+ ;; buffer killed
+ (set-process-buffer proc nil)
+ (with-current-buffer buffer
+ ;; Write something in the compilation buffer
+ ;; and hack its mode line.
+ (compilation-handle-exit (process-status proc)
+ (process-exit-status proc)
+ msg)
+ ;; Since the buffer and mode line will show that the
+ ;; process is dead, we can delete it now. Otherwise it
+ ;; will stay around until M-x list-processes.
+ (delete-process proc)))
+ (setq compilation-in-progress (delq proc compilation-in-progress)))))
+
+(defun compilation-filter (proc string)
+ "Process filter for compilation buffers.
+Just inserts the text, but uses `insert-before-markers'."
+ (if (buffer-name (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char (process-mark proc))
+ (insert-before-markers string)
+ (run-hooks 'compilation-filter-hook))))))
+
+;;; test if a buffer is a compilation buffer, assuming we're in the buffer
+(defsubst compilation-buffer-internal-p ()
+ "Test if inside a compilation buffer."
+ (local-variable-p 'compilation-locs))
+
+;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p
+(defsubst compilation-buffer-p (buffer)
+ "Test if BUFFER is a compilation buffer."
+ (with-current-buffer buffer
+ (compilation-buffer-internal-p)))
+
+(defmacro compilation-loop (< property-change 1+ error)
+ `(while (,< n 0)
+ (or (setq pt (,property-change pt 'message))
+ (error ,error compilation-error))
+ ;; prop 'message usually has 2 changes, on and off, so re-search if off
+ (or (setq msg (get-text-property pt 'message))
+ (if (setq pt (,property-change pt 'message))
+ (setq msg (get-text-property pt 'message)))
+ (error ,error compilation-error))
+ (or (< (cadr msg) compilation-skip-threshold)
+ (if different-file
+ (eq (prog1 last (setq last (nth 2 (car msg))))
+ last))
+ (if compilation-skip-visited
+ (nthcdr 4 (car msg)))
+ (if compilation-skip-to-next-location
+ (eq (car msg) loc))
+ ;; count this message only if none of the above are true
+ (setq n (,1+ n)))))
+
+(defun compilation-next-error (n &optional different-file pt)
+ "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"))
+ (or pt (setq pt (point)))
+ (let* ((msg (get-text-property pt 'message))
+ (loc (car msg))
+ last)
+ (if (zerop n)
+ (unless (or msg ; find message near here
+ (setq msg (get-text-property (max (1- pt) (point-min))
+ 'message)))
+ (setq pt (previous-single-property-change pt 'message nil
+ (line-beginning-position)))
+ (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
+ (setq pt (next-single-property-change pt 'message nil
+ (line-end-position)))
+ (or (setq msg (get-text-property pt 'message))
+ (setq pt (point)))))
+ (setq last (nth 2 (car msg)))
+ (if (>= n 0)
+ (compilation-loop > next-single-property-change 1-
+ (if (get-buffer-process (current-buffer))
+ "No more %ss yet"
+ "Moved past last %s"))
+ ;; Don't move "back" to message at or before point.
+ ;; Pass an explicit (point-min) to make sure pt is non-nil.
+ (setq pt (previous-single-property-change pt 'message nil (point-min)))
+ (compilation-loop < previous-single-property-change 1+
+ "Moved back before first %s")))
+ (goto-char pt)
+ (or msg
+ (error "No %s here" compilation-error))))
+
+(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 \\[previous-error]."
+ (interactive "p")
+ (compilation-next-error (- n)))
+
+(defun compilation-next-file (n)
+ "Move point to the next error for a different file than the current one.
+Prefix arg N says how many files to move forwards (or backwards, if negative)."
+ (interactive "p")
+ (compilation-next-error n t))
+
+(defun compilation-previous-file (n)
+ "Move point to the previous error for a different file than the current one.
+Prefix arg N says how many files to move backwards (or forwards, if negative)."
+ (interactive "p")
+ (compilation-next-file (- n)))
+
+(defun kill-compilation ()
+ "Kill the process made by the \\[compile] or \\[grep] commands."
+ (interactive)
+ (let ((buffer (compilation-find-buffer)))
+ (if (get-buffer-process buffer)
+ (interrupt-process (get-buffer-process buffer))
+ (error "The compilation process is not running"))))
+
+(defalias 'compile-mouse-goto-error 'compile-goto-error)
+
+(defun compile-goto-error (&optional event)
+ "Visit the source for the error message at point.
+Use this command in a compilation log buffer. Sets the mark at point there."
+ (interactive (list last-input-event))
+ (if event (posn-set-point (event-end event)))
+ (or (compilation-buffer-p (current-buffer))
+ (error "Not in a compilation buffer"))
+ (if (get-text-property (point) 'directory)
+ (dired-other-window (car (get-text-property (point) 'directory)))
+ (push-mark)
+ (setq compilation-current-error (point))
+ (next-error 0)))
+
+;; Return a compilation buffer.
+;; If the current buffer is a compilation buffer, return it.
+;; Otherwise, look for a compilation buffer and signal an error
+;; if there are none.
+(defun compilation-find-buffer (&optional other-buffer)
+ (next-error-find-buffer other-buffer 'compilation-buffer-internal-p))
+
+;;;###autoload
+(defun compilation-next-error-function (n &optional reset)
+ (interactive "p")
+ (set-buffer (compilation-find-buffer))
+ (when reset
+ (setq compilation-current-error nil))
+ (let* ((columns compilation-error-screen-columns) ; buffer's local value
+ (last 1)
+ (loc (compilation-next-error (or n 1) nil
+ (or compilation-current-error
+ compilation-messages-start
+ (point-min))))
+ (end-loc (nth 2 loc))
+ (marker (point-marker)))
+ (setq compilation-current-error (point-marker)
+ overlay-arrow-position
+ (if (bolp)
+ compilation-current-error
+ (copy-marker (line-beginning-position)))
+ loc (car loc))
+ ;; If loc contains no marker, no error in that file has been visited. If
+ ;; the marker is invalid the buffer has been killed. So, recalculate all
+ ;; markers for that file.
+ (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)))
+ (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
+ (or (cdar (nth 2 loc))
+ default-directory))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ ;; Treat file's found lines in forward order, 1 by 1.
+ (dolist (line (reverse (cddr (nth 2 loc))))
+ (when (car line) ; else this is a filename w/o a line#
+ (beginning-of-line (- (car line) last -1))
+ (setq last (car line)))
+ ;; Treat line's found columns and store/update a marker for each.
+ (dolist (col (cdr line))
+ (if (car col)
+ (if (eq (car col) -1) ; special case for range end
+ (end-of-line)
+ (if columns
+ (move-to-column (car col))
+ (beginning-of-line)
+ (forward-char (car col))))
+ (beginning-of-line)
+ (skip-chars-forward " \t"))
+ (if (nth 3 col)
+ (set-marker (nth 3 col) (point))
+ (setcdr (nthcdr 2 col) `(,(point-marker)))))))))
+ (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
+ (setcdr (nthcdr 3 loc) t))) ; Set this one as visited.
+
+(defvar compilation-gcpro nil
+ "Internal variable used to keep some values from being GC'd.")
+(make-variable-buffer-local 'compilation-gcpro)
+
+(defun compilation-fake-loc (marker file &optional line col)
+ "Preassociate MARKER with FILE.
+FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
+This is useful when you compile temporary files, but want
+automatic translation of the messages to the real buffer from
+which the temporary file came. This only works if done before a
+message about FILE appears!
+
+Optional args LINE and COL default to 1 and beginning of
+indentation respectively. The marker is expected to reflect
+this. In the simplest case the marker points to the first line
+of the region that was saved to the temp file.
+
+If you concatenate several regions into the temp file (e.g. a
+header with variable assignments and a code region), you must
+call this several times, once each for the last line of one
+region and the first line of the next region."
+ (or (consp file) (setq file (list file)))
+ (setq file (compilation-get-file-structure file))
+ ;; Between the current call to compilation-fake-loc and the first occurrence
+ ;; of an error message referring to `file', the data is only kept is the
+ ;; weak hash-table compilation-locs, so we need to prevent this entry
+ ;; in compilation-locs from being GC'd away. --Stef
+ (push file compilation-gcpro)
+ (let ((loc (compilation-assq (or line 1) (cdr file))))
+ (setq loc (compilation-assq col loc))
+ (if (cdr loc)
+ (setcdr (cddr loc) (list marker))
+ (setcdr loc (list line file marker)))
+ loc))
+
+(defcustom compilation-context-lines 0
+ "*Display this many lines of leading context before message.
+If nil, don't scroll the compilation output window."
+ :type '(choice integer (const :tag "No window scrolling" nil))
+ :group 'compilation
+ :version "21.4")
+
+(defsubst compilation-set-window (w mk)
+ "Align the compilation output window W with marker MK near top."
+ (if (integerp compilation-context-lines)
+ (set-window-start w (save-excursion
+ (goto-char mk)
+ (beginning-of-line (- 1 compilation-context-lines))
+ (point))))
+ (set-window-point w mk))
+
+(defun compilation-goto-locus (msg mk end-mk)
+ "Jump to an error corresponding to MSG at MK.
+All arguments are markers. If END-MK is non nil, mark is set there."
+ (if (eq (window-buffer (selected-window))
+ (marker-buffer msg))
+ ;; If the compilation buffer window is selected,
+ ;; keep the compilation buffer in this window;
+ ;; display the source in another window.
+ (let ((pop-up-windows t))
+ (pop-to-buffer (marker-buffer mk)))
+ (if (window-dedicated-p (selected-window))
+ (pop-to-buffer (marker-buffer mk))
+ (switch-to-buffer (marker-buffer mk))))
+ ;; If narrowing gets in the way of going to the right place, widen.
+ (unless (eq (goto-char mk) (point))
+ (widen)
+ (goto-char mk))
+ (if end-mk
+ (push-mark end-mk nil t)
+ (if mark-active (setq mark-active)))
+ ;; If hideshow got in the way of
+ ;; seeing the right place, open permanently.
+ (dolist (ov (overlays-at (point)))
+ (when (eq 'hs (overlay-get ov 'invisible))
+ (delete-overlay ov)
+ (goto-char mk)))
+
+ ;; 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 msg) 'visible)
+ ;; Pop up a window.
+ (display-buffer (marker-buffer msg))))
+ (highlight-regexp (with-current-buffer (marker-buffer msg)
+ ;; also do this while we change buffer
+ (compilation-set-window w msg)
+ compilation-highlight-regexp)))
+ (compilation-set-window-height w)
+
+ (when (and highlight-regexp
+ (not (and end-mk transient-mark-mode)))
+ (unless compilation-highlight-overlay
+ (setq compilation-highlight-overlay
+ (make-overlay (point-min) (point-min)))
+ (overlay-put compilation-highlight-overlay 'face 'region))
+ (with-current-buffer (marker-buffer mk)
+ (save-excursion
+ (end-of-line)
+ (let ((end (point)))
+ (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.5)
+ (delete-overlay compilation-highlight-overlay)))))))
+
+\f
+(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")))
+ (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.
+ (let ((pop-up-windows t))
+ (compilation-set-window (display-buffer (marker-buffer marker))
+ 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-get-file-structure (file &optional fmt)
+ "Retrieve FILE's file-structure or create a new one.
+FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
+
+ (or (gethash file compilation-locs)
+ ;; File was not previously encountered, at least not in the form passed.
+ ;; Let's normalize it and look again.
+ (let ((filename (car file))
+ (default-directory (if (cdr file)
+ (file-truename (cdr file))
+ default-directory)))
+
+ ;; 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.)
+ (if (boundp 'comint-file-name-prefix)
+ (if (file-name-absolute-p filename)
+ (setq filename
+ (concat (with-no-warnings comint-file-name-prefix) filename))
+ (setq default-directory
+ (file-truename
+ (concat (with-no-warnings comint-file-name-prefix) default-directory)))))
+
+ ;; 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.
+ (setq filename (command-line-normalize-file-name filename))
+
+ ;; Now eliminate any "..", because find-file would get them wrong.
+ ;; Make relative and absolute filenames, with or without links, the
+ ;; same.
+ (setq filename
+ (list (abbreviate-file-name
+ (file-truename (if (cdr file)
+ (expand-file-name filename)
+ filename)))))
+
+ ;; Store it for the possibly unnormalized name
+ (puthash file
+ ;; Retrieve or create file-structure for normalized name
+ (or (gethash filename compilation-locs)
+ (puthash filename (list filename fmt) compilation-locs))
+ compilation-locs))))
+
+(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
+
+;;; Compatibility with the old compile.el.
+
+(defun compile-buffer-substring (n) (if n (match-string n)))
+
+(defun compilation-compat-error-properties (err)
+ "Map old-style error ERR to new-style message."
+ ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
+ ;; (MARKER . MARKER).
+ (let ((dst (cdr err)))
+ (if (markerp dst)
+ ;; Must start with a face, for font-lock.
+ `(face nil
+ message ,(list (list nil nil nil dst) 2)
+ help-echo "mouse-2: visit the source location"
+ keymap compilation-button-map
+ mouse-face highlight)
+ ;; Too difficult to do it by hand: dispatch to the normal code.
+ (let* ((file (pop dst))
+ (line (pop dst))
+ (col (pop dst))
+ (filename (pop file))
+ (dirname (pop file))
+ (fmt (pop file)))
+ (compilation-internal-error-properties
+ (cons filename dirname) line nil col nil 2 fmt)))))
+
+(defun compilation-compat-parse-errors (limit)
+ (when compilation-parse-errors-function
+ ;; FIXME: We should remove the rest of the compilation keywords
+ ;; but we can't do that from here because font-lock is using
+ ;; the value right now. --stef
+ (save-excursion
+ (setq compilation-error-list nil)
+ ;; Reset compilation-parsing-end each time because font-lock
+ ;; might force us the re-parse many times (typically because
+ ;; some code adds some text-property to the output that we
+ ;; already parsed). You might say "why reparse", well:
+ ;; because font-lock has just removed the `message' property so
+ ;; have to do it all over again.
+ (if compilation-parsing-end
+ (set-marker compilation-parsing-end (point))
+ (setq compilation-parsing-end (point-marker)))
+ (condition-case nil
+ ;; Ignore any error: we're calling this function earlier than
+ ;; in the old compile.el so things might not all be setup yet.
+ (funcall compilation-parse-errors-function limit nil)
+ (error nil))
+ (dolist (err (if (listp compilation-error-list) compilation-error-list))
+ (let* ((src (car err))
+ (dst (cdr err))
+ (loc (cond ((markerp dst) (list nil nil nil dst))
+ ((consp dst)
+ (list (nth 2 dst) (nth 1 dst)
+ (cons (cdar dst) (caar dst)))))))
+ (when loc
+ (goto-char src)
+ ;; (put-text-property src (line-end-position) 'font-lock-face 'font-lock-warning-face)
+ (put-text-property src (line-end-position)
+ 'message (list loc 2)))))))
+ (goto-char limit)
+ nil)
+
+;; Beware: this is not only compatiblity code. New code stil uses it. --Stef
+(defun compilation-forget-errors ()
+ ;; In case we hit the same file/line specs, we want to recompute a new
+ ;; marker for them, so flush our cache.
+ (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
+ (setq compilation-gcpro nil)
+ ;; FIXME: the old code reset the directory-stack, so maybe we should
+ ;; put a `directory change' marker of some sort, but where? -stef
+ ;;
+ ;; FIXME: The old code moved compilation-current-error (which was
+ ;; virtually represented by a mix of compilation-parsing-end and
+ ;; compilation-error-list) to point-min, but that was only meaningful for
+ ;; the internal uses of compilation-forget-errors: all calls from external
+ ;; packages seem to be followed by a move of compilation-parsing-end to
+ ;; something equivalent to point-max. So we speculatively move
+ ;; compilation-current-error to point-max (since the external package
+ ;; won't know that it should do it). --stef
+ (setq compilation-current-error nil)
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (mark (if proc (process-mark proc)))
+ (pos (or mark (point-max))))
+ (setq compilation-messages-start
+ ;; In the future, ignore the text already present in the buffer.
+ ;; Since many process filter functions insert before markers,
+ ;; we need to put ours just before the insertion point rather
+ ;; than at the insertion point. If that's not possible, then
+ ;; don't use a marker. --Stef
+ (if (> pos (point-min)) (copy-marker (1- pos)) pos))))
+
+(provide 'compile)
+
+;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
+;;; compile.el ends here
HCoop / bpt / emacs.git / blobdiff