Function: compilation-error-properties

compilation-error-properties is a byte-compiled function defined in compile.el.gz.

Signature

(compilation-error-properties FILE LINE END-LINE COL END-COL TYPE FMT RULE)

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/compile.el.gz
;; 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)
  (unless (text-property-not-all (match-beginning 0) (point)
                                 'compilation-message nil)
    (if file
        (when (stringp
               (setq file (if (functionp file) (funcall file)
                            (match-string-no-properties file))))
	  (let ((dir
                 (unless (file-name-absolute-p file)
                   (let ((pos (compilation--previous-directory
                               (match-beginning 0))))
                     (when pos
                       (or (get-text-property (1- pos) 'compilation-directory)
                           (get-text-property pos 'compilation-directory)))))))
	    (setq file (cons file (car dir)))))
      ;; This message didn't mention one, get it from previous
      (let ((prev-pos
	     ;; Find the previous message.
	     (previous-single-property-change (point) 'compilation-message)))
	(if prev-pos
	    ;; Get the file structure that belongs to it.
	    (let* ((prev
		    (or (get-text-property (1- prev-pos) 'compilation-message)
			(get-text-property prev-pos 'compilation-message)))
		   (prev-file-struct
		    (and prev
			 (compilation--loc->file-struct
			  (compilation--message->loc prev)))))

	      ;; Construct FILE . DIR from that.
	      (if prev-file-struct
		  (setq file (cons (caar prev-file-struct)
				   (cadr (car prev-file-struct)))))))
	(unless file
	  (setq file '("*unknown*")))))
    ;; All of these fields are optional, get them only if we have an index, and
    ;; it matched some part of the message.
    (setq line
          (if (functionp line) (funcall line)
            (and line
                 (setq line (match-string-no-properties line))
                 (string-to-number line))))
    (setq end-line
          (if (functionp end-line) (funcall end-line)
            (and end-line
                 (setq end-line (match-string-no-properties end-line))
                 (string-to-number end-line))))
    (setq col
          (if (functionp col) (funcall col)
            (and col
                 (setq col (match-string-no-properties col))
                 (string-to-number col))))
    (setq end-col
          (let ((ec (if (functionp end-col)
                        (funcall end-col)
                      (and end-col (match-beginning end-col)
                           (string-to-number
                            (match-string-no-properties end-col))))))
            (if ec
                (1+ ec)     ; Add one to get an exclusive upper bound.
              (and end-line -1))))
    (if (consp type)            ; not a static type, check what it is.
	(setq type (or (and (car type) (match-end (car type)) 1)
		       (and (cdr type) (match-end (cdr type)) 0)
		       2)))
    ;; Remove matches like /bin/sh and do other file name transforms.
    (save-match-data
      (when-let* ((file-name
                   (and (consp file)
                        (not (bufferp (car file)))
                        (if (cdr file)
                            (expand-file-name (car file) (cdr file))
                          (car file)))))
        (cl-loop for (regexp replacement)
                 in compilation-transform-file-match-alist
                 when (string-match regexp file-name)
                 return (if replacement
                            (setq file (list (replace-match replacement nil nil
                                                            file-name)))
                          (setq file nil)))))
    (if (not file)
        ;; If we ignored all the files with errors on this line, then
        ;; return nil.
        nil
      (when (and compilation-auto-jump-to-next
                 (>= type compilation-skip-threshold))
        (kill-local-variable 'compilation-auto-jump-to-next)
        (run-with-timer 0 nil 'compilation-auto-jump
                        (current-buffer) (match-beginning 0)))

      (compilation-internal-error-properties
       file line end-line col end-col type fmt rule))))