;;; 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.
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
;; Daniel Pfeiffer <occitan@esperanto.org>
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(eval-when-compile (require 'cl))
+(defvar font-lock-extra-managed-props)
+(defvar font-lock-keywords)
+(defvar font-lock-maximum-size)
+(defvar font-lock-support-mode)
+
+
(defgroup compilation nil
"Run compiler as inferior of Emacs, parse error messages."
:group 'tools
;;;###autoload
(defcustom compilation-mode-hook nil
- "*List of hook functions run by `compilation-mode' (see `run-hooks')."
+ "*List of hook functions run by `compilation-mode' (see `run-mode-hooks')."
:type 'hook
:group 'compilation)
It is called with two arguments: the compilation buffer, and a string
describing how the process finished.")
+(make-obsolete-variable 'compilation-finish-function
+ "Use `compilation-finish-functions', but it works a little differently."
+ "22.1")
+
;;;###autoload
(defvar compilation-finish-functions nil
"Functions to call when a compilation process finishes.
(epc
"^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
+ (ftnchek
+ "\\(^Warning .*\\)? line[ \n]\\([0-9]+\\)[ \n]\\(?:col \\([0-9]+\\)[ \n]\\)?file \\([^ :;\n]+\\)"
+ 4 2 3 (1))
+
(iar
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
1 2 nil (3))
;; 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))
+ "^[-[: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))
nil 1 nil 2 0
(2 (compilation-face '(3))))
- (gcc-include
- "^\\(?:In file included\\| \\) from \
-\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
-
(gnu
+ ;; I have no idea what this first line is supposed to match, but it
+ ;; makes things ambiguous with output such as "foo:344:50:blabla" since
+ ;; the "foo" part can match this first line (in which case the file
+ ;; name as "344"). To avoid this, the second line disallows filenames
+ ;; exclusively composed of digits. --Stef
+ ;; Similarly, we get lots of false positives with messages including
+ ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
+ ;; the last line tries to rule out message where the info after the
+ ;; line number starts with "SS". --Stef
"^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
-\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
-\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
-\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
+\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-\n]\\)*?\\): ?\
+\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
+\\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
- *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\)\\)?"
+ *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\)\\|\
+\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
1 (2 . 5) (4 . 6) (7 . 8))
+ ;; The `gnu' style above can incorrectly match gcc's "In file
+ ;; included from" message, so we process that first. -- cyd
+ (gcc-include
+ "^\\(?:In file included\\| \\) from \
+\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
+
(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]+\\)\\)?\\)'\\)"
+ "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\|Imported\\) \\|.*?\\)\
+`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)"
4 5 nil (1 . 2) 3
- ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'" nil nil
+ ("`\\(\\(\\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)
" in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
(msft
- "^\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
-: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))
+ "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
+: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 2 3 nil (4))
(oracle
"^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
(4bsd
"\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
-\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)))
+\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))
+
+ (gcov-file
+ "^ *-: *\\(0\\):Source:\\(.+\\)$"
+ 2 1 nil 0 nil
+ (1 compilation-line-face prepend) (2 compilation-info-face prepend))
+ (gcov-header
+ "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
+ nil 1 nil 0 nil
+ (1 compilation-line-face prepend))
+ ;; Underlines over all lines of gcov output are too uncomfortable to read.
+ ;; However, hyperlinks embedded in the lines are useful.
+ ;; So I put default face on the lines; and then put
+ ;; compilation-*-face by manually to eliminate the underlines.
+ ;; The hyperlinks are still effective.
+ (gcov-nomark
+ "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$"
+ nil 1 nil 0 nil
+ (0 'default t)
+ (1 compilation-line-face prepend))
+ (gcov-called-line
+ "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$"
+ nil 2 nil 0 nil
+ (0 'default t)
+ (1 compilation-info-face prepend) (2 compilation-line-face prepend))
+ (gcov-never-called
+ "^ *\\(#####\\): *\\([0-9]+\\):.*$"
+ nil 2 nil 2 nil
+ (0 'default t)
+ (1 compilation-error-face prepend) (2 compilation-line-face prepend))
+ )
"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
+On GNU and Unix, any string 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.
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.
+function that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
+In the former case, FILENAME may be relative or absolute.
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)
(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
+If nil, do not 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
("^\\([[: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))
+ ("^Compilation \\(finished\\).*"
+ (0 '(face nil message nil help-echo nil mouse-face nil) t)
+ (1 compilation-info-face))
+ ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
+ (0 '(face nil message nil help-echo nil mouse-face nil) t)
+ (1 compilation-error-face)
+ (2 compilation-error-face nil t)))
"Additional things to highlight in Compilation mode.
This gets tacked on the end of the generated expressions.")
(string :tag "Directory")))
:group 'compilation)
+;;;###autoload
(defcustom compile-command "make -k "
"*Last shell command used to do a compilation; default for next compilation.
(file-name-sans-extension buffer-file-name))))))"
:type 'string
:group 'compilation)
+;;;###autoload(put 'compile-command 'safe-local-variable 'stringp)
+
+;;;###autoload
+(defcustom compilation-disable-input nil
+ "*If non-nil, send end-of-file as compilation process input.
+This only affects platforms that support asynchronous processes (see
+`start-process'); synchronous compilation processes never accept input."
+ :type 'boolean
+ :group 'compilation
+ :version "22.1")
;; 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
;; History of compile commands.
(defvar compile-history nil)
-(defface compilation-warning-face
+(defface compilation-error
+ '((t :inherit font-lock-warning-face))
+ "Face used to highlight compiler errors."
+ :group 'compilation
+ :version "22.1")
+
+(defface compilation-warning
'((((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")
+ :group 'compilation
+ :version "22.1")
-(defface compilation-info-face
+(defface compilation-info
'((((class color) (min-colors 16) (background light))
(:foreground "Green3" :weight bold))
+ (((class color) (min-colors 88) (background dark))
+ (:foreground "Green1" :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")
+ "Face used to highlight compiler information."
+ :group 'compilation
+ :version "22.1")
+
+(defface compilation-line-number
+ '((t :inherit font-lock-variable-name-face))
+ "Face for displaying line numbers in compiler messages."
+ :group 'compilation
+ :version "22.1")
-(defvar compilation-message-face nil
+(defface compilation-column-number
+ '((t :inherit font-lock-type-face))
+ "Face for displaying column numbers in compiler messages."
+ :group 'compilation
+ :version "22.1")
+
+(defcustom compilation-message-face 'underline
"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.")
+`compilation-column-face' get prepended to this, when applicable."
+ :type 'face
+ :group 'compilation
+ :version "22.1")
-(defvar compilation-error-face 'font-lock-warning-face
+(defvar compilation-error-face 'compilation-error
"Face name to use for file name in error messages.")
-(defvar compilation-warning-face 'compilation-warning-face
+(defvar compilation-warning-face 'compilation-warning
"Face name to use for file name in warning messages.")
-(defvar compilation-info-face 'compilation-info-face
+(defvar compilation-info-face 'compilation-info
"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-line-face 'compilation-line-number
+ "Face name to use for line numbers in compiler messages.")
-(defvar compilation-column-face 'font-lock-type-face
- "Face name to use for column number in message.")
+(defvar compilation-column-face 'compilation-column-number
+ "Face name to use for column numbers in compiler messages.")
;; same faces as dired uses
(defvar compilation-enter-directory-face 'font-lock-function-name-face
- "Face name to use for column number in message.")
+ "Face name to use for entering directory messages.")
(defvar compilation-leave-directory-face 'font-lock-type-face
- "Face name to use for column number in message.")
+ "Face name to use for leaving directory messages.")
(and (cdr type) (match-end (cdr type)) compilation-info-face)
compilation-error-face))
+;; Internal function for calculating the text properties of a directory
+;; change message. The directory property is important, because it is
+;; the stack of nested enter-messages. Relative filenames on the following
+;; lines are relative to the top of the stack.
(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
(cons (match-string-no-properties idx) dir))
mouse-face highlight
keymap compilation-button-map
- help-echo "mouse-2: visit current directory")))
+ help-echo "mouse-2: visit this 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
;; 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))
(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*"))))
+ (let ((prev-pos
+ ;; Find the previous message.
+ (previous-single-property-change (point) 'message)))
+ (if prev-pos
+ ;; Get the file structure that belongs to it.
+ (let* ((prev
+ (or (get-text-property (1- prev-pos) 'message)
+ (get-text-property prev-pos 'message)))
+ (prev-struct
+ (car (nth 2 (car prev)))))
+ ;; Construct FILE . DIR from that.
+ (if prev-struct
+ (setq file (cons (car prev-struct)
+ (cadr prev-struct))))))
+ (unless file
+ (setq file '("*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
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)
+(defun compilation-move-to-column (col screen)
+ "Go to column COL on the current line.
+If SCREEN is non-nil, columns are screen columns, otherwise, they are
+just char-counts."
+ (if screen
+ (move-to-column col)
+ (goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
+
+(defun compilation-internal-error-properties (file line end-line col end-col type fmts)
"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."
+TYPE can be 0, 1, or 2, meaning error, warning, or just info.
+FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
+FMTS is a list of format specs for transforming the file name.
+ (See `compilation-error-regexp-alist'.)"
(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
+ (let* ((file-struct (compilation-get-file-structure file fmts))
+ ;; Get first already existing marker (if any has one, all have one).
+ ;; Do this first, as the compilation-assq`s may create new nodes.
+ (marker-line (car (cddr file-struct))) ; 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 marker nil) ; 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
+ (dolist (x (nthcdr 3 file-struct)) ; loop over remaining lines
(if (> (car x) loc) ; still bigger
(setq marker-line x)
(if (> (- (or (car marker-line) 1) loc)
(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)))
+ (save-excursion
+ (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 (or (null end-col) (< end-col 0))
+ (end-of-line)
+ (compilation-move-to-column
+ end-col compilation-error-screen-columns))
+ (setq end-marker (list (point-marker))))
+ (beginning-of-line (if end-line
+ (- line end-line -1)
+ (- loc marker-line -1)))
+ (if col
+ (compilation-move-to-column
+ col compilation-error-screen-columns)
+ (forward-to-indentation 0))
+ (setq marker (list (point-marker)))))))
+
+ (setq loc (compilation-assq line (cdr file-struct)))
(if end-line
- (setq end-loc (compilation-assq end-line (cdr file))
+ (setq end-loc (compilation-assq end-line (cdr file-struct))
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)))
+ (or (cdr loc) (setcdr loc `(,line ,file-struct ,@marker)))
(if end-loc
- (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
+ (or (cdr end-loc)
+ (setcdr end-loc `(,(or end-line line) ,file-struct ,@end-marker))))
;; Must start with face
`(face ,compilation-message-face
`(,(car elt)
(compilation-directory-properties
,(car elt) ,(cdr elt))
- t))
+ t t))
(cdr compilation-directory-matcher)))))
;; Compiler warning/error lines.
;; 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)))))
+ (0 (save-match-data
+ (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)))
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))
+ (let ((command (eval compile-command)))
+ (if (or compilation-read-command current-prefix-arg)
+ (read-from-minibuffer "Compile command: "
+ command nil nil
+ (if (equal (car compile-history) command)
+ '(compile-history . 1)
+ 'compile-history))
+ command))
(consp current-prefix-arg)))
(unless (equal command (eval compile-command))
(setq compile-command command))
:group 'compilation)
-(defun compilation-buffer-name (mode-name name-function)
+(defun compilation-buffer-name (mode-name mode-command 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
+If current buffer is the mode MODE-COMMAND,
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))
- ((eq major-mode (nth 1 compilation-arguments))
+ ((and (eq mode-command major-mode)
+ (eq major-mode (nth 1 compilation-arguments)))
(buffer-name))
(t
(concat "*" (downcase mode-name) "*"))))
(compilation-start command nil name-function highlight-regexp)))
(make-obsolete 'compile-internal 'compilation-start)
+;;;###autoload
(defun compilation-start (command &optional mode name-function highlight-regexp)
"Run compilation command COMMAND (low level interface).
If COMMAND starts with a cd command, that becomes the `default-directory'.
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 NAME-FUNCTION is non-nil, call it with one argument (the mode name)
+to determine the buffer name.
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
(if (eq mode t)
(prog1 "compilation" (require 'comint))
(replace-regexp-in-string "-mode$" "" (symbol-name mode))))
- cd-path ; in case process-environment contains CDPATH
- (thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command)
- (substitute-in-file-name (match-string 1 command))
- default-directory))
+ (thisdir default-directory)
outwin outbuf)
(with-current-buffer
(setq outbuf
(get-buffer-create
- (compilation-buffer-name name-of-mode name-function)))
+ (compilation-buffer-name name-of-mode mode name-function)))
(let ((comp-proc (get-buffer-process (current-buffer))))
(if comp-proc
(if (or (not (eq (process-status comp-proc) 'run))
(error "Cannot have two processes in `%s' at once"
(buffer-name)))))
(buffer-disable-undo (current-buffer))
+ ;; first transfer directory from where M-x compile was called
+ (setq default-directory thisdir)
;; Make compilation buffer read-only. The filter can still write it.
;; Clear out the compilation buffer.
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (default-directory thisdir))
+ ;; Then evaluate a cd command if any, but don't perform it yet, else start-command
+ ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make"
+ (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
+ (if (match-end 1)
+ (substitute-env-vars (match-string 1 command))
+ "~")
+ default-directory))
(erase-buffer)
- ;; Change its default-directory to the directory where the compilation
- ;; will happen, and insert a `cd' command to indicate this.
- (setq default-directory thisdir)
- ;; output a mode setter, for saving and later reloading this buffer
+ ;; Select the desired mode.
+ (if (not (eq mode t))
+ (funcall mode)
+ (setq buffer-read-only nil)
+ (with-no-warnings (comint-mode))
+ (compilation-shell-minor-mode))
+ (if highlight-regexp
+ (set (make-local-variable 'compilation-highlight-regexp)
+ highlight-regexp))
+ ;; Output a mode setter, for saving and later reloading this buffer.
(insert "-*- mode: " name-of-mode
"; default-directory: " (prin1-to-string default-directory)
- " -*-\n" command "\n"))
+ " -*-\n"
+ (format "%s started at %s\n\n"
+ mode-name
+ (substring (current-time-string) 0 19))
+ command "\n")
+ (setq thisdir default-directory))
(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.
(window-width))))
;; Set the EMACS variable, but
;; don't override users' setting of $EMACS.
- (unless (getenv "EMACS") '("EMACS=t"))
+ (unless (getenv "EMACS")
+ (list (concat "EMACS=" invocation-directory invocation-name)))
(copy-sequence process-environment))))
- (if (not (eq mode t))
- (funcall mode)
- (setq buffer-read-only nil)
- (with-no-warnings (comint-mode))
- (compilation-shell-minor-mode))
- (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)
(set-process-sentinel proc 'compilation-sentinel)
(set-process-filter proc 'compilation-filter)
(set-marker (process-mark proc) (point) outbuf)
+ (when compilation-disable-input
+ (condition-case nil
+ (process-send-eof proc)
+ ;; The process may have exited already.
+ (error nil)))
(setq compilation-in-progress
(cons proc compilation-in-progress)))
;; No asynchronous processes available.
(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)))
+ (let* ((buffer-read-only nil) ; call-process needs to modify outbuf
+ (status (call-process shell-file-name nil outbuf nil "-c"
+ command)))
(cond ((numberp status)
(compilation-handle-exit 'exit status
(if (zerop status)
;; fontified, so fontify it now.
(let ((font-lock-verbose nil)) ; shut up font-lock messages
(font-lock-fontify-buffer))
- (message "Executing `%s'...done" command))))
+ (set-buffer-modified-p nil)
+ (message "Executing `%s'...done" command)))
+ ;; Now finally cd to where the shell started make/grep/...
+ (setq default-directory thisdir))
(if (buffer-local-value 'compilation-scroll-output outbuf)
(save-selected-window
(select-window outwin)
(defvar compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'compile-goto-error)
+ (define-key map [follow-link] 'mouse-face)
(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)
(defvar compilation-button-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'compile-goto-error)
+ (define-key map [follow-link] 'mouse-face)
(define-key map "\C-m" 'compile-goto-error)
map)
"Keymap for compilation-message buttons.")
(defvar compilation-mode-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map compilation-minor-mode-map)
+ ;; Don't inherit from compilation-minor-mode-map,
+ ;; because that introduces a menu bar item we don't want.
+ ;; That confuses C-down-mouse-3.
+ (define-key map [mouse-2] 'compile-goto-error)
+ (define-key map [follow-link] 'mouse-face)
+ (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)
+ (define-key map "\t" 'compilation-next-error)
+ (define-key map [backtab] 'compilation-previous-error)
+
(define-key map " " 'scroll-up)
(define-key map "\^?" 'scroll-down)
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
;; Set up the menu-bar
- (define-key map [menu-bar compilation]
- (cons "Compile" (make-sparse-keymap "Compile")))
+ (let ((submap (make-sparse-keymap "Compile")))
+ (define-key map [menu-bar compilation]
+ (cons "Compile" submap))
+ (set-keymap-parent submap compilation-menu-map))
(define-key map [menu-bar compilation compilation-separator2]
'("----" . nil))
(define-key map [menu-bar compilation compilation-grep]
- '("Search Files (grep)" . grep))
+ '("Search Files (grep)..." . grep))
(define-key map [menu-bar compilation compilation-recompile]
'("Recompile" . recompile))
(define-key map [menu-bar compilation compilation-compile]
(const :tag "Info" 1)
(const :tag "None" 0))
:group 'compilation
- :version "21.4")
+ :version "22.1")
(defcustom compilation-skip-visited nil
"*Compilation motion commands skip visited messages if this is t.
from a different message."
:type 'boolean
:group 'compilation
- :version "21.4")
+ :version "22.1")
;;;###autoload
(defun compilation-mode (&optional name-of-mode)
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).
+Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
\\{compilation-mode-map}"
(interactive)
(set (make-local-variable 'page-delimiter)
compilation-page-delimiter)
(compilation-setup)
+ (setq buffer-read-only t)
(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."
+variables are also set from the name of the mode you have chosen,
+by replacing the first 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
"Prepare the buffer for the compilation parsing commands to work.
Optional argument MINOR indicates this is called from
`compilation-minor-mode'."
- (setq buffer-read-only t)
(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)
+ (set (make-local-variable 'overlay-arrow-string) "")
+ (setq next-error-overlay-arrow-position nil)
+ (add-hook 'kill-buffer-hook
+ (lambda () (setq next-error-overlay-arrow-position nil)) nil t)
;; 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.
;; 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)
+ (if minor
+ (let ((fld font-lock-defaults))
(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))))
+ (turn-on-font-lock)))
+ (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))
+ ;; 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
(force-mode-line-update)
(if (and opoint (< opoint omax))
(goto-char opoint))
- (if compilation-finish-function
- (funcall compilation-finish-function (current-buffer) msg))
+ (with-no-warnings
+ (if compilation-finish-function
+ (funcall compilation-finish-function (current-buffer) msg)))
(let ((functions compilation-finish-functions))
(while functions
(funcall (car functions) (current-buffer) msg)
(let ((buffer (compilation-find-buffer)))
(if (get-buffer-process buffer)
(interrupt-process (get-buffer-process buffer))
- (error "The compilation process is not running"))))
+ (error "The %s process is not running" (downcase mode-name)))))
(defalias 'compile-mouse-goto-error 'compile-goto-error)
(dired-other-window (car (get-text-property (point) 'directory)))
(push-mark)
(setq compilation-current-error (point))
- (next-error 0)))
+ (next-error-internal)))
;; 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))
+(defun compilation-find-buffer (&optional avoid-current)
+ (next-error-find-buffer avoid-current 'compilation-buffer-internal-p))
;;;###autoload
(defun compilation-next-error-function (n &optional reset)
+ "Advance to the next error message and visit the file where the error was.
+This is the value of `next-error-function' in Compilation buffers."
(interactive "p")
- (set-buffer (compilation-find-buffer))
(when reset
(setq compilation-current-error nil))
(let* ((columns compilation-error-screen-columns) ; buffer's local value
;; 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))
+ (cadr (car (nth 2 loc))))
(save-restriction
(widen)
(goto-char (point-min))
(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))))
+ (compilation-move-to-column (car col) columns))
(beginning-of-line)
(skip-chars-forward " \t"))
(if (nth 3 col)
(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."
+(defcustom compilation-context-lines nil
+ "Display this many lines of leading context before the current message.
+If nil and the left fringe is displayed, don't scroll the
+compilation output window; an arrow in the left fringe points to
+the current message. If nil and there is no left fringe, the message
+displays at the top of the window; there is no arrow."
:type '(choice integer (const :tag "No window scrolling" nil))
:group 'compilation
- :version "21.4")
+ :version "22.1")
(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))
+ (goto-char mk)
+ (beginning-of-line
+ (- 1 compilation-context-lines))
+ (point)))
+ ;; If there is no left fringe.
+ (if (equal (car (window-fringes)) 0)
+ (set-window-start w (save-excursion
+ (goto-char mk)
+ (beginning-of-line 1)
+ (point)))))
+ (set-window-point w mk))
+
+(defvar next-error-highlight-timer)
(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
and overlay is highlighted between MK and END-MK."
- (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 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))))
+ (let* ((from-compilation-buffer (eq (window-buffer (selected-window))
+ (marker-buffer msg)))
+ ;; Use an existing window if it is in a visible frame.
+ (pre-existing (get-buffer-window (marker-buffer msg) 0))
+ (w (if (and from-compilation-buffer pre-existing)
+ ;; Calling display-buffer here may end up (partly) hiding
+ ;; the error location if the two buffers are in two
+ ;; different frames. So don't do it if it's not necessary.
+ pre-existing
+ (let ((display-buffer-reuse-frames t)
+ (pop-up-windows t))
+ ;; 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)
+ ;; Ideally, the window-size should be passed to `display-buffer' (via
+ ;; something like special-display-buffer) so it's only used when
+ ;; creating a new window.
+ (unless pre-existing (compilation-set-window-height w))
+
+ (if from-compilation-buffer
+ ;; If the compilation buffer window was 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) 'other-window))
+ (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 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)))
(when highlight-regexp
+ (if (timerp next-error-highlight-timer)
+ (cancel-timer next-error-highlight-timer))
(unless compilation-highlight-overlay
(setq compilation-highlight-overlay
(make-overlay (point-min) (point-min)))
(current-buffer)))
(move-overlay compilation-highlight-overlay
(point) end (current-buffer)))
- (if (numberp next-error-highlight)
- (sit-for next-error-highlight))
- (if (not (eq next-error-highlight t))
- (delete-overlay compilation-highlight-overlay))))))
+ (if (or (eq next-error-highlight t)
+ (numberp next-error-highlight))
+ ;; We want highlighting: delete overlay on next input.
+ (add-hook 'pre-command-hook
+ 'compilation-goto-locus-delete-o)
+ ;; We don't want highlighting: delete overlay now.
+ (delete-overlay compilation-highlight-overlay))
+ ;; We want highlighting for a limited time:
+ ;; set up a timer to delete it.
+ (when (numberp next-error-highlight)
+ (setq next-error-highlight-timer
+ (run-at-time next-error-highlight nil
+ 'compilation-goto-locus-delete-o)))))))
(when (and (eq next-error-highlight 'fringe-arrow))
- (set (make-local-variable 'overlay-arrow-position)
- (copy-marker (line-beginning-position))))))
+ ;; We want a fringe arrow (instead of highlighting).
+ (setq next-error-overlay-arrow-position
+ (copy-marker (line-beginning-position))))))
+
+(defun compilation-goto-locus-delete-o ()
+ (delete-overlay compilation-highlight-overlay)
+ ;; Get rid of timer and hook that would try to do this again.
+ (if (timerp next-error-highlight-timer)
+ (cancel-timer next-error-highlight-timer))
+ (remove-hook 'pre-command-hook
+ 'compilation-goto-locus-delete-o))
\f
-(defun compilation-find-file (marker filename dir &rest formats)
+(defun compilation-find-file (marker filename directory &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.
+\"current\" directory, which is passed in DIRECTORY.
+If DIRECTORY. is relative, it is combined with `default-directory'.
+If DIRECTORY. is nil, that means use `default-directory'.
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)))
+ (let ((dirs compilation-search-path)
+ (spec-dir (if directory
+ (expand-file-name directory)
+ default-directory))
+ 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) spec-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)))
+ (while (null buffer) ;Repeat until the user selects an existing file.
+ ;; The file doesn't exist. Ask the user where to find it.
+ (save-excursion ;This save-excursion is probably not right.
+ (let ((pop-up-windows t))
+ (compilation-set-window (display-buffer (marker-buffer marker))
+ marker)
+ (let* ((name (read-file-name
+ (format "Find this %s in (default %s): "
+ compilation-error filename)
+ spec-dir filename t nil
+ ;; Try to make sure the user can only select
+ ;; a valid answer. This predicate may be ignored,
+ ;; tho, so we still have to double-check afterwards.
+ ;; TODO: We should probably fix read-file-name so
+ ;; that it never ignores this predicate, even when
+ ;; using popup dialog boxes.
+ (lambda (name)
+ (if (file-directory-p name)
+ (setq name (expand-file-name filename name)))
+ (file-exists-p name))))
+ (origname name))
+ (cond
+ ((not (file-exists-p name))
+ (message "Cannot find file `%s'" name)
+ (ding) (sit-for 2))
+ ((and (file-directory-p name)
+ (not (file-exists-p
+ (setq name (expand-file-name filename name)))))
+ (message "No `%s' in directory %s" filename origname)
+ (ding) (sit-for 2))
+ (t
+ (setq buffer (find-file-noselect name))))))))
+ ;; Make intangible overlays tangible.
+ ;; This is weird: it's not even clear which is the current buffer,
+ ;; so the code below can't be expected to DTRT here. -- Stef
+ (dolist (ov (overlays-in (point-min) (point-max)))
+ (when (overlay-get ov 'intangible)
+ (overlay-put ov 'intangible nil)))
+ 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)."
+FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
+In the former case, FILENAME may be relative or absolute.
+The file-structure looks like this:
+ (list (list FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)
+"
(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)))
+ ;; Get the specified directory from FILE.
+ (spec-directory (if (cdr file)
+ (file-truename (cdr file)))))
;; 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)))))
+ (when (and (boundp 'comint-file-name-prefix)
+ (not (equal comint-file-name-prefix "")))
+ (if (file-name-absolute-p filename)
+ (setq filename
+ (concat comint-file-name-prefix filename))
+ (if spec-directory
+ (setq spec-directory
+ (file-truename
+ (concat comint-file-name-prefix spec-directory))))))
;; If compilation-parse-errors-filename-function is
;; defined, use it to process the filename.
;; 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))
+ (or (gethash (list filename) compilation-locs)
+ (puthash (list filename)
+ (list (list filename spec-directory) fmt)
+ compilation-locs))
compilation-locs))))
(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
;; don't use a marker. --Stef
(if (> pos (point-min)) (copy-marker (1- pos)) pos))))
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.gcov\\'" . compilation-mode))
+
(provide 'compile)
;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c