code.delx.au - gnu-emacs-elpa/blob - sml-smlnj.el

   1 ;;; sml-nj.el: Modifies inferior-sml-mode defaults for SML/NJ.
   2
   3 ;; Copyright (C) 1997, Matthew J. Morley
   4
   5 ;; $Revision$
   6 ;; $Date$
   7
   8 ;; This file is not part of GNU Emacs, but it is distributed under the
   9 ;; same conditions.
  10
  11 ;; ====================================================================
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
  25 ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;; ====================================================================
  28
  29 ;;; DESCRIPTION
  30
  31 ;; To use this library just put
  32
  33 ;;(autoload 'sml-smlnj "sml-nj" "Set up and run SML/NJ." t)
  34
  35 ;; in your .emacs file. If you only ever use the New Jersey compiler
  36 ;; then you might as well put something like
  37
  38 ;;(setq sml-mode-hook
  39 ;;      '(lambda() "SML mode defaults to SML/NJ"
  40 ;;       (define-key  sml-mode-map "\C-cp" 'sml-smlnj)))
  41
  42 ;; for your sml-mode-hook. The command prompts for the program name
  43 ;; and any command line options.
  44
  45 ;; If you need to reset the default value of sml-program-name, or any
  46 ;; of the other compiler variables, put something like
  47
  48 ;;(eval-after-load "sml-nj" '(setq sml-program-name "whatever"))
  49
  50 ;; in your .emacs -- or (better) you can use the inferior-sml-{load,
  51 ;; mode}-hooks to achieve the same ends.
  52
  53 ;;; CODE
  54
  55 (require 'sml-proc)
  56
  57 ;; std_in:2.1-4.3 Error: operator and operand don't agree (tycon mismatch)
  58 ;; std_in:2.1 Error: operator and operand don't agree (tycon mismatch)
  59
  60 (defconst sml-smlnj-error-regexp
  61   (concat
  62    "^[-= ]*\\(.+\\):"                     ;file name
  63    "\\([0-9]+\\)\\.\\([0-9]+\\)"          ;start line.column
  64    "\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)?"  ;end line.colum
  65    ".+\\(\\(Error\\|Warning\\): .*\\)")   ;the message
  66
  67   "Default regexp matching SML/NJ error and warning messages.
  68
  69 There should be no need to customise this, though you might decide
  70 that you aren't interested in Warnings -- my advice would be to modify
  71 `sml-error-regexp' explicitly to do that though.
  72
  73 If you do customise `sml-smlnj-error-regexp' you may need to modify
  74 the function `sml-smlnj-error-parser' (qv).")
  75
  76 (defun sml-smlnj-error-parser (pt)
  77  "This parses the SML/NJ error message at PT into a 5 element list
  78
  79     \(file start-line start-col end-of-err msg\)
  80
  81 where FILE is the file in which the error occurs\; START-LINE is the line
  82 number in the file where the error occurs\; START-COL is the character
  83 position on that line where the error occurs.
  84
  85 If present, the fourth return value is a simple Emacs Lisp expression that
  86 will move point to the end of the errorful text, assuming that point is at
  87 \(start-line,start-col\) to begin with\; and MSG is the text of the error
  88 message given by the compiler."
  89
  90  ;; This function uses `sml-smlnj-error-regexp' to do the parsing, and
  91  ;; assumes that regexp groups 1, 2, and 3 correspond to the first three
  92  ;; elements of the list returned\; and groups 5, 6 and 7 correspond to the
  93  ;; optional elements in that order.
  94
  95  (save-excursion
  96    (goto-char pt)
  97    (if (not (looking-at sml-smlnj-error-regexp))
  98        ;; the user loses big time.
  99        (list nil nil nil)
 100      (let ((file (match-string 1))                  ; the file
 101            (slin (string-to-int (match-string 2)))  ; the start line
 102            (scol (string-to-int (match-string 3)))  ; the start col
 103            (msg (if (match-beginning 7) (match-string 7))))
 104        ;; another loss: buggy sml/nj's produce nonsense like file:0.0 Error
 105        (if (zerop slin) (list file nil scol)
 106          ;; ok, was a range of characters mentioned?
 107          (if (match-beginning 4)
 108              ;; assume m-b 4 implies m-b 5 and m-b 6 (sml-smlnj-error-regexp)
 109              (let* ((elin (string-to-int (match-string 5))) ; end line
 110                     (ecol (string-to-int (match-string 6))) ; end col
 111                     (jump (if (= elin slin)
 112                               ;; move forward on the same line
 113                               `(forward-char ,(1+ (- ecol scol)))
 114                             ;; otherwise move down, and over to ecol
 115                             `(progn
 116                                (forward-line ,(- elin slin))
 117                                (forward-char ,ecol)))))
 118                ;; nconc glues lists together. jump & msg aren't lists
 119                (nconc (list file slin scol) (list jump) (list msg)))
 120            (nconc (list file slin scol) (list nil) (list msg))))))))
 121
 122 ;;;###autoload
 123 (defun sml-smlnj (pfx)
 124    "Set up and run Standard ML of New Jersey.
 125 Prefix argument means accept the defaults below.
 126
 127 Note: defaults set here will be clobbered if you setq them in the
 128 inferior-sml-mode-hook.
 129
 130  sml-program-name  <option> \(default \"sml\"\)
 131  sml-default-arg   <option> \(default \"\"\)
 132  sml-use-command   \"use \\\"%s\\\"\"
 133  sml-cd-command    \"OS.FileSys.chDir \\\"%s\\\"\"
 134  sml-prompt-regexp \"^[\\-=] *\"
 135  sml-error-regexp  sml-sml-nj-error-regexp
 136  sml-error-parser  'sml-sml-nj-error-parser"
 137    (interactive "P")
 138    (let ((cmd (if pfx "sml"
 139                 (read-string "Command name: " sml-program-name)))
 140          (arg (if pfx ""
 141                 (read-string "Any arguments or options (default none): "))))
 142      ;; sml-mode global variables
 143      (setq sml-program-name cmd)
 144      (setq sml-default-arg  arg)
 145      ;; buffer-local (compiler-local) variables
 146      (setq-default sml-use-command   "use \"%s\""
 147                    sml-cd-command    "OS.FieSys.chDir \"%s\""
 148                    sml-prompt-regexp "^[\-=] *"
 149                    sml-error-regexp  sml-smlnj-error-regexp
 150                    sml-error-parser  'sml-smlnj-error-parser)
 151      (sml-run cmd sml-default-arg)))
 152
 153 ;;; Do the default setup on loading this file.
 154
 155 ;; setqing these two may override user's hooked defaults. users
 156 ;; therefore need load this file before setting sml-program-name or
 157 ;; sml-default-arg in their inferior-sml-load-hook. sorry.
 158
 159 (setq         sml-program-name  "sml"
 160               sml-default-arg   "")
 161
 162 ;; same sort of problem here too: users should to setq-default these
 163 ;; after this file is loaded, on inferior-sml-load-hook. as these are
 164 ;; buffer-local, users can instead set them on inferior-sml-mode-hook.
 165
 166 (setq-default sml-use-command   "use \"%s\""
 167               sml-cd-command    "OS.FileSys.chDir \"%s\""
 168               sml-prompt-regexp "^[\-=] *"
 169               sml-error-regexp  sml-smlnj-error-regexp
 170               sml-error-parser  'sml-smlnj-error-parser)
 171
 172 ;;; sml-nj.el endeded