diff options
Diffstat (limited to 'lisp/progmodes/compile.el')
| -rw-r--r-- | lisp/progmodes/compile.el | 323 |
1 files changed, 236 insertions, 87 deletions
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 7d4a8ffc6fc..9f33186d8b1 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -82,6 +82,25 @@ after `call-process' inserts the grep output into the buffer.") "Position of the start of the text inserted by `compilation-filter'. This is bound before running `compilation-filter-hook'.") +(defcustom compilation-hidden-output nil + "Regexp to match output from the compilation that should be hidden. +This can also be a list of regexps. + +The text matched by this variable will be made invisible, which +means that it'll still be present in the buffer, so that +navigation commands (for instance, `next-error') can still make +use of the hidden text to determine the current directory and the +like. + +For instance, to hide the verbose output from recursive +makefiles, you can say something like: + + (setq compilation-hidden-output + \\='(\"^make[^\n]+\n\"))" + :type '(choice regexp + (repeat regexp)) + :version "29.1") + (defvar compilation-first-column 1 "This is how compilers number the first column, usually 1 or 0. If this is buffer-local in the destination buffer, Emacs obeys @@ -257,7 +276,16 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) "): ") 3 4 5 (1 . 2)) - (iar + (gradle-android + ,(rx bol (* " ") "ERROR:" + (group-n 1 ; file + (+ (not (in ":\n")))) + ":" + (group-n 2 (+ digit)) ; line + ": ") + 1 2) + + (iar "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" 1 2 nil (3)) @@ -340,69 +368,73 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1) (gnu + ;; The `gnu' message syntax is + ;; [PROGRAM:]FILE:LINE[-ENDLINE]:[COL[-ENDCOL]:] MESSAGE + ;; or + ;; [PROGRAM:]FILE:LINE[.COL][-ENDLINE[.ENDCOL]]: MESSAGE ,(rx bol - ;; Match an optional program name in the format - ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE - ;; which is used for non-interactive programs other than - ;; compilers (e.g. the "jade:" entry in compilation.txt). - (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?") - ;; FIXME: This pattern was added for handling messages - ;; from Ruby, but it is unclear whether it is actually - ;; used since the gcc-include rule above seems to cover - ;; it. - (regexp "[ \t]+\\(?:in \\|from\\)"))) + ;; Match an optional program name which is used for + ;; non-interactive programs other than compilers (e.g. the + ;; "jade:" entry in compilation.txt). + (? (| (: alpha (+ (in ?. ?- alnum)) ":" (? " ")) + ;; Skip indentation generated by GCC's -fanalyzer. + (: (+ " ") "|"))) ;; File name group. (group-n 1 - ;; Avoid matching the file name as a program in the pattern - ;; above by disallow file names entirely composed of digits. - (: (regexp "[0-9]*[^0-9\n]") - ;; This rule says that a file name 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. - (*? (| (regexp "[^\n :]") - (regexp " [^-/\n]") - (regexp ":[^ \n]"))))) - (regexp ": ?") + ;; Avoid matching the file name as a program in the pattern + ;; above by disallowing file names entirely composed of digits. + ;; Do not allow file names beginning with a space. + (| (not (in "0-9" "\n\t ")) + (: (+ (in "0-9")) + (not (in "0-9" "\n")))) + ;; A file name can be composed of any non-newline char, but + ;; rule out some valid but unlikely cases, such as a trailing + ;; space or a space followed by a -, or a colon followed by a + ;; space. + (*? (| (not (in "\n :")) + (: " " (not (in ?- "/\n"))) + (: ":" (not (in " \n")))))) + ":" (? " ") ;; Line number group. - (group-n 2 (regexp "[0-9]+")) + (group-n 2 (+ (in "0-9"))) (? (| (: "-" - (group-n 4 (regexp "[0-9]+")) ; ending line - (? "." (group-n 5 (regexp "[0-9]+")))) ; ending column + (group-n 4 (+ (in "0-9"))) ; ending line + (? "." (group-n 5 (+ (in "0-9"))))) ; ending column (: (in ".:") - (group-n 3 (regexp "[0-9]+")) ; starting column + (group-n 3 (+ (in "0-9"))) ; starting column (? "-" - (? (group-n 4 (regexp "[0-9]+")) ".") ; ending line - (group-n 5 (regexp "[0-9]+")))))) ; ending column + (? (group-n 4 (+ (in "0-9"))) ".") ; ending line + (group-n 5 (+ (in "0-9"))))))) ; ending column ":" (| (: (* " ") (group-n 6 (| "FutureWarning" "RuntimeWarning" - "Warning" - "warning" + "Warning" "warning" "W:"))) (: (* " ") - (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)") - "I:" - (: "[ skipping " (+ nonl) " ]") - "instantiated from" - "required from" - (regexp "[Nn]ote")))) + (group-n 7 + (| (| "Info" "info" + "Information" "information" + "Informational" "informational" + "I:" + "instantiated from" + "required from" + "Note" "note") + (: "[ skipping " (+ nonl) " ]")))) (: (* " ") - (regexp "[Ee]rror")) + (| "Error" "error")) ;; Avoid matching time stamps on the form "HH:MM:SS" where ;; MM is interpreted as a line number by trying to rule out ;; messages where the text after the line number starts with ;; a 2-digit number. - (: (regexp "[0-9]?") - (| (regexp "[^0-9\n]") + (: (? (in "0-9")) + (| (not (in "0-9\n")) eol)) - (regexp "[0-9][0-9][0-9]"))) + (: (in "0-9") (in "0-9") (in "0-9")))) 1 (2 . 4) (3 . 5) (6 . 7)) (cucumber @@ -954,7 +986,10 @@ Faces `compilation-error-face', `compilation-warning-face', (defcustom compilation-auto-jump-to-first-error nil "If non-nil, automatically jump to the first error during compilation." - :type 'boolean + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "If location known" if-location-known) + (const :tag "First known location" first-known)) :version "23.1") (defvar-local compilation-auto-jump-to-next nil @@ -1185,21 +1220,46 @@ POS and RES.") l2 (setcdr l1 (cons (list ,key) l2))))))) +(defun compilation--file-known-p () + "Say whether the file under point can be found." + (when-let* ((msg (get-text-property (point) 'compilation-message)) + (loc (compilation--message->loc msg)) + (elem (compilation-find-file-1 + (point-marker) + (caar (compilation--loc->file-struct loc)) + (cadr (car (compilation--loc->file-struct loc))) + (compilation--file-struct->formats + (compilation--loc->file-struct loc))))) + (car elem))) + (defun compilation-auto-jump (buffer pos) (when (buffer-live-p buffer) (with-current-buffer buffer (goto-char pos) (let ((win (get-buffer-window buffer 0))) (if win (set-window-point win pos))) - (if compilation-auto-jump-to-first-error - (compile-goto-error))))) + (when compilation-auto-jump-to-first-error + (cl-case compilation-auto-jump-to-first-error + ('if-location-known + (when (compilation--file-known-p) + (compile-goto-error))) + ('first-known + (let (match) + (while (and (not (compilation--file-known-p)) + (setq match (text-property-search-forward + 'compilation-message nil nil t))) + (goto-char (prop-match-beginning match)))) + (when (compilation--file-known-p) + (compile-goto-error))) + (otherwise + (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. ;; Return a property list with all meta information on this error location. (defun compilation-error-properties (file line end-line col end-col type fmt - rule) + rule) (unless (text-property-not-all (match-beginning 0) (point) 'compilation-message nil) (if file @@ -1523,7 +1583,8 @@ to `compilation-error-regexp-alist' if RULES is nil." ;; FIXME-omake: Doing it here seems wrong, at least it should depend on ;; whether or not omake's own error messages are recognized. (cond - ((not omake-included) nil) + ((or (not omake-included) (not pat)) + nil) ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) nil) ;; Not anchored or anchored but already allows empty spaces. (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) @@ -1542,7 +1603,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (error "HYPERLINK should be an integer: %s" (nth 5 item))) (goto-char start) - (while (re-search-forward pat end t) + (while (and pat (re-search-forward pat end t)) (when (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule)) @@ -1755,13 +1816,21 @@ If nil, ask to kill it." :type 'boolean :version "24.3") +(defcustom compilation-max-output-line-length 400 + "Output lines that are longer than this value will be hidden. +If nil, don't hide anything." + :type '(choice (const :tag "Hide nothing" nil) + integer) + :version "29.1") + (defun compilation--update-in-progress-mode-line () ;; `compilation-in-progress' affects the mode-line of all ;; buffers when it changes from nil to non-nil or vice-versa. (unless compilation-in-progress (force-mode-line-update t))) ;;;###autoload -(defun compilation-start (command &optional mode name-function highlight-regexp) +(defun compilation-start (command &optional mode name-function highlight-regexp + continue) "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. @@ -1778,6 +1847,12 @@ If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight the matching section of the visited source line; the default is to use the global value of `compilation-highlight-regexp'. +If CONTINUE is non-nil, the buffer won't be emptied before +compilation is started. This can be useful if you wish to +combine the output from several compilation commands in the same +buffer. The new output will be at the end of the buffer, and +point is not changed. + Returns the compilation buffer created." (or mode (setq mode 'compilation-mode)) (let* ((name-of-mode @@ -1841,7 +1916,12 @@ Returns the compilation buffer created." (if (= (length expanded-dir) 1) (car expanded-dir) substituted-dir))))) - (erase-buffer) + (if continue + (progn + ;; Save the point so we can restore it. + (setq continue (point)) + (goto-char (point-max))) + (erase-buffer)) ;; Select the desired mode. (if (not (eq mode t)) (progn @@ -1867,12 +1947,13 @@ Returns the compilation buffer created." (if (or compilation-auto-jump-to-first-error (eq compilation-scroll-output 'first-error)) (setq-local compilation-auto-jump-to-next t)) - ;; 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" - (format "%s started at %s\n\n" + (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") @@ -1891,28 +1972,33 @@ Returns the compilation buffer created." (and (derived-mode-p 'comint-mode) (comint-term-environment)) (list (format "INSIDE_EMACS=%s,compile" emacs-version)) + ;; Some external programs (like "git grep") use a pager; + ;; defeat that. + (list "PAGER=") (copy-sequence process-environment)))) (setq-local compilation-arguments (list command mode name-function highlight-regexp)) (setq-local revert-buffer-function 'compilation-revert-buffer) - (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))) + (when (and outwin + (not continue) + ;; 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 - ;; Put it at the end if `compilation-scroll-output' is set. - (if compilation-scroll-output - (point-max) - ;; Normally put it at the top. - (point-min)))) + (cond + (continue continue) + ;; Put it at the end if `compilation-scroll-output' is set. + (compilation-scroll-output (point-max)) + ;; Normally put it at the top. + (t (point-min))))) (goto-char desired-visible-point) (when (and outwin (not (eq outwin (selected-window)))) (set-window-point outwin desired-visible-point))) @@ -2228,6 +2314,7 @@ The parent is always `compilation-mode' and the customizable `compilation-...' variables are also set from the name of the mode you have chosen, by replacing the first word, e.g., `compilation-scroll-output' from `grep-scroll-output' if that variable exists." + (declare (indent defun)) (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode)))) `(define-derived-mode ,mode compilation-mode ,name ,doc @@ -2407,8 +2494,8 @@ commands of Compilation major mode are available. See (defun compilation-filter (proc string) "Process filter for compilation buffers. -Just inserts the text, -handles carriage motion (see `comint-inhibit-carriage-motion'), +Just inserts the text, handles carriage motion (see +`comint-inhibit-carriage-motion'), `compilation-hidden-output', and runs `compilation-filter-hook'." (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) @@ -2428,13 +2515,18 @@ and runs `compilation-filter-hook'." ;; We used to use `insert-before-markers', so that windows with ;; point at `process-mark' scroll along with the output, but we ;; now use window-point-insertion-type instead. - (insert string) + (if (not compilation-max-output-line-length) + (insert string) + (dolist (line (string-lines string nil t)) + (compilation--insert-abbreviated-line + line compilation-max-output-line-length))) + (when compilation-hidden-output + (compilation--hide-output compilation-filter-start)) (unless comint-inhibit-carriage-motion (comint-carriage-motion (process-mark proc) (point))) (set-marker (process-mark proc) (point)) ;; Update the number of errors in compilation-mode-line-errors (compilation--ensure-parse (point)) - ;; (setq-local compilation-buffer-modtime (current-time)) (run-hooks 'compilation-filter-hook)) (goto-char pos) (narrow-to-region min max) @@ -2442,6 +2534,58 @@ and runs `compilation-filter-hook'." (set-marker min nil) (set-marker max nil)))))) +(defun compilation--hide-output (start) + (save-excursion + (goto-char start) + (beginning-of-line) + ;; Apply the match to each line, but wait until we have a complete + ;; line. + (let ((start (point))) + (while (search-forward "\n" nil t) + (save-restriction + (narrow-to-region start (point)) + (dolist (regexp (ensure-list compilation-hidden-output)) + (goto-char start) + (while (re-search-forward regexp nil t) + (add-text-properties (match-beginning 0) (match-end 0) + '( invisible t + rear-nonsticky t)))) + (goto-char (point-max))))))) + +(defun compilation--insert-abbreviated-line (string width) + (if (and (> (current-column) 0) + (get-text-property (1- (point)) 'button)) + ;; We already have an abbreviation; just add the string to it. + (let ((beg (point))) + (insert string) + (add-text-properties + beg + ;; Don't make the final newline invisible. + (if (= (aref string (1- (length string))) ?\n) + (1- (point)) + (point)) + (text-properties-at (1- beg)))) + (insert string) + ;; If we exceeded the limit, hide the last portion of the line. + (when (> (current-column) width) + (let ((start (save-excursion + (move-to-column width) + (point)))) + (buttonize-region + start (point) + (lambda (start) + (let ((inhibit-read-only t)) + (remove-text-properties start (save-excursion + (goto-char start) + (line-end-position)) + (text-properties-at start))))) + (put-text-property + start (if (= (aref string (1- (length string))) ?\n) + ;; Don't hide the final newline. + (1- (point)) + (point)) + 'display (if (char-displayable-p ?…) "[…]" "[...]")))))) + (defsubst compilation-buffer-internal-p () "Test if inside a compilation buffer." (local-variable-p 'compilation-locs)) @@ -2931,19 +3075,7 @@ and overlay is highlighted between MK and END-MK." (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) -(defun compilation-find-file (marker filename directory &rest formats) - "Find a buffer for file FILENAME. -If FILENAME is not found at all, ask the user where to find it. -Pop up the buffer containing MARKER and scroll to MARKER if we ask -the user where to find the file. -Search the directories in `compilation-search-path'. -A nil in `compilation-search-path' means to try the -\"current\" directory, which is passed in DIRECTORY. -If DIRECTORY is relative, it is combined with `default-directory'. -If DIRECTORY is nil, that means use `default-directory'. -FORMATS, if given, is a list of formats to reformat FILENAME when -looking for it: for each element FMT in FORMATS, this function -attempts to find a file whose name is produced by (format FMT FILENAME)." +(defun compilation-find-file-1 (marker filename directory &optional formats) (or formats (setq formats '("%s"))) (let ((dirs compilation-search-path) (spec-dir (if directory @@ -2992,6 +3124,23 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (find-file-noselect name)) fmts (cdr fmts))) (setq dirs (cdr dirs)))) + (list buffer spec-dir))) + +(defun compilation-find-file (marker filename directory &rest formats) + "Find a buffer for file FILENAME. +If FILENAME is not found at all, ask the user where to find it. +Pop up the buffer containing MARKER and scroll to MARKER if we ask +the user where to find the file. +Search the directories in `compilation-search-path'. +A nil in `compilation-search-path' means to try the +\"current\" directory, which is passed in DIRECTORY. +If DIRECTORY is relative, it is combined with `default-directory'. +If DIRECTORY is nil, that means use `default-directory'. +FORMATS, if given, is a list of formats to reformat FILENAME when +looking for it: for each element FMT in FORMATS, this function +attempts to find a file whose name is produced by (format FMT FILENAME)." + (pcase-let ((`(,buffer ,spec-dir) + (compilation-find-file-1 marker filename directory formats))) (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. |