comparison lisp/progmodes/compile.el @ 55131:2a263df48184

(compilation-error-regexp-alist-alist): Also recognize severe Irix et al. messages. (compilation-normalize-filename, compile-abbreviate-directory): Delete functions. (compilation-get-file-structure): New function inherits functionality of the two preceding ones. (compilation-internal-error-properties, compilation-fake-loc): Use it so that different paths to the same file share the same markers. Also optimize finding adjacent marker slightly.

55130:c4aac1add82f

     "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
 \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))

    ;; fixme: should be `mips'
    (irix
     "^[-[:alnum:]_/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
 \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))

    (java
     "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))

(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)

    (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
    (setcdr (nthcdr 3 loc) t)))		; Set this one as visited.

(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!

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

			  (when (overlay-get ov 'intangible)
			    (overlay-put ov 'intangible nil))))
	      (overlays-in (point-min) (point-max)))
      buffer)))

(defun compilation-normalize-filename (filename)
  "Convert FILENAME string found in an error message to make it usable."

  ;; Check for a comint-file-name-prefix and prepend it if
  ;; appropriate.  (This is very useful for
  ;; compilation-minor-mode in an rlogin-mode buffer.)
  (and (boundp 'comint-file-name-prefix)
       ;; If file name is relative, default-directory will
       ;; already contain the comint-file-name-prefix (done
       ;; by compile-abbreviate-directory).
       (file-name-absolute-p filename)
       (setq filename
	     (concat (with-no-warnings 'comint-file-name-prefix) filename)))

  ;; If compilation-parse-errors-filename-function is
  ;; defined, use it to process the filename.
  (when compilation-parse-errors-filename-function
    (setq filename
	  (funcall compilation-parse-errors-filename-function
		   filename)))

  ;; Some compilers (e.g. Sun's java compiler, reportedly)
  ;; produce bogus file names like "./bar//foo.c" for file
  ;; "bar/foo.c"; expand-file-name will collapse these into
  ;; "/foo.c" and fail to find the appropriate file.  So we
  ;; look for doubled slashes in the file name and fix them
  ;; up in the buffer.
  (setq filename (command-line-normalize-file-name filename)))


;; If directory DIR is a subdir of ORIG or of ORIG's parent,
;; return a relative name for it starting from ORIG or its parent.
;; ORIG-EXPANDED is an expanded version of ORIG.
;; PARENT-EXPANDED is an expanded version of ORIG's parent.
;; Those two args could be computed here, but we run faster by
;; having the caller compute them just once.
(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)
  ;; Apply canonical abbreviations to DIR first thing.
  ;; Those abbreviations are already done in the other arguments passed.
  (setq dir (abbreviate-file-name dir))

  ;; Check for a comint-file-name-prefix and prepend it if appropriate.
  ;; (This is very useful for compilation-minor-mode in an rlogin-mode
  ;; buffer.)
  (if (boundp 'comint-file-name-prefix)
      (setq dir (concat comint-file-name-prefix dir)))

  (if (and (> (length dir) (length orig-expanded))
	   (string= orig-expanded
		    (substring dir 0 (length orig-expanded))))
      (setq dir
	    (concat orig
		    (substring dir (length orig-expanded)))))
  (if (and (> (length dir) (length parent-expanded))
	   (string= parent-expanded
		    (substring dir 0 (length parent-expanded))))
    (setq dir
	  (concat (file-name-directory
		   (directory-file-name orig))
		  (substring dir (length parent-expanded)))))
  dir)

(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")

;;; Compatibility with the old compile.el.

55131:2a263df48184

     "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
 \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))

    ;; fixme: should be `mips'
    (irix
     "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
 \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))

    (java
     "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))

(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 (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
  (unless file (setq file '("*unknown*")))
  (setq file (compilation-get-file-structure file fmt))
  ;; 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
      (catch 'marker			; find nearest loc, at least one exists
	(dolist (x (nthcdr 3 file))	; loop over remaining lines
	  (if (> (car x) loc)		; still bigger
	      (setq marker-line x)
	    (if (> (- (or (car marker-line) 1) loc)
		   (- loc (car x)))	; current line is nearer
		(setq marker-line x))
	    (throw 'marker t))))
      (setq marker (nth 3 (cadr marker-line))
	    marker-line (or (car marker-line) 1))
      (with-current-buffer (marker-buffer marker)
	(save-restriction
	  (widen)
	  (goto-char (marker-position marker))
	  (when (or end-col end-line)

    (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
    (setcdr (nthcdr 3 loc) t)))		; Set this one as visited.

(defun compilation-fake-loc (marker file &optional line col)
  "Preassociate MARKER with FILE.
FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
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!

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 (compilation-get-file-structure file))
  (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 line file marker)))
    loc))

(defcustom compilation-context-lines next-screen-context-lines
  "*Display this many lines of leading context before message."
  :type 'integer

			  (when (overlay-get ov 'intangible)
			    (overlay-put ov 'intangible nil))))
	      (overlays-in (point-min) (point-max)))
      buffer)))

(defun compilation-get-file-structure (file &optional fmt)
  "Retrieve FILE's file-structure or create a new one.
FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."

  (or (gethash file compilation-locs)
      ;; File was not previously encountered, at least not in the form passed.
      ;; Let's normalize it and look again.
      (let ((filename (car file))
	    (default-directory (if (cdr file)
				   (file-truename (cdr file))
				 default-directory)))

	;; Check for a comint-file-name-prefix and prepend it if appropriate.
	;; (This is very useful for compilation-minor-mode in an rlogin-mode
	;; buffer.)
	(if (boundp 'comint-file-name-prefix)
	    (if (file-name-absolute-p filename)
		(setq filename
		      (concat (with-no-warnings comint-file-name-prefix) filename))
	      (setq default-directory
		    (file-truename
		     (concat (with-no-warnings comint-file-name-prefix) default-directory)))))

	;; If compilation-parse-errors-filename-function is
	;; defined, use it to process the filename.
	(when compilation-parse-errors-filename-function
	  (setq filename
		(funcall compilation-parse-errors-filename-function
			 filename)))

	;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus
	;; file names like "./bar//foo.c" for file "bar/foo.c";
	;; expand-file-name will collapse these into "/foo.c" and fail to find
	;; the appropriate file.  So we look for doubled slashes in the file
	;; name and fix them.
	(setq filename (command-line-normalize-file-name filename))

	;; Now eliminate any "..", because find-file would get them wrong.
	;; Make relative and absolute filenames, with or without links, the
	;; same.
	(setq filename
	      (list (abbreviate-file-name
		     (file-truename (if (cdr file)
					(expand-file-name filename)
				      filename)))))

	;; Store it for the possibly unnormalized name
	(puthash file
		 ;; Retrieve or create file-structure for normalized name
		 (or (gethash filename compilation-locs)
		     (puthash filename (list filename fmt) compilation-locs))
		 compilation-locs))))

(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")

;;; Compatibility with the old compile.el.