-(defvar sml-prompt-regexp "^[\-=] *"
- "*Regexp used to recognise prompts in the inferior ML process.")
-
-(defvar sml-error-parser 'sml-smlnj-error-parser
- "*This function parses an error message into a 3-5 element list:
-
- \(file start-line start-col end-line-col err-msg\).
-
-The first three components are required by `sml-next-error', but the other
-two are optional. If the file associated with the input is the standard
-input stream, this function should probably return
-
- \(\"std_in\" start-line start-col\).
-
-This function will be called in a context in which the match data \(see
-`match-data'\) are current for `sml-error-regexp'. The mode sets the
-default value to the function `sml-smlnj-error-parser'.
-
-In a step towards greater sml-mode modularity END-LINE-COL can be either
-
- - the symbol nil \(in which case it is ignored\)
-
-or
-
- - an Emacs Lisp expression that when `eval'd at \(start-line,start-col\)
- will move point to the end of the errorful text in the file.
-
-Note that the compiler should return the full path name of the errorful
-file, and that this might require you to fiddle with the compiler's
-prettyprinting switches.")
-
-;; std_in:2.1-4.3 Error: operator and operand don't agree (tycon mismatch)
-;; std_in:2.1 Error: operator and operand don't agree (tycon mismatch)
-
-(defconst sml-smlnj-error-regexp
- (concat
- "^[-= ]*\\(.+\\):" ;file name
- "\\([0-9]+\\)\\.\\([0-9]+\\)" ;start line.column
- "\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)?" ;end line.colum
- ".+\\(\\(Error\\|Warning\\): .*\\)") ;the message
-
- "Default regexp matching SML/NJ error and warning messages.
-
-There should be no need to customise this, though you might decide
-that you aren't interested in Warnings -- my advice would be to modify
-`sml-error-regexp' explicitly to do that though.
-
-If you do customise `sml-smlnj-error-regexp' you may need to modify
-the function `sml-smlnj-error-parser' (qv).")
-
-(defvar sml-error-regexp sml-smlnj-error-regexp
- "*Regexp for matching \(the start of\) an error message.")
-
-(defun sml-smlnj-error-parser (pt)
- "This parses the SML/NJ error message at PT into a 5 element list
-
- \(file start-line start-col end-of-err msg\)
-
-where FILE is the file in which the error occurs\; START-LINE is the line
-number in the file where the error occurs\; START-COL is the character
-position on that line where the error occurs.
-
-If present, the fourth return value is a simple Emacs Lisp expression that
-will move point to the end of the errorful text, assuming that point is at
-\(start-line,start-col\) to begin with\; and MSG is the text of the error
-message given by the compiler."
-
- ;; This function uses `sml-smlnj-error-regexp' to do the parsing, and
- ;; assumes that regexp groups 1, 2, and 3 correspond to the first three
- ;; elements of the list returned\; and groups 5, 6 and 7 correspond to the
- ;; optional elements in that order.
-
- (save-excursion
- (goto-char pt)
- (if (not (looking-at sml-smlnj-error-regexp))
- ;; the user loses big time.
- (list nil nil nil)
- (let ((file (match-string 1)) ; the file
- (slin (string-to-int (match-string 2))) ; the start line
- (scol (string-to-int (match-string 3))) ; the start col
- (msg (if (match-beginning 7) (match-string 7))))
- ;; another loss: buggy sml/nj's produce nonsense like file:0.0 Error
- (if (zerop slin) (list file nil scol)
- ;; ok, was a range of characters mentioned?
- (if (match-beginning 4)
- ;; assume m-b 4 implies m-b 5 and m-b 6 (sml-smlnj-error-regexp)
- (let* ((elin (string-to-int (match-string 5))) ; end line
- (ecol (string-to-int (match-string 6))) ; end col
- (jump (if (= elin slin)
- ;; move forward on the same line
- `(forward-char ,(1+ (- ecol scol)))
- ;; otherwise move down, and over to ecol
- `(progn
- (forward-line ,(- elin slin))
- (forward-char ,ecol)))))
- ;; nconc glues lists together. jump & msg aren't lists
- (nconc (list file slin scol) (list jump) (list msg)))
- (nconc (list file slin scol) (list nil) (list msg))))))))
-
-(defun sml-smlnj (pfx)
- "Set up and run Standard ML of New Jersey.
-Prefix argument means accept the defaults below.
-
-Note: defaults set here will be clobbered if you setq them in the
-inferior-sml-mode-hook.
-
- sml-program-name <option> \(default \"sml\"\)
- sml-default-arg <option> \(default \"\"\)
- sml-use-command \"use \\\"%s\\\"\"
- sml-cd-command \"System.Directory.cd \\\"%s\\\"\"
- sml-prompt-regexp \"^[\\-=] *\"
- sml-error-regexp sml-sml-nj-error-regexp
- sml-error-parser 'sml-sml-nj-error-parser"
- (interactive "P")
- (let ((cmd (if pfx "sml"
- (read-string "Command name: " sml-program-name)))
- (arg (if pfx ""
- (read-string "Any arguments or options (default none): "))))
- ;; sml-mode global variables
- (setq sml-program-name cmd)
- (setq sml-default-arg arg)
- ;; buffer-local (compiler-local) variables
- (setq-default sml-use-command "use \"%s\""
- sml-cd-command "System.Directory.cd \"%s\""
- sml-prompt-regexp "^[\-=] *"
- sml-error-regexp sml-smlnj-error-regexp
- sml-error-parser 'sml-smlnj-error-parser)
- (sml-run cmd sml-default-arg)))
+(defcustom sml-prompt-regexp "^[-=>#] *"
+ "*Regexp used to recognise prompts in the inferior ML process."
+ :group 'sml-proc
+ :type '(regexp))
+
+(defvar sml-error-regexp-alist
+ '(;; Poly/ML messages
+ ("\\(Error\\|Warning:\\) in '\\(.+\\)', line \\([0-9]+\\)" 2 3)
+ ;; Moscow ML
+ ("File \"\\([^\"]+\\)\", line \\([0-9]+\\)\\(-\\([0-9]+\\)\\)?, characters \\([0-9]+\\)-\\([0-9]+\\):" 1 2 5)
+ ;; SML/NJ: the file-pattern is anchored to avoid
+ ;; pathological behavior with very long lines.
+ ("^[-= ]*\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)? \\(Error\\|Warning\\): .*" 1 sml-make-error 2 3 5 6)
+ ;; SML/NJ's exceptions: see above.
+ ("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2 sml-make-error 3 4 6 7))
+ "Alist that specifies how to match errors in compiler output.
+See `compilation-error-regexp-alist' for a description of the format.")
+
+;; font-lock support
+(defconst inferior-sml-font-lock-keywords
+ `(;; prompt and following interactive command
+ (,(concat "\\(" sml-prompt-regexp "\\)\\(.*\\)")
+ (1 font-lock-prompt-face)
+ (2 font-lock-command-face keep))
+ ;; CM's messages
+ ("^\\[\\(.*GC #.*\n\\)*.*\\]" . font-lock-comment-face)
+ ;; SML/NJ's irritating GC messages
+ ("^GC #.*" . font-lock-comment-face)
+ ;; error messages
+ ,@(mapcar (lambda (ra) (cons (car ra) 'font-lock-warning-face))
+ sml-error-regexp-alist))
+ "Font-locking specification for inferior SML mode.")
+
+(defface font-lock-prompt-face
+ '((t (:bold t)))
+ "Font Lock mode face used to highlight prompts."
+ :group 'font-lock-highlighting-faces)
+(defvar font-lock-prompt-face 'font-lock-prompt-face
+ "Face name to use for prompts.")
+
+(defface font-lock-command-face
+ '((t (:bold t)))
+ "Font Lock mode face used to highlight interactive commands."
+ :group 'font-lock-highlighting-faces)
+(defvar font-lock-command-face 'font-lock-command-face
+ "Face name to use for interactive commands.")
+
+(defconst inferior-sml-font-lock-defaults
+ '(inferior-sml-font-lock-keywords nil nil nil nil))