;;; 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, 2003, 2004 Free Software Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
;; Daniel Pfeiffer <occitan@esperanto.org>
;; This package provides the compile facilities documented in the Emacs user's
;; manual.
-;;; This mode uses some complex data-structures:
+;; This mode uses some complex data-structures:
-;;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE)
+;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE)
;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe
;; LINE will be nil for a message that doesn't contain them. Then the
;; Being a marker it sticks to some text, when the buffer grows or shrinks
;; before that point. VISITED is t if we have jumped there, else nil.
-;;; FILE-STRUCTURE is a list of ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...)
-;;; ...)
+;; FILE-STRUCTURE is a list of
+;; ((FILENAME . DIRECTORY) FORMATS (LINE LOC ...) ...)
;; FILENAME is a string parsed from an error message. DIRECTORY is a string
;; obtained by following directory change messages. DIRECTORY will be nil for
;; ordered the same way. Note that the whole file structure is referenced in
;; every LOC.
-;;; MESSAGE is a list of (LOC TYPE END-LOC)
+;; MESSAGE is a list of (LOC TYPE END-LOC)
;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the
;; These are the value of the `message' text-properties in the compilation
;; buffer.
-
;;; Code:
-;; This is the parsing engine for compile:
-(require 'font-lock) ; needed to get font-lock-value-in-major-mode
+(eval-when-compile (require 'cl))
(defgroup compilation nil
"Run compiler as inferior of Emacs, parse error messages."
;;;###autoload
(defvar compilation-process-setup-function nil
"*Function to call to customize the compilation process.
-This functions is called immediately before the compilation process is
+This function is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
while processing the output of the compilation process. The function
is called with variables `compilation-buffer' and `compilation-window'
Each function is called with two arguments: the compilation buffer,
and a string describing how the process finished.")
-(defvar compilation-last-buffer nil
- "The most recent compilation buffer.
-A buffer becomes most recent when its compilation is started
-or when it is used with \\[next-error] or \\[compile-goto-error].")
-
(defvar compilation-in-progress nil
"List of compilation processes now running.")
(or (assq 'compilation-in-progress minor-mode-alist)
\\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
(caml
- "^ *File \"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)-?\\([0-9]+\\)?,\
-\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?"
- 1 (2 . 3) (4 . 5) (6))
+ "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
+\\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
+ 2 (3 . 4) (5 . 6) (7))
(comma
"^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
\\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
+ (edg-1
+ "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
+ 1 2 nil (3 . 4))
+ (edg-2
+ "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$"
+ 2 1 nil 0)
+
(epc
- "^Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1)
+ "^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]+\\]:"
"^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
\\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))
+ ;; fixme: should be `mips'
(irix
- "^[a-z0-9/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\)[0-9 ]*:\
- \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 2 3 nil (1))
+ "^[-[: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))
\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
(gnu
- "^\\(?:[a-zA-Z][-a-zA-Z0-9.]+: ?\\)?\
-\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\
+ "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
+\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'" nil nil
(2 compilation-info-face)
(3 compilation-line-face nil t)
- (1 (compilation-error-properties 2 3 nil nil nil 2 nil)
+ (1 (compilation-error-properties 2 3 nil nil nil 0 nil)
append)))
+ ;; Should be lint-1, lint-2 (SysV lint)
(mips-1
" (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
(mips-2
: \\(?: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
nil 1 nil (3) nil (2 (compilation-face '(3))))
(sun
- ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[a-zA-Z0-9 ]+, \\)?\
+ ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\
File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
3 4 5 (1 . 2))
(sun-ada
"^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
- (ultrix
- "^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1))
-
(4bsd
"\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)))
(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 exerything is a valid filename, so these
+Note that on Unix everything is a valid filename, so these
matchers must make some common sense assumptions, which catch
normal cases. A shorter list will be lighter on resource usage.
Instead of an alist element, you can use a symbol, which is
looked up in `compilation-error-regexp-alist-alist'. You can see
the predefined symbols and their effects in the file
-`etc/compilation.txt' (linked below if your are customizing this).
+`etc/compilation.txt' (linked below if you are customizing this).
Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK
HIGHLIGHT...]). If REGEXP matches, the FILE'th subexpression
(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
(1 font-lock-variable-name-face)
(2 (compilation-face '(4 . 3))))
;; Command output lines. Recognize `make[n]:' lines too.
- ("^\\([A-Za-z_0-9/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
+ ("^\\([[: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)
(defvar compilation-locs ())
(defvar compilation-debug nil
- "*Set this to `t' before creating a *compilation* buffer.
+ "*Set this to t before creating a *compilation* buffer.
Then every error line will have a debug text property with the matcher that
fit this line and the match data. Use `describe-text-properties'.")
(defvar 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)
+ :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)
+ :group 'font-lock-highlighting-faces
+ :version "21.4")
(defvar compilation-message-face nil
"Face name to use for whole messages.
+;; Used for compatibility with the old compile.el.
+(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
+(defvar compilation-parsing-end (make-marker))
+(defvar compilation-parse-errors-function nil)
+(defvar compilation-error-list nil)
+(defvar compilation-old-error-list nil)
+
(defun compilation-face (type)
(or (and (car type) (match-end (car type)) compilation-warning-face)
(and (cdr type) (match-end (cdr type)) compilation-info-face)
'(nil)) ; nil only isn't a property-change
(cons (match-string-no-properties idx) dir))
mouse-face highlight
+ keymap compilation-button-map
help-echo "mouse-2: visit current directory")))
;; Data type `reverse-ordered-alist' retriever. This function retrieves the
;; may be nil. The other KEYs are ordered backwards so that growing line
;; numbers can be inserted in front and searching can abort after half the
;; list on average.
+(eval-when-compile ;Don't keep it at runtime if not needed.
(defmacro compilation-assq (key alist)
`(let* ((l1 ,alist)
(l2 (cdr l1)))
l2 (cdr l1)))
(if l2 (eq ,key (caar l2))))
l2
- (setcdr l1 (cons (list ,key) l2))))))
+ (setcdr l1 (cons (list ,key) l2)))))))
;; This function is the central driver, called when font-locking to gather
(setq dir (previous-single-property-change (point) 'directory)
dir (if dir (or (get-text-property (1- dir) 'directory)
(get-text-property dir 'directory)))))
- (setq file (cons file (car dir)) ; top of dir stack is current
- file (or (gethash file compilation-locs)
- (puthash file (list file fmt) compilation-locs)))))
+ (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
- (nth 2 (car (or (get-text-property (1- file) 'message)
- (get-text-property file 'message)))))
- ;; no previous either -- let font-lock continue
- (gethash (setq file '("*unknown*")) compilation-locs)
- (puthash file (list file fmt) compilation-locs))))
+ (car (nth 2 (car (or (get-text-property (1- file) 'message)
+ (get-text-property file 'message))))))
+ '("*unknown*"))))
;; All of these fields are optional, get them only if we have an index, and
;; it matched some part of the message.
(and line
(and end-line
(setq end-line (match-string-no-properties end-line))
(setq end-line (string-to-number end-line)))
- (and col
- (setq col (match-string-no-properties col))
- (setq col (- (string-to-number col) compilation-first-column)))
- (if (and end-col (setq end-col (match-string-no-properties end-col)))
- (setq end-col (- (string-to-number end-col) compilation-first-column))
- (if end-line (setq end-col -1)))
- (if (consp type) ; not a preset type, check what it is.
+ (if col
+ (if (functionp col)
+ (setq col (funcall col))
+ (and
+ (setq col (match-string-no-properties col))
+ (setq col (- (string-to-number col) compilation-first-column)))))
+ (if (and end-col (functionp end-col))
+ (setq end-col (funcall end-col))
+ (if (and end-col (setq end-col (match-string-no-properties end-col)))
+ (setq end-col (- (string-to-number end-col) compilation-first-column -1))
+ (if end-line (setq end-col -1))))
+ (if (consp type) ; not a static type, check what it is.
(setq type (or (and (car type) (match-end (car type)) 1)
(and (cdr type) (match-end (cdr type)) 0)
2)))
- ;; Get any (first) already existing marker (if any has one, all have one).
- ;; Do this first, as the next assq`s may create new nodes.
- (let ((marker (nth 3 (car (cdar (cddr file)))))
- (loc (compilation-assq line (cdr file)))
- end-loc)
- (if end-line
- (setq end-loc (compilation-assq end-line (cdr file))
- end-loc (compilation-assq end-col end-loc))
- (if end-col ; use same line element
- (setq end-loc (compilation-assq end-col loc))))
- (setq loc (compilation-assq col loc))
- ;; If they are new, make the loc(s) reference the file they point to.
- (or (cdr loc) (setcdr loc (list line file)))
- (if end-loc
- (or (cdr end-loc) (setcdr end-loc (list (or end-line line) file))))
- ;; If we'd found a marker, ensure that the new locs also get markers
- (when (and marker
- (not (or (cddr loc) (cddr end-loc))) ; maybe new node w/o marker
- (marker-buffer marker)) ; other marker still valid
- (or line (setq line 1)) ; normalize no linenumber to line 1
- (catch 'marker ; find nearest loc, at least one exists
- (dolist (x (cddr file))
- (if (> (or (car x) 1) line)
- (setq marker x)
- (if (eq (or (car x) 1) line)
- (if (cdr (cddr x)) ; at least one other column
- (throw 'marker (setq marker x))
- (if marker (throw 'marker t)))
- (throw 'marker (or marker (setq marker x)))))))
- (setq marker (if (eq (car (cddr marker)) col)
- (nthcdr 3 marker)
- (cddr marker))
- file compilation-error-screen-columns)
- (save-excursion
- (set-buffer (marker-buffer (cddr marker)))
- (save-restriction
- (widen)
- (goto-char (marker-position (cddr marker)))
- (beginning-of-line (- line (car (cadr marker)) -1))
- (if file ; original c.-error-screen-columns
- (move-to-column (car loc))
- (forward-char (car loc)))
- (setcdr (cdr loc) (point-marker))
- (when end-loc
- (beginning-of-line (- end-line line -1))
- (if (< end-col 0)
- (end-of-line)
- (if file ; original c.-error-screen-columns
- (move-to-column (car end-loc))
- (forward-char (car end-loc))))
- (setcdr (cdr end-loc) (point-marker))))))
- ;; Must start with face
- `(face ,compilation-message-face
- message (,loc ,type ,end-loc)
- ,@(if compilation-debug
- `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
- ,@(match-data))))
- help-echo ,(if col
- "mouse-2: visit this file, line and column"
- (if line
- "mouse-2: visit this file and line"
- "mouse-2: visit this file"))
- mouse-face highlight))))
+ (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 fmt)
+ "Get the meta-info that will be added as text-properties.
+LINE, END-LINE, COL, END-COL are integers or nil.
+TYPE can be 0, 1, or 2.
+FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
+ (unless file (setq file '("*unknown*")))
+ (setq file (compilation-get-file-structure file fmt))
+ ;; Get first already existing marker (if any has one, all have one).
+ ;; Do this first, as the compilation-assq`s may create new nodes.
+ (let* ((marker-line (car (cddr file))) ; a line structure
+ (marker (nth 3 (cadr marker-line))) ; its marker
+ (compilation-error-screen-columns compilation-error-screen-columns)
+ end-marker loc end-loc)
+ (if (not (and marker (marker-buffer marker)))
+ (setq marker) ; no valid marker for this file
+ (setq loc (or line 1)) ; normalize no linenumber to line 1
+ (catch 'marker ; find nearest loc, at least one exists
+ (dolist (x (nthcdr 3 file)) ; loop over remaining lines
+ (if (> (car x) loc) ; still bigger
+ (setq marker-line x)
+ (if (> (- (or (car marker-line) 1) loc)
+ (- loc (car x))) ; current line is nearer
+ (setq marker-line x))
+ (throw 'marker t))))
+ (setq marker (nth 3 (cadr marker-line))
+ marker-line (or (car marker-line) 1))
+ (with-current-buffer (marker-buffer marker)
+ (save-restriction
+ (widen)
+ (goto-char (marker-position marker))
+ (when (or end-col end-line)
+ (beginning-of-line (- (or end-line line) marker-line -1))
+ (if (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)))
+ (if end-line
+ (setq end-loc (compilation-assq end-line (cdr file))
+ end-loc (compilation-assq end-col end-loc))
+ (if end-col ; use same line element
+ (setq end-loc (compilation-assq end-col loc))))
+ (setq loc (compilation-assq col loc))
+ ;; If they are new, make the loc(s) reference the file they point to.
+ (or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
+ (if end-loc
+ (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
+
+ ;; Must start with face
+ `(face ,compilation-message-face
+ message (,loc ,type ,end-loc)
+ ,@(if compilation-debug
+ `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
+ ,@(match-data))))
+ help-echo ,(if col
+ "mouse-2: visit this file, line and column"
+ (if line
+ "mouse-2: visit this file and line"
+ "mouse-2: visit this file"))
+ keymap compilation-button-map
+ mouse-face highlight)))
(defun compilation-mode-font-lock-keywords ()
"Return expressions to highlight in Compilation mode."
- (nconc
- ;; make directory tracking
- (if compilation-directory-matcher
- `((,(car compilation-directory-matcher)
- ,@(mapcar (lambda (elt)
- `(,(car elt)
- (compilation-directory-properties
- ,(car elt) ,(cdr elt))
- t))
- (cdr compilation-directory-matcher)))))
-
- ;; Compiler warning/error lines.
- (mapcar (lambda (item)
- (if (symbolp item)
- (setq item (cdr (assq item
- compilation-error-regexp-alist-alist))))
- (let ((file (nth 1 item))
- (line (nth 2 item))
- (col (nth 3 item))
- (type (nth 4 item))
- end-line end-col fmt)
- (if (consp file) (setq fmt (cdr file) file (car file)))
- (if (consp line) (setq end-line (cdr line) line (car line)))
- (if (consp col) (setq end-col (cdr col) col (car col)))
-
- `(,(nth 0 item)
-
- ,@(when (integerp file)
- `((,file ,(if (consp type)
- `(compilation-face ',type)
- (aref [compilation-info-face
- compilation-warning-face
- compilation-error-face]
- (or type 2))))))
-
- ,@(when line
- `((,line compilation-line-face nil t)))
- ,@(when end-line
- `((,end-line compilation-line-face nil t)))
-
- ,@(when col
- `((,col compilation-column-face nil t)))
- ,@(when end-col
- `((,end-col compilation-column-face nil t)))
-
- ,@(nthcdr 6 item)
- (,(or (nth 5 item) 0)
- (compilation-error-properties ',file ,line ,end-line
- ,col ,end-col ',(or type 2)
- ',fmt)
- append)))) ; for compilation-message-face
- compilation-error-regexp-alist)
-
- compilation-mode-font-lock-keywords))
+ (if compilation-parse-errors-function
+ ;; An old package! Try the compatibility code.
+ '((compilation-compat-parse-errors))
+ (append
+ ;; make directory tracking
+ (if compilation-directory-matcher
+ `((,(car compilation-directory-matcher)
+ ,@(mapcar (lambda (elt)
+ `(,(car elt)
+ (compilation-directory-properties
+ ,(car elt) ,(cdr elt))
+ t))
+ (cdr compilation-directory-matcher)))))
+
+ ;; Compiler warning/error lines.
+ (mapcar
+ (lambda (item)
+ (if (symbolp item)
+ (setq item (cdr (assq item
+ compilation-error-regexp-alist-alist))))
+ (let ((file (nth 1 item))
+ (line (nth 2 item))
+ (col (nth 3 item))
+ (type (nth 4 item))
+ end-line end-col fmt)
+ (if (consp file) (setq fmt (cdr file) file (car file)))
+ (if (consp line) (setq end-line (cdr line) line (car line)))
+ (if (consp col) (setq end-col (cdr col) col (car col)))
+
+ (if (functionp line)
+ ;; The old compile.el had here an undocumented hook that
+ ;; allowed `line' to be a function that computed the actual
+ ;; error location. Let's do our best.
+ `(,(car item)
+ (0 (compilation-compat-error-properties
+ (funcall ',line (cons (match-string ,file)
+ (cons default-directory
+ ',(nthcdr 4 item)))
+ ,(if col `(match-string ,col)))))
+ (,file compilation-error-face t))
+
+ (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
+ (error "HYPERLINK should be an integer: %s" (nth 5 item)))
+
+ `(,(nth 0 item)
+
+ ,@(when (integerp file)
+ `((,file ,(if (consp type)
+ `(compilation-face ',type)
+ (aref [compilation-info-face
+ compilation-warning-face
+ compilation-error-face]
+ (or type 2))))))
+
+ ,@(when line
+ `((,line compilation-line-face nil t)))
+ ,@(when end-line
+ `((,end-line compilation-line-face nil t)))
+
+ ,@(when (integerp col)
+ `((,col compilation-column-face nil t)))
+ ,@(when (integerp end-col)
+ `((,end-col compilation-column-face nil t)))
+
+ ,@(nthcdr 6 item)
+ (,(or (nth 5 item) 0)
+ (compilation-error-properties ',file ,line ,end-line
+ ,col ,end-col ',(or type 2)
+ ',fmt)
+ append))))) ; for compilation-message-face
+ compilation-error-regexp-alist)
+
+ compilation-mode-font-lock-keywords)))
\f
;;;###autoload
Runs COMMAND, a shell command, in a separate process asynchronously
with output going to the buffer `*compilation*'.
-If optional second arg COMINT is t the buffer will be in comint mode with
+If optional second arg COMINT is t the buffer will be in Comint mode with
`compilation-shell-minor-mode'.
You can then use the command \\[next-error] to find the next error message
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
+ (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))
(save-some-buffers (not compilation-ask-about-save) nil)
;; run compile with the default command line
(defun recompile ()
"Re-compile the program including the current buffer.
-If this is run in a compilation-mode buffer, re-use the arguments from the
-original use. Otherwise, it recompiles using `compile-command'."
+If this is run in a Compilation mode buffer, re-use the arguments from the
+original use. Otherwise, recompile using `compile-command'."
(interactive)
(save-some-buffers (not compilation-ask-about-save) nil)
- (let ((default-directory (or compilation-directory default-directory)))
+ (let ((default-directory
+ (or (and (not (eq major-mode (nth 1 compilation-arguments)))
+ compilation-directory)
+ default-directory)))
(apply 'compilation-start (or compilation-arguments
`(,(eval compile-command))))))
(defcustom compilation-scroll-output nil
"*Non-nil to scroll the *compilation* buffer window as output appears.
-Setting it causes the compilation-mode commands to put point at the
+Setting it causes the Compilation mode commands to put point at the
end of their output window so that the end of the output is always
-visible rather than the begining."
+visible rather than the beginning."
:type 'boolean
:version "20.3"
:group 'compilation)
(funcall name-function mode-name))
(compilation-buffer-name-function
(funcall compilation-buffer-name-function mode-name))
- ((and (eq major-mode 'compilation-mode)
- (equal mode-name (nth 2 compilation-arguments)))
+ ((eq major-mode (nth 1 compilation-arguments))
(buffer-name))
(t
(concat "*" (downcase mode-name) "*"))))
(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'.
The rest of the arguments are optional; for them, nil means use the default.
MODE is the major mode to set in the compilation buffer. Mode
-may also be `t' meaning `compilation-shell-minor-mode' under `comint-mode'.
+may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.
NAME-FUNCTION is a function called to name the buffer.
If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
-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
global value of `compilation-highlight-regexp'.
Returns the compilation buffer created."
(or mode (setq mode 'compilation-mode))
- (let ((name-of-mode
- (if (eq mode t)
- (prog1 "compilation" (require 'comint))
- (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
- (process-environment
- (append
- compilation-environment
- (if (and (boundp 'system-uses-terminfo)
- system-uses-terminfo)
- (list "TERM=dumb" "TERMCAP="
- (format "COLUMNS=%d" (window-width)))
- (list "TERM=emacs"
- (format "TERMCAP=emacs:co#%d:tc=unknown:"
- (window-width))))
- ;; Set the EMACS variable, but
- ;; don't override users' setting of $EMACS.
- (unless (getenv "EMACS") '("EMACS=t"))
- process-environment))
- (thisdir default-directory)
- outwin outbuf)
- (save-excursion
- (setq outbuf
- (get-buffer-create (compilation-buffer-name name-of-mode
- name-function)))
- (set-buffer outbuf)
+ (let* ((name-of-mode
+ (if (eq mode t)
+ (prog1 "compilation" (require 'comint))
+ (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
+ (thisdir default-directory)
+ outwin outbuf)
+ (with-current-buffer
+ (setq outbuf
+ (get-buffer-create
+ (compilation-buffer-name name-of-mode name-function)))
(let ((comp-proc (get-buffer-process (current-buffer))))
(if comp-proc
(if (or (not (eq (process-status comp-proc) 'run))
(error nil))
(error "Cannot have two processes in `%s' at once"
(buffer-name)))))
- ;; Clear out the compilation buffer and make it writable.
- ;; Change its default-directory to the directory where the compilation
- ;; will happen, and insert a `cd' command to indicate this.
- (setq buffer-read-only nil)
(buffer-disable-undo (current-buffer))
- (erase-buffer)
- (buffer-enable-undo (current-buffer))
+ ;; first transfer directory from where M-x compile was called
(setq default-directory thisdir)
- ;; output a mode setter, for saving and later reloading this buffer
- (insert "cd " thisdir " # -*-" name-of-mode
- "-*-\nEntering directory `" thisdir "'\n" command "\n")
+ ;; Make compilation buffer read-only. The filter can still write it.
+ ;; Clear out the compilation buffer.
+ (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)
+ ;; 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")
+ (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.
;; Pop up the compilation buffer.
(setq outwin (display-buffer outbuf nil t))
(with-current-buffer outbuf
- (if (not (eq mode t))
- (funcall mode)
- (with-no-warnings (comint-mode))
- (compilation-shell-minor-mode))
- ;; In what way is it non-ergonomic ? -stef
- ;; (toggle-read-only 1) ;;; Non-ergonomic.
- (if highlight-regexp
- (set (make-local-variable 'compilation-highlight-regexp)
- highlight-regexp))
- (set (make-local-variable 'compilation-arguments)
- (list command mode name-function highlight-regexp))
- (set (make-local-variable 'revert-buffer-function)
- 'compilation-revert-buffer)
- (set-window-start outwin (point-min))
- (or (eq outwin (selected-window))
- (set-window-point outwin (point)))
- ;; The setup function is called before compilation-set-window-height
- ;; so it can set the compilation-window-height buffer locally.
- (if compilation-process-setup-function
- (funcall compilation-process-setup-function))
- (compilation-set-window-height outwin)
- ;; Start the compilation.
- (if (fboundp 'start-process)
- (let ((proc (if (eq mode t)
- (get-buffer-process
- (with-no-warnings
- (comint-exec outbuf (downcase mode-name)
- shell-file-name nil `("-c" ,command))))
- (start-process-shell-command (downcase mode-name)
- outbuf command))))
- ;; Make the buffer's mode line show process state.
- (setq mode-line-process '(":%s"))
- (set-process-sentinel proc 'compilation-sentinel)
- (set-process-filter proc 'compilation-filter)
- (set-marker (process-mark proc) (point) outbuf)
- (setq compilation-in-progress
- (cons proc compilation-in-progress)))
- ;; No asynchronous processes available.
- (message "Executing `%s'..." command)
- ;; Fake modeline display as if `start-process' were run.
- (setq mode-line-process ":run")
- (force-mode-line-update)
- (let ((status (call-process shell-file-name nil outbuf nil "-c"
- command)))
- (cond ((numberp status)
- (compilation-handle-exit 'exit status
- (if (zerop status)
- "finished\n"
- (format "\
+ (let ((process-environment
+ (append
+ compilation-environment
+ (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
+ system-uses-terminfo)
+ (list "TERM=dumb" "TERMCAP="
+ (format "COLUMNS=%d" (window-width)))
+ (list "TERM=emacs"
+ (format "TERMCAP=emacs:co#%d:tc=unknown:"
+ (window-width))))
+ ;; Set the EMACS variable, but
+ ;; don't override users' setting of $EMACS.
+ (unless (getenv "EMACS") '("EMACS=t"))
+ (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)
+ 'compilation-revert-buffer)
+ (set-window-start outwin (point-min))
+ (or (eq outwin (selected-window))
+ (set-window-point outwin (if compilation-scroll-output
+ (point)
+ (point-min))))
+ ;; The setup function is called before compilation-set-window-height
+ ;; so it can set the compilation-window-height buffer locally.
+ (if compilation-process-setup-function
+ (funcall compilation-process-setup-function))
+ (compilation-set-window-height outwin)
+ ;; Start the compilation.
+ (if (fboundp 'start-process)
+ (let ((proc (if (eq mode t)
+ (get-buffer-process
+ (with-no-warnings
+ (comint-exec outbuf (downcase mode-name)
+ shell-file-name nil `("-c" ,command))))
+ (start-process-shell-command (downcase mode-name)
+ outbuf command))))
+ ;; Make the buffer's mode line show process state.
+ (setq mode-line-process '(":%s"))
+ (set-process-sentinel proc 'compilation-sentinel)
+ (set-process-filter proc 'compilation-filter)
+ (set-marker (process-mark proc) (point) outbuf)
+ (setq compilation-in-progress
+ (cons proc compilation-in-progress)))
+ ;; No asynchronous processes available.
+ (message "Executing `%s'..." command)
+ ;; Fake modeline display as if `start-process' were run.
+ (setq mode-line-process ":run")
+ (force-mode-line-update)
+ (sit-for 0) ; Force redisplay
+ (let* ((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)
+ "finished\n"
+ (format "\
exited abnormally with code %d\n"
- status))))
- ((stringp status)
- (compilation-handle-exit 'signal status
- (concat status "\n")))
- (t
- (compilation-handle-exit 'bizarre status status))))
- (message "Executing `%s'...done" command)))
+ status))))
+ ((stringp status)
+ (compilation-handle-exit 'signal status
+ (concat status "\n")))
+ (t
+ (compilation-handle-exit 'bizarre status status))))
+ ;; Without async subprocesses, the buffer is not yet
+ ;; fontified, so fontify it now.
+ (let ((font-lock-verbose nil)) ; shut up font-lock messages
+ (font-lock-fontify-buffer))
+ (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)
(goto-char (point-max))))
;; Make it so the next C-x ` will use this buffer.
- (setq compilation-last-buffer outbuf)))
+ (setq next-error-last-buffer outbuf)))
(defun compilation-set-window-height (window)
"Set the height of WINDOW according to `compilation-window-height'."
;; 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))))))))
(defvar compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'compile-mouse-goto-error)
+ (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-shell-minor-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'compile-mouse-goto-error)
(define-key map "\M-\C-m" 'compile-goto-error)
(define-key map "\M-\C-n" 'compilation-next-error)
(define-key map "\M-\C-p" 'compilation-previous-error)
map)
"Keymap for `compilation-shell-minor-mode'.")
+(defvar compilation-button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'compile-goto-error)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map "\C-m" 'compile-goto-error)
+ map)
+ "Keymap for compilation-message buttons.")
+(fset 'compilation-button-map compilation-button-map)
+
(defvar compilation-mode-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map compilation-minor-mode-map)
+ ;; 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 " " '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]
(put 'compilation-mode 'mode-class 'special)
+(defvar compilation-skip-to-next-location t
+ "*If non-nil, skip multiple error messages for the same source location.")
+
+(defcustom compilation-skip-threshold 1
+ "*Compilation motion commands skip less important messages.
+The value can be either 2 -- skip anything less than error, 1 --
+skip anything less than warning or 0 -- don't skip any messages.
+Note that all messages not positively identified as warning or
+info, are considered errors."
+ :type '(choice (const :tag "Warnings and info" 2)
+ (const :tag "Info" 1)
+ (const :tag "None" 0))
+ :group 'compilation
+ :version "21.4")
+
+(defcustom compilation-skip-visited nil
+ "*Compilation motion commands skip visited messages if this is t.
+Visited messages are ones for which the file, line and column have been jumped
+to from the current content in the current compilation buffer, even if it was
+from a different message."
+ :type 'boolean
+ :group 'compilation
+ :version "21.4")
+
;;;###autoload
-(defun compilation-mode ()
+(defun compilation-mode (&optional name-of-mode)
"Major mode for compilation log buffers.
\\<compilation-mode-map>To visit the source for a line-numbered error,
move point to the error message line and type \\[compile-goto-error].
To kill the compilation, type \\[kill-compilation].
-Runs `compilation-mode-hook' with `run-hooks' (which see)."
+Runs `compilation-mode-hook' with `run-hooks' (which see).
+
+\\{compilation-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map compilation-mode-map)
(setq major-mode 'compilation-mode
- mode-name "Compilation")
+ mode-name (or name-of-mode "Compilation"))
(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)
(if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
(apply 'compilation-start compilation-arguments))))
+(defvar compilation-current-error nil
+ "Marker to the location from where the next error will be found.
+The global commands next/previous/first-error/goto-error use this.")
+
+(defvar compilation-messages-start nil
+ "Buffer position of the beginning of the compilation messages.
+If nil, use the beginning of buffer.")
+
;; A function name can't be a hook, must be something with a value.
(defconst compilation-turn-on-font-lock 'turn-on-font-lock)
(defun compilation-setup (&optional minor)
- "Prepare the buffer for the compilation parsing commands to work."
+ "Prepare the buffer for the compilation parsing commands to work.
+Optional argument MINOR indicates this is called from
+`compilation-minor-mode'."
+ (make-local-variable 'compilation-current-error)
+ (make-local-variable 'compilation-messages-start)
(make-local-variable 'compilation-error-screen-columns)
- (setq compilation-last-buffer (current-buffer))
- (if minor
- (if font-lock-defaults
- (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
- (set (make-local-variable 'font-lock-defaults)
- '(compilation-mode-font-lock-keywords t)))
- (set (make-local-variable 'font-lock-defaults)
- '(compilation-mode-font-lock-keywords t)))
+ (make-local-variable 'overlay-arrow-position)
+ ;; Note that compilation-next-error-function is for interfacing
+ ;; with the next-error function in simple.el, and it's only
+ ;; coincidentally named similarly to compilation-next-error.
+ (setq next-error-function 'compilation-next-error-function)
(set (make-local-variable 'font-lock-extra-managed-props)
'(directory message help-echo mouse-face debug))
(set (make-local-variable 'compilation-locs)
(make-hash-table :test 'equal :weakness 'value))
- ;; lazy-lock would never find the message unless it's scrolled to
- ;; jit-lock might fontify some things too late
- (if (font-lock-value-in-major-mode font-lock-support-mode)
- (set (make-local-variable 'font-lock-support-mode) nil))
+ ;; lazy-lock would never find the message unless it's scrolled to.
+ ;; jit-lock might fontify some things too late.
+ (set (make-local-variable 'font-lock-support-mode) nil)
(set (make-local-variable 'font-lock-maximum-size) nil)
- (if minor
- (if font-lock-mode
- (font-lock-fontify-buffer)
- (turn-on-font-lock))
- ;; maybe defer font-lock till after derived mode is set up
- (run-mode-hooks 'compilation-turn-on-font-lock)))
+ (let ((fld font-lock-defaults))
+ (if (and minor fld)
+ (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
+ (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))
+ (if minor
+ (if font-lock-mode
+ (if fld
+ (font-lock-fontify-buffer)
+ (font-lock-change-mode)
+ (turn-on-font-lock))
+ (turn-on-font-lock))
+ ;; maybe defer font-lock till after derived mode is set up
+ (run-mode-hooks 'compilation-turn-on-font-lock))))
;;;###autoload
(define-minor-mode compilation-shell-minor-mode
(font-lock-fontify-buffer)))
(defun compilation-handle-exit (process-status exit-status msg)
- "Write msg in the current buffer and hack its mode-line-process."
- (let ((buffer-read-only nil)
+ "Write MSG in the current buffer and hack its mode-line-process."
+ (let ((inhibit-read-only t)
(status (if compilation-exit-message-function
(funcall compilation-exit-message-function
process-status exit-status msg)
(cons msg exit-status)))
(omax (point-max))
(opoint (point)))
- ;; Record where we put the message, so we can ignore it
- ;; later on.
+ ;; Record where we put the message, so we can ignore it later on.
(goto-char omax)
(insert ?\n mode-name " " (car status))
(if (and (numberp compilation-window-height)
;; Called when compilation process changes state.
(defun compilation-sentinel (proc msg)
"Sentinel for compilation buffers."
- (let ((buffer (process-buffer proc)))
- (if (memq (process-status proc) '(signal exit))
- (progn
- (if (null (buffer-name buffer))
- ;; buffer killed
- (set-process-buffer proc nil)
- (let ((obuf (current-buffer)))
- ;; save-excursion isn't the right thing if
- ;; process-buffer is current-buffer
- (unwind-protect
- (progn
- ;; Write something in the compilation buffer
- ;; and hack its mode line.
- (set-buffer buffer)
- (compilation-handle-exit (process-status proc)
- (process-exit-status proc)
- msg)
- ;; Since the buffer and mode line will show that the
- ;; process is dead, we can delete it now. Otherwise it
- ;; will stay around until M-x list-processes.
- (delete-process proc))
- (set-buffer obuf))))
- (setq compilation-in-progress (delq proc compilation-in-progress))
- ))))
+ (if (memq (process-status proc) '(exit signal))
+ (let ((buffer (process-buffer proc)))
+ (if (null (buffer-name buffer))
+ ;; buffer killed
+ (set-process-buffer proc nil)
+ (with-current-buffer buffer
+ ;; Write something in the compilation buffer
+ ;; and hack its mode line.
+ (compilation-handle-exit (process-status proc)
+ (process-exit-status proc)
+ msg)
+ ;; Since the buffer and mode line will show that the
+ ;; process is dead, we can delete it now. Otherwise it
+ ;; will stay around until M-x list-processes.
+ (delete-process proc)))
+ (setq compilation-in-progress (delq proc compilation-in-progress)))))
(defun compilation-filter (proc string)
"Process filter for compilation buffers.
Just inserts the text, but uses `insert-before-markers'."
(if (buffer-name (process-buffer proc))
- (save-excursion
- (set-buffer (process-buffer proc))
- (let ((buffer-read-only nil))
+ (with-current-buffer (process-buffer proc)
+ (let ((inhibit-read-only t))
(save-excursion
(goto-char (process-mark proc))
(insert-before-markers string)
(run-hooks 'compilation-filter-hook))))))
+;;; test if a buffer is a compilation buffer, assuming we're in the buffer
+(defsubst compilation-buffer-internal-p ()
+ "Test if inside a compilation buffer."
+ (local-variable-p 'compilation-locs))
+
+;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p
(defsubst compilation-buffer-p (buffer)
- (local-variable-p 'compilation-locs buffer))
+ "Test if BUFFER is a compilation buffer."
+ (with-current-buffer buffer
+ (compilation-buffer-internal-p)))
(defmacro compilation-loop (< property-change 1+ error)
`(while (,< n 0)
;; count this message only if none of the above are true
(setq n (,1+ n)))))
-(defun compilation-next-error (n &optional different-file)
+(defun compilation-next-error (n &optional different-file pt)
"Move point to the next error in the compilation buffer.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
(interactive "p")
(or (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer"))
- (setq compilation-last-buffer (current-buffer))
- (let* ((pt (point))
- (msg (get-text-property pt 'message))
- (loc (car msg))
- last)
+ (or pt (setq pt (point)))
+ (let* ((msg (get-text-property pt 'message))
+ (loc (car msg))
+ last)
(if (zerop n)
(unless (or msg ; find message near here
- (setq msg (get-text-property (max (1- pt) 1) 'message)))
+ (setq msg (get-text-property (max (1- pt) (point-min))
+ 'message)))
(setq pt (previous-single-property-change pt 'message nil
- (save-excursion
- (beginning-of-line)
- (point))))
- (if pt
- (setq msg (get-text-property (max (1- pt) 1) 'message))
+ (line-beginning-position)))
+ (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
(setq pt (next-single-property-change pt 'message nil
- (save-excursion
- (end-of-line)
- (point))))
- (if pt
- (setq msg (get-text-property pt 'message))
- (setq pt (point)))))
+ (line-end-position)))
+ (or (setq msg (get-text-property pt 'message))
+ (setq pt (point)))))
(setq last (nth 2 (car msg)))
- ;; These loops search only either forwards or backwards
- (compilation-loop > next-single-property-change 1-
- (if (get-buffer-process (current-buffer))
- "No more %ss yet"
- "Moved past last %s"))
- (compilation-loop < previous-single-property-change 1+
- "Moved back before first %s"))
+ (if (>= n 0)
+ (compilation-loop > next-single-property-change 1-
+ (if (get-buffer-process (current-buffer))
+ "No more %ss yet"
+ "Moved past last %s"))
+ ;; Don't move "back" to message at or before point.
+ ;; Pass an explicit (point-min) to make sure pt is non-nil.
+ (setq pt (previous-single-property-change pt 'message nil (point-min)))
+ (compilation-loop < previous-single-property-change 1+
+ "Moved back before first %s")))
(goto-char pt)
(or msg
(error "No %s here" compilation-error))))
(interactive "p")
(compilation-next-error (- n)))
-(defun next-error-no-select (n)
- "Move point to the next error in the compilation buffer and highlight match.
-Prefix arg N says how many error messages to move forwards (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)))
-
(defun compilation-next-file (n)
"Move point to the next error for a different file than the current one.
Prefix arg N says how many files to move forwards (or backwards, if negative)."
(interrupt-process (get-buffer-process buffer))
(error "The compilation process is not running"))))
-(defun compile-mouse-goto-error (event)
- "Visit the source for the error message the mouse is pointing at."
- (interactive "e")
- (mouse-set-point event)
- (if (get-text-property (point) 'directory)
- (dired-other-window (car (get-text-property (point) 'directory)))
- (next-error 0)))
+(defalias 'compile-mouse-goto-error 'compile-goto-error)
-(defun compile-goto-error ()
- "Visit the source for the error message point is on.
+(defun compile-goto-error (&optional event)
+ "Visit the source for the error message at point.
Use this command in a compilation log buffer. Sets the mark at point there."
- (interactive)
+ (interactive (list last-input-event))
+ (if event (posn-set-point (event-end event)))
(or (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer"))
(if (get-text-property (point) 'directory)
(dired-other-window (car (get-text-property (point) 'directory)))
(push-mark)
+ (setq compilation-current-error (point))
(next-error 0)))
;; Return a compilation buffer.
;; If the current buffer is a compilation buffer, return it.
-;; If compilation-last-buffer is set to a live buffer, use that.
;; Otherwise, look for a compilation buffer and signal an error
;; if there are none.
-(defun compilation-find-buffer (&optional other-buffer)
- (if (and (not other-buffer)
- (compilation-buffer-p (current-buffer)))
- ;; The current buffer is a compilation buffer.
- (current-buffer)
- (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
- (compilation-buffer-p compilation-last-buffer)
- (or (not other-buffer) (not (eq compilation-last-buffer
- (current-buffer)))))
- compilation-last-buffer
- (let ((buffers (buffer-list)))
- (while (and buffers (or (not (compilation-buffer-p (car buffers)))
- (and other-buffer
- (eq (car buffers) (current-buffer)))))
- (setq buffers (cdr buffers)))
- (if buffers
- (car buffers)
- (or (and other-buffer
- (compilation-buffer-p (current-buffer))
- ;; The current buffer is a compilation buffer.
- (progn
- (if other-buffer
- (message "This is the only compilation buffer."))
- (current-buffer)))
- (error "No compilation started!")))))))
+(defun compilation-find-buffer (&optional avoid-current)
+ (next-error-find-buffer avoid-current 'compilation-buffer-internal-p))
;;;###autoload
-(defun next-error (&optional n)
- "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."
+(defun compilation-next-error-function (n &optional reset)
(interactive "p")
- (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
+ (set-buffer (compilation-find-buffer))
+ (when reset
+ (setq compilation-current-error nil))
(let* ((columns compilation-error-screen-columns) ; buffer's local value
(last 1)
- (loc (compilation-next-error (or n 1)))
+ (loc (compilation-next-error (or n 1) nil
+ (or compilation-current-error
+ compilation-messages-start
+ (point-min))))
(end-loc (nth 2 loc))
(marker (point-marker)))
- (setq loc (car loc))
+ (setq compilation-current-error (point-marker)
+ overlay-arrow-position
+ (if (bolp)
+ compilation-current-error
+ (copy-marker (line-beginning-position)))
+ loc (car loc))
;; If loc contains no marker, no error in that file has been visited. If
;; the marker is invalid the buffer has been killed. So, recalculate all
;; markers for that file.
- (unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc)))
- (save-excursion
- (set-buffer (compilation-find-file marker (caar (nth 2 loc))
- (or (cdar (nth 2 loc))
- default-directory)))
+ (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)))
+ (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
+ (or (cdar (nth 2 loc))
+ default-directory))
(save-restriction
(widen)
- (goto-char 1)
+ (goto-char (point-min))
;; Treat file's found lines in forward order, 1 by 1.
(dolist (line (reverse (cddr (nth 2 loc))))
(when (car line) ; else this is a filename w/o a line#
(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 (nthcdr 3 col)
+ (if (nth 3 col)
(set-marker (nth 3 col) (point))
(setcdr (nthcdr 2 col) `(,(point-marker)))))))))
(compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
(setcdr (nthcdr 3 loc) t))) ; Set this one as visited.
-;;;###autoload (define-key ctl-x-map "`" 'next-error)
-
-(defun previous-error (n)
- "Visit previous compilation error message and corresponding source code.
-Prefix arg N says how many error messages to move backwards (or
-forwards, if negative).
-
-This operates on the output from the \\[compile] and \\[grep] commands."
- (interactive "p")
- (next-error (- n)))
-
-(defun first-error (n)
- "Restart at the first error.
-Visit corresponding source code.
-With prefix arg N, visit the source code of the Nth error.
-This operates on the output from the \\[compile] command."
- (interactive "p")
- (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
- (goto-char (point-min))
- (next-error n))
-
-(defvar compilation-skip-to-next-location nil
- "*If non-nil, skip multiple error messages for the same source location.")
-
-(defcustom compilation-skip-threshold 1
- "*Compilation motion commands skip less important messages.
-The value can be either 2 -- skip anything less than error, 1 --
-skip anything less than warning or 0 -- don't skip any messages.
-Note that all messages not positively identified as warning or
-info, are considered errors."
- :type '(choice (const :tag "Warnings and info" 2)
- (const :tag "Info" 1)
- (const :tag "None" 0))
- :group 'compilation)
-
-(defcustom compilation-skip-visited nil
- "*Compilation motion commands skip visited messages if this is t.
-Visited messages are ones for which the file, line and column have been jumped
-to from the current content in the current compilation buffer, even if it was
-from a different message."
- :type 'boolean
- :group 'compilation)
-
-(defcustom compilation-context-lines next-screen-context-lines
- "*Display this many lines of leading context before message."
- :type 'integer
- :group 'compilation)
+(defvar compilation-gcpro nil
+ "Internal variable used to keep some values from being GC'd.")
+(make-variable-buffer-local 'compilation-gcpro)
+
+(defun compilation-fake-loc (marker file &optional line col)
+ "Preassociate MARKER with FILE.
+FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
+This is useful when you compile temporary files, but want
+automatic translation of the messages to the real buffer from
+which the temporary file came. This only works if done before a
+message about FILE appears!
+
+Optional args LINE and COL default to 1 and beginning of
+indentation respectively. The marker is expected to reflect
+this. In the simplest case the marker points to the first line
+of the region that was saved to the temp file.
+
+If you concatenate several regions into the temp file (e.g. a
+header with variable assignments and a code region), you must
+call this several times, once each for the last line of one
+region and the first line of the next region."
+ (or (consp file) (setq file (list file)))
+ (setq file (compilation-get-file-structure file))
+ ;; Between the current call to compilation-fake-loc and the first occurrence
+ ;; of an error message referring to `file', the data is only kept is the
+ ;; weak hash-table compilation-locs, so we need to prevent this entry
+ ;; in compilation-locs from being GC'd away. --Stef
+ (push file compilation-gcpro)
+ (let ((loc (compilation-assq (or line 1) (cdr file))))
+ (setq loc (compilation-assq col loc))
+ (if (cdr loc)
+ (setcdr (cddr loc) (list marker))
+ (setcdr loc (list line file marker)))
+ loc))
+
+(defcustom compilation-context-lines 0
+ "*Display this many lines of leading context before message.
+If nil, don't scroll the compilation output window."
+ :type '(choice integer (const :tag "No window scrolling" nil))
+ :group 'compilation
+ :version "21.4")
(defsubst compilation-set-window (w mk)
- ;; Align the compilation output window W with marker MK near top.
- (set-window-start w (save-excursion
- (goto-char mk)
- (beginning-of-line (- 1 compilation-context-lines))
- (point)))
+ "Align the compilation output window W with marker MK near top."
+ (if (integerp compilation-context-lines)
+ (set-window-start w (save-excursion
+ (goto-char mk)
+ (beginning-of-line (- 1 compilation-context-lines))
+ (point))))
(set-window-point w mk))
(defun compilation-goto-locus (msg mk end-mk)
- "Jump to an error MESSAGE and SOURCE.
-All arguments are markers. If SOURCE-END is non nil, mark is set there."
+ "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,
(widen)
(goto-char mk))
(if end-mk
- (push-mark end-mk nil t)
+ (push-mark end-mk t)
(if mark-active (setq mark-active)))
;; If hideshow got in the way of
;; seeing the right place, open permanently.
compilation-highlight-regexp)))
(compilation-set-window-height w)
- (when (and highlight-regexp
- (not (and end-mk transient-mark-mode)))
+ (when highlight-regexp
(unless compilation-highlight-overlay
- (setq compilation-highlight-overlay (make-overlay 1 1))
- (overlay-put compilation-highlight-overlay 'face 'region))
+ (setq compilation-highlight-overlay
+ (make-overlay (point-min) (point-min)))
+ (overlay-put compilation-highlight-overlay 'face 'next-error))
(with-current-buffer (marker-buffer mk)
(save-excursion
- (end-of-line)
- (let ((end (point)) olay)
- (beginning-of-line)
+ (if end-mk (goto-char end-mk) (end-of-line))
+ (let ((end (point)))
+ (if mk (goto-char mk) (beginning-of-line))
(if (and (stringp highlight-regexp)
(re-search-forward highlight-regexp end t))
(progn
(goto-char (match-beginning 0))
- (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0)))
- (move-overlay compilation-highlight-overlay (point) end))
- (sit-for 0 500)
- (delete-overlay compilation-highlight-overlay)))))))
-
+ (move-overlay compilation-highlight-overlay
+ (match-beginning 0) (match-end 0)
+ (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))))))
+ (when (and (eq next-error-highlight 'fringe-arrow))
+ (set (make-local-variable 'overlay-arrow-position)
+ (copy-marker (line-beginning-position))))))
\f
(defun compilation-find-file (marker filename dir &rest formats)
"Find a buffer for file FILENAME.
(overlays-in (point-min) (point-max)))
buffer)))
-(defun compilation-normalize-filename (filename)
- "Convert a 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$")
+;;; Compatibility with the old compile.el.
+
+(defun compile-buffer-substring (n) (if n (match-string n)))
+
+(defun compilation-compat-error-properties (err)
+ "Map old-style error ERR to new-style message."
+ ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
+ ;; (MARKER . MARKER).
+ (let ((dst (cdr err)))
+ (if (markerp dst)
+ ;; Must start with a face, for font-lock.
+ `(face nil
+ message ,(list (list nil nil nil dst) 2)
+ help-echo "mouse-2: visit the source location"
+ keymap compilation-button-map
+ mouse-face highlight)
+ ;; Too difficult to do it by hand: dispatch to the normal code.
+ (let* ((file (pop dst))
+ (line (pop dst))
+ (col (pop dst))
+ (filename (pop file))
+ (dirname (pop file))
+ (fmt (pop file)))
+ (compilation-internal-error-properties
+ (cons filename dirname) line nil col nil 2 fmt)))))
+
+(defun compilation-compat-parse-errors (limit)
+ (when compilation-parse-errors-function
+ ;; FIXME: We should remove the rest of the compilation keywords
+ ;; but we can't do that from here because font-lock is using
+ ;; the value right now. --stef
+ (save-excursion
+ (setq compilation-error-list nil)
+ ;; Reset compilation-parsing-end each time because font-lock
+ ;; might force us the re-parse many times (typically because
+ ;; some code adds some text-property to the output that we
+ ;; already parsed). You might say "why reparse", well:
+ ;; because font-lock has just removed the `message' property so
+ ;; have to do it all over again.
+ (if compilation-parsing-end
+ (set-marker compilation-parsing-end (point))
+ (setq compilation-parsing-end (point-marker)))
+ (condition-case nil
+ ;; Ignore any error: we're calling this function earlier than
+ ;; in the old compile.el so things might not all be setup yet.
+ (funcall compilation-parse-errors-function limit nil)
+ (error nil))
+ (dolist (err (if (listp compilation-error-list) compilation-error-list))
+ (let* ((src (car err))
+ (dst (cdr err))
+ (loc (cond ((markerp dst) (list nil nil nil dst))
+ ((consp dst)
+ (list (nth 2 dst) (nth 1 dst)
+ (cons (cdar dst) (caar dst)))))))
+ (when loc
+ (goto-char src)
+ ;; (put-text-property src (line-end-position) 'font-lock-face 'font-lock-warning-face)
+ (put-text-property src (line-end-position)
+ 'message (list loc 2)))))))
+ (goto-char limit)
+ nil)
+
+;; Beware: this is not only compatiblity code. New code stil uses it. --Stef
+(defun compilation-forget-errors ()
+ ;; In case we hit the same file/line specs, we want to recompute a new
+ ;; marker for them, so flush our cache.
+ (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
+ (setq compilation-gcpro nil)
+ ;; FIXME: the old code reset the directory-stack, so maybe we should
+ ;; put a `directory change' marker of some sort, but where? -stef
+ ;;
+ ;; FIXME: The old code moved compilation-current-error (which was
+ ;; virtually represented by a mix of compilation-parsing-end and
+ ;; compilation-error-list) to point-min, but that was only meaningful for
+ ;; the internal uses of compilation-forget-errors: all calls from external
+ ;; packages seem to be followed by a move of compilation-parsing-end to
+ ;; something equivalent to point-max. So we speculatively move
+ ;; compilation-current-error to point-max (since the external package
+ ;; won't know that it should do it). --stef
+ (setq compilation-current-error nil)
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (mark (if proc (process-mark proc)))
+ (pos (or mark (point-max))))
+ (setq compilation-messages-start
+ ;; In the future, ignore the text already present in the buffer.
+ ;; Since many process filter functions insert before markers,
+ ;; we need to put ours just before the insertion point rather
+ ;; than at the insertion point. If that's not possible, then
+ ;; don't use a marker. --Stef
+ (if (> pos (point-min)) (copy-marker (1- pos)) pos))))
+
(provide 'compile)
-;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
+;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
;;; compile.el ends here