[MLton-user] effectively tracking MLton error locations with emacs

[Stephen Weeks]

> Could you post (or wiki) the emacs code for this?  I didn't know
> anybody had written an error parser for MLton.

Here's (a newly cleaned up version of) the code I use.  Warning: I'm
not an Elisp wizard and this code has only been tested by me (in
Xemacs).  I'm happy to receive suggestions, and we'll find a way to
proceed with development of this, probably by moving it into the MLton
CVS.

BTW, I think markers could be used similarly in combination with
-show-def-use to provide nice emacs functionality for jumping between
uses and definitions.

----------------------------------------------------------------------

;; To use this code, put the output of MLton in the buffer named
;; mlton-buffer-name (I use shell-command to do so).  Then, call
;; mlton-parse-errors.  Then, call mlton-next-error repeatedly to visit each
;; error.
;;
;; mlton-parse-errors uses markers so that file edits don't interfere with
;; locating the errros.

(setq mlton-buffer-name "*mlton-output*")
(setq mlton-errors nil)
(setq mlton-error-regexp
      "^\\(Error\\|Warning\\): \\(.+\\) \\([0-9]+\\)\\.\\([0-9]+\\).")

(defun mlton-parse-errors (prefix)
  "Parse a sequence of MLton error messages in buffer.  prefix is the path
relative to which files in the error messages should be interpreted.
Returns a list of pairs of the form (pos . marker), where pos is a position
in buffer at the start of the second line of an error message (i.e. after the
file, line, and column info) and marker is at the point of the error in the
source file."
  (if (not (get-buffer mlton-buffer-name))
      (message "No errors.")
    (let ((errors ()))
      (save-excursion
	(set-buffer mlton-buffer-name)
	(goto-char 0)
	(condition-case ()
	  (while t
	    (re-search-forward mlton-error-regexp)
	    (let* ((match (lambda (i)
			    (buffer-substring (match-beginning i)
					      (match-end i))))
		   (file (concat prefix (funcall match 2)))
		   (line (string-to-int (funcall match 3)))
		   (col (string-to-int (funcall match 4)))
		   (marker (save-excursion
			     (find-file file)
			     (goto-line line)
			     (forward-char (sub1 col))
			     (set-marker (make-marker) (point)))))
	      (beginning-of-line)
	      (forward-line)
	      (setq errors (cons (cons (point) marker) errors))))
	  (error)))
      (setq mlton-errors (reverse errors)))))

(defun mlton-next-error ()
  (interactive)
  (if (or (not (get-buffer mlton-buffer-name))
	  (null mlton-errors))
      (message "No more errors.")
    (let ((error (caar mlton-errors))
	  (marker (cdar mlton-errors)))
      (setq mlton-errors (cdr mlton-errors))
      (set-window-start (display-buffer mlton-buffer-name) error)
      (set-buffer (marker-buffer marker))
      (goto-char marker))))