Commit 3062f81d authored by Stefan Monnier's avatar Stefan Monnier

* lisp/progmodes/compile.el: Allow 'line' functions in error-regexp-alist

(compilation-error-properties): Allow 'line' and 'end-line' to be functions,
like 'col' and 'end-col'.
(compilation-error-regexp-alist): Document this.
(compilation-parse-errors): Drop support for old undocumented feature
where 'line' was a function of 2 arguments.
(compilation--compat-error-properties): Delete function.
parent 39c0795e
Pipeline #1146 failed with stage
in 53 minutes
...@@ -385,6 +385,10 @@ current and the previous or the next line, as before. ...@@ -385,6 +385,10 @@ current and the previous or the next line, as before.
* Changes in Specialized Modes and Packages in Emacs 27.1 * Changes in Specialized Modes and Packages in Emacs 27.1
** compile.el
---
*** In compilation-error-regexp-alist, 'line' (and 'end-line') can be functions
** cl-lib ** cl-lib
+++ +++
*** cl-defstruct has a new :noinline argument to prevent inlining its functions *** cl-defstruct has a new :noinline argument to prevent inlining its functions
...@@ -1272,6 +1276,9 @@ documentation of the new mode and its commands. ...@@ -1272,6 +1276,9 @@ documentation of the new mode and its commands.
* Incompatible Lisp Changes in Emacs 27.1 * Incompatible Lisp Changes in Emacs 27.1
** In compilation-error-regexp-alist the old undocumented feature where 'line'
could be a function of 2 arguments has been dropped.
** 'define-fringe-bitmap' is always defined, even when Emacs is built ** 'define-fringe-bitmap' is always defined, even when Emacs is built
without any GUI support. without any GUI support.
......
...@@ -558,7 +558,11 @@ of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) ...@@ -558,7 +558,11 @@ of lines. COLUMN can also be of the form (COLUMN . END-COLUMN)
meaning a range of columns starting on LINE and ending on meaning a range of columns starting on LINE and ending on
END-LINE, if that matched. END-LINE, if that matched.
TYPE is 2 or nil for a real error or 1 for warning or 0 for info. LINE, END-LINE, COL, and END-COL can also be functions of no argument
that return the corresponding line or column number. They can assume REGEXP
has just been matched, and should correspondingly preserve this match data.
f/usr/shaTYPE is 2 or nil for a real error or 1 for warning or 0 for info.
TYPE can also be of the form (WARNING . INFO). In that case this TYPE can also be of the form (WARNING . INFO). In that case this
will be equivalent to 1 if the WARNING'th subexpression matched will be equivalent to 1 if the WARNING'th subexpression matched
or else equivalent to 0 if the INFO'th subexpression matched. or else equivalent to 0 if the INFO'th subexpression matched.
...@@ -1105,23 +1109,27 @@ POS and RES.") ...@@ -1105,23 +1109,27 @@ POS and RES.")
(setq file '("*unknown*"))))) (setq file '("*unknown*")))))
;; All of these fields are optional, get them only if we have an index, and ;; All of these fields are optional, get them only if we have an index, and
;; it matched some part of the message. ;; it matched some part of the message.
(and line (setq line
(setq line (match-string-no-properties line)) (if (functionp line) (funcall line)
(setq line (string-to-number line))) (and line
(and end-line (setq line (match-string-no-properties line))
(setq end-line (match-string-no-properties end-line)) (string-to-number line))))
(setq end-line (string-to-number end-line))) (setq end-line
(if col (if (functionp end-line) (funcall end-line)
(if (functionp col) (and end-line
(setq col (funcall col)) (setq end-line (match-string-no-properties end-line))
(and (string-to-number end-line))))
(setq col (match-string-no-properties col)) (setq col
(setq col (string-to-number col))))) (if (functionp col) (funcall col)
(if (and end-col (functionp end-col)) (and col
(setq end-col (funcall end-col)) (setq col (match-string-no-properties col))
(if (and end-col (setq end-col (match-string-no-properties end-col))) (string-to-number col))))
(setq end-col (- (string-to-number end-col) -1)) (setq end-col
(if end-line (setq end-col -1)))) (or (if (functionp end-col) (funcall end-col)
(and end-col
(setq end-col (match-string-no-properties end-col))
(- (string-to-number end-col) -1)))
(and end-line -1)))
(if (consp type) ; not a static type, check what it is. (if (consp type) ; not a static type, check what it is.
(setq type (or (and (car type) (match-end (car type)) 1) (setq type (or (and (car type) (match-end (car type)) 1)
(and (cdr type) (match-end (cdr type)) 0) (and (cdr type) (match-end (cdr type)) 0)
...@@ -1222,12 +1230,12 @@ FMTS is a list of format specs for transforming the file name. ...@@ -1222,12 +1230,12 @@ FMTS is a list of format specs for transforming the file name.
(setq loc (compilation-assq line (compilation--file-struct->loc-tree (setq loc (compilation-assq line (compilation--file-struct->loc-tree
file-struct))) file-struct)))
(setq end-loc (setq end-loc
(if end-line (if end-line
(compilation-assq (compilation-assq
end-col (compilation-assq end-col (compilation-assq
end-line (compilation--file-struct->loc-tree end-line (compilation--file-struct->loc-tree
file-struct))) file-struct)))
(if end-col ; use same line element (if end-col ; use same line element
(compilation-assq end-col loc)))) (compilation-assq end-col loc))))
(setq loc (compilation-assq col loc)) (setq loc (compilation-assq col loc))
;; If they are new, make the loc(s) reference the file they point to. ;; If they are new, make the loc(s) reference the file they point to.
...@@ -1370,92 +1378,70 @@ to `compilation-error-regexp-alist' if RULES is nil." ...@@ -1370,92 +1378,70 @@ to `compilation-error-regexp-alist' if RULES is nil."
(if (consp line) (setq end-line (cdr line) line (car line))) (if (consp line) (setq end-line (cdr line) line (car line)))
(if (consp col) (setq end-col (cdr col) col (car col))) (if (consp col) (setq end-col (cdr col) col (car col)))
(if (functionp line) (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
;; The old compile.el had here an undocumented hook that (error "HYPERLINK should be an integer: %s" (nth 5 item)))
;; allowed `line' to be a function that computed the actual
;; error location. Let's do our best.
(progn
(goto-char start)
(while (re-search-forward pat end t)
(save-match-data
(when compilation-debug
(font-lock-append-text-property
(match-beginning 0) (match-end 0)
'compilation-debug (vector 'functionp item)))
(add-text-properties
(match-beginning 0) (match-end 0)
(compilation--compat-error-properties
(funcall line (cons (match-string file)
(cons default-directory
(nthcdr 4 item)))
(if col (match-string col))))))
(compilation--put-prop
file 'font-lock-face compilation-error-face)))
(unless (or (null (nth 5 item)) (integerp (nth 5 item))) (goto-char start)
(error "HYPERLINK should be an integer: %s" (nth 5 item))) (while (re-search-forward pat end t)
(when (setq props (compilation-error-properties
file line end-line col end-col (or type 2) fmt))
(goto-char start) (when (integerp file)
(while (re-search-forward pat end t) (let ((this-type (if (consp type)
(when (setq props (compilation-error-properties (compilation-type type)
file line end-line col end-col (or type 2) fmt)) (or type 2))))
(compilation--note-type this-type)
(when (integerp file)
(let ((this-type (if (consp type) (compilation--put-prop
(compilation-type type) file 'font-lock-face
(or type 2)))) (symbol-value (aref [compilation-info-face
(compilation--note-type this-type) compilation-warning-face
compilation-error-face]
(compilation--put-prop this-type)))))
file 'font-lock-face
(symbol-value (aref [compilation-info-face (compilation--put-prop
compilation-warning-face line 'font-lock-face compilation-line-face)
compilation-error-face] (compilation--put-prop
this-type))))) end-line 'font-lock-face compilation-line-face)
(compilation--put-prop (compilation--put-prop
line 'font-lock-face compilation-line-face) col 'font-lock-face compilation-column-face)
(compilation--put-prop (compilation--put-prop
end-line 'font-lock-face compilation-line-face) end-col 'font-lock-face compilation-column-face)
(compilation--put-prop ;; Obey HIGHLIGHT.
col 'font-lock-face compilation-column-face) (dolist (extra-item (nthcdr 6 item))
(compilation--put-prop (let ((mn (pop extra-item)))
end-col 'font-lock-face compilation-column-face) (when (match-beginning mn)
(let ((face (eval (car extra-item))))
;; Obey HIGHLIGHT. (cond
(dolist (extra-item (nthcdr 6 item)) ((null face))
(let ((mn (pop extra-item))) ((or (symbolp face) (stringp face))
(when (match-beginning mn) (put-text-property
(let ((face (eval (car extra-item)))) (match-beginning mn) (match-end mn)
(cond 'font-lock-face face))
((null face)) ((and (listp face)
((or (symbolp face) (stringp face)) (eq (car face) 'face)
(put-text-property (or (symbolp (cadr face))
(match-beginning mn) (match-end mn) (stringp (cadr face))))
'font-lock-face face)) (compilation--put-prop mn 'font-lock-face (cadr face))
((and (listp face) (add-text-properties
(eq (car face) 'face) (match-beginning mn) (match-end mn)
(or (symbolp (cadr face)) (nthcdr 2 face)))
(stringp (cadr face)))) (t
(compilation--put-prop mn 'font-lock-face (cadr face)) (error "Don't know how to handle face %S"
(add-text-properties face)))))))
(match-beginning mn) (match-end mn) (let ((mn (or (nth 5 item) 0)))
(nthcdr 2 face))) (when compilation-debug
(t
(error "Don't know how to handle face %S"
face)))))))
(let ((mn (or (nth 5 item) 0)))
(when compilation-debug
(font-lock-append-text-property
(match-beginning 0) (match-end 0)
'compilation-debug (vector 'std item props)))
(add-text-properties
(match-beginning mn) (match-end mn)
(cddr props))
(font-lock-append-text-property (font-lock-append-text-property
(match-beginning mn) (match-end mn) (match-beginning 0) (match-end 0)
'font-lock-face (cadr props))))))))) 'compilation-debug (vector 'std item props)))
(add-text-properties
(match-beginning mn) (match-end mn)
(cddr props))
(font-lock-append-text-property
(match-beginning mn) (match-end mn)
'font-lock-face (cadr props))))))))
(defvar compilation--parsed -1) (defvar compilation--parsed -1)
(make-variable-buffer-local 'compilation--parsed) (make-variable-buffer-local 'compilation--parsed)
...@@ -2837,29 +2823,6 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given." ...@@ -2837,29 +2823,6 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
(defvar compilation-error-list nil) (defvar compilation-error-list nil)
(defvar compilation-old-error-list nil) (defvar compilation-old-error-list nil)
(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)
`(compilation-message ,(compilation--make-message
(cons nil (compilation--make-cdrloc
nil nil dst))
2 nil)
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) (defun compilation--compat-parse-errors (limit)
(when compilation-parse-errors-function (when compilation-parse-errors-function
;; FIXME: We should remove the rest of the compilation keywords ;; FIXME: We should remove the rest of the compilation keywords
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment