procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(compilation-error-properties): Fix for adding messages when there are already

Browse source 
markers for their file.
(compilation-fake-loc): New function.
This commit is contained in:
Daniel Pfeiffer 2004-04-16 23:06:34 +00:00
parent b6ea794037
commit eb6fb6e2d5
2 changed files with 83 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/ChangeLog
View file

@ -1,3 +1,9 @@
2004-04-17 Daniel Pfeiffer <occitan@esperanto.org>
* progmodes/compile.el (compilation-error-properties): Fix for
adding messages when there are already markers for their file.
(compilation-fake-loc): New function.
2004-04-16 Andre Spiegel <spiegel@gnu.org>
* vc-hooks.el (vc-default-workfile-unchanged-p): Quote signal.

123
lisp/progmodes/compile.el
View file

@ -564,7 +564,7 @@ Faces `compilation-error-face', `compilation-warning-face',
file (or (if file
(nth 2 (car (or (get-text-property (1- file) 'message)
(get-text-property file 'message)))))
;; no previous either -- let font-lock continue
;; no previous either -- but don't let font-lock fail
(gethash (setq file '("*unknown*")) compilation-locs)
(puthash file (list file fmt) compilation-locs))))
;; All of these fields are optional, get them only if we have an index, and
@ -581,15 +581,54 @@ Faces `compilation-error-face', `compilation-warning-face',
(if (and end-col (setq end-col (match-string-no-properties end-col)))
(setq end-col (- (string-to-number end-col) compilation-first-column))
(if end-line (setq end-col -1)))
(if (consp type) ; not a preset 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)
(and (cdr type) (match-end (cdr type)) 0)
2)))
;; Get any (first) already existing marker (if any has one, all have one).
;; Do this first, as the next assq`s may create new nodes.
(let ((marker (nth 3 (car (cdar (cddr file)))))
(loc (compilation-assq line (cdr file)))
end-loc)
;; 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))
@ -597,44 +636,10 @@ Faces `compilation-error-face', `compilation-warning-face',
(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 (list line file)))
(or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
(if end-loc
(or (cdr end-loc) (setcdr end-loc (list (or end-line line) file))))
;; If we'd found a marker, ensure that the new locs also get markers
(when (and marker
(not (or (cddr loc) (cddr end-loc))) ; maybe new node w/o marker
(marker-buffer marker)) ; other marker still valid
(or line (setq line 1)) ; normalize no linenumber to line 1
(catch 'marker ; find nearest loc, at least one exists
(dolist (x (cddr file))
(if (> (or (car x) 1) line)
(setq marker x)
(if (eq (or (car x) 1) line)
(if (cdr (cddr x)) ; at least one other column
(throw 'marker (setq marker x))
(if marker (throw 'marker t)))
(throw 'marker (or marker (setq marker x)))))))
(setq marker (if (eq (car (cddr marker)) col)
(nthcdr 3 marker)
(cddr marker))
file compilation-error-screen-columns)
(with-current-buffer (marker-buffer (cddr marker))
(save-restriction
(widen)
(goto-char (marker-position (cddr marker)))
(beginning-of-line (- line (car (cadr marker)) -1))
(if file ; original c.-error-screen-columns
(move-to-column (car loc))
(forward-char (car loc)))
(setcdr (cdr loc) (point-marker))
(when end-loc
(beginning-of-line (- end-line line -1))
(if (< end-col 0)
(end-of-line)
(if file ; original c.-error-screen-columns
(move-to-column (car end-loc))
(forward-char (car end-loc))))
(setcdr (cdr end-loc) (point-marker))))))
(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)
@ -1449,7 +1454,7 @@ See variable `compilation-error-regexp-alist' for customization ideas."
;; If loc contains no marker, no error in that file has been visited. If
;; the marker is invalid the buffer has been killed. So, recalculate all
;; markers for that file.
(unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc)))
(unless (and (nth 3 loc) (marker-buffer (nth 3 loc)))
(with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
(or (cdar (nth 2 loc))
default-directory))
@ -1472,7 +1477,7 @@ See variable `compilation-error-regexp-alist' for customization ideas."
(forward-char (car col))))
(beginning-of-line)
(skip-chars-forward " \t"))
(if (nthcdr 3 col)
(if (nth 3 col)
(set-marker (nth 3 col) (point))
(setcdr (nthcdr 2 col) `(,(point-marker)))))))))
(compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
@ -1499,6 +1504,32 @@ This operates on the output from the \\[compile] command."
(setq compilation-current-error nil)
(next-error n))
(defun compilation-fake-loc (marker file &optional line col)
"Preassociate MARKER with FILE.
This is useful when you compile temporary files, but want
automatic translation of the messages to the real buffer from
which the temporary file came. This only works if done before a
message about FILE appears!
Optional args LINE and COL default to 1 and beginning of
indentation respectively. The marker is expected to reflect
this. In the simplest case the marker points to the first line
of the region that was saved to the temp file.
If you concatenate several regions into the temp file (e.g. a
header with variable assignments and a code region), you must
call this several times, once each for the last line of one
region and the first line of the next region."
(or (consp file) (setq file (list file)))
(setq file (or (gethash file compilation-locs)
(puthash file (list file nil) compilation-locs)))
(let ((loc (compilation-assq (or line 1) (cdr file))))
(setq loc (compilation-assq col loc))
(if (cdr loc)
(setcdr (cddr loc) (list marker))
(setcdr loc (list (or line 1) file marker)))
loc))
(defcustom compilation-context-lines next-screen-context-lines
"*Display this many lines of leading context before message."
:type 'integer