"^\"\\([^,\" \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)
+ "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
(iar
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
;; fixme: should be `mips'
(irix
- "^[-[:alnum:]_/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
+ "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
(java
(gnu
"^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
-\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\
+\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))
(oracle
- "^Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):$"
+ "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
+\\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
+\\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
3 1 2)
(perl
(sun-ada
"^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
- ;; Redundant with `mips'
-;; (ultrix
-;; "^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1))
-
(4bsd
"\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)))
(list 'const (car elt)))
compilation-error-regexp-alist-alist))
:link `(file-link :tag "example file"
- ,(concat doc-directory "compilation.txt"))
+ ,(expand-file-name "compilation.txt" data-directory))
:group 'compilation)
(defvar compilation-directory nil
(defvar compile-history nil)
(defface compilation-warning-face
- '((((type tty) (class color)) (:foreground "cyan" :weight bold))
- (((class color)) (:foreground "Orange" :weight bold))
+ '((((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
- '((((type tty) (class color)) (:foreground "green" :weight bold))
- (((class color) (background light)) (:foreground "Green3" :weight bold))
- (((class color) (background dark)) (:foreground "Green" :weight bold))
+ '((((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
;; 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)
"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 (FILENAME . DIRNAME) or nil."
+FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
(unless file (setq file '("*unknown*")))
- (setq file (or (gethash file compilation-locs)
- (puthash file (list file fmt) compilation-locs)))
+ (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
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
- marker-line)
- (catch 'marker ; find nearest loc, at least one exists
- (dolist (x (cddr file)) ; loop over lines
- (if (> (or (car x) 1) loc) ; still bigger
+ (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 (not marker-line) ; first in list
- (> (- (or (car marker-line) 1) loc)
- (- loc (or (car x) 1)))) ; current line is nearer
+ (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 (car marker-line))
+ marker-line (or (car marker-line) 1))
(with-current-buffer (marker-buffer marker)
(save-restriction
(widen)
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
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))))
+ (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)
;; 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)
(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
;; If window is alone in its frame, aside from a minibuffer,
;; don't change its height.
(not (eq window (frame-root-window (window-frame window))))
- ;; This save-current-buffer prevents us from changing the current
- ;; buffer, which might not be the same as the selected window's buffer.
- (save-current-buffer
+ ;; Stef said that doing the saves in this order is safer:
+ (save-excursion
(save-selected-window
(select-window window)
(enlarge-window (- height (window-height))))))))
(set (make-local-variable 'page-delimiter)
compilation-page-delimiter)
(compilation-setup)
- ;; 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)
(run-mode-hooks 'compilation-mode-hook))
(defmacro define-compilation-mode (mode name doc &rest body)
"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)
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)
(let* ((columns compilation-error-screen-columns) ; buffer's local value
(last 1)
(loc (compilation-next-error (or n 1) nil
- (or compilation-current-error (point-min))))
+ (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
- (save-excursion
- (beginning-of-line)
- (point-marker)))
+ (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
(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
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 (or (gethash file compilation-locs)
- (puthash file (list file nil) compilation-locs)))
+ (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 (or line 1) file marker)))
+ (setcdr loc (list line file marker)))
loc))
-(defcustom compilation-context-lines next-screen-context-lines
- "*Display this many lines of leading context before message."
- :type 'integer
+(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."
- (set-window-start w (save-excursion
- (goto-char mk)
- (beginning-of-line (- 1 compilation-context-lines))
- (point)))
+ (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)
(overlays-in (point-min) (point-max)))
buffer)))
-(defun compilation-normalize-filename (filename)
- "Convert FILENAME string found in an error message to make it usable."
-
- ;; Check for a comint-file-name-prefix and prepend it if
- ;; appropriate. (This is very useful for
- ;; compilation-minor-mode in an rlogin-mode buffer.)
- (and (boundp 'comint-file-name-prefix)
- ;; If file name is relative, default-directory will
- ;; already contain the comint-file-name-prefix (done
- ;; by compile-abbreviate-directory).
- (file-name-absolute-p filename)
- (setq filename
- (concat (with-no-warnings 'comint-file-name-prefix) filename)))
-
- ;; If compilation-parse-errors-filename-function is
- ;; defined, use it to process the filename.
- (when compilation-parse-errors-filename-function
- (setq filename
- (funcall compilation-parse-errors-filename-function
- filename)))
-
- ;; Some compilers (e.g. Sun's java compiler, reportedly)
- ;; produce bogus file names like "./bar//foo.c" for file
- ;; "bar/foo.c"; expand-file-name will collapse these into
- ;; "/foo.c" and fail to find the appropriate file. So we
- ;; look for doubled slashes in the file name and fix them
- ;; up in the buffer.
- (setq filename (command-line-normalize-file-name filename)))
-
-
-;; 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)
+(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$")
(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
;;
;; 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 (point-max)))
+ (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
+;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
;;; compile.el ends here
HCoop / bpt / emacs.git / blobdiff