- ;; Get first already existing marker (if any has one, all have one).
- ;; Do this first, as the compilation-assq`s may create new nodes.
- (let* ((marker-line (car (cddr file))) ; a line structure
- (marker (nth 3 (cadr marker-line))) ; its marker
- (compilation-error-screen-columns compilation-error-screen-columns)
- end-marker loc end-loc)
- (if (not (and marker (marker-buffer marker)))
- (setq marker) ; no valid marker for this file
- (setq loc (or line 1) ; normalize no linenumber to line 1
- marker-line)
- (catch 'marker ; find nearest loc, at least one exists
- (dolist (x (cddr file)) ; loop over lines
- (if (> (or (car x) 1) loc) ; still bigger
- (setq marker-line x)
- (if (or (not marker-line) ; first in list
- (> (- (or (car marker-line) 1) loc)
- (- loc (or (car x) 1)))) ; current line is nearer
- (setq marker-line x))
- (throw 'marker t))))
- (setq marker (nth 3 (cadr marker-line))
- marker-line (car marker-line))
- (with-current-buffer (marker-buffer marker)
- (save-restriction
- (widen)
- (goto-char (marker-position marker))
- (when (or end-col end-line)
- (beginning-of-line (- (or end-line line) marker-line -1))
- (if (< end-col 0)
- (end-of-line)
- (if compilation-error-screen-columns
- (move-to-column end-col)
- (forward-char end-col)))
- (setq end-marker (list (point-marker))))
- (beginning-of-line (if end-line
- (- end-line line -1)
- (- loc marker-line -1)))
- (if col
- (if compilation-error-screen-columns
- (move-to-column col)
- (forward-char col))
- (forward-to-indentation 0))
- (setq marker (list (point-marker))))))
-
- (setq loc (compilation-assq line (cdr file)))
- (if end-line
- (setq end-loc (compilation-assq end-line (cdr file))
- end-loc (compilation-assq end-col end-loc))
- (if end-col ; use same line element
- (setq end-loc (compilation-assq end-col loc))))
- (setq loc (compilation-assq col loc))
- ;; If they are new, make the loc(s) reference the file they point to.
- (or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
- (if end-loc
- (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
-
- ;; Must start with face
- `(face ,compilation-message-face
- message (,loc ,type ,end-loc)
- ,@(if compilation-debug
- `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
- ,@(match-data))))
- help-echo ,(if col
- "mouse-2: visit this file, line and column"
- (if line
- "mouse-2: visit this file and line"
- "mouse-2: visit this file"))
- keymap compilation-button-map
- mouse-face highlight))))
+ (compilation-internal-error-properties file line end-line col end-col type fmt)))
+
+(defun compilation-internal-error-properties (file line end-line col end-col type fmt)
+ "Get the meta-info that will be added as text-properties.
+LINE, END-LINE, COL, END-COL are integers or nil.
+TYPE can be 0, 1, or 2.
+FILE should be (FILENAME . DIRNAME) or nil."
+ (unless file (setq file '("*unknown*")))
+ (setq file (or (gethash file compilation-locs)
+ (puthash file (list file fmt) compilation-locs)))
+ ;; Get first already existing marker (if any has one, all have one).
+ ;; Do this first, as the compilation-assq`s may create new nodes.
+ (let* ((marker-line (car (cddr file))) ; a line structure
+ (marker (nth 3 (cadr marker-line))) ; its marker
+ (compilation-error-screen-columns compilation-error-screen-columns)
+ end-marker loc end-loc)
+ (if (not (and marker (marker-buffer marker)))
+ (setq marker) ; no valid marker for this file
+ (setq loc (or line 1) ; normalize no linenumber to line 1
+ marker-line)
+ (catch 'marker ; find nearest loc, at least one exists
+ (dolist (x (cddr file)) ; loop over lines
+ (if (> (or (car x) 1) loc) ; still bigger
+ (setq marker-line x)
+ (if (or (not marker-line) ; first in list
+ (> (- (or (car marker-line) 1) loc)
+ (- loc (or (car x) 1)))) ; current line is nearer
+ (setq marker-line x))
+ (throw 'marker t))))
+ (setq marker (nth 3 (cadr marker-line))
+ marker-line (car marker-line))
+ (with-current-buffer (marker-buffer marker)
+ (save-restriction
+ (widen)
+ (goto-char (marker-position marker))
+ (when (or end-col end-line)
+ (beginning-of-line (- (or end-line line) marker-line -1))
+ (if (< end-col 0)
+ (end-of-line)
+ (if compilation-error-screen-columns
+ (move-to-column end-col)
+ (forward-char end-col)))
+ (setq end-marker (list (point-marker))))
+ (beginning-of-line (if end-line
+ (- end-line line -1)
+ (- loc marker-line -1)))
+ (if col
+ (if compilation-error-screen-columns
+ (move-to-column col)
+ (forward-char col))
+ (forward-to-indentation 0))
+ (setq marker (list (point-marker))))))
+
+ (setq loc (compilation-assq line (cdr file)))
+ (if end-line
+ (setq end-loc (compilation-assq end-line (cdr file))
+ end-loc (compilation-assq end-col end-loc))
+ (if end-col ; use same line element
+ (setq end-loc (compilation-assq end-col loc))))
+ (setq loc (compilation-assq col loc))
+ ;; If they are new, make the loc(s) reference the file they point to.
+ (or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
+ (if end-loc
+ (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
+
+ ;; Must start with face
+ `(face ,compilation-message-face
+ message (,loc ,type ,end-loc)
+ ,@(if compilation-debug
+ `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
+ ,@(match-data))))
+ help-echo ,(if col
+ "mouse-2: visit this file, line and column"
+ (if line
+ "mouse-2: visit this file and line"
+ "mouse-2: visit this file"))
+ keymap compilation-button-map
+ mouse-face highlight)))