;; Run compiler as inferior of Emacs, and parse its error messages.
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

(provide 'amiga-compile)

(defvar compilation-error-list nil
  "List of error message descriptors for visiting erring functions.
Each error descriptor is a list of length two.
Its car is a marker pointing to an error message.
Its cadr is a marker pointing to the text of the line the message is about,
  or nil if that is not interesting.
The value may be t instead of a list;
this means that the buffer of error messages should be reparsed
the next time the list of errors is wanted.")

(defvar compilation-parsing-end nil
  "Position of end of buffer when last error messages parsed.")

(defvar compilation-error-message nil
  "Message to print when no more matches for compilation-error-regexp are found")

;; The filename excludes colons to avoid confusion when error message
;; starts with digits.
(defvar compilation-error-regexp
  "^[^ ]+ [0-9]+"
  "Regular expression for filename/linenumber in error in compilation log.")

(defun compile (command)
  "Compile the program including the current buffer.  Default: run `make'.
Runs COMMAND synchronously
with output going to the buffer *compilation*.
You can then use the command \\[next-error] to find the next error message
and move to the source code that caused it."
  (interactive (list (read-string "Compile command: " compile-command)))
  (setq compile-command command)
  (compile1 compile-command "No more errors"))

(defun grep (command)
  "Run grep, with user-specified args, and collect output in a buffer.
While grep runs synchronously, you can use the \\[next-error] command
to find the text that grep hits refer to."
  (interactive "sRun grep (with args): ")
  (compile1 (concat "grep -n " command " /dev/null")
	    "No more grep hits" "grep"))

(defun compile1 (command error-message &optional name-of-mode)
  (save-some-buffers)
  (compilation-forget-errors)
  (setq compilation-error-list t)
  (setq compilation-error-message error-message)
  (kill-buffer  "*compilation*")
  (let ((end-cmd (string-match "[ \t]" command)))
    (if (not end-cmd) (setq end-cmd (length command)))
    (call-process (substring command 0 end-cmd) nil
		  (get-buffer-create "*compilation*") t
		  (substring command end-cmd))))

(defun next-error (&optional argp)
  "Visit next compilation error message and corresponding source code.
This operates on the output from the \\[compile] command.
If all preparsed error messages have been processed,
the error message buffer is checked for new ones.
A non-nil argument (prefix arg, if interactive)
means reparse the error message buffer and start at the first error."
  (interactive "P")
  (if (or (eq compilation-error-list t)
	  argp)
      (progn (compilation-forget-errors)
	     (setq compilation-parsing-end 1)))
  (if compilation-error-list
      nil
    (save-excursion
      (set-buffer "*compilation*")
      (set-buffer-modified-p nil)
      (compilation-parse-errors)))
  (let ((next-error (car compilation-error-list)))
    (if (null next-error)
	(error compilation-error-message))
    (setq compilation-error-list (cdr compilation-error-list))
    (if (null (car (cdr next-error)))
	nil
      (switch-to-buffer (marker-buffer (car (cdr next-error))))
      (goto-char (car (cdr next-error)))
      (set-marker (car (cdr next-error)) nil))
    (let* ((pop-up-windows t)
	   (w (display-buffer (marker-buffer (car next-error)))))
      (set-window-point w (car next-error))
      (set-window-start w (car next-error)))
    (set-marker (car next-error) nil)))

;; Set compilation-error-list to nil, and
;; unchain the markers that point to the error messages and their text,
;; so that they no longer slow down gap motion.
;; This would happen anyway at the next garbage collection,
;; but it is better to do it right away.
(defun compilation-forget-errors ()
  (if (eq compilation-error-list t)
      (setq compilation-error-list nil))
  (while compilation-error-list
    (let ((next-error (car compilation-error-list)))
      (set-marker (car next-error) nil)
      (if (car (cdr next-error))
	  (set-marker (car (cdr next-error)) nil)))
    (setq compilation-error-list (cdr compilation-error-list))))

(defun compilation-parse-errors ()
  "Parse the current buffer as error messages.
This makes a list of error descriptors, compilation-error-list.
For each source-file, line-number pair in the buffer,
the source file is read in, and the text location is saved in compilation-error-list.
The function next-error, assigned to \\[next-error], takes the next error off the list
and visits its location."
  (setq compilation-error-list nil)
  (message "Parsing error messages...")
  (let (text-buffer
	last-filename last-linenum)
    ;; Don't reparse messages already seen at last parse.
    (goto-char compilation-parsing-end)
    ;; Don't parse the first two lines as error messages.
    ;; This matters for grep.
    (if (bobp)
	(forward-line 2))
    (while (re-search-forward compilation-error-regexp nil t)
      (let (linenum filename
	    error-marker text-marker)
	;; Extract file name and line number from error message.
	(save-restriction
	  (narrow-to-region (match-beginning 0) (match-end 0))
	  (goto-char (point-max))
	  (skip-chars-backward "[0-9]")
	  ;; If it's a lint message, use the last file(linenum) on the line.
	  ;; Normally we use the first on the line.
	  (if (= (preceding-char) ?\()
	      (progn
		(narrow-to-region (point-min) (1+ (buffer-size)))
		(end-of-line)
		(re-search-backward compilation-error-regexp)
		(skip-chars-backward "^ \t\n")
		(narrow-to-region (point) (match-end 0))
		(goto-char (point-max))
		(skip-chars-backward "[0-9]")))
	  ;; Are we looking at a "filename-first" or "line-number-first" form?
	  (if (looking-at "[0-9]")
	      (progn
		(setq linenum (read (current-buffer)))
		(goto-char (point-min)))
	    ;; Line number at start, file name at end.
	    (progn
	      (goto-char (point-min))
	      (setq linenum (read (current-buffer)))
	      (goto-char (point-max))
	      (skip-chars-backward "^ \t\n")))
	  (setq filename (compilation-grab-filename)))
	;; Locate the erring file and line.
	(if (and (equal filename last-filename)
		 (= linenum last-linenum))
	    nil
	  (beginning-of-line 1)
	  (setq error-marker (point-marker))
	  ;; text-buffer gets the buffer containing this error's file.
	  (if (not (equal filename last-filename))
	      (setq text-buffer
		    (and (file-exists-p (setq last-filename filename))
			 (find-file-noselect filename))
		    last-linenum 0))
	  (if text-buffer
	      ;; Go to that buffer and find the erring line.
	      (save-excursion
		(set-buffer text-buffer)
		(if (zerop last-linenum)
		    (progn
		      (goto-char 1)
		      (setq last-linenum 1)))
		(forward-line (- linenum last-linenum))
		(setq last-linenum linenum)
		(setq text-marker (point-marker))
		(setq compilation-error-list
		      (cons (list error-marker text-marker)
			    compilation-error-list)))))
	(forward-line 1)))
    (setq compilation-parsing-end (point-max)))
  (message "Parsing error messages...done")
  (setq compilation-error-list (nreverse compilation-error-list)))

(defun compilation-grab-filename ()
  "Return a string which is a filename, starting at point.
Ignore quotes and parentheses around it, as well as trailing colons."
  (if (eq (following-char) ?\")
      (save-restriction
	(narrow-to-region (point)
			  (progn (forward-sexp 1) (point)))
	(goto-char (point-min))
	(read (current-buffer)))
    (buffer-substring (point)
		      (progn
			(skip-chars-forward "^ :,\n\t(")
			(point)))))

(define-key ctl-x-map "`" 'next-error)