100 |
;;;###autoload |
;;;###autoload |
101 |
(defvar compilation-process-setup-function nil |
(defvar compilation-process-setup-function nil |
102 |
"*Function to call to customize the compilation process. |
"*Function to call to customize the compilation process. |
103 |
This functions is called immediately before the compilation process is |
This function is called immediately before the compilation process is |
104 |
started. It can be used to set any variables or functions that are used |
started. It can be used to set any variables or functions that are used |
105 |
while processing the output of the compilation process. The function |
while processing the output of the compilation process. The function |
106 |
is called with variables `compilation-buffer' and `compilation-window' |
is called with variables `compilation-buffer' and `compilation-window' |
125 |
Each function is called with two arguments: the compilation buffer, |
Each function is called with two arguments: the compilation buffer, |
126 |
and a string describing how the process finished.") |
and a string describing how the process finished.") |
127 |
|
|
|
(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].") |
|
|
|
|
128 |
(defvar compilation-in-progress nil |
(defvar compilation-in-progress nil |
129 |
"List of compilation processes now running.") |
"List of compilation processes now running.") |
130 |
(or (assq 'compilation-in-progress minor-mode-alist) |
(or (assq 'compilation-in-progress minor-mode-alist) |
171 |
"^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\ |
"^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\ |
172 |
\\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4)) |
\\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4)) |
173 |
|
|
174 |
|
(edg-1 |
175 |
|
"^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)" |
176 |
|
1 2 nil (3 . 4)) |
177 |
|
(edg-2 |
178 |
|
"at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$" |
179 |
|
2 1 nil 0) |
180 |
|
|
181 |
(epc |
(epc |
182 |
"^Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1) |
"^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1) |
183 |
|
|
184 |
(iar |
(iar |
185 |
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" |
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" |
189 |
"^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\ |
"^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\ |
190 |
\\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5)) |
\\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5)) |
191 |
|
|
192 |
|
;; fixme: should be `mips' |
193 |
(irix |
(irix |
194 |
"^[a-z0-9/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ |
"^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ |
195 |
\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) |
\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) |
196 |
|
|
197 |
(java |
(java |
209 |
\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4)) |
\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4)) |
210 |
|
|
211 |
(gnu |
(gnu |
212 |
"^\\(?:[a-zA-Z][-a-zA-Z0-9.]+: ?\\)?\ |
"^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ |
213 |
\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\ |
\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\ |
214 |
\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ |
\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ |
215 |
\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\ |
\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\ |
216 |
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ |
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ |
231 |
(1 (compilation-error-properties 2 3 nil nil nil 0 nil) |
(1 (compilation-error-properties 2 3 nil nil nil 0 nil) |
232 |
append))) |
append))) |
233 |
|
|
234 |
|
;; Should be lint-1, lint-2 (SysV lint) |
235 |
(mips-1 |
(mips-1 |
236 |
" (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1) |
" (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1) |
237 |
(mips-2 |
(mips-2 |
242 |
: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3)) |
: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3)) |
243 |
|
|
244 |
(oracle |
(oracle |
245 |
"^Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):$" |
"^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ |
246 |
|
\\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\ |
247 |
|
\\(?:,\\| in\\| of\\)? file \\(.*?\\):?$" |
248 |
3 1 2) |
3 1 2) |
249 |
|
|
250 |
(perl |
(perl |
267 |
nil 1 nil (3) nil (2 (compilation-face '(3)))) |
nil 1 nil (3) nil (2 (compilation-face '(3)))) |
268 |
|
|
269 |
(sun |
(sun |
270 |
": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[a-zA-Z0-9 ]+, \\)?\ |
": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\ |
271 |
File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" |
File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" |
272 |
3 4 5 (1 . 2)) |
3 4 5 (1 . 2)) |
273 |
|
|
274 |
(sun-ada |
(sun-ada |
275 |
"^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) |
"^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) |
276 |
|
|
|
(ultrix |
|
|
"^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1)) |
|
|
|
|
277 |
(4bsd |
(4bsd |
278 |
"\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\ |
"\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\ |
279 |
\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))) |
\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))) |
282 |
(defcustom compilation-error-regexp-alist |
(defcustom compilation-error-regexp-alist |
283 |
(mapcar 'car compilation-error-regexp-alist-alist) |
(mapcar 'car compilation-error-regexp-alist-alist) |
284 |
"Alist that specifies how to match errors in compiler output. |
"Alist that specifies how to match errors in compiler output. |
285 |
Note that on Unix exerything is a valid filename, so these |
Note that on Unix everything is a valid filename, so these |
286 |
matchers must make some common sense assumptions, which catch |
matchers must make some common sense assumptions, which catch |
287 |
normal cases. A shorter list will be lighter on resource usage. |
normal cases. A shorter list will be lighter on resource usage. |
288 |
|
|
289 |
Instead of an alist element, you can use a symbol, which is |
Instead of an alist element, you can use a symbol, which is |
290 |
looked up in `compilation-error-regexp-alist-alist'. You can see |
looked up in `compilation-error-regexp-alist-alist'. You can see |
291 |
the predefined symbols and their effects in the file |
the predefined symbols and their effects in the file |
292 |
`etc/compilation.txt' (linked below if your are customizing this). |
`etc/compilation.txt' (linked below if you are customizing this). |
293 |
|
|
294 |
Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK |
Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK |
295 |
HIGHLIGHT...]). If REGEXP matches, the FILE'th subexpression |
HIGHLIGHT...]). If REGEXP matches, the FILE'th subexpression |
331 |
(list 'const (car elt))) |
(list 'const (car elt))) |
332 |
compilation-error-regexp-alist-alist)) |
compilation-error-regexp-alist-alist)) |
333 |
:link `(file-link :tag "example file" |
:link `(file-link :tag "example file" |
334 |
,(concat doc-directory "compilation.txt")) |
,(expand-file-name "compilation.txt" data-directory)) |
335 |
:group 'compilation) |
:group 'compilation) |
336 |
|
|
337 |
(defvar compilation-directory nil |
(defvar compilation-directory nil |
360 |
(1 font-lock-variable-name-face) |
(1 font-lock-variable-name-face) |
361 |
(2 (compilation-face '(4 . 3)))) |
(2 (compilation-face '(4 . 3)))) |
362 |
;; Command output lines. Recognize `make[n]:' lines too. |
;; Command output lines. Recognize `make[n]:' lines too. |
363 |
("^\\([A-Za-z_0-9/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:" |
("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:" |
364 |
(1 font-lock-function-name-face) (3 compilation-line-face nil t)) |
(1 font-lock-function-name-face) (3 compilation-line-face nil t)) |
365 |
(" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1) |
(" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1) |
366 |
("^Compilation finished" . compilation-info-face) |
("^Compilation finished" . compilation-info-face) |
430 |
(defvar compilation-locs ()) |
(defvar compilation-locs ()) |
431 |
|
|
432 |
(defvar compilation-debug nil |
(defvar compilation-debug nil |
433 |
"*Set this to `t' before creating a *compilation* buffer. |
"*Set this to t before creating a *compilation* buffer. |
434 |
Then every error line will have a debug text property with the matcher that |
Then every error line will have a debug text property with the matcher that |
435 |
fit this line and the match data. Use `describe-text-properties'.") |
fit this line and the match data. Use `describe-text-properties'.") |
436 |
|
|
450 |
(defvar compile-history nil) |
(defvar compile-history nil) |
451 |
|
|
452 |
(defface compilation-warning-face |
(defface compilation-warning-face |
453 |
'((((type tty) (class color)) (:foreground "cyan" :weight bold)) |
'((((class color) (min-colors 16)) (:foreground "Orange" :weight bold)) |
454 |
(((class color)) (:foreground "Orange" :weight bold)) |
(((class color)) (:foreground "cyan" :weight bold)) |
455 |
(t (:weight bold))) |
(t (:weight bold))) |
456 |
"Face used to highlight compiler warnings." |
"Face used to highlight compiler warnings." |
457 |
:group 'font-lock-highlighting-faces |
:group 'font-lock-highlighting-faces |
458 |
:version "21.4") |
:version "21.4") |
459 |
|
|
460 |
(defface compilation-info-face |
(defface compilation-info-face |
461 |
'((((type tty) (class color)) (:foreground "green" :weight bold)) |
'((((class color) (min-colors 16) (background light)) |
462 |
(((class color) (background light)) (:foreground "Green3" :weight bold)) |
(:foreground "Green3" :weight bold)) |
463 |
(((class color) (background dark)) (:foreground "Green" :weight bold)) |
(((class color) (min-colors 16) (background dark)) |
464 |
|
(:foreground "Green" :weight bold)) |
465 |
|
(((class color)) (:foreground "green" :weight bold)) |
466 |
(t (:weight bold))) |
(t (:weight bold))) |
467 |
"Face used to highlight compiler warnings." |
"Face used to highlight compiler warnings." |
468 |
:group 'font-lock-highlighting-faces |
:group 'font-lock-highlighting-faces |
499 |
|
|
500 |
|
|
501 |
;; Used for compatibility with the old compile.el. |
;; Used for compatibility with the old compile.el. |
502 |
(defvar compilation-parsing-end nil) |
(defvaralias 'compilation-last-buffer 'next-error-last-buffer) |
503 |
|
(defvar compilation-parsing-end (make-marker)) |
504 |
(defvar compilation-parse-errors-function nil) |
(defvar compilation-parse-errors-function nil) |
505 |
(defvar compilation-error-list nil) |
(defvar compilation-error-list nil) |
506 |
(defvar compilation-old-error-list nil) |
(defvar compilation-old-error-list nil) |
524 |
'(nil)) ; nil only isn't a property-change |
'(nil)) ; nil only isn't a property-change |
525 |
(cons (match-string-no-properties idx) dir)) |
(cons (match-string-no-properties idx) dir)) |
526 |
mouse-face highlight |
mouse-face highlight |
527 |
|
keymap compilation-button-map |
528 |
help-echo "mouse-2: visit current directory"))) |
help-echo "mouse-2: visit current directory"))) |
529 |
|
|
530 |
;; Data type `reverse-ordered-alist' retriever. This function retrieves the |
;; Data type `reverse-ordered-alist' retriever. This function retrieves the |
535 |
;; may be nil. The other KEYs are ordered backwards so that growing line |
;; may be nil. The other KEYs are ordered backwards so that growing line |
536 |
;; numbers can be inserted in front and searching can abort after half the |
;; numbers can be inserted in front and searching can abort after half the |
537 |
;; list on average. |
;; list on average. |
538 |
|
(eval-when-compile ;Don't keep it at runtime if not needed. |
539 |
(defmacro compilation-assq (key alist) |
(defmacro compilation-assq (key alist) |
540 |
`(let* ((l1 ,alist) |
`(let* ((l1 ,alist) |
541 |
(l2 (cdr l1))) |
(l2 (cdr l1))) |
546 |
l2 (cdr l1))) |
l2 (cdr l1))) |
547 |
(if l2 (eq ,key (caar l2)))) |
(if l2 (eq ,key (caar l2)))) |
548 |
l2 |
l2 |
549 |
(setcdr l1 (cons (list ,key) l2)))))) |
(setcdr l1 (cons (list ,key) l2))))))) |
550 |
|
|
551 |
|
|
552 |
;; This function is the central driver, called when font-locking to gather |
;; This function is the central driver, called when font-locking to gather |
564 |
(setq dir (previous-single-property-change (point) 'directory) |
(setq dir (previous-single-property-change (point) 'directory) |
565 |
dir (if dir (or (get-text-property (1- dir) 'directory) |
dir (if dir (or (get-text-property (1- dir) 'directory) |
566 |
(get-text-property dir 'directory))))) |
(get-text-property dir 'directory))))) |
567 |
(setq file (cons file (car dir)) ; top of dir stack is current |
(setq file (cons file (car dir))))) |
|
file (or (gethash file compilation-locs) |
|
|
(puthash file (list file fmt) compilation-locs))))) |
|
568 |
;; This message didn't mention one, get it from previous |
;; This message didn't mention one, get it from previous |
569 |
(setq file (previous-single-property-change (point) 'message) |
(setq file (previous-single-property-change (point) 'message) |
570 |
file (or (if file |
file (or (if file |
571 |
(nth 2 (car (or (get-text-property (1- file) 'message) |
(car (nth 2 (car (or (get-text-property (1- file) 'message) |
572 |
(get-text-property file 'message))))) |
(get-text-property file 'message)))))) |
573 |
;; no previous either -- let font-lock continue |
'("*unknown*")))) |
|
(gethash (setq file '("*unknown*")) compilation-locs) |
|
|
(puthash file (list file fmt) compilation-locs)))) |
|
574 |
;; All of these fields are optional, get them only if we have an index, and |
;; All of these fields are optional, get them only if we have an index, and |
575 |
;; it matched some part of the message. |
;; it matched some part of the message. |
576 |
(and line |
(and line |
583 |
(setq col (match-string-no-properties col)) |
(setq col (match-string-no-properties col)) |
584 |
(setq col (- (string-to-number col) compilation-first-column))) |
(setq col (- (string-to-number col) compilation-first-column))) |
585 |
(if (and end-col (setq end-col (match-string-no-properties end-col))) |
(if (and end-col (setq end-col (match-string-no-properties end-col))) |
586 |
(setq end-col (- (string-to-number end-col) compilation-first-column)) |
(setq end-col (- (string-to-number end-col) compilation-first-column -1)) |
587 |
(if end-line (setq end-col -1))) |
(if end-line (setq end-col -1))) |
588 |
(if (consp type) ; not a preset type, check what it is. |
(if (consp type) ; not a static type, check what it is. |
589 |
(setq type (or (and (car type) (match-end (car type)) 1) |
(setq type (or (and (car type) (match-end (car type)) 1) |
590 |
(and (cdr type) (match-end (cdr type)) 0) |
(and (cdr type) (match-end (cdr type)) 0) |
591 |
2))) |
2))) |
592 |
;; Get any (first) already existing marker (if any has one, all have one). |
(compilation-internal-error-properties file line end-line col end-col type fmt))) |
593 |
;; Do this first, as the next assq`s may create new nodes. |
|
594 |
(let ((marker (nth 3 (car (cdar (cddr file))))) |
(defun compilation-internal-error-properties (file line end-line col end-col type fmt) |
595 |
(loc (compilation-assq line (cdr file))) |
"Get the meta-info that will be added as text-properties. |
596 |
end-loc) |
LINE, END-LINE, COL, END-COL are integers or nil. |
597 |
(if end-line |
TYPE can be 0, 1, or 2. |
598 |
(setq end-loc (compilation-assq end-line (cdr file)) |
FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." |
599 |
end-loc (compilation-assq end-col end-loc)) |
(unless file (setq file '("*unknown*"))) |
600 |
(if end-col ; use same line element |
(setq file (compilation-get-file-structure file fmt)) |
601 |
(setq end-loc (compilation-assq end-col loc)))) |
;; Get first already existing marker (if any has one, all have one). |
602 |
(setq loc (compilation-assq col loc)) |
;; Do this first, as the compilation-assq`s may create new nodes. |
603 |
;; If they are new, make the loc(s) reference the file they point to. |
(let* ((marker-line (car (cddr file))) ; a line structure |
604 |
(or (cdr loc) (setcdr loc (list line file))) |
(marker (nth 3 (cadr marker-line))) ; its marker |
605 |
(if end-loc |
(compilation-error-screen-columns compilation-error-screen-columns) |
606 |
(or (cdr end-loc) (setcdr end-loc (list (or end-line line) file)))) |
end-marker loc end-loc) |
607 |
;; If we'd found a marker, ensure that the new locs also get markers |
(if (not (and marker (marker-buffer marker))) |
608 |
(when (and marker |
(setq marker) ; no valid marker for this file |
609 |
(not (or (cddr loc) (cddr end-loc))) ; maybe new node w/o marker |
(setq loc (or line 1)) ; normalize no linenumber to line 1 |
610 |
(marker-buffer marker)) ; other marker still valid |
(catch 'marker ; find nearest loc, at least one exists |
611 |
(or line (setq line 1)) ; normalize no linenumber to line 1 |
(dolist (x (nthcdr 3 file)) ; loop over remaining lines |
612 |
(catch 'marker ; find nearest loc, at least one exists |
(if (> (car x) loc) ; still bigger |
613 |
(dolist (x (cddr file)) |
(setq marker-line x) |
614 |
(if (> (or (car x) 1) line) |
(if (> (- (or (car marker-line) 1) loc) |
615 |
(setq marker x) |
(- loc (car x))) ; current line is nearer |
616 |
(if (eq (or (car x) 1) line) |
(setq marker-line x)) |
617 |
(if (cdr (cddr x)) ; at least one other column |
(throw 'marker t)))) |
618 |
(throw 'marker (setq marker x)) |
(setq marker (nth 3 (cadr marker-line)) |
619 |
(if marker (throw 'marker t))) |
marker-line (or (car marker-line) 1)) |
620 |
(throw 'marker (or marker (setq marker x))))))) |
(with-current-buffer (marker-buffer marker) |
621 |
(setq marker (if (eq (car (cddr marker)) col) |
(save-restriction |
622 |
(nthcdr 3 marker) |
(widen) |
623 |
(cddr marker)) |
(goto-char (marker-position marker)) |
624 |
file compilation-error-screen-columns) |
(when (or end-col end-line) |
625 |
(with-current-buffer (marker-buffer (cddr marker)) |
(beginning-of-line (- (or end-line line) marker-line -1)) |
626 |
(save-restriction |
(if (< end-col 0) |
627 |
(widen) |
(end-of-line) |
628 |
(goto-char (marker-position (cddr marker))) |
(if compilation-error-screen-columns |
629 |
(beginning-of-line (- line (car (cadr marker)) -1)) |
(move-to-column end-col) |
630 |
(if file ; original c.-error-screen-columns |
(forward-char end-col))) |
631 |
(move-to-column (car loc)) |
(setq end-marker (list (point-marker)))) |
632 |
(forward-char (car loc))) |
(beginning-of-line (if end-line |
633 |
(setcdr (cdr loc) (point-marker)) |
(- end-line line -1) |
634 |
(when end-loc |
(- loc marker-line -1))) |
635 |
(beginning-of-line (- end-line line -1)) |
(if col |
636 |
(if (< end-col 0) |
(if compilation-error-screen-columns |
637 |
(end-of-line) |
(move-to-column col) |
638 |
(if file ; original c.-error-screen-columns |
(forward-char col)) |
639 |
(move-to-column (car end-loc)) |
(forward-to-indentation 0)) |
640 |
(forward-char (car end-loc)))) |
(setq marker (list (point-marker)))))) |
641 |
(setcdr (cdr end-loc) (point-marker)))))) |
|
642 |
;; Must start with face |
(setq loc (compilation-assq line (cdr file))) |
643 |
`(face ,compilation-message-face |
(if end-line |
644 |
message (,loc ,type ,end-loc) |
(setq end-loc (compilation-assq end-line (cdr file)) |
645 |
,@(if compilation-debug |
end-loc (compilation-assq end-col end-loc)) |
646 |
`(debug (,(assoc (with-no-warnings matcher) font-lock-keywords) |
(if end-col ; use same line element |
647 |
,@(match-data)))) |
(setq end-loc (compilation-assq end-col loc)))) |
648 |
help-echo ,(if col |
(setq loc (compilation-assq col loc)) |
649 |
"mouse-2: visit this file, line and column" |
;; If they are new, make the loc(s) reference the file they point to. |
650 |
(if line |
(or (cdr loc) (setcdr loc `(,line ,file ,@marker))) |
651 |
"mouse-2: visit this file and line" |
(if end-loc |
652 |
"mouse-2: visit this file")) |
(or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker)))) |
653 |
keymap compilation-button-map |
|
654 |
mouse-face highlight)))) |
;; Must start with face |
655 |
|
`(face ,compilation-message-face |
656 |
|
message (,loc ,type ,end-loc) |
657 |
|
,@(if compilation-debug |
658 |
|
`(debug (,(assoc (with-no-warnings matcher) font-lock-keywords) |
659 |
|
,@(match-data)))) |
660 |
|
help-echo ,(if col |
661 |
|
"mouse-2: visit this file, line and column" |
662 |
|
(if line |
663 |
|
"mouse-2: visit this file and line" |
664 |
|
"mouse-2: visit this file")) |
665 |
|
keymap compilation-button-map |
666 |
|
mouse-face highlight))) |
667 |
|
|
668 |
(defun compilation-mode-font-lock-keywords () |
(defun compilation-mode-font-lock-keywords () |
669 |
"Return expressions to highlight in Compilation mode." |
"Return expressions to highlight in Compilation mode." |
702 |
;; error location. Let's do our best. |
;; error location. Let's do our best. |
703 |
`(,(car item) |
`(,(car item) |
704 |
(0 (compilation-compat-error-properties |
(0 (compilation-compat-error-properties |
705 |
(funcall ',line (list* (match-string ,file) |
(funcall ',line (cons (match-string ,file) |
706 |
default-directory |
(cons default-directory |
707 |
',(nthcdr 4 item)) |
',(nthcdr 4 item))) |
708 |
,(if col `(match-string ,col))))) |
,(if col `(match-string ,col))))) |
709 |
(,file compilation-error-face t)) |
(,file compilation-error-face t)) |
710 |
|
|
711 |
|
(unless (or (null (nth 5 item)) (integerp (nth 5 item))) |
712 |
|
(error "HYPERLINK should be an integer: %s" (nth 5 item))) |
713 |
|
|
714 |
`(,(nth 0 item) |
`(,(nth 0 item) |
715 |
|
|
716 |
,@(when (integerp file) |
,@(when (integerp file) |
748 |
Runs COMMAND, a shell command, in a separate process asynchronously |
Runs COMMAND, a shell command, in a separate process asynchronously |
749 |
with output going to the buffer `*compilation*'. |
with output going to the buffer `*compilation*'. |
750 |
|
|
751 |
If optional second arg COMINT is t the buffer will be in comint mode with |
If optional second arg COMINT is t the buffer will be in Comint mode with |
752 |
`compilation-shell-minor-mode'. |
`compilation-shell-minor-mode'. |
753 |
|
|
754 |
You can then use the command \\[next-error] to find the next error message |
You can then use the command \\[next-error] to find the next error message |
756 |
|
|
757 |
Interactively, prompts for the command if `compilation-read-command' is |
Interactively, prompts for the command if `compilation-read-command' is |
758 |
non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. |
non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. |
759 |
|
Additionally, with universal prefix arg, compilation buffer will be in |
760 |
|
comint mode, i.e. interactive. |
761 |
|
|
762 |
To run more than one compilation at once, start one and rename |
To run more than one compilation at once, start one and rename |
763 |
the \`*compilation*' buffer to some other name with |
the \`*compilation*' buffer to some other name with |
769 |
the function in `compilation-buffer-name-function', so you can set that |
the function in `compilation-buffer-name-function', so you can set that |
770 |
to a function that generates a unique name." |
to a function that generates a unique name." |
771 |
(interactive |
(interactive |
772 |
(if (or compilation-read-command current-prefix-arg) |
(list |
773 |
(list (read-from-minibuffer "Compile command: " |
(if (or compilation-read-command current-prefix-arg) |
774 |
(eval compile-command) nil nil |
(read-from-minibuffer "Compile command: " |
775 |
'(compile-history . 1))) |
(eval compile-command) nil nil |
776 |
(list (eval compile-command)))) |
'(compile-history . 1)) |
777 |
|
(eval compile-command)) |
778 |
|
(consp current-prefix-arg))) |
779 |
(unless (equal command (eval compile-command)) |
(unless (equal command (eval compile-command)) |
780 |
(setq compile-command command)) |
(setq compile-command command)) |
781 |
(save-some-buffers (not compilation-ask-about-save) nil) |
(save-some-buffers (not compilation-ask-about-save) nil) |
785 |
;; run compile with the default command line |
;; run compile with the default command line |
786 |
(defun recompile () |
(defun recompile () |
787 |
"Re-compile the program including the current buffer. |
"Re-compile the program including the current buffer. |
788 |
If this is run in a compilation-mode buffer, re-use the arguments from the |
If this is run in a Compilation mode buffer, re-use the arguments from the |
789 |
original use. Otherwise, it recompiles using `compile-command'." |
original use. Otherwise, recompile using `compile-command'." |
790 |
(interactive) |
(interactive) |
791 |
(save-some-buffers (not compilation-ask-about-save) nil) |
(save-some-buffers (not compilation-ask-about-save) nil) |
792 |
(let ((default-directory (or compilation-directory default-directory))) |
(let ((default-directory (or compilation-directory default-directory))) |
796 |
(defcustom compilation-scroll-output nil |
(defcustom compilation-scroll-output nil |
797 |
"*Non-nil to scroll the *compilation* buffer window as output appears. |
"*Non-nil to scroll the *compilation* buffer window as output appears. |
798 |
|
|
799 |
Setting it causes the compilation-mode commands to put point at the |
Setting it causes the Compilation mode commands to put point at the |
800 |
end of their output window so that the end of the output is always |
end of their output window so that the end of the output is always |
801 |
visible rather than the begining." |
visible rather than the beginning." |
802 |
:type 'boolean |
:type 'boolean |
803 |
:version "20.3" |
:version "20.3" |
804 |
:group 'compilation) |
:group 'compilation) |
845 |
The rest of the arguments are optional; for them, nil means use the default. |
The rest of the arguments are optional; for them, nil means use the default. |
846 |
|
|
847 |
MODE is the major mode to set in the compilation buffer. Mode |
MODE is the major mode to set in the compilation buffer. Mode |
848 |
may also be `t' meaning `compilation-shell-minor-mode' under `comint-mode'. |
may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'. |
849 |
NAME-FUNCTION is a function called to name the buffer. |
NAME-FUNCTION is a function called to name the buffer. |
850 |
|
|
851 |
If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight |
If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight |
852 |
matching section of the visited source line; the default is to use the |
the matching section of the visited source line; the default is to use the |
853 |
global value of `compilation-highlight-regexp'. |
global value of `compilation-highlight-regexp'. |
854 |
|
|
855 |
Returns the compilation buffer created." |
Returns the compilation buffer created." |
861 |
(process-environment |
(process-environment |
862 |
(append |
(append |
863 |
compilation-environment |
compilation-environment |
864 |
(if (and (boundp 'system-uses-terminfo) |
(if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning |
865 |
system-uses-terminfo) |
system-uses-terminfo) |
866 |
(list "TERM=dumb" "TERMCAP=" |
(list "TERM=dumb" "TERMCAP=" |
867 |
(format "COLUMNS=%d" (window-width))) |
(format "COLUMNS=%d" (window-width))) |
868 |
(list "TERM=emacs" |
(list "TERM=emacs" |
926 |
'compilation-revert-buffer) |
'compilation-revert-buffer) |
927 |
(set-window-start outwin (point-min)) |
(set-window-start outwin (point-min)) |
928 |
(or (eq outwin (selected-window)) |
(or (eq outwin (selected-window)) |
929 |
(set-window-point outwin (point))) |
(set-window-point outwin (if compilation-scroll-output |
930 |
|
(point) |
931 |
|
(point-min)))) |
932 |
;; The setup function is called before compilation-set-window-height |
;; The setup function is called before compilation-set-window-height |
933 |
;; so it can set the compilation-window-height buffer locally. |
;; so it can set the compilation-window-height buffer locally. |
934 |
(if compilation-process-setup-function |
(if compilation-process-setup-function |
955 |
;; Fake modeline display as if `start-process' were run. |
;; Fake modeline display as if `start-process' were run. |
956 |
(setq mode-line-process ":run") |
(setq mode-line-process ":run") |
957 |
(force-mode-line-update) |
(force-mode-line-update) |
958 |
|
(sit-for 0) ; Force redisplay |
959 |
(let ((status (call-process shell-file-name nil outbuf nil "-c" |
(let ((status (call-process shell-file-name nil outbuf nil "-c" |
960 |
command))) |
command))) |
961 |
(cond ((numberp status) |
(cond ((numberp status) |
970 |
(concat status "\n"))) |
(concat status "\n"))) |
971 |
(t |
(t |
972 |
(compilation-handle-exit 'bizarre status status)))) |
(compilation-handle-exit 'bizarre status status)))) |
973 |
|
;; Without async subprocesses, the buffer is not yet |
974 |
|
;; fontified, so fontify it now. |
975 |
|
(let ((font-lock-verbose nil)) ; shut up font-lock messages |
976 |
|
(font-lock-fontify-buffer)) |
977 |
(message "Executing `%s'...done" command))) |
(message "Executing `%s'...done" command))) |
978 |
(if (buffer-local-value 'compilation-scroll-output outbuf) |
(if (buffer-local-value 'compilation-scroll-output outbuf) |
979 |
(save-selected-window |
(save-selected-window |
980 |
(select-window outwin) |
(select-window outwin) |
981 |
(goto-char (point-max)))) |
(goto-char (point-max)))) |
982 |
;; Make it so the next C-x ` will use this buffer. |
;; Make it so the next C-x ` will use this buffer. |
983 |
(setq compilation-last-buffer outbuf))) |
(setq next-error-last-buffer outbuf))) |
984 |
|
|
985 |
(defun compilation-set-window-height (window) |
(defun compilation-set-window-height (window) |
986 |
"Set the height of WINDOW according to `compilation-window-height'." |
"Set the height of WINDOW according to `compilation-window-height'." |
990 |
;; If window is alone in its frame, aside from a minibuffer, |
;; If window is alone in its frame, aside from a minibuffer, |
991 |
;; don't change its height. |
;; don't change its height. |
992 |
(not (eq window (frame-root-window (window-frame window)))) |
(not (eq window (frame-root-window (window-frame window)))) |
993 |
;; This save-current-buffer prevents us from changing the current |
;; Stef said that doing the saves in this order is safer: |
994 |
;; buffer, which might not be the same as the selected window's buffer. |
(save-excursion |
|
(save-current-buffer |
|
995 |
(save-selected-window |
(save-selected-window |
996 |
(select-window window) |
(select-window window) |
997 |
(enlarge-window (- height (window-height)))))))) |
(enlarge-window (- height (window-height)))))))) |
1161 |
"Marker to the location from where the next error will be found. |
"Marker to the location from where the next error will be found. |
1162 |
The global commands next/previous/first-error/goto-error use this.") |
The global commands next/previous/first-error/goto-error use this.") |
1163 |
|
|
1164 |
|
(defvar compilation-messages-start nil |
1165 |
|
"Buffer position of the beginning of the compilation messages. |
1166 |
|
If nil, use the beginning of buffer.") |
1167 |
|
|
1168 |
;; A function name can't be a hook, must be something with a value. |
;; A function name can't be a hook, must be something with a value. |
1169 |
(defconst compilation-turn-on-font-lock 'turn-on-font-lock) |
(defconst compilation-turn-on-font-lock 'turn-on-font-lock) |
1170 |
|
|
1171 |
(defun compilation-setup (&optional minor) |
(defun compilation-setup (&optional minor) |
1172 |
"Prepare the buffer for the compilation parsing commands to work." |
"Prepare the buffer for the compilation parsing commands to work. |
1173 |
|
Optional argument MINOR indicates this is called from |
1174 |
|
`compilation-minor-mode'." |
1175 |
(make-local-variable 'compilation-current-error) |
(make-local-variable 'compilation-current-error) |
1176 |
|
(make-local-variable 'compilation-messages-start) |
1177 |
(make-local-variable 'compilation-error-screen-columns) |
(make-local-variable 'compilation-error-screen-columns) |
1178 |
(make-local-variable 'overlay-arrow-position) |
(make-local-variable 'overlay-arrow-position) |
1179 |
(setq compilation-last-buffer (current-buffer)) |
;; Note that compilation-next-error-function is for interfacing |
1180 |
|
;; with the next-error function in simple.el, and it's only |
1181 |
|
;; coincidentally named similarly to compilation-next-error. |
1182 |
|
(setq next-error-function 'compilation-next-error-function) |
1183 |
(set (make-local-variable 'font-lock-extra-managed-props) |
(set (make-local-variable 'font-lock-extra-managed-props) |
1184 |
'(directory message help-echo mouse-face debug)) |
'(directory message help-echo mouse-face debug)) |
1185 |
(set (make-local-variable 'compilation-locs) |
(set (make-local-variable 'compilation-locs) |
1186 |
(make-hash-table :test 'equal :weakness 'value)) |
(make-hash-table :test 'equal :weakness 'value)) |
1187 |
;; lazy-lock would never find the message unless it's scrolled to |
;; lazy-lock would never find the message unless it's scrolled to. |
1188 |
;; jit-lock might fontify some things too late. |
;; jit-lock might fontify some things too late. |
1189 |
(set (make-local-variable 'font-lock-support-mode) nil) |
(set (make-local-variable 'font-lock-support-mode) nil) |
1190 |
(set (make-local-variable 'font-lock-maximum-size) nil) |
(set (make-local-variable 'font-lock-maximum-size) nil) |
1232 |
(font-lock-fontify-buffer))) |
(font-lock-fontify-buffer))) |
1233 |
|
|
1234 |
(defun compilation-handle-exit (process-status exit-status msg) |
(defun compilation-handle-exit (process-status exit-status msg) |
1235 |
"Write msg in the current buffer and hack its mode-line-process." |
"Write MSG in the current buffer and hack its mode-line-process." |
1236 |
(let ((buffer-read-only nil) |
(let ((buffer-read-only nil) |
1237 |
(status (if compilation-exit-message-function |
(status (if compilation-exit-message-function |
1238 |
(funcall compilation-exit-message-function |
(funcall compilation-exit-message-function |
1296 |
(insert-before-markers string) |
(insert-before-markers string) |
1297 |
(run-hooks 'compilation-filter-hook)))))) |
(run-hooks 'compilation-filter-hook)))))) |
1298 |
|
|
1299 |
|
;;; test if a buffer is a compilation buffer, assuming we're in the buffer |
1300 |
|
(defsubst compilation-buffer-internal-p () |
1301 |
|
"Test if inside a compilation buffer." |
1302 |
|
(local-variable-p 'compilation-locs)) |
1303 |
|
|
1304 |
|
;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p |
1305 |
(defsubst compilation-buffer-p (buffer) |
(defsubst compilation-buffer-p (buffer) |
1306 |
(local-variable-p 'compilation-locs buffer)) |
"Test if BUFFER is a compilation buffer." |
1307 |
|
(with-current-buffer buffer |
1308 |
|
(compilation-buffer-internal-p))) |
1309 |
|
|
1310 |
(defmacro compilation-loop (< property-change 1+ error) |
(defmacro compilation-loop (< property-change 1+ error) |
1311 |
`(while (,< n 0) |
`(while (,< n 0) |
1336 |
(or (compilation-buffer-p (current-buffer)) |
(or (compilation-buffer-p (current-buffer)) |
1337 |
(error "Not in a compilation buffer")) |
(error "Not in a compilation buffer")) |
1338 |
(or pt (setq pt (point))) |
(or pt (setq pt (point))) |
|
(setq compilation-last-buffer (current-buffer)) |
|
1339 |
(let* ((msg (get-text-property pt 'message)) |
(let* ((msg (get-text-property pt 'message)) |
1340 |
(loc (car msg)) |
(loc (car msg)) |
1341 |
last) |
last) |
1373 |
(interactive "p") |
(interactive "p") |
1374 |
(compilation-next-error (- n))) |
(compilation-next-error (- n))) |
1375 |
|
|
|
(defun next-error-no-select (n) |
|
|
"Move point to the next error in the compilation buffer and highlight match. |
|
|
Prefix arg N says how many error messages to move forwards (or |
|
|
backwards, if negative). |
|
|
Finds and highlights the source line like \\[next-error], but does not |
|
|
select the source buffer." |
|
|
(interactive "p") |
|
|
(next-error n) |
|
|
(pop-to-buffer compilation-last-buffer)) |
|
|
|
|
|
(defun previous-error-no-select (n) |
|
|
"Move point to the previous error in the compilation buffer and highlight match. |
|
|
Prefix arg N says how many error messages to move backwards (or |
|
|
forwards, if negative). |
|
|
Finds and highlights the source line like \\[previous-error], but does not |
|
|
select the source buffer." |
|
|
(interactive "p") |
|
|
(next-error-no-select (- n))) |
|
|
|
|
1376 |
(defun compilation-next-file (n) |
(defun compilation-next-file (n) |
1377 |
"Move point to the next error for a different file than the current one. |
"Move point to the next error for a different file than the current one. |
1378 |
Prefix arg N says how many files to move forwards (or backwards, if negative)." |
Prefix arg N says how many files to move forwards (or backwards, if negative)." |
1410 |
|
|
1411 |
;; Return a compilation buffer. |
;; Return a compilation buffer. |
1412 |
;; If the current buffer is a compilation buffer, return it. |
;; If the current buffer is a compilation buffer, return it. |
|
;; If compilation-last-buffer is set to a live buffer, use that. |
|
1413 |
;; Otherwise, look for a compilation buffer and signal an error |
;; Otherwise, look for a compilation buffer and signal an error |
1414 |
;; if there are none. |
;; if there are none. |
1415 |
(defun compilation-find-buffer (&optional other-buffer) |
(defun compilation-find-buffer (&optional other-buffer) |
1416 |
(if (and (not other-buffer) |
(next-error-find-buffer other-buffer 'compilation-buffer-internal-p)) |
|
(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!"))))))) |
|
1417 |
|
|
1418 |
;;;###autoload |
;;;###autoload |
1419 |
(defun next-error (&optional n) |
(defun compilation-next-error-function (n &optional reset) |
|
"Visit next compilation error message and corresponding source code. |
|
|
Prefix arg N says how many error messages to move forwards (or |
|
|
backwards, if negative). |
|
|
|
|
|
\\[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 variable `compilation-error-regexp-alist' for customization ideas." |
|
1420 |
(interactive "p") |
(interactive "p") |
1421 |
(set-buffer (setq compilation-last-buffer (compilation-find-buffer))) |
(set-buffer (compilation-find-buffer)) |
1422 |
|
(when reset |
1423 |
|
(setq compilation-current-error nil)) |
1424 |
(let* ((columns compilation-error-screen-columns) ; buffer's local value |
(let* ((columns compilation-error-screen-columns) ; buffer's local value |
1425 |
(last 1) |
(last 1) |
1426 |
(loc (compilation-next-error (or n 1) nil |
(loc (compilation-next-error (or n 1) nil |
1427 |
(or compilation-current-error (point-min)))) |
(or compilation-current-error |
1428 |
|
compilation-messages-start |
1429 |
|
(point-min)))) |
1430 |
(end-loc (nth 2 loc)) |
(end-loc (nth 2 loc)) |
1431 |
(marker (point-marker))) |
(marker (point-marker))) |
1432 |
(setq compilation-current-error (point-marker) |
(setq compilation-current-error (point-marker) |
1433 |
overlay-arrow-position |
overlay-arrow-position |
1434 |
(if (bolp) |
(if (bolp) |
1435 |
compilation-current-error |
compilation-current-error |
1436 |
(save-excursion |
(copy-marker (line-beginning-position))) |
|
(beginning-of-line) |
|
|
(point-marker))) |
|
1437 |
loc (car loc)) |
loc (car loc)) |
1438 |
;; If loc contains no marker, no error in that file has been visited. If |
;; If loc contains no marker, no error in that file has been visited. If |
1439 |
;; the marker is invalid the buffer has been killed. So, recalculate all |
;; the marker is invalid the buffer has been killed. So, recalculate all |
1440 |
;; markers for that file. |
;; markers for that file. |
1441 |
(unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc))) |
(unless (and (nth 3 loc) (marker-buffer (nth 3 loc))) |
1442 |
(with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) |
(with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) |
1443 |
(or (cdar (nth 2 loc)) |
(or (cdar (nth 2 loc)) |
1444 |
default-directory)) |
default-directory)) |
1461 |
(forward-char (car col)))) |
(forward-char (car col)))) |
1462 |
(beginning-of-line) |
(beginning-of-line) |
1463 |
(skip-chars-forward " \t")) |
(skip-chars-forward " \t")) |
1464 |
(if (nthcdr 3 col) |
(if (nth 3 col) |
1465 |
(set-marker (nth 3 col) (point)) |
(set-marker (nth 3 col) (point)) |
1466 |
(setcdr (nthcdr 2 col) `(,(point-marker))))))))) |
(setcdr (nthcdr 2 col) `(,(point-marker))))))))) |
1467 |
(compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) |
(compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) |
1468 |
(setcdr (nthcdr 3 loc) t))) ; Set this one as visited. |
(setcdr (nthcdr 3 loc) t))) ; Set this one as visited. |
1469 |
|
|
1470 |
;;;###autoload (define-key ctl-x-map "`" 'next-error) |
(defvar compilation-gcpro nil |
1471 |
|
"Internal variable used to keep some values from being GC'd.") |
1472 |
(defun previous-error (n) |
(make-variable-buffer-local 'compilation-gcpro) |
1473 |
"Visit previous compilation error message and corresponding source code. |
|
1474 |
Prefix arg N says how many error messages to move backwards (or |
(defun compilation-fake-loc (marker file &optional line col) |
1475 |
forwards, if negative). |
"Preassociate MARKER with FILE. |
1476 |
|
FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). |
1477 |
This operates on the output from the \\[compile] and \\[grep] commands." |
This is useful when you compile temporary files, but want |
1478 |
(interactive "p") |
automatic translation of the messages to the real buffer from |
1479 |
(next-error (- n))) |
which the temporary file came. This only works if done before a |
1480 |
|
message about FILE appears! |
1481 |
(defun first-error (n) |
|
1482 |
"Restart at the first error. |
Optional args LINE and COL default to 1 and beginning of |
1483 |
Visit corresponding source code. |
indentation respectively. The marker is expected to reflect |
1484 |
With prefix arg N, visit the source code of the Nth error. |
this. In the simplest case the marker points to the first line |
1485 |
This operates on the output from the \\[compile] command." |
of the region that was saved to the temp file. |
1486 |
(interactive "p") |
|
1487 |
(set-buffer (setq compilation-last-buffer (compilation-find-buffer))) |
If you concatenate several regions into the temp file (e.g. a |
1488 |
(setq compilation-current-error nil) |
header with variable assignments and a code region), you must |
1489 |
(next-error n)) |
call this several times, once each for the last line of one |
1490 |
|
region and the first line of the next region." |
1491 |
(defcustom compilation-context-lines next-screen-context-lines |
(or (consp file) (setq file (list file))) |
1492 |
"*Display this many lines of leading context before message." |
(setq file (compilation-get-file-structure file)) |
1493 |
:type 'integer |
;; Between the current call to compilation-fake-loc and the first occurrence |
1494 |
|
;; of an error message referring to `file', the data is only kept is the |
1495 |
|
;; weak hash-table compilation-locs, so we need to prevent this entry |
1496 |
|
;; in compilation-locs from being GC'd away. --Stef |
1497 |
|
(push file compilation-gcpro) |
1498 |
|
(let ((loc (compilation-assq (or line 1) (cdr file)))) |
1499 |
|
(setq loc (compilation-assq col loc)) |
1500 |
|
(if (cdr loc) |
1501 |
|
(setcdr (cddr loc) (list marker)) |
1502 |
|
(setcdr loc (list line file marker))) |
1503 |
|
loc)) |
1504 |
|
|
1505 |
|
(defcustom compilation-context-lines 0 |
1506 |
|
"*Display this many lines of leading context before message. |
1507 |
|
If nil, don't scroll the compilation output window." |
1508 |
|
:type '(choice integer (const :tag "No window scrolling" nil)) |
1509 |
:group 'compilation |
:group 'compilation |
1510 |
:version "21.4") |
:version "21.4") |
1511 |
|
|
1512 |
(defsubst compilation-set-window (w mk) |
(defsubst compilation-set-window (w mk) |
1513 |
;; Align the compilation output window W with marker MK near top. |
"Align the compilation output window W with marker MK near top." |
1514 |
(set-window-start w (save-excursion |
(if (integerp compilation-context-lines) |
1515 |
(goto-char mk) |
(set-window-start w (save-excursion |
1516 |
(beginning-of-line (- 1 compilation-context-lines)) |
(goto-char mk) |
1517 |
(point))) |
(beginning-of-line (- 1 compilation-context-lines)) |
1518 |
|
(point)))) |
1519 |
(set-window-point w mk)) |
(set-window-point w mk)) |
1520 |
|
|
1521 |
(defun compilation-goto-locus (msg mk end-mk) |
(defun compilation-goto-locus (msg mk end-mk) |
1522 |
"Jump to an error MESSAGE and SOURCE. |
"Jump to an error corresponding to MSG at MK. |
1523 |
All arguments are markers. If SOURCE-END is non nil, mark is set there." |
All arguments are markers. If END-MK is non nil, mark is set there." |
1524 |
(if (eq (window-buffer (selected-window)) |
(if (eq (window-buffer (selected-window)) |
1525 |
(marker-buffer msg)) |
(marker-buffer msg)) |
1526 |
;; If the compilation buffer window is selected, |
;; If the compilation buffer window is selected, |
1627 |
(overlays-in (point-min) (point-max))) |
(overlays-in (point-min) (point-max))) |
1628 |
buffer))) |
buffer))) |
1629 |
|
|
1630 |
(defun compilation-normalize-filename (filename) |
(defun compilation-get-file-structure (file &optional fmt) |
1631 |
"Convert a filename string found in an error message to make it usable." |
"Retrieve FILE's file-structure or create a new one. |
1632 |
|
FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)." |
1633 |
;; Check for a comint-file-name-prefix and prepend it if |
|
1634 |
;; appropriate. (This is very useful for |
(or (gethash file compilation-locs) |
1635 |
;; compilation-minor-mode in an rlogin-mode buffer.) |
;; File was not previously encountered, at least not in the form passed. |
1636 |
(and (boundp 'comint-file-name-prefix) |
;; Let's normalize it and look again. |
1637 |
;; If file name is relative, default-directory will |
(let ((filename (car file)) |
1638 |
;; already contain the comint-file-name-prefix (done |
(default-directory (if (cdr file) |
1639 |
;; by compile-abbreviate-directory). |
(file-truename (cdr file)) |
1640 |
(file-name-absolute-p filename) |
default-directory))) |
1641 |
(setq filename |
|
1642 |
(concat (with-no-warnings 'comint-file-name-prefix) filename))) |
;; Check for a comint-file-name-prefix and prepend it if appropriate. |
1643 |
|
;; (This is very useful for compilation-minor-mode in an rlogin-mode |
1644 |
;; If compilation-parse-errors-filename-function is |
;; buffer.) |
1645 |
;; defined, use it to process the filename. |
(if (boundp 'comint-file-name-prefix) |
1646 |
(when compilation-parse-errors-filename-function |
(if (file-name-absolute-p filename) |
1647 |
(setq filename |
(setq filename |
1648 |
(funcall compilation-parse-errors-filename-function |
(concat (with-no-warnings comint-file-name-prefix) filename)) |
1649 |
filename))) |
(setq default-directory |
1650 |
|
(file-truename |
1651 |
;; Some compilers (e.g. Sun's java compiler, reportedly) |
(concat (with-no-warnings comint-file-name-prefix) default-directory))))) |
1652 |
;; produce bogus file names like "./bar//foo.c" for file |
|
1653 |
;; "bar/foo.c"; expand-file-name will collapse these into |
;; If compilation-parse-errors-filename-function is |
1654 |
;; "/foo.c" and fail to find the appropriate file. So we |
;; defined, use it to process the filename. |
1655 |
;; look for doubled slashes in the file name and fix them |
(when compilation-parse-errors-filename-function |
1656 |
;; up in the buffer. |
(setq filename |
1657 |
(setq filename (command-line-normalize-file-name filename))) |
(funcall compilation-parse-errors-filename-function |
1658 |
|
filename))) |
1659 |
|
|
1660 |
;; If directory DIR is a subdir of ORIG or of ORIG's parent, |
;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus |
1661 |
;; return a relative name for it starting from ORIG or its parent. |
;; file names like "./bar//foo.c" for file "bar/foo.c"; |
1662 |
;; ORIG-EXPANDED is an expanded version of ORIG. |
;; expand-file-name will collapse these into "/foo.c" and fail to find |
1663 |
;; PARENT-EXPANDED is an expanded version of ORIG's parent. |
;; the appropriate file. So we look for doubled slashes in the file |
1664 |
;; Those two args could be computed here, but we run faster by |
;; name and fix them. |
1665 |
;; having the caller compute them just once. |
(setq filename (command-line-normalize-file-name filename)) |
1666 |
(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) |
|
1667 |
;; Apply canonical abbreviations to DIR first thing. |
;; Now eliminate any "..", because find-file would get them wrong. |
1668 |
;; Those abbreviations are already done in the other arguments passed. |
;; Make relative and absolute filenames, with or without links, the |
1669 |
(setq dir (abbreviate-file-name dir)) |
;; same. |
1670 |
|
(setq filename |
1671 |
;; Check for a comint-file-name-prefix and prepend it if appropriate. |
(list (abbreviate-file-name |
1672 |
;; (This is very useful for compilation-minor-mode in an rlogin-mode |
(file-truename (if (cdr file) |
1673 |
;; buffer.) |
(expand-file-name filename) |
1674 |
(if (boundp 'comint-file-name-prefix) |
filename))))) |
1675 |
(setq dir (concat comint-file-name-prefix dir))) |
|
1676 |
|
;; Store it for the possibly unnormalized name |
1677 |
(if (and (> (length dir) (length orig-expanded)) |
(puthash file |
1678 |
(string= orig-expanded |
;; Retrieve or create file-structure for normalized name |
1679 |
(substring dir 0 (length orig-expanded)))) |
(or (gethash filename compilation-locs) |
1680 |
(setq dir |
(puthash filename (list filename fmt) compilation-locs)) |
1681 |
(concat orig |
compilation-locs)))) |
|
(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) |
|
1682 |
|
|
1683 |
(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$") |
(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$") |
1684 |
|
|
1687 |
(defun compile-buffer-substring (n) (if n (match-string n))) |
(defun compile-buffer-substring (n) (if n (match-string n))) |
1688 |
|
|
1689 |
(defun compilation-compat-error-properties (err) |
(defun compilation-compat-error-properties (err) |
1690 |
;; Map old-style ERROR to new-style MESSAGE. |
"Map old-style error ERR to new-style message." |
1691 |
(let* ((dst (cdr err)) |
;; Old-style structure is (MARKER (FILE DIR) LINE COL) or |
1692 |
(loc (cond ((markerp dst) (list nil nil nil dst)) |
;; (MARKER . MARKER). |
1693 |
((consp dst) |
(let ((dst (cdr err))) |
1694 |
(list (nth 2 dst) (nth 1 dst) |
(if (markerp dst) |
1695 |
(cons (cdar dst) (caar dst))))))) |
;; Must start with a face, for font-lock. |
1696 |
;; Must start with a face, for font-lock. |
`(face nil |
1697 |
`(face nil |
message ,(list (list nil nil nil dst) 2) |
1698 |
message ,(list loc 2) |
help-echo "mouse-2: visit the source location" |
1699 |
help-echo "mouse-2: visit the source location" |
keymap compilation-button-map |
1700 |
mouse-face highlight))) |
mouse-face highlight) |
1701 |
|
;; Too difficult to do it by hand: dispatch to the normal code. |
1702 |
|
(let* ((file (pop dst)) |
1703 |
|
(line (pop dst)) |
1704 |
|
(col (pop dst)) |
1705 |
|
(filename (pop file)) |
1706 |
|
(dirname (pop file)) |
1707 |
|
(fmt (pop file))) |
1708 |
|
(compilation-internal-error-properties |
1709 |
|
(cons filename dirname) line nil col nil 2 fmt))))) |
1710 |
|
|
1711 |
(defun compilation-compat-parse-errors (limit) |
(defun compilation-compat-parse-errors (limit) |
1712 |
(when compilation-parse-errors-function |
(when compilation-parse-errors-function |
1744 |
(goto-char limit) |
(goto-char limit) |
1745 |
nil) |
nil) |
1746 |
|
|
1747 |
|
;; Beware: this is not only compatiblity code. New code stil uses it. --Stef |
1748 |
(defun compilation-forget-errors () |
(defun compilation-forget-errors () |
1749 |
;; In case we hit the same file/line specs, we want to recompute a new |
;; In case we hit the same file/line specs, we want to recompute a new |
1750 |
;; marker for them, so flush our cache. |
;; marker for them, so flush our cache. |
1751 |
(setq compilation-locs (make-hash-table :test 'equal :weakness 'value)) |
(setq compilation-locs (make-hash-table :test 'equal :weakness 'value)) |
1752 |
|
(setq compilation-gcpro nil) |
1753 |
;; FIXME: the old code reset the directory-stack, so maybe we should |
;; FIXME: the old code reset the directory-stack, so maybe we should |
1754 |
;; put a `directory change' marker of some sort, but where? -stef |
;; put a `directory change' marker of some sort, but where? -stef |
1755 |
;; |
;; |
1761 |
;; something equivalent to point-max. So we speculatively move |
;; something equivalent to point-max. So we speculatively move |
1762 |
;; compilation-current-error to point-max (since the external package |
;; compilation-current-error to point-max (since the external package |
1763 |
;; won't know that it should do it). --stef |
;; won't know that it should do it). --stef |
1764 |
(setq compilation-current-error (point-max))) |
(setq compilation-current-error nil) |
1765 |
|
(let* ((proc (get-buffer-process (current-buffer))) |
1766 |
|
(mark (if proc (process-mark proc))) |
1767 |
|
(pos (or mark (point-max)))) |
1768 |
|
(setq compilation-messages-start |
1769 |
|
;; In the future, ignore the text already present in the buffer. |
1770 |
|
;; Since many process filter functions insert before markers, |
1771 |
|
;; we need to put ours just before the insertion point rather |
1772 |
|
;; than at the insertion point. If that's not possible, then |
1773 |
|
;; don't use a marker. --Stef |
1774 |
|
(if (> pos (point-min)) (copy-marker (1- pos)) pos)))) |
1775 |
|
|
1776 |
(provide 'compile) |
(provide 'compile) |
1777 |
|
|
1778 |
;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c |
;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c |
1779 |
;;; compile.el ends here |
;;; compile.el ends here |