;; 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
;;; Code:
;; This is the parsing engine for compile:
-(require 'font-lock) ; needed to get font-lock-value-in-major-mode
(defgroup compilation nil
"Run compiler as inferior of Emacs, parse error messages."
+;; Used for compatibility with the old compile.el.
+(defvar compilation-parsing-end nil)
+(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)
(nthcdr 3 marker)
(cddr marker))
file compilation-error-screen-columns)
- (save-excursion
- (set-buffer (marker-buffer (cddr marker)))
+ (with-current-buffer (marker-buffer (cddr marker))
(save-restriction
(widen)
(goto-char (marker-position (cddr marker)))
(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 (symbolp 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 (list* (match-string ,file)
+ default-directory
+ ',(nthcdr 4 item))
+ ,(if col `(match-string ,col)))))
+ (,file compilation-error-face t))
+
+ `(,(nth 0 item)
+
+ ,@(when (integerp file)
+ `((,file ,(if (consp type)
+ `(compilation-face ',type)
+ (aref [compilation-info-face
+ compilation-warning-face
+ compilation-error-face]
+ (or type 2))))))
+
+ ,@(when line
+ `((,line compilation-line-face nil t)))
+ ,@(when end-line
+ `((,end-line compilation-line-face nil t)))
+
+ ,@(when col
+ `((,col compilation-column-face nil t)))
+ ,@(when end-col
+ `((,end-col compilation-column-face nil t)))
+
+ ,@(nthcdr 6 item)
+ (,(or (nth 5 item) 0)
+ (compilation-error-properties ',file ,line ,end-line
+ ,col ,end-col ',(or type 2)
+ ',fmt)
+ append))))) ; for compilation-message-face
+ compilation-error-regexp-alist)
+
+ compilation-mode-font-lock-keywords)))
\f
;;;###autoload
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)
+ (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))
(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 "\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 [mouse-2] 'compile-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)
(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)
+
+(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)
+
;;;###autoload
(defun compilation-mode ()
"Major mode for compilation log buffers.
(if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
(apply 'compilation-start compilation-arguments))))
-;; This points to the location from where the next error will be found.
-;; The global commands next/previous/first-error... as well as
-;; (mouse-)goto-error use this.
-(defvar compilation-current-error nil)
+(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.")
;; A function name can't be a hook, must be something with a value.
(defconst compilation-turn-on-font-lock 'turn-on-font-lock)
(make-local-variable 'compilation-current-error)
(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)))
+ (if (and minor 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-extra-managed-props)
(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))
+ ;; 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
(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))))
+ (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))
))))
"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)
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)))
+ (if pt ; FIXME: `pt' can never be nil here anyway. --stef
+ (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
+ (line-end-position)))
+ (if pt ; FIXME: `pt' can never be nil here anyway. --stef
(setq msg (get-text-property pt 'message))
(setq pt (point)))))
(setq last (nth 2 (car msg)))
(if (get-buffer-process (current-buffer))
"No more %ss yet"
"Moved past last %s"))
- ;; don't move "back" to message at or before point
- (setq pt (previous-single-property-change pt 'message))
+ ;; 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)
(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)))
- (setq compilation-current-error (point))
- (next-error 0)))
-
-(defun compile-goto-error ()
- "Visit the source for the error message point is on.
+(defalias 'compile-mouse-goto-error 'compile-goto-error)
+
+(defun compile-goto-error (&optional event)
+ "Visit the source for the error message at point.
Use this command in a compilation log buffer. Sets the mark at point there."
- (interactive)
+ (interactive (list last-input-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)))
+ (let ((pos (if event (posn-point (event-end event)) (point))))
+ (if (get-text-property (point) 'directory)
+ (dired-other-window (car (get-text-property pos 'directory)))
+ (push-mark)
+ (setq compilation-current-error pos)
+ (next-error 0))))
;; Return a compilation buffer.
;; If the current buffer is a compilation buffer, return it.
;; 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)))
+ (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#
This operates on the output from the \\[compile] command."
(interactive "p")
(set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
- (setq compilation-current-error (point-min))
+ (setq compilation-current-error nil)
(next-error n))
-(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)
-
-(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
(when (and highlight-regexp
(not (and end-mk transient-mark-mode)))
(unless compilation-highlight-overlay
- (setq compilation-highlight-overlay (make-overlay 1 1))
+ (setq compilation-highlight-overlay
+ (make-overlay (point-min) (point-min)))
(overlay-put compilation-highlight-overlay 'face 'region))
(with-current-buffer (marker-buffer mk)
(save-excursion
(end-of-line)
- (let ((end (point)) olay)
+ (let ((end (point)))
(beginning-of-line)
(if (and (stringp highlight-regexp)
(re-search-forward highlight-regexp end t))
(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)
+ (sit-for 0.5)
(delete-overlay compilation-highlight-overlay)))))))
\f
(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 to new-style MESSAGE.
+ (let* ((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)))))))
+ ;; Must start with a face, for font-lock.
+ `(face nil
+ message ,(list loc 2)
+ help-echo "mouse-2: visit the source location"
+ mouse-face highlight)))
+
+(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)
+
+(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.
+ (set (make-local-variable 'compilation-locs)
+ (make-hash-table :test 'equal :weakness 'value))
+ ;; 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 (point-max))
+ ;; FIXME the old code removed the mouse-face and help-echo properties.
+ ;; Should we font-lock-fontify-buffer? --stef
+ )
+
(provide 'compile)
;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
projects / emacs.git / commitdiff