diff options
Diffstat (limited to 'lisp/progmodes/compile.el')
| -rw-r--r-- | lisp/progmodes/compile.el | 113 |
1 files changed, 86 insertions, 27 deletions
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 11902cd469b..11d400e145a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -362,6 +362,28 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (ruby-Test::Unit "^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2) + ;; Tested with Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1. + (lua + ,(rx bol + (+? (not (in "\t\n"))) + ": " + (group (+? (not (in "\t\n")))) + ":" + (group (+ (in "0-9"))) + ": " + (+ nonl) + "\nstack traceback:\n\t") + 1 2 nil 2 1) + (lua-stack + ,(rx bol "\t" + (| "[C]:" + (: (group (+? (not (in "\t\n")))) + ":" + (? (group (+ (in "0-9"))) + ":"))) + " in ") + 1 2 nil 0 1) + (gmake ;; Set GNU make error messages as INFO level. ;; It starts with the name of the make program which is variable, @@ -683,7 +705,10 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" "Alist of values for `compilation-error-regexp-alist'.") (defcustom compilation-error-regexp-alist - (mapcar #'car compilation-error-regexp-alist-alist) + ;; Omit `omake' by default: its mere presence here triggers special processing + ;; and modifies regexps for other rules (see `compilation-parse-errors'), + ;; which may slow down matching (or even cause mismatches). + (delq 'omake (mapcar #'car compilation-error-regexp-alist-alist)) "Alist that specifies how to match errors in compiler output. On GNU and Unix, any string is a valid filename, so these matchers must make some common sense assumptions, which catch @@ -1706,7 +1731,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (set-marker (make-marker) (save-excursion (goto-char (point-min)) - (text-property-search-forward 'compilation-header-end) + (text-property-search-forward 'compilation-annotation) ;; If we have no end marker, this will be ;; `point-min' still. (point))))) @@ -1854,6 +1879,23 @@ If nil, don't hide anything." ;; buffers when it changes from nil to non-nil or vice-versa. (unless compilation-in-progress (force-mode-line-update t))) +(defun compilation-insert-annotation (&rest args) + "Insert ARGS at point, adding the `compilation-annotation' text property. +This property is used to distinguish output of the compilation +process from additional information inserted by Emacs." + (let ((start (point))) + (apply #'insert args) + (put-text-property start (point) 'compilation-annotation t))) + +(defvar-local compilation--start-time nil + "The time when the compilation started as returned by `float-time'.") + +(defun compilation--downcase-mode-name (mode) + "Downcase the name of major MODE, even if MODE is not a string. +The function `downcase' will barf if passed the name of a `major-mode' +which is not a string, but instead a symbol or a list." + (downcase (format-mode-line mode))) + ;;;###autoload (defun compilation-start (command &optional mode name-function highlight-regexp continue) @@ -1975,17 +2017,17 @@ Returns the compilation buffer created." (setq-local compilation-auto-jump-to-next t)) (when (zerop (buffer-size)) ;; Output a mode setter, for saving and later reloading this buffer. - (insert "-*- mode: " name-of-mode - "; default-directory: " - (prin1-to-string (abbreviate-file-name default-directory)) - " -*-\n")) - (insert (format "%s started at %s\n\n" - mode-name - (substring (current-time-string) 0 19)) - command "\n") - ;; Mark the end of the header so that we don't interpret - ;; anything in it as an error. - (put-text-property (1- (point)) (point) 'compilation-header-end t) + (compilation-insert-annotation + "-*- mode: " name-of-mode + "; default-directory: " + (prin1-to-string (abbreviate-file-name default-directory)) + " -*-\n")) + (compilation-insert-annotation + (format "%s started at %s\n\n" + mode-name + (substring (current-time-string) 0 19)) + command "\n") + (setq compilation--start-time (float-time)) (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; Pop up the compilation buffer. @@ -2045,11 +2087,12 @@ Returns the compilation buffer created." (get-buffer-process (with-no-warnings (comint-exec - outbuf (downcase mode-name) + outbuf (compilation--downcase-mode-name mode-name) shell-file-name nil `(,shell-command-switch ,command))))) - (start-file-process-shell-command (downcase mode-name) - outbuf command)))) + (start-file-process-shell-command + (compilation--downcase-mode-name mode-name) + outbuf command)))) ;; Make the buffer's mode line show process state. (setq mode-line-process '((:propertize ":%s" face compilation-mode-line-run) @@ -2467,13 +2510,20 @@ commands of Compilation major mode are available. See (cur-buffer (current-buffer))) ;; Record where we put the message, so we can ignore it later on. (goto-char omax) - (insert ?\n mode-name " " (car status)) + (compilation-insert-annotation ?\n mode-name " " (car status)) (if (and (numberp compilation-window-height) (zerop compilation-window-height)) (message "%s" (cdr status))) (if (bolp) (forward-char -1)) - (insert " at " (substring (current-time-string) 0 19)) + (compilation-insert-annotation + " at " + (substring (current-time-string) 0 19) + ", duration " + (let ((elapsed (- (float-time) compilation--start-time))) + (cond ((< elapsed 10) (format "%.2f s" elapsed)) + ((< elapsed 60) (format "%.1f s" elapsed)) + (t (format-seconds "%h:%02m:%02s" elapsed))))) (goto-char (point-max)) ;; Prevent that message from being recognized as a compilation error. (add-text-properties omax (point) @@ -2703,7 +2753,7 @@ looking for the next message." (compilation-loop > compilation-next-single-property-change 1- (if (get-buffer-process (current-buffer)) "No more %ss yet" - "Moved past last %s") + "Past last %s") (point-max)) ;; Don't move "back" to message at or before point. ;; Pass an explicit (point-min) to make sure pt is non-nil. @@ -2747,7 +2797,8 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." (let ((buffer (compilation-find-buffer))) (if (get-buffer-process buffer) (interrupt-process (get-buffer-process buffer)) - (error "The %s process is not running" (downcase mode-name))))) + (error "The %s process is not running" + (compilation--downcase-mode-name mode-name))))) (defalias 'compile-mouse-goto-error 'compile-goto-error) @@ -3101,7 +3152,16 @@ and overlay is highlighted between MK and END-MK." (cancel-timer next-error-highlight-timer)) (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) - + +(defun compilation--expand-fn (directory filename) + "Expand FILENAME or resolve its true name. +Unlike `expand-file-name', `file-truename' follows symlinks, which +we try to avoid if possible." + (let* ((expandedname (expand-file-name filename directory))) + (if (file-exists-p expandedname) + expandedname + (file-truename (file-name-concat directory filename))))) + (defun compilation-find-file-1 (marker filename directory &optional formats) (or formats (setq formats '("%s"))) (let ((dirs compilation-search-path) @@ -3122,8 +3182,8 @@ and overlay is highlighted between MK and END-MK." fmts formats) ;; For each directory, try each format string. (while (and fmts (null buffer)) - (setq name (file-truename - (file-name-concat thisdir (format (car fmts) filename))) + (setq name (compilation--expand-fn thisdir + (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3145,8 +3205,8 @@ and overlay is highlighted between MK and END-MK." (setq thisdir (car dirs) fmts formats) (while (and fmts (null buffer)) - (setq name (file-truename - (file-name-concat thisdir (format (car fmts) filename))) + (setq name (compilation--expand-fn thisdir + (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3206,8 +3266,7 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (ding) (sit-for 2)) ((and (file-directory-p name) (not (file-exists-p - (setq name (file-truename - (file-name-concat name filename)))))) + (setq name (compilation--expand-fn name filename))))) (message "No `%s' in directory %s" filename origname) (ding) (sit-for 2)) (t |