;;; compile.el --- run compiler as inferior of Emacs, parse error messages
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2013 Free Software
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2014 Free Software
;; Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
;; Daniel Pfeiffer <occitan@esperanto.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: tools, processes
;; This file is part of GNU Emacs.
;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
(defvar compilation-error-regexp-alist-alist
- '((absoft
+ `((absoft
"^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; can be composed of any non-newline char, but it also rules out some
;; valid but unlikely cases, such as a trailing space or a space
;; followed by a -, or a colon followed by a space.
-
+ ;;
;; The "in \\|from " exception was added to handle messages from Ruby.
- "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
-\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\
-\\([0-9]+\\)\\(?:-\\(?4:[0-9]+\\)\\(?:\\.\\(?5:[0-9]+\\)\\)?\
-\\|[.:]\\(?3:[0-9]+\\)\\(?:-\\(?:\\(?4:[0-9]+\\)\\.\\)?\\(?5:[0-9]+\\)\\)?\\)?:\
-\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
- *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|\\[ skipping .+ \\]\\|\
-\\(?:instantiated\\|required\\) from\\|[Nn]ote\\)\\|\
- *[Ee]rror\\|[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
+ ,(rx
+ bol
+ (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
+ (regexp "[ \t]+\\(?:in \\|from\\)")))
+ (group-n 1 (: (regexp "[0-9]*[^0-9\n]")
+ (*? (| (regexp "[^\n :]")
+ (regexp " [^-/\n]")
+ (regexp ":[^ \n]")))))
+ (regexp ": ?")
+ (group-n 2 (regexp "[0-9]+"))
+ (? (| (: "-"
+ (group-n 4 (regexp "[0-9]+"))
+ (? "." (group-n 5 (regexp "[0-9]+"))))
+ (: (in ".:")
+ (group-n 3 (regexp "[0-9]+"))
+ (? "-"
+ (? (group-n 4 (regexp "[0-9]+")) ".")
+ (group-n 5 (regexp "[0-9]+"))))))
+ ":"
+ (| (: (* " ")
+ (group-n 6 (| "FutureWarning"
+ "RuntimeWarning"
+ "Warning"
+ "warning"
+ "W:")))
+ (: (* " ")
+ (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)")
+ "I:"
+ (: "[ skipping " (+ ".") " ]")
+ "instantiated from"
+ "required from"
+ (regexp "[Nn]ote"))))
+ (: (* " ")
+ (regexp "[Ee]rror"))
+ (: (regexp "[0-9]?")
+ (| (regexp "[^0-9\n]")
+ eol))
+ (regexp "[0-9][0-9][0-9]")))
1 (2 . 4) (3 . 5) (6 . 7))
(lcc
;;
"^\\([^ \t\r\n(]+\\) (\\([0-9]+\\):\\([0-9]+\\)) "
1 2 3)
+ (guile-file "^In \\(.+\\):\n" 1)
+ (guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2)
)
"Alist of values for `compilation-error-regexp-alist'.")
"Directory to restore to when doing `recompile'.")
(defvar compilation-directory-matcher
- '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1))
+ '("\\(?:Entering\\|Leavin\\(g\\)\\) directory [`']\\(.+\\)'$" (2 . 1))
"A list for tracking when directories are entered or left.
If nil, do not track directories, e.g. if all file names are absolute. The
first element is the REGEXP matching these messages. It can match any number
you may also want to change `compilation-page-delimiter'.")
(defvar compilation-page-delimiter
- "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory `.+'\n\\)+"
+ "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory [`'].+'\n\\)+"
"Value of `page-delimiter' in Compilation mode.")
(defvar compilation-mode-font-lock-keywords
(file-exists-p \"Makefile\"))
(set (make-local-variable 'compile-command)
(concat \"make -k \"
- (file-name-sans-extension buffer-file-name))))))"
+ (if buffer-file-name
+ (shell-quote-argument
+ (file-name-sans-extension buffer-file-name))))))))"
:type 'string
:group 'compilation)
;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command))))
(cons (copy-marker pos) (if prev (copy-marker prev))))
prev)
((and prev (= prev cache))
- (if cache
- (set-marker (car compilation--previous-directory-cache) pos)
- (setq compilation--previous-directory-cache
- (cons (copy-marker pos) nil)))
+ (set-marker (car compilation--previous-directory-cache) pos)
(cdr compilation--previous-directory-cache))
(t
- (if cache
- (progn
- (set-marker cache pos)
- (setcdr compilation--previous-directory-cache
- (copy-marker prev)))
- (setq compilation--previous-directory-cache
- (cons (copy-marker pos) (if prev (copy-marker prev)))))
+ (set-marker cache pos)
+ (setcdr compilation--previous-directory-cache
+ (copy-marker prev))
prev))))
(if (markerp res) (marker-position res) res))))
(let ((win (get-buffer-window buffer 0)))
(if win (set-window-point win pos)))
(if compilation-auto-jump-to-first-error
- (compile-goto-error nil t))))
+ (compile-goto-error))))
;; This function is the central driver, called when font-locking to gather
;; all information needed to later jump to corresponding source code.
(eq (car face) 'face)
(or (symbolp (cadr face))
(stringp (cadr face))))
- (put-text-property
- (match-beginning mn) (match-end mn)
- 'font-lock-face (cadr face))
+ (compilation--put-prop mn 'font-lock-face (cadr face))
(add-text-properties
(match-beginning mn) (match-end mn)
(nthcdr 2 face)))
(move-marker compilation--parsed limit)
(goto-char start)
(forward-line 0) ;Not line-beginning-position: ignore (comint) fields.
+ (while (and (not (bobp))
+ (get-text-property (1- (point)) 'compilation-multiline))
+ (forward-line -1))
(with-silent-modifications
(compilation--parse-region (point) compilation--parsed)))))
nil)
`compilation-shell-minor-mode'.
Interactively, prompts for the command if the variable
-`compilation-read-command' is non-nil; otherwise uses`compile-command'.
+`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.
(interactive "P")
(save-some-buffers (not compilation-ask-about-save)
compilation-save-buffers-predicate)
- (let ((default-directory (or compilation-directory default-directory)))
+ (let ((default-directory (or compilation-directory default-directory))
+ (command (eval compile-command)))
(when edit-command
- (setcar compilation-arguments
- (compilation-read-command (car compilation-arguments))))
- (apply 'compilation-start (or compilation-arguments
- `(,(eval compile-command))))))
+ (setq command (compilation-read-command (or (car compilation-arguments)
+ command)))
+ (if compilation-arguments (setcar compilation-arguments command)))
+ (apply 'compilation-start (or compilation-arguments (list command)))))
(defcustom compilation-scroll-output nil
"Non-nil to scroll the *compilation* buffer window as output appears.
"\\\\\\(.\\)" "\\1"
(substring command (1+ (match-beginning 1))
(1- (match-end 1)))))
- (t (substitute-env-vars (match-string 1 command)))))
+ ;; Try globbing as well (bug#15417).
+ (t (let* ((substituted-dir
+ (substitute-env-vars (match-string 1 command)))
+ ;; FIXME: This also tries to expand `*' that were
+ ;; introduced by the envvar expansion!
+ (expanded-dir
+ (file-expand-wildcards substituted-dir)))
+ (if (= (length expanded-dir) 1)
+ (car expanded-dir)
+ substituted-dir)))))
(erase-buffer)
;; Select the desired mode.
(if (not (eq mode t))
(format "%s started at %s\n\n"
mode-name
(substring (current-time-string) 0 19))
- ;; The command could be split into several lines, see
- ;; `rgrep' for example. We want to display it as one
- ;; line.
- (apply 'concat (split-string command (regexp-quote "\\\n") t))
- "\n")
+ command "\n")
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; Pop up the compilation buffer.
;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
- (setq outwin (display-buffer outbuf))
+ (setq outwin (display-buffer outbuf '(nil (allow-no-window . t))))
(with-current-buffer outbuf
(let ((process-environment
(append
(list command mode name-function highlight-regexp))
(set (make-local-variable 'revert-buffer-function)
'compilation-revert-buffer)
- (set-window-start outwin (point-min))
+ (and outwin
+ ;; Forcing the window-start overrides the usual redisplay
+ ;; feature of bringing point into view, so setting the
+ ;; window-start to top of the buffer risks losing the
+ ;; effect of moving point to EOB below, per
+ ;; compilation-scroll-output, if the command is long
+ ;; enough to push point outside of the window. This
+ ;; could happen, e.g., in `rgrep'.
+ (not compilation-scroll-output)
+ (set-window-start outwin (point-min)))
;; Position point as the user will see it.
(let ((desired-visible-point
(point-max)
;; Normally put it at the top.
(point-min))))
- (if (eq outwin (selected-window))
- (goto-char desired-visible-point)
+ (goto-char desired-visible-point)
+ (when (and outwin (not (eq outwin (selected-window))))
(set-window-point outwin desired-visible-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)
+ (and outwin (compilation-set-window-height outwin))
;; Start the compilation.
(if (fboundp 'start-process)
(let ((proc
compilation-page-delimiter)
;; (set (make-local-variable 'compilation-buffer-modtime) nil)
(compilation-setup)
+ ;; Turn off deferred fontifications in the compilation buffer, if
+ ;; the user turned them on globally. This is because idle timers
+ ;; aren't re-run after receiving input from a subprocess, so the
+ ;; buffer is left unfontified after the compilation exits, until
+ ;; some other input event happens.
+ (set (make-local-variable 'jit-lock-defer-time) nil)
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
(if minor
(progn
(font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
- (if font-lock-mode
- (font-lock-fontify-buffer)))
+ (font-lock-flush))
(setq font-lock-defaults '(compilation-mode-font-lock-keywords t))))
(defun compilation--unsetup ()
(remove-hook 'before-change-functions 'compilation--flush-parse t)
(kill-local-variable 'compilation--parsed)
(compilation--remove-properties)
- (if font-lock-mode
- (font-lock-fontify-buffer)))
+ (font-lock-flush))
;;;###autoload
(define-minor-mode compilation-shell-minor-mode
(or (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer"))
(or pt (setq pt (point)))
+ (compilation--ensure-parse pt)
(let* ((msg (get-text-property pt 'compilation-message))
;; `loc', `msg', and `last' are used by the compilation-loop macro.
(loc (and msg (compilation--message->loc msg)))
(line-beginning-position)))
(unless (setq msg (get-text-property (max (1- pt) (point-min))
'compilation-message))
- (setq pt (next-single-property-change pt 'compilation-message nil
+ (setq pt (compilation-next-single-property-change
+ pt 'compilation-message nil
(line-end-position)))
(or (setq msg (get-text-property pt 'compilation-message))
(setq pt (point)))))
"No more %ss yet"
"Moved past last %s")
(point-max))
- (compilation--ensure-parse pt)
;; 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
(defalias 'compile-mouse-goto-error 'compile-goto-error)
-(defun compile-goto-error (&optional event nomsg)
+(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."
+Use this command in a compilation log buffer."
(interactive (list last-input-event))
(if event (posn-set-point (event-end event)))
(or (compilation-buffer-p (current-buffer))
(if (get-text-property (point) 'compilation-directory)
(dired-other-window
(car (get-text-property (point) 'compilation-directory)))
- (push-mark nil nomsg)
(setq compilation-current-error (point))
(next-error-internal)))
All arguments are markers. If END-MK is non-nil, mark is set there
and overlay is highlighted between MK and END-MK."
;; Show compilation buffer in other window, scrolled to this error.
- (let* ((from-compilation-buffer (eq (window-buffer (selected-window))
+ (let* ((from-compilation-buffer (eq (window-buffer)
(marker-buffer msg)))
;; Use an existing window if it is in a visible frame.
(pre-existing (get-buffer-window (marker-buffer msg) 0))
;; the error location if the two buffers are in two
;; different frames. So don't do it if it's not necessary.
pre-existing
- (display-buffer (marker-buffer msg))))
+ (display-buffer (marker-buffer msg) '(nil (allow-no-window . t)))))
(highlight-regexp (with-current-buffer (marker-buffer msg)
;; also do this while we change buffer
- (compilation-set-window w msg)
+ (goto-char (marker-position msg))
+ (and w (compilation-set-window w msg))
compilation-highlight-regexp)))
;; Ideally, the window-size should be passed to `display-buffer'
;; so it's only used when creating a new window.
- (unless pre-existing (compilation-set-window-height w))
+ (when (and (not pre-existing) w)
+ (compilation-set-window-height w))
(if from-compilation-buffer
;; If the compilation buffer window was selected,
(while (null buffer) ;Repeat until the user selects an existing file.
;; The file doesn't exist. Ask the user where to find it.
(save-excursion ;This save-excursion is probably not right.
- (let ((pop-up-windows t))
- (compilation-set-window (display-buffer (marker-buffer marker))
- marker)
+ (let ((w (let ((pop-up-windows t))
+ (display-buffer (marker-buffer marker)
+ '(nil (allow-no-window . t))))))
+ (with-current-buffer (marker-buffer marker)
+ (goto-char marker)
+ (and w (compilation-set-window w marker)))
(let* ((name (read-file-name
(format "Find this %s in (default %s): "
compilation-error filename)