First seemingly acceptable new code.

diff --git a/BUGS b/BUGS
new file mode 100644 (file)
index 0000000..2b33216
--- /dev/null
+++ b/BUGS
@@ -0,0 +1,5 @@
+* in SML `!' is like a single-char symbol (not an operator).
+  sml-mode considers it as a tightly-binding prefix.  A similar problem
+  happens with `~'.
+
+* `raise', `div' and `mod' should not be treated like functions.

diff --git a/ChangeLog b/ChangeLog
index b288ca5e47039e96201ed287f83067e08ad4620c..21468268aaae27665a6a1a5fb098950e101b9f32 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,22 @@
+1999-05-29  Stefan Monnier  <monnier@cs.yale.edu>
+
+       * sml-defs.el (sml-mode-syntax-table): added ~ of prefix-syntax.
+
+       * sml-mode.el (sml-find-match-indent): (nilp sml-type-of-indent) is only
+         applied if the `let' is alone at the end of the line.
+       (sml-type-of-indent): default changed to `nil'.
+
+1999-05-28  Stefan Monnier  <monnier@cs.yale.edu>
+
+       * sml-mode.el (sml-font-lock-keywords): changed _ and ' back to word
+         syntax for font-locking.
+
+1999-05-27  Stefan Monnier  <monnier@cs.yale.edu>
+
+       * sml-mode.el (sml-font-lock-syntactic-keywords): finally got the
+         matching of let...end working.
+         (sml-electric-pipe): take a fun sexp (symbol) rather than a fun word.
+

 1998-10-26  Stefan Monnier  <monnier@cs.yale.edu>
 
        * sml-mode.el (sml-font-lock-syntactic-keywords): added syntactic-keywords
 1998-10-26  Stefan Monnier  <monnier@cs.yale.edu>
 
        * sml-mode.el (sml-font-lock-syntactic-keywords): added syntactic-keywords

diff --git a/Makefile b/Makefile
index ce481dee1fdf9e3f07fa382f03d70a82c9e2f6fb..78b78ca76991bc99bdf2b48a9f2949447c00c354 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,8 +1,124 @@
-FILES  = sml-menus sml-mode sml-mosml sml-poly-ml sml-proc
+# Makefile for emacs-lisp package

 
 

-include ../Makefile.rules
+# This file 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 2, or (at your option) any
+# later version.

 
 

-ELCFILES= $(FILES:%=$(ELCSUBDIR)/%.elc)
-PACKAGE        =sml
+# This file 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.

 
 

-all:: sml-mode.info sml-mode.dvi $(ELCFILES)
+EMACS   = emacs
+prefix  = /usr/local
+
+# the directory where you install third-party emacs packges
+lispdir = $(prefix)/share/emacs/site-lisp
+
+# the directory where you installed the elib .elc files.
+# This is only needed if your site-start.el (or default.el) does not
+# set up elib correctly.
+elibdir = $(lispdir)/elib
+
+# the directory where you install the info doc
+infodir = $(prefix)/info
+docdir = $(prefix)/doc
+
+######################################################################
+###        No changes below this line should be necessary          ###
+######################################################################
+
+
+PACKAGE = sml-mode
+
+# the directory where the .elc files will be installed
+elcdir  = $(lispdir)/$(PACKAGE)
+eldir   = $(elcdir)
+
+ELFLAGS        = --eval '(setq load-path (append (list "." "$(elibdir)" "$(lispdir)") load-path))'
+ELC    = $(EMACS) -batch $(ELFLAGS) -f batch-byte-compile
+
+ELFILES        = sml-compat.el sml-util.el sml-defs.el sml-move.el sml-mode.el \
+       sml-proc.el sml-menus.el sml-mosml.el sml-poly-ml.el sml-smlnj.el
+ELCFILES = $(ELFILES:.el=.elc)
+
+TEXEXTS =  *.cps *.fns *.kys *.vr *.tp *.pg *.log *.aux *.toc *.cp *.ky *.fn
+
+.SUFFIXES: .elc .el .info .ps .dvi .texi
+.PHONY: elcfiles info clean distclean default
+.PHONY: install_startup install_elc install install_el install_info
+
+.el.elc:
+       $(ELC) $<
+
+.texi.info:
+       makeinfo $<
+
+.texi.dvi:
+       texi2dvi $<
+
+.dvi.ps:
+       dvips -f $< >$@
+
+######################################################################
+
+default: elcfiles
+
+elcfiles: $(ELCFILES)
+info: $(PACKAGE).info
+
+install_elc: $(ELCFILES)
+       mkdir -p $(elcdir)
+       cp $(ELCFILES) $(elcdir)/
+
+install_el:
+       mkdir -p $(eldir)
+       cp $(ELFILES) $(eldir)/
+
+install_info: $(PACKAGE).info
+       mkdir -p $(infodir)
+       cp *.info* $(infodir)/
+       -[ ! -w $(infodir)/dir ] || install-info $(PACKAGE).info $(infodir)/dir
+
+install_startup:
+       mkdir -p $(lispdir)
+       if grep $(PACKAGE) $(lispdir)/site-start.el >/dev/null 2>&1 || \
+          grep $(PACKAGE) $(lispdir)/default.el >/dev/null 2>&1; then :; else \
+           sed 's/@elcdir@/$(elcdir)/' \
+               $(PACKAGE)-startup.el >>$(lispdir)/site-start.el ;\
+       fi
+
+install_dvi: $(PACKAGE).dvi
+       mkdir -p $(docdir)
+       cp *.dvi $(docdir)/
+
+install: install_elc install_info # install_el
+
+clean:
+       $(RM) .\#* $(TEXEXTS)
+
+distclean: clean
+       $(RM) *.elc *.dvi *.info* *.ps
+
+######################################################################
+###                    don't look below                            ###
+######################################################################
+
+TAG = $(shell echo v$(VERSION) | tr '.' '_')
+ftpdir=/home/ftp/pub/monnier/$(PACKAGE)
+
+dist:
+       cvs tag -F $(TAG) &&\
+       cd $(TMP) &&\
+       cvs export -r $(TAG) -d $(PACKAGE)-$(VERSION) elisp/$(PACKAGE) &&\
+       cd $(PACKAGE)-$(VERSION) &&\
+       gmake info &&\
+       cd .. &&\
+       ztar $(PACKAGE)-$(VERSION) &&\
+       rm -rf $(PACKAGE)-$(VERSION)
+       mv $(TMP)/$(PACKAGE)-$(VERSION).tar.gz $(ftpdir)/
+       ln -sf $(PACKAGE)-$(VERSION).tar.gz $(ftpdir)/$(PACKAGE).tar.gz
+
+
+#ident @(#)$Name$:$Id$

diff --git a/TODO b/TODO
new file mode 100644 (file)
index 0000000..4cb05b9
--- /dev/null
+++ b/TODO
@@ -0,0 +1,106 @@
+-*- sml -*-
+
+* make `end' align on `in' when possible
+
+* if indentation is non-obvious, return a list of possible indentations
+  and choose the first unless the current is one of the possible choices.
+
+* M-| with datatypes gives "|  => " instead of "|  of "
+
+* tab at end or beginning of buffer infinite-loop
+
+* ignore warnings in C-c `
+
+* improve the run-sml to allow running on another machine and to take args
+
+* C-c ` tends to switch to another window
+
+* sample problematic indentations:
+
+let fun toStringFKind {isrec,cconv,inline,...} =
+       (if isSome isrec then "R" else "")^
+       (if cconv = F.CC_FCT then "FCT" else "FUN")^
+       (foo)
+       
+      | toStringFKind =
+       let fun cfun (fk,f,args,body) = let 
+           in (fk, f, args, loop body)
+           end
+           fun foo x = let
+               val 
+           in 
+               
+               let f
+               in if 2 then
+                      ~3
+                  else 
+                      asdf
+               end
+                   
+                   (
+                    if foo then 1 else 2;
+                    ())
+           end
+       end
+      | toStringFKind =
+       let bla
+       in foooooooooo;
+          faaaaaaaaaaa
+       end
+           
+           
+           let bla
+           in (fn toto => 1,
+               fn tata => 2)
+           end
+           
+           let
+           in clet1 (fn [nv] => (Conlv, nv, ndc),
+                     fn ([nv],nle) => F.CON(dcon, tycs, nv, lv, nle))
+                    (lv,[v],le)
+           end
+           
+           let
+           in a d
+                awsdfg
+                sadf
+                (fn bla =>
+                    gfsse
+                  | ss => 
+                    asdf)
+           end
+           (* sadgasgf *) 
+           app (fn (fk,f,args,body as F.APP(F.VAR g,vs)) =>
+                   if not C.escaping f
+                      orelse vs = (map (F.VAR o #1) args) andalso
+                             not (C.escaping g)
+                   then
+                       let val g = F.VAR g
+                       in substitute(f, val2sval g, g)
+                       end
+                       handle NotFound =>
+                              addbind (f, Fun(f, body, args, fk, od))
+                   else addbind (f, Fun(f, body, args, fk, od))
+                 | (fk,f,args,body) =>
+                   addbind (f, Fun(f, body, args, fk, od)))
+           
+           (if 1 then 1 + 2 else
+            if
+                1 then
+                1
+                + df
+            else
+                hell
+                    de
+                    der
+                    +1)
+           
+           case
+               case a
+                of 2 =>
+                   1
+                   + 2
+                 |  => 
+            of 1 =>
+               sd
+             |  => 

diff --git a/sml-compat.el b/sml-compat.el
new file mode 100644 (file)
index 0000000..e43e0f2
--- /dev/null
+++ b/sml-compat.el
@@ -0,0 +1,32 @@
+;;; sml-compat.el
+
+(defconst rcsid-sml-compat "@(#)$Name$:$Id$")
+
+;; Copyright (C) 1999-1999  Stefan Monnier <monnier@cs.yale.edu>
+;;
+;; This program 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 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;
+
+(unless (fboundp 'set-keymap-parents)
+  (defun set-keymap-parents (m parents)
+    (set-keymap-parent
+     m (reduce (lambda (m1 m2)
+                (let ((m (copy-keymap m1)))
+                  (set-keymap-parent m m2) m))
+              parents))))
+
+;;
+(provide 'sml-compat)

diff --git a/sml-defs.el b/sml-defs.el
new file mode 100644 (file)
index 0000000..58f7774
--- /dev/null
+++ b/sml-defs.el
@@ -0,0 +1,153 @@
+;;; sml-move.el
+
+(defconst rcsid-sml-defs "@(#)$Name$:$Id$")
+
+;; Copyright (C) 1999-1999  Stefan Monnier <monnier@cs.yale.edu>
+;;
+;; This program 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 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(require 'cl)
+(require 'sml-util)
+
+;;; 
+;;; Code
+;;; 
+
+(defvar sml-outline-regexp "[ \t]*\\((\\*+\\|\\(let[ \t]+\\)?fun.\\)"
+  "Regexp matching a major heading.")
+
+;;; 
+;;; Internal defines
+;;; 
+
+(defmap sml-bindings
+  ;; smarter cursor movement
+  '((forward-sexp      . sml-user-forward-sexp)
+    (backward-sexp     . sml-user-backward-sexp)
+    ;; Text-formatting commands:
+    ("\C-c\C-m" . sml-insert-form)
+    ("\C-c\C-i" . sml-mode-info)
+    ("\M-|"     . sml-electric-pipe)
+    ("\;"       . sml-electric-semi)
+    ("\M-\t"    . sml-back-to-outer-indent)
+    ("\C-\M-\\" . sml-indent-region)
+    ("\t"       . sml-indent-line)     ; ...except this one
+    ;; Process commands added to sml-mode-map -- these should autoload
+    ("\C-c\C-l" . sml-load-file)
+    ("\C-c`"    . sml-next-error))
+  "Generic bindings used in sml-mode and sml-inferior-mode.")
+
+(defmap sml-mode-map
+  '(("\C-c\C-c" . sml-make)
+    ("\C-c\C-s" . switch-to-sml)
+    ("\C-c\C-r" . sml-send-region)
+    ("\C-c\C-b" . sml-send-buffer))
+  "The keymap used in sml-mode."
+  :inherit sml-bindings)
+
+(defsyntax sml-mode-syntax-table 
+  '((?\*   . ". 23n")
+    (?\(   . "()1")
+    (?\)   . ")(4")
+    ("._'" . "_")
+    (",;"  . ".")
+    ;; `!' is not really a prefix-char, oh well!
+    ("~#!" . "'")
+    ("%&$+-/:<=>?@`^|"  . "."))
+  "The syntax table used in sml-mode.")
+
+;;
+;; regexps
+;;
+
+(defun sml-syms-re (&rest syms)
+  (concat "\\<" (regexp-opt (flatten syms) t) "\\>"))
+
+;;
+
+(defconst sml-module-head-syms
+  '("signature" "structure" "functor" "abstraction"))
+
+(defconst sml-begin-symbols-re
+  (sml-syms-re "let" "abstype" "local" "struct" "sig")
+  "Symbols matching the `end' symbol.")
+
+;; (defconst sml-user-begin-symbols-re
+;;   (sml-syms-re "let" "abstype" "local" "struct" "sig" "in" "with")
+;;   "Symbols matching (loosely) the `end' symbol.")
+
+(defconst sml-sexp-head-symbols-re
+  (sml-syms-re "let" "abstype" "local" "struct" "sig" "in" "with"
+              "if" "then" "else" "case" "of" "fn" "fun" "val" "and"
+              sml-module-head-syms
+              "handle" "raise")
+  "Symbols starting an sexp.")
+
+;; (defconst sml-not-arg-start-re
+;;   (sml-syms-re "in" "of" "end" "andalso")
+;;   "Symbols that can't be found at the head of an arg.")
+
+;; (defconst sml-not-arg-re
+;;   (sml-syms-re "in" "of" "end" "andalso")
+;;   "Symbols that should not be confused with an arg.")
+
+(defconst sml-indent-starters
+  (list
+   (cons "\\<struct\\>" 0)
+   (cons (sml-syms-re sml-module-head-syms) '(sml-indent-level 0))
+   (cons "\\<local\\>" '(sml-indent-level 0))
+   (cons "\\<of\\>" '(3 nil))
+   (cons "\\<else\\>" '(sml-indent-level 0))
+   (cons "\\<in\\>" '(sml-indent-level nil))
+   (cons (sml-syms-re "abstype" "and" "case" "of" "datatype"
+                     "fun" "if" "then" "else" "sharing" "infix" "infixr"
+                     "let" "in" "local" "nonfix" "open" "raise" "sig"
+                     "struct" "type" "val" "while" "do" "with" "withtype")
+        'sml-indent-level))
+  "")
+
+(defconst sml-starters-indent-after
+  (sml-syms-re "let" "local" "struct" "in" "sig" "with")
+  "Indent after these.")
+
+(defconst sml-=-starter-re
+  (sml-syms-re "val" "fun" "and" "datatype" "type" "abstype" "eqtype"
+              sml-module-head-syms)
+  "keywords which can be followed by a `='")
+
+(defconst sml-delegate
+  (list
+   (cons (sml-syms-re "of" "else" "then") '(not (sml-bolp)))
+   (cons "\\<in\\>" t))
+  "Words which might delegate indentation to their parent.")
+
+(defconst sml-starters-syms
+  (append sml-module-head-syms
+         '("abstype" "datatype" "exception" "fun"
+           "local" "infix" "infixr" "sharing" "nonfix"
+           "open" "type" "val" "and"
+           "withtype" "with"))
+  "The starters of new expressions.")
+(defconst sml-starters-re (sml-syms-re sml-starters-syms))
+
+(defconst sml-exptrail-syms
+  '("if" "then" "else" "while" "do" "case" "of" "raise" "fn"))
+
+(defconst sml-pipehead-re
+  (sml-syms-re "fun" "fn" "and" "handle" "case" "datatype" "abstype")
+  "A `|' corresponds to one of these.")
+
+;;
+(provide 'sml-defs)

diff --git a/sml-mode-startup.el b/sml-mode-startup.el
new file mode 100644 (file)
index 0000000..df43c3f
--- /dev/null
+++ b/sml-mode-startup.el
@@ -0,0 +1,17 @@
+;;;
+;;; sample autoload entries for your site-lisp/site-start.el file
+;;;
+
+;;#ident "@(#)$Name$:$Id$"
+
+;; don't forget to add the directory to your load-path
+(setq load-path (cons "@elcdir@" load-path))
+
+;; make sure the mode is loaded when necessary
+(setq auto-mode-alist
+      (cons '("\\.s\\(ml\\|ig\\)\\'" . sml-mode) auto-mode-alist))
+(autoload 'sml-mode "sml-mode" "Major mode for editing SML." t)
+(autoload 'run-sml "sml-proc" "Run an inferior SML process" t)
+
+;; put this also if you feel like it (for SML/NJ's compilation manager)
+(setq completion-ignored-extensions (cons "CM/" completion-ignored-extensions))

diff --git a/sml-mode.el b/sml-mode.el
index 5f7e820f2ad89308bba5906300997c7f672fcc42..1fd5b3f79be7fb3babebd2979919343fbe6bc58e 100644 (file)
--- a/sml-mode.el
+++ b/sml-mode.el
@@ -1,6 +1,8 @@
 ;;; sml-mode.el. Major mode for editing (Standard) ML. Version 3.3(beta)
 
 ;;; sml-mode.el. Major mode for editing (Standard) ML. Version 3.3(beta)
 

-;; Copyright (C) 1989, Lars Bo Nielsen; 1994,1997, Matthew J. Morley
+(defconst rcsid-sml-mode "@(#)$Name$:$Id$")
+
+;; Copyright (C) 1989-1999, Lars Bo Nielsen; 1994,1997, Matthew J. Morley

 
 ;; $Revision$
 ;; $Date$
 
 ;; $Revision$
 ;; $Date$


@@ -37,6 +39,16 @@
 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
 ;; and numerous bugs and bug-fixes.
 
 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
 ;; and numerous bugs and bug-fixes.
 

+;; Author: Lars Bo Nielsen
+;;      Olin Shivers
+;;     Fritz Knabe (?)
+;;     Steven Gilmore (?)
+;;     Matthew Morley <mjm@scs.leeds.ac.uk> (aka <matthew@verisity.com>)
+;;     Matthias Blume <blume@cs.princeton.edu> (aka <blume@kurims.kyoto-u.ac.jp>)
+;;      (Stefan Monnier) monnier@cs.yale.edu
+;; Maintainer: (Stefan Monnier) monnier+lists/emacs/sml@tequila.cs.yale.edu
+;; Keywords: SML
+

 ;;; DESCRIPTION 
 
 ;; See accompanying info file: sml-mode.info
 ;;; DESCRIPTION 
 
 ;; See accompanying info file: sml-mode.info


@@ -96,7 +108,9 @@
   "sml-mode, version 3.3")
 
 (require 'cl)
   "sml-mode, version 3.3")
 
 (require 'cl)

-(provide 'sml-mode)
+(require 'sml-util)
+(require 'sml-move)
+(require 'sml-defs)

 
 ;;; VARIABLES CONTROLLING INDENTATION
 
 
 ;;; VARIABLES CONTROLLING INDENTATION
 


@@ -146,7 +160,7 @@ seems nicer...")
           else if exp5 then exp6                         else if exp5 then exp6
           else exp7                                           else exp7")
 
           else if exp5 then exp6                         else if exp5 then exp6
           else exp7                                           else exp7")
 

-(defvar sml-type-of-indent t
+(defvar sml-type-of-indent nil

   "*How to indent `let' `struct' etc.
     If t:  fun foo bar = let              If nil:  fun foo bar = let
                              val p = 4                 val p = 4
   "*How to indent `let' `struct' etc.
     If t:  fun foo bar = let              If nil:  fun foo bar = let
                              val p = 4                 val p = 4


@@ -209,120 +223,55 @@ See doc for the variable sml-mode-info."
   (interactive)
   (require 'info)
   (condition-case nil
   (interactive)
   (require 'info)
   (condition-case nil

-      (funcall 'Info-goto-node (concat "(" sml-mode-info ")"))
+      (Info-goto-node (concat "(" sml-mode-info ")"))

     (error (progn
              (describe-variable 'sml-mode-info)
              (message "Can't find it... set this variable first!")))))
 
     (error (progn
              (describe-variable 'sml-mode-info)
              (message "Can't find it... set this variable first!")))))
 

-(defun sml-indent-level (&optional indent)
-   "Allow the user to change the block indentation level. Numeric prefix 
-accepted in lieu of prompting."
-   (interactive "NIndentation level: ")
-   (setq sml-indent-level indent))
-
-(defun sml-pipe-indent (&optional indent)
-  "Allow to change pipe indentation level (usually negative). Numeric prefix
-accepted in lieu of prompting."
-   (interactive "NPipe Indentation level: ")
-   (setq sml-pipe-indent indent))
-
-(defun sml-case-indent (&optional of)
-  "Toggle sml-case-indent. Prefix means set it to nil."
-  (interactive "P")
-  (setq sml-case-indent (and (not of) (not sml-case-indent)))
-  (if sml-case-indent (message "%s" "true") (message "%s" nil)))

 
 

-(defun sml-nested-if-indent (&optional of)
-  "Toggle sml-nested-if-indent. Prefix means set it to nil."
-  (interactive "P")
-  (setq sml-nested-if-indent (and (not of) (not sml-nested-if-indent)))
-  (if sml-nested-if-indent (message "%s" "true") (message "%s" nil)))
-
-(defun sml-type-of-indent (&optional of)
-  "Toggle sml-type-of-indent. Prefix means set it to nil."
-  (interactive "P")
-  (setq sml-type-of-indent (and (not of) (not sml-type-of-indent)))
-  (if sml-type-of-indent (message "%s" "true") (message "%s" nil)))
+;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!

 
 

-(defun sml-electric-semi-mode (&optional of)
-  "Toggle sml-electric-semi-mode. Prefix means set it to nil."
-  (interactive "P")
-  (setq sml-electric-semi-mode (and (not of) (not sml-electric-semi-mode)))
-  (message "%s" (concat "Electric semi mode is " 
-                   (if sml-electric-semi-mode "on" "off"))))
-
-;;; BINDINGS: these should be common to the source and process modes...
-
-(defun install-sml-keybindings (map)
-  ;; Text-formatting commands:
-  (define-key map "\C-c\C-m" 'sml-insert-form)
-  (define-key map "\C-c\C-i" 'sml-mode-info)
-  (define-key map "\M-|"     'sml-electric-pipe)
-  (define-key map "\;"       'sml-electric-semi)
-  (define-key map "\M-\t"    'sml-back-to-outer-indent)
-  (define-key map "\C-\M-\\" 'sml-indent-region)
-  (define-key map "\t"       'sml-indent-line) ; ...except this one
-  ;; Process commands added to sml-mode-map -- these should autoload
-  (define-key map "\C-c\C-l" 'sml-load-file)
-  (define-key map "\C-c`"    'sml-next-error))
+(let ((sml-no-doc
+       "This function is part of sml-proc, and has not yet been loaded.
+Full documentation will be available after autoloading the function."))

 
 

-;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!
+  (autoload 'run-sml      "sml-proc"   sml-no-doc t)
+  (autoload 'sml-make     "sml-proc"   sml-no-doc t)
+  (autoload 'sml-load-file   "sml-proc"   sml-no-doc t)

 
 

-(defvar sml-no-doc
-  "This function is part of sml-proc, and has not yet been loaded.
-Full documentation will be available after autoloading the function."
-  "Documentation for autoloading functions.")
-
-(autoload 'run-sml        "sml-proc"   sml-no-doc t)
-(autoload 'sml-make       "sml-proc"   sml-no-doc t)
-(autoload 'sml-load-file   "sml-proc"   sml-no-doc t)
-
-(autoload 'switch-to-sml   "sml-proc"   sml-no-doc t)
-(autoload 'sml-send-region "sml-proc"   sml-no-doc t)
-(autoload 'sml-send-buffer "sml-proc"   sml-no-doc t)
-(autoload 'sml-next-error  "sml-proc"   sml-no-doc t)
-
-(defvar sml-mode-map nil "The keymap used in sml-mode.")
-(cond ((not sml-mode-map)
-       (setq sml-mode-map (make-sparse-keymap))
-       (install-sml-keybindings sml-mode-map)
-       (define-key sml-mode-map "\C-c\C-c" 'sml-make)
-       (define-key sml-mode-map "\C-c\C-s" 'switch-to-sml)
-       (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)
-       (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)))
+  (autoload 'switch-to-sml   "sml-proc"   sml-no-doc t)
+  (autoload 'sml-send-region "sml-proc"   sml-no-doc t)
+  (autoload 'sml-send-buffer "sml-proc"   sml-no-doc t)
+  (autoload 'sml-next-error  "sml-proc"   sml-no-doc t))

 
 ;; font-lock setup
 
 (defconst sml-keywords-regexp
 
 ;; font-lock setup
 
 (defconst sml-keywords-regexp

-  (eval-when-compile
-    (concat
-     "\\<"
-     (regexp-opt '("abstraction" "abstype" "and" "andalso" "as" "before" "case"
-                  "datatype" "else" "end" "eqtype" "exception" "do" "fn"
-                  "fun" "functor" "handle" "if" "in" "include" "infix"
-                  "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"
-                  "overload" "raise" "rec" "sharing" "sig" "signature"
-                  "struct" "structure" "then" "type" "val" "where" "while"
-                  "with" "withtype") t)
-     "\\>"))
+  (sml-syms-re "abstraction" "abstype" "and" "andalso" "as" "before" "case"
+              "datatype" "else" "end" "eqtype" "exception" "do" "fn"
+              "fun" "functor" "handle" "if" "in" "include" "infix"
+              "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"
+              "overload" "raise" "rec" "sharing" "sig" "signature"
+              "struct" "structure" "then" "type" "val" "where" "while"
+              "with" "withtype")

   "A regexp that matches any and all keywords of SML.")
 
 (defconst sml-font-lock-keywords
   `(;;(sml-font-comments-and-strings)
   "A regexp that matches any and all keywords of SML.")
 
 (defconst sml-font-lock-keywords
   `(;;(sml-font-comments-and-strings)

-    ("\\<\\(fun\\|and\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
+    ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)"

      (1 font-lock-keyword-face)
      (2 font-lock-function-def-face))
      (1 font-lock-keyword-face)
      (2 font-lock-function-def-face))

-    ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\s-*\\(\\sw\\|\\s_\\)+\\s-+\\)*\\(\\(\\sw\\|\\s_\\)+\\)"
+    ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\s-*\\sw+\\s-+\\)*\\(\\sw+\\)"

      (1 font-lock-keyword-face)
      (1 font-lock-keyword-face)

-     (5 font-lock-type-def-face))
-    ("\\<\\(val\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\>\\s-*\\)?\\(\\(\\sw\\|\\s_\\)+\\)\\s-*="
+     (4 font-lock-type-def-face))
+    ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*="

      (1 font-lock-keyword-face)
      ;;(6 font-lock-variable-def-face nil t)
      (1 font-lock-keyword-face)
      ;;(6 font-lock-variable-def-face nil t)

-     (4 font-lock-variable-def-face))
-    ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
+     (3 font-lock-variable-def-face))
+    ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\sw+\\)"

      (1 font-lock-keyword-face)
      (2 font-lock-module-def-face))
      (1 font-lock-keyword-face)
      (2 font-lock-module-def-face))

-    ("\\<\\(signature\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
+    ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"

      (1 font-lock-keyword-face)
      (2 font-lock-interface-def-face))
     
      (1 font-lock-keyword-face)
      (2 font-lock-interface-def-face))
     


@@ -343,12 +292,13 @@ Full documentation will be available after autoloading the function."
   (def-face 'font-lock-interface-def-face 'font-lock-type-face)
   (def-face 'font-lock-variable-def-face 'font-lock-variable-name-face))
 
   (def-face 'font-lock-interface-def-face 'font-lock-type-face)
   (def-face 'font-lock-variable-def-face 'font-lock-variable-name-face))
 

-;; (setq sml-alt-syntax-table
-;;       (let ((st (make-syntax-table)))
-;;     (modify-syntax-entry ?l "(d" st)
-;;     (modify-syntax-entry ?d ")l" st)
-;;     (modify-syntax-entry ?\) ")(" st)
-;;     st))
+(defvar sml-syntax-prop-table
+  (let ((st (make-syntax-table)))
+    (modify-syntax-entry ?l "(d" st)
+    (modify-syntax-entry ?s "(d" st)
+    (modify-syntax-entry ?d ")l" st)
+    (modify-syntax-entry ?* "." st)
+    st))

 
 (defun sml-get-depth-st ()
   (save-excursion
 
 (defun sml-get-depth-st ()
   (save-excursion


@@ -366,15 +316,16 @@ Full documentation will be available after autoloading the function."
                    0)))
               (depth (if (> depth 0) depth)))
          (put-text-property pt (1+ pt) 'comment-depth depth)
                    0)))
               (depth (if (> depth 0) depth)))
          (put-text-property pt (1+ pt) 'comment-depth depth)

-         (when depth '(?.)))))))
+         (when depth sml-syntax-prop-table))))))

 
 (defconst sml-font-lock-syntactic-keywords
 
 (defconst sml-font-lock-syntactic-keywords

-  '(;;("\\<\\(l\\)et\\>" (1 (?\( . ?d))) ;; sml-alt-syntax-table))
-    ;;("\\<en\\(d\\)\\>" (1 (?\) . ?l))) ;;sml-alt-syntax-table))
+  `(;;("\\<\\(l\\)\\(et\\|ocal\\)\\>" (1 ',sml-syntax-prop-table))
+    ;;("\\<\\(s\\)\\(ig\\truct\\)\\>" (1 ',sml-syntax-prop-table))
+    ;;("\\<en\\(d\\)\\>" (1 ',sml-syntax-prop-table))

     ("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))
 
 (defconst sml-font-lock-defaults
     ("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))
 
 (defconst sml-font-lock-defaults

-  '(sml-font-lock-keywords nil nil nil nil
+  '(sml-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil

                           (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))
 
 ;; code to get comment fontification working in the face of recursive
                           (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))
 
 ;; code to get comment fontification working in the face of recursive


@@ -434,24 +385,24 @@ Full documentation will be available after autoloading the function."
 
 ;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S
 
 
 ;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S
 

-(cond ((fboundp 'make-extent)
-       ;; suppose this is XEmacs
+;; (cond ((fboundp 'make-extent)
+;;        ;; suppose this is XEmacs

 
 

-       (defun sml-make-overlay ()
-         "Create a new text overlay (extent) for the SML buffer."
-         (let ((ex (make-extent 1 1)))
-           (set-extent-property ex 'face 'zmacs-region) ex))
+;;        (defun sml-make-overlay ()
+;;          "Create a new text overlay (extent) for the SML buffer."
+;;          (let ((ex (make-extent 1 1)))
+;;            (set-extent-property ex 'face 'zmacs-region) ex))

 
 

-       (defalias 'sml-is-overlay 'extentp)
+;;        (defalias 'sml-is-overlay 'extentp)

 
 

-       (defun sml-overlay-active-p ()
-         "Determine whether the current buffer's error overlay is visible."
-         (and (sml-is-overlay sml-error-overlay)
-              (not (zerop (extent-length sml-error-overlay)))))
+;;        (defun sml-overlay-active-p ()
+;;          "Determine whether the current buffer's error overlay is visible."
+;;          (and (sml-is-overlay sml-error-overlay)
+;;               (not (zerop (extent-length sml-error-overlay)))))

 
 

-       (defalias 'sml-move-overlay 'set-extent-endpoints))
+;;        (defalias 'sml-move-overlay 'set-extent-endpoints))

 
 

-      ((fboundp 'make-overlay)
+;;       ((fboundp 'make-overlay)

        ;; otherwise assume it's Emacs
 
        (defun sml-make-overlay ()
        ;; otherwise assume it's Emacs
 
        (defun sml-make-overlay ()


@@ -467,13 +418,13 @@ Full documentation will be available after autoloading the function."
               (not (equal (overlay-start sml-error-overlay)
                           (overlay-end sml-error-overlay)))))
 
               (not (equal (overlay-start sml-error-overlay)
                           (overlay-end sml-error-overlay)))))
 

-       (defalias 'sml-move-overlay 'move-overlay))
-      (t
-       ;; what *is* this!?
-       (defalias 'sml-is-overlay 'ignore)
-       (defalias 'sml-overlay-active-p 'ignore)
-       (defalias 'sml-make-overlay 'ignore)
-       (defalias 'sml-move-overlay 'ignore)))
+       (defalias 'sml-move-overlay 'move-overlay);;)
+;;       (t
+;;        ;; what *is* this!?
+;;        (defalias 'sml-is-overlay 'ignore)
+;;        (defalias 'sml-overlay-active-p 'ignore)
+;;        (defalias 'sml-make-overlay 'ignore)
+;;        (defalias 'sml-move-overlay 'ignore)))

 
 ;;; MORE CODE FOR SML-MODE
 
 
 ;;; MORE CODE FOR SML-MODE
 


@@ -482,47 +433,6 @@ Full documentation will be available after autoloading the function."
   (interactive)
   (message sml-mode-version-string))
 
   (interactive)
   (message sml-mode-version-string))
 

-(defvar sml-mode-syntax-table nil "The syntax table used in sml-mode.")
-(if sml-mode-syntax-table
-    ()
-  (setq sml-mode-syntax-table (make-syntax-table))
-  ;; Set everything to be "." (punctuation) except for [A-Za-z0-9],
-  ;; which will default to "w" (word-constituent).
-  (let ((i 0))
-    (while (< i ?0)
-      (modify-syntax-entry i "." sml-mode-syntax-table)
-      (setq i (1+ i)))
-    (setq i (1+ ?9))
-    (while (< i ?A)
-      (modify-syntax-entry i "." sml-mode-syntax-table)
-      (setq i (1+ i)))
-    (setq i (1+ ?Z))
-    (while (< i ?a)
-      (modify-syntax-entry i "." sml-mode-syntax-table)
-      (setq i (1+ i)))
-    (setq i (1+ ?z))
-    (while (< i 128)
-      (modify-syntax-entry i "." sml-mode-syntax-table)
-      (setq i (1+ i))))
-
-  ;; Now we change the characters that are meaningful to us.
-  (modify-syntax-entry ?.      "_"     sml-mode-syntax-table)
-  (modify-syntax-entry ?\\     "\\"    sml-mode-syntax-table)
-  (modify-syntax-entry ?\(      "()1"   sml-mode-syntax-table)
-  (modify-syntax-entry ?\)      ")(4"   sml-mode-syntax-table)
-  (modify-syntax-entry ?\[      "(]"    sml-mode-syntax-table)
-  (modify-syntax-entry ?\]      ")["    sml-mode-syntax-table)
-  (modify-syntax-entry ?{       "(}"    sml-mode-syntax-table)
-  (modify-syntax-entry ?}       "){"    sml-mode-syntax-table)
-  (modify-syntax-entry ?\*      ". 23"  sml-mode-syntax-table)
-  (modify-syntax-entry ?\"      "\""    sml-mode-syntax-table)
-  (modify-syntax-entry ?        " "     sml-mode-syntax-table)
-  (modify-syntax-entry ?\t      " "     sml-mode-syntax-table)
-  (modify-syntax-entry ?\n      " "     sml-mode-syntax-table)
-  (modify-syntax-entry ?\f      " "     sml-mode-syntax-table)
-  (modify-syntax-entry ?\'      "_"     sml-mode-syntax-table)
-  (modify-syntax-entry ?\_      "_"     sml-mode-syntax-table))
-

 ;;;###Autoload
 (defun sml-mode ()
   "Major mode for editing ML code.
 ;;;###Autoload
 (defun sml-mode ()
   "Major mode for editing ML code.


@@ -553,7 +463,7 @@ sml-case-indent (default nil)
 sml-nested-if-indent (default nil)
     Determine how nested if-then-else expressions are formatted.
 
 sml-nested-if-indent (default nil)
     Determine how nested if-then-else expressions are formatted.
 

-sml-type-of-indent (default t)
+sml-type-of-indent (default nil)

     How to indent let, struct, local, etc.
     Will not have any effect if the starting keyword is first on the line.
 
     How to indent let, struct, local, etc.
     Will not have any effect if the starting keyword is first on the line.
 


@@ -574,6 +484,7 @@ Mode map
   (use-local-map sml-mode-map)
   (setq major-mode 'sml-mode)
   (setq mode-name "SML")
   (use-local-map sml-mode-map)
   (setq major-mode 'sml-mode)
   (setq mode-name "SML")

+  (set (make-local-variable 'outline-regexp) sml-outline-regexp)

   (run-hooks 'sml-mode-hook))            ; Run the hook last
 
 (defun sml-mode-variables ()
   (run-hooks 'sml-mode-hook))            ; Run the hook last
 
 (defun sml-mode-variables ()


@@ -591,16 +502,10 @@ Mode map
   (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")
   (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)
   (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)
   (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")
   (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)
   (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)

-  (set (make-local-variable 'parse-sexp-lookup-properties) t)
-  (set (make-local-variable 'parse-sexp-ignore-comments) t)
+  ;;(set (make-local-variable 'parse-sexp-lookup-properties) t)
+  ;;(set (make-local-variable 'parse-sexp-ignore-comments) t)

   (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))
 
   (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))
 

-  ;; Adding these will fool the matching of parens -- because of a
-  ;; bug in Emacs (in scan_lists, i think)... it would be nice to 
-  ;; have comments treated as white-space.
-  ;;(make-local-variable 'parse-sexp-ignore-comments)
-  ;;(setq parse-sexp-ignore-comments t)
-

 (defun sml-error-overlay (undo &optional beg end buffer)
   "Move `sml-error-overlay' so it surrounds the text region in the
 current buffer. If the buffer-local variable `sml-error-overlay' is
 (defun sml-error-overlay (undo &optional beg end buffer)
   "Move `sml-error-overlay' so it surrounds the text region in the
 current buffer. If the buffer-local variable `sml-error-overlay' is


@@ -623,67 +528,39 @@ the overlay should simply be removed: \\[universal-argument] \
                 (end (or end (region-end))))
             (sml-move-overlay sml-error-overlay beg end))))))
 
                 (end (or end (region-end))))
             (sml-move-overlay sml-error-overlay beg end))))))
 

-(defconst sml-pipe-matchers-reg
-  (eval-when-compile
-    (concat
-     "\\<"
-     (regexp-opt '("case" "fn" "fun" "handle" "datatype" "abstype" "and") t)
-     "\\>"))
-  "The keywords a `|' can follow.")
-

 (defun sml-electric-pipe ()
 (defun sml-electric-pipe ()

-  "Insert a \"|\". 
+  "Insert a \"|\".

 Depending on the context insert the name of function, a \"=>\" etc."
   (interactive)
 Depending on the context insert the name of function, a \"=>\" etc."
   (interactive)

-  (let ((case-fold-search nil)          ; Case sensitive
-        (here (point))
-        (match (save-excursion
-                 (sml-find-matching-starter sml-pipe-matchers-reg)
-                 (point)))
-        (tmp "  => ")
-        (case-or-handle-exp t))
-    (if (/= (save-excursion (beginning-of-line) (point))
-            (save-excursion (skip-chars-backward "\t ") (point)))
-        (insert "\n"))
-    (insert "|")
-    (save-excursion
-      (goto-char match)
-      (cond
-       ;; It was a function, insert the function name
-       ((looking-at "fun\\b")
-        (setq tmp (concat " " (buffer-substring
-                               (progn (forward-char 3)
-                                      (skip-chars-forward "\t\n ") (point))
-                               (progn (forward-word 1) (point))) " "))
-        (setq case-or-handle-exp nil))
-       ;; It was a datatype, insert nothing
-       ((looking-at "datatype\\b\\|abstype\\b")
-        (setq tmp " ") (setq case-or-handle-exp nil))
-       ;; If it is an and, then we have to see what is was
-       ((looking-at "and\\b")
-        (let (isfun)
-          (save-excursion
-            (condition-case ()
-                (progn
-                  (re-search-backward "datatype\\b\\|abstype\\b\\|fun\\b")
-                  (setq isfun (looking-at "fun\\b")))
-              (error (setq isfun nil))))
-          (if isfun
-              (progn
-                (setq tmp
-                      (concat " " (buffer-substring
-                                   (progn (forward-char 3)
-                                          (skip-chars-forward "\t\n ") (point))
-                                   (progn (forward-word 1) (point))) " "))
-                (setq case-or-handle-exp nil))
-            (setq tmp " ") (setq case-or-handle-exp nil))))))
-    (insert tmp)
-    (sml-indent-line)
-    (beginning-of-line)
-    (skip-chars-forward "\t ")
-    (forward-char (1+ (length tmp)))
-    (if case-or-handle-exp
-        (forward-char -4))))
+  (sml-with-ist
+   (let ((text
+         (save-excursion
+           (sml-find-matching-starter sml-pipehead-re)
+           (cond
+            ;; It was a function, insert the function name
+            ((or (looking-at "fun\\>")
+                 (and (looking-at "and\\>")
+                      (save-excursion
+                        (sml-find-matching-starter
+                         (sml-syms-re "datatype" "abstype" "fun"))
+                        (looking-at "fun\\>"))))
+             (forward-word 1) (sml-forward-spaces)
+             (concat
+              (buffer-substring (point) (progn (forward-word 1) (point)))
+              "  = "))
+
+            ((looking-at (sml-syms-re "case" "handle" "fn")) " => ")
+            ((looking-at (sml-syms-re "abstype" "datatype" "and")) "")
+            (t (error "Wow, now, there's a bug"))))))
+
+     (unless (save-excursion (skip-chars-backward "\t ") (bolp)) (insert "\n"))
+     (insert "| " text)
+     (sml-indent-line)
+     (beginning-of-line)
+     (skip-chars-forward "\t |")
+     (skip-syntax-forward "w")
+     (skip-chars-forward "\t ")
+     (when (= ?= (char-after)) (backward-char)))))

 
 (defun sml-electric-semi ()
   "Inserts a \;.
 
 (defun sml-electric-semi ()
   "Inserts a \;.


@@ -746,51 +623,6 @@ If anyone has a good algorithm for this..."
                   (setq indent 0))))
             (backward-delete-char-untabify (- start-column indent)))))))
 
                   (setq indent 0))))
             (backward-delete-char-untabify (- start-column indent)))))))
 

-(defconst sml-indent-starters-reg
-  (eval-when-compile
-    (concat "\\<"
-           (regexp-opt '("abstype" "and" "case" "datatype" "else"
-                         "fun" "if" "sharing" "in" "infix" "infixr"
-                         "let" "local" "nonfix" "of" "open" "raise" "sig"
-                         "struct" "then" "btype" "val"
-                         "while" "with" "withtype") t)
-           ;; removed "signature" "structure" "functor"
-           "\\>"))
-  "The indentation starters. The next line will be indented.")
-
-(defconst sml-starters-reg
-  (eval-when-compile
-    (concat "\\<"
-           (regexp-opt '("abstraction" "abstype" "datatype" "exception" "fun"
-                          "functor" "local" "infix" "infixr" "sharing" "nonfix"
-                          "open" "signature" "structure" "type" "val"
-                          "withtype" "with") t)
-           "\\>"))
-  "The starters of new expressions.")
-
-(defconst sml-end-starters-reg
-  (eval-when-compile
-    (concat "\\<" (regexp-opt '("let" "local" "sig" "struct" "with") t) "\\>"))
-  "Matching reg-expression for the \"end\" keyword.")
-
-(defconst sml-starters-indent-after
-  (eval-when-compile
-    (concat "\\<" (regexp-opt '("let" "local" "struct" "in" "sig" "with") t)
-           "\\>"))
-  "Indent after these.")
-
-(defconst sml-pipehead-regexp
-  (eval-when-compile
-    (concat "\\<" (regexp-opt '("fun" "fn" "and" "handle" "case" "datatype") t)
-           "\\>"))
-  "A `|' corresponds to one of these.")
-
-(defconst sml-not-arg-regexp
-  (eval-when-compile
-    (concat "\\<" (regexp-opt '("in" "of" "end") t) "\\>"))
-  "Regexp matching lines that should never be indented as args.")
-
-

 (defun sml-find-comment-indent ()
   (save-excursion
     (let ((depth 1))
 (defun sml-find-comment-indent ()
   (save-excursion
     (let ((depth 1))


@@ -806,330 +638,358 @@ If anyone has a good algorithm for this..."
 
 (defun sml-calculate-indentation ()
   (save-excursion
 
 (defun sml-calculate-indentation ()
   (save-excursion

-    (let ((case-fold-search nil)
-         (indent 0))
-      (or
-       (and (beginning-of-line) nil)
-       (and (bobp) 0)
-       (and (skip-chars-forward "\t ") nil)
-
-       ;; Indentation for comments alone on a line, matches the
-       ;; proper indentation of the next line.
-       (and (looking-at comment-start-skip) (sml-skip-spaces) nil)
-
-       ;; continued comment
-       (and (looking-at "\\*") (setq indent (sml-find-comment-indent))
-         (1+ indent))
-
-       ;; Continued string ? (Added 890113 lbn)
-       (and (looking-at "\\\\")
-           (save-excursion
-             (if (save-excursion (previous-line 1)
-                                 (beginning-of-line)
-                                 (looking-at "[\t ]*\\\\"))
-                 (progn (previous-line 1) (current-indentation))
-               (if (re-search-backward "[^\\\\]\"" nil t)
-                   (1+ (current-indentation))
-                 0))))
-
-       (and (looking-at "and\\>")
-           (if (sml-find-matching-starter sml-starters-reg)
-               (current-column)
-             0))
-
-       (and (looking-at "in\\>")          ; Match the beginning let/local
-           (sml-find-match-indent "in" "\\<in\\>" "\\<l\\(ocal\\|et\\)\\>"))
-
-       (and (looking-at "end\\>")         ; Match the beginning
-           (sml-find-match-indent "end" "\\<end\\>" sml-end-starters-reg))
-
-       (and (looking-at "else\\>")        ; Match the if
-           (progn
-             (sml-find-match-backward "else" "\\<else\\>" "\\<if\\>")
-             (let ((indent (current-column)))
-               (if (and sml-nested-if-indent
-                        (progn (sml-backward-sexp)
-                               (looking-at "else[ \t]+if\\b")))
-                   (current-column)
-                 indent))))
-
-       (and (looking-at "then\\>")        ; Match the if + extra indentation
-           (sml-find-match-indent "then" "\\<then\\>" "\\<if\\>" t))
-
-       (and (looking-at "of\\>")
-           (progn
-             (sml-re-search-backward "\\<case\\>")
-             (+ (current-column) sml-indent-case-of)))
-
-       (and (looking-at sml-starters-reg)
-           (let ((start (point)))
-             (if (not (sml-backward-sexp))
-                 (if (and (looking-at sml-starters-indent-after)
-                          (/= start (point)))
-                     (+ (if sml-type-of-indent
+    (beginning-of-line) (skip-chars-forward "\t ")
+    (sml-with-ist
+     (let ((indent 0)
+          (sml-point (point)))
+       (or
+       ;;(and (bobp) 0)
+
+       ;; Indentation for comments alone on a line, matches the
+       ;; proper indentation of the next line.
+       (and (looking-at comment-start-skip) (sml-forward-spaces) nil)
+
+       ;; continued comment
+       (and (looking-at "\\*") (setq indent (sml-find-comment-indent))
+            (1+ indent))
+
+       ;; Continued string ? (Added 890113 lbn)
+       (and (looking-at "\\\\")
+            (save-excursion
+              (if (save-excursion (previous-line 1)
+                                  (beginning-of-line)
+                                  (looking-at "[\t ]*\\\\"))
+                  (progn (previous-line 1) (current-indentation))
+                (if (re-search-backward "[^\\\\]\"" nil t)
+                    (1+ (current-indentation))
+                  0))))
+
+       (and (looking-at "in\\>")       ; Match the beginning let/local
+            (sml-find-match-indent "\\<in\\>" "\\<l\\(ocal\\|et\\)\\>"))
+
+       (and (looking-at "end\\>")      ; Match the beginning
+            ;; FIXME: should match "in" if available.  Or maybe not
+            (sml-find-match-indent "\\<end\\>" sml-begin-symbols-re))
+
+       (and (looking-at "else\\>")     ; Match the if
+            (progn
+              (sml-find-match-backward "\\<else\\>" "\\<if\\>")
+              (sml-move-if (backward-word 1)
+                           (and sml-nested-if-indent
+                                (looking-at "else[ \t]+if\\>")))
+              (current-column)))
+
+       (and (looking-at "then\\>")     ; Match the if + extra indentation
+            (sml-find-match-indent "\\<then\\>" "\\<if\\>" t))
+
+       (and (looking-at "of\\>")
+            (progn
+              (sml-find-match-backward "\\<of\\>" "\\<case\\>")
+              (+ (current-column) sml-indent-case-of)))
+
+       (and (looking-at sml-starters-re)
+            (let ((sym (sml-move-read (sml-move-if (not (sml-backward-arg))))))
+              (if sym (sml-get-sym-indent sym)
+                (sml-find-matching-starter sml-starters-re)
+                (current-column))))
+
+       (and (looking-at "|") (sml-indent-pipe))
+
+       (sml-indent-arg)
+       (sml-indent-default))))))
+
+;;       (let ((indent (current-column)))
+;;         ;;(skip-chars-forward "\t (")
+;;         (cond
+;;          ;; a "let fun" or "let val"
+;;          ((looking-at "let \\(fun\\|val\\)\\>")
+;;           (+ (current-column) 4 sml-indent-level))
+;;          ;; Started val/fun/structure...
+;;          ;; Indent after "=>" pattern, but only if its not an fn _ =>
+;;          ;; (890726)
+;;          ((looking-at ".*=>")
+;;           (if (looking-at ".*\\<fn\\>.*=>")
+;;               indent
+;;             (+ indent sml-indent-case-arm)))
+;;          ;; else keep the same indentation as previous line
+;;          (t indent)))))))))
+
+
+       ;;(and (setq indent (sml-get-indent)) nil)
+
+       ;;(and (looking-at "=[^>]") (+ indent sml-indent-equal))
+       ;;(and (looking-at "fn\\>") (+ indent sml-indent-fn))
+       ;;       (and (looking-at "(") (+ indent sml-indent-paren))
+
+       ;;(and sml-paren-lookback    ; Look for open parenthesis ?
+       ;;    (max indent (sml-get-paren-indent)))
+       ;;indent)))))
+
+(defun sml-indent-pipe ()
+  (when (sml-find-matching-starter (concat "|\\|\\<of\\>\\|" sml-pipehead-re)
+                                  (sml-op-prec "|" 'back))
+    (if (looking-at "|")
+       (if (sml-bolp) (current-column) (sml-indent-pipe))
+      (cond
+       ((looking-at "datatype")
+       (re-search-forward "=")
+       (forward-char))
+       ((looking-at "case\\>")
+       (sml-forward-sym)       ;skip `case'
+       (sml-find-match-forward "\\<case\\>" "\\<of\\>"))
+       (t
+       (forward-word 1)))
+      (sml-forward-spaces)
+      (+ sml-pipe-indent (current-column)))))
+
+
+(defun sml-indent-arg ()
+  (and (save-excursion (ignore-errors (sml-forward-arg)))
+       ;;(not (looking-at sml-not-arg-re))
+       ;; looks like a function or an argument
+       (sml-move-if (sml-backward-arg))
+       ;; an argument
+       (if (save-excursion (not (sml-backward-arg)))
+          ;; a first argument
+          (+ (current-column) sml-indent-args)
+        ;; not a first arg
+        (while (and (/= (current-column) (current-indentation))
+                    (sml-move-if (sml-backward-arg))))
+        (unless (save-excursion (sml-backward-arg))
+          ;; all earlier args are on the same line
+          (sml-forward-arg) (sml-forward-spaces))
+        (current-column))))
+
+(defun sml-re-assoc (al sym)
+  (when sym
+    (cdr (assoc* sym al
+                :test (lambda (x y) (string-match y x))))))
+(defun sml-get-indent (data n &optional strict)
+  (eval (if (listp data)
+           (nth n data)
+         (and (not strict) data))))
+
+(defun sml-dangling-sym ()
+  (save-excursion
+    (and (not (sml-bolp))
+        (< (sml-point-after (end-of-line))
+           (sml-point-after (sml-forward-sym)
+                            (sml-forward-spaces))))))
+
+(defun sml-get-sym-indent (sym &optional style)
+  "expects to be looking-at SYM."
+  (let ((indent-data (sml-re-assoc sml-indent-starters sym))
+       (delegate (eval (sml-re-assoc sml-delegate sym))))
+    (or (when indent-data
+         (if (or style (not delegate))
+             ;; normal indentation
+             (let ((indent (sml-get-indent indent-data (or style 0))))
+               (when indent
+                 (+ (if (sml-dangling-sym)
+                        (sml-indent-default 'noindent)
+                      (current-column))
+                    indent)))
+           ;; delgate indentation to the parent
+           (sml-forward-sym) (sml-backward-sexp nil)
+           (let* ((parent-sym (save-excursion (sml-move-read (sml-forward-sym))))
+                  (parent-indent (sml-re-assoc sml-indent-starters parent-sym)))
+             ;; check the special rules
+             (sml-move-if (backward-word 1)
+                          (looking-at "\\<else[ \t]+if\\>"))
+             (+ (if (sml-dangling-sym)
+                    (sml-indent-default 'noindent)
+                  (current-column))
+                (or (sml-get-indent indent-data 1 'strict)
+                    (sml-get-indent parent-indent 1 'strict)
+                    (sml-get-indent indent-data 0)
+                    (sml-get-indent parent-indent 0))))))
+       ;; (save-excursion
+       ;;   (sml-forward-sym)
+       ;;   (when (> (sml-point-after (end-of-line))
+       ;;            (progn (sml-forward-spaces) (point)))
+       ;;     (current-column)))
+       )))
+
+(defun sml-indent-default (&optional noindent)
+  (let* ((sym-after (save-excursion (sml-move-read (sml-forward-sym))))
+        (prec-after (sml-op-prec sym-after 'back))
+        (_ (sml-backward-spaces))
+        (sym-before (sml-move-read (sml-backward-sym)))
+        (prec (or (sml-op-prec sym-before 'back) prec-after 100))
+        sexp)
+    (or (and sym-before (sml-get-sym-indent sym-before))
+       (progn
+         ;;(sml-forward-sym)
+         (while (and (not (sml-bolp))
+                     (sml-move-if (sml-backward-sexp (1- prec)))
+                     (not (sml-bolp)))
+           (while (sml-move-if (sml-backward-sexp prec))))
+         (or (and (not (sml-bolp))
+                  (= prec 65) (string-equal "=" sym-before) ;Yuck!!
+                  (save-excursion
+                    (sml-backward-spaces)
+                    (let* ((sym (sml-move-read (sml-backward-sym)))
+                           (sym-indent (sml-re-assoc sml-indent-starters sym)))
+                      (when sym-indent
+                        (if noindent

                             (current-column)
                             (current-column)

-                          (if (progn (beginning-of-line)
-                                     (skip-chars-forward "\t ")
-                                     (looking-at "|"))
-                              (- (current-indentation) sml-pipe-indent)
-                            (current-indentation)))
-                        sml-indent-level)
-                   (beginning-of-line)
-                   (skip-chars-forward "\t ")
-                   (if (and (looking-at sml-starters-indent-after)
-                            (/= start (point)))
-                       (+ (if sml-type-of-indent
-                              (current-column)
-                            (current-indentation))
-                          sml-indent-level)))
-               (goto-char start)
-               (if (sml-find-matching-starter sml-starters-reg)
-                   (current-column)
-                 0))))
-
-       (and (looking-at "|")
-           (when (sml-find-matching-starter sml-pipehead-regexp)
-             (cond
-              ((looking-at "datatype")
-               (re-search-forward "=[ \n\t]*") nil t)
-              ((looking-at "case\\>")
-               (forward-word 1)        ;skip `case'
-               (sml-forward-sexps "of\\>")     ;skip the argument
-               (sml-forward-word)      ;skif the `of'
-               (sml-skip-spaces))
-              (t
-               (forward-word 1)
-               (sml-skip-spaces)))
-             (+ sml-pipe-indent (current-column))))
-
-       (and (setq indent (sml-get-indent)) nil)
-
-       (and (looking-at "=[^>]") (+ indent sml-indent-equal))
-       (and (looking-at "fn\\>") (+ indent sml-indent-fn))
-;;       (and (looking-at "(") (+ indent sml-indent-paren))
-
-       (and sml-paren-lookback    ; Look for open parenthesis ?
-           (max indent (sml-get-paren-indent)))
-       indent))))
-
-(defun sml-goto-first-subexp ()
-  (let ((initpoint (point)))
-    (skip-chars-forward " \t")
-    (let ((argp (and (looking-at "[\\-\\[({a-zA-Z0-9_'#~+*]\\|$")
-                    (not (looking-at (concat "[ \t]*" sml-not-arg-regexp))))))
-      (while (and argp (not (bobp)))
-       (let* ((endpoint (point))
-              (startpoint endpoint))
-         (setq argp
-               (condition-case ()
-                   (progn (backward-sexp 1)
-                          (setq startpoint (point))
-                          (and (not (looking-at sml-keywords-regexp))
-                               (progn (forward-sexp 1)
-                                      (sml-skip-spaces
-                                       (concat comment-start-skip "\\|[-~+*]"))
-                                      (>= (point) endpoint))))
-                 (error nil)))
-         (goto-char (if argp startpoint endpoint))))
-      (let ((res (point)))
-       (skip-syntax-backward " ") (skip-syntax-backward "^ ")
-       (if (looking-at "*\\|:[^=]\\|->\\|of\\>")
-           (goto-char initpoint)
-         (goto-char res)
-         (sml-skip-spaces))))))
-
-(defun sml-get-indent ()
+                          (sml-get-sym-indent sym 1))))))
+             (current-column))))))
+
+
+(defun sml-bolp ()

   (save-excursion
   (save-excursion

-    (let ((case-fold-search nil)
-         (endpoint (point))
-         rover)
-      (beginning-of-line)
-
-      ;; let's try to see whether we are inside an expression
-      (sml-goto-first-subexp)
-      (setq rover (current-column))
-      (sml-skip-spaces)
-      (if (< (point) endpoint)
-         (progn                        ; we're not the first subexp
-           (sml-forward-sexp)
-           (if (and sml-indent-align-args
-                    (< (point) endpoint)
-                    (re-search-forward "[^ \n\t]" endpoint t))
-               ;; we're not the second subexp
-               (- (current-column) 1)
-             (+ rover sml-indent-args)))
-
-       (goto-char endpoint)
-       ;; we're not inside an expr
-       (skip-syntax-backward " ") (skip-chars-backward ";")
-       (if (looking-at ";") (sml-backward-sexp))
-       (cond
-        ((save-excursion (sml-backward-sexp) (looking-at "end\\>"))
-         (- (current-indentation) sml-indent-level))
-        (t
-         (while (/= (point)
-                    (save-excursion
-                      (beginning-of-line)
-                      (skip-chars-forward " \t|")
-                      (point)))
-           (sml-backward-sexp))
-         (when (looking-at "of") (forward-char 2))
-         (skip-chars-forward "\t |")
-         (let ((indent (current-column)))
-           (skip-chars-forward "\t (")
-           (cond
-            ;; a "let fun" or "let val"
-            ((looking-at "let \\(fun\\|val\\)\\>")
-             (+ (current-column) 4 sml-indent-level))
-            ;; Started val/fun/structure...
-            ((looking-at sml-indent-starters-reg)
-             (+ (current-column) sml-indent-level))
-            ;; Indent after "=>" pattern, but only if its not an fn _ =>
-            ;; (890726)
-            ((looking-at ".*=>")
-             (if (looking-at ".*\\<fn\\>.*=>")
-                 indent
-               (+ indent sml-indent-case-arm)))
-            ;; else keep the same indentation as previous line
-            (t indent)))))))))
-
-(defun sml-get-paren-indent ()
+    (skip-chars-backward " \t|") (bolp)))
+
+;; (defun sml-goto-first-subexp ()
+;;   (let ((initpoint (point)))
+    
+;;     (let ((argp (and (looking-at "[[({a-zA-Z0-9_'#~]\\|$")
+;;                  (not (looking-at (concat "[ \t]*" sml-not-arg-regexp))))))
+;;       (while (and argp (not (bobp)))
+;;     (let* ((endpoint (point))
+;;            (startpoint endpoint))
+;;       (setq argp
+;;             (ignore-errors
+;;              (sml-backward-sexp t)
+;;              (setq startpoint (point))
+;;              (and (not (looking-at (concat "[[(]\\|" sml-keywords-regexp)))
+;;                   (progn (sml-forward-sexp)
+;;                          (sml-skip-spaces)
+;;                          (>= (point) endpoint)))))
+;;       (goto-char (if argp startpoint endpoint))))
+;;       (let ((res (point)))
+;;     (sml-backward-spaces) (skip-syntax-backward "^ ")
+;;     (if (looking-at "*\\|:[^=]\\|->\\|of\\>")
+;;         (goto-char initpoint)
+;;       (goto-char res)
+;;       (sml-skip-spaces))))))
+
+;; maybe `|' should be set to word-syntax in our temp syntax table ?
+(defun sml-current-indentation ()

   (save-excursion
   (save-excursion

-    (let ((levelpar 0)                  ; Level of "()"
-          (levelcurl 0)                 ; Level of "{}"
-          (levelsqr 0)                  ; Level of "[]"
-          (backpoint (max (- (point) sml-paren-lookback) (point-min))))
-      (catch 'loop
-        (while (and (/= levelpar 1) (/= levelsqr 1) (/= levelcurl 1))
-          (if (re-search-backward "[][{}()]" backpoint t)
-              (if (not (sml-inside-comment-or-string-p))
-                  (cond
-                   ((looking-at "(") (setq levelpar (1+ levelpar)))
-                   ((looking-at ")") (setq levelpar (1- levelpar)))
-                   ((looking-at "\\[") (setq levelsqr (1+ levelsqr)))
-                   ((looking-at "\\]") (setq levelsqr (1- levelsqr)))
-                   ((looking-at "{") (setq levelcurl (1+ levelcurl)))
-                   ((looking-at "}") (setq levelcurl (1- levelcurl)))))
-            (throw 'loop 0)))           ; Exit with value 0
-        (if (save-excursion
-              (forward-char 1)
-              (looking-at sml-indent-starters-reg))
-            (1+ (+ (current-column) sml-indent-level))
-          (1+ (current-column)))))))
-
-(defun sml-inside-comment-or-string-p ()
-  (let ((start (point)))
-    (if (save-excursion
-          (condition-case ()
-              (progn
-                (search-backward "(*")
-                (search-forward "*)")
-                (forward-char -1)       ; A "*)" is not inside the comment
-                (> (point) start))
-            (error nil)))
-        t
-      (let ((numb 0))
-        (save-excursion
-          (save-restriction
-            (narrow-to-region (progn (beginning-of-line) (point)) start)
-            (condition-case ()
-                (while t
-                  (search-forward "\"")
-                  (setq numb (1+ numb)))
-              (error (if (and (not (zerop numb))
-                              (not (zerop (% numb 2))))
-                         t nil)))))))))
-
-(defun sml-find-match-backward (unquoted-this this match)
-  (let ((case-fold-search nil)
-       (level 1)
-       (pattern (concat this "\\|" match)))
-    (while (not (zerop level))
-      (if (sml-re-search-backward pattern)
-         (setq level (cond
-                      ((looking-at this) (1+ level))
-                      ((looking-at match) (1- level))))
-       ;; The right match couldn't be found
-       (error (concat "Unbalanced: " unquoted-this))))))
-
-(defun sml-find-match-indent (unquoted-this this match &optional indented)
+    (beginning-of-line)
+    (skip-chars-forward " \t|")
+    (current-column)))
+
+;; (defun sml-get-indent ()
+;;   (save-excursion
+;;     ;;(let ((endpoint (point)))
+
+;;       ;; let's try to see whether we are inside an `f a1 a2 ..' expression
+;;       ;;(sml-goto-first-subexp)
+;;       ;;(setq rover (current-column))
+;;       ;;(sml-skip-spaces)
+;;       (cond
+;; ;;        ((< (point) endpoint)
+;; ;;  ;; we're not the first subexp
+;; ;;  (sml-forward-sexp)
+;; ;;  (if (and sml-indent-align-args
+;; ;;           (progn (sml-skip-spaces) (< (point) endpoint)))
+;; ;;      ;; we're not the second subexp
+;; ;;      (current-column)
+;; ;;    (+ rover sml-indent-args)))
+
+;;        ;; we're not inside an `f a1 a2 ..' expr
+;;        ((progn ;;(goto-char endpoint)
+;;            (sml-backward-spaces)
+;;            (/= (skip-chars-backward ";,") 0))
+;;     (sml-backward-sexps (concat "[[(]\\'\\|" sml-user-begin-symbols-re))
+;;     (current-column))
+
+;;        (t
+;;     (while (/= (current-column) (current-indentation))
+;;       (sml-backward-sexp t))
+;;     (when (looking-at "\\<of\\>") (forward-word 1))
+;;     (skip-chars-forward "\t |")
+;;     (let ((indent (current-column)))
+;;       ;;(skip-chars-forward "\t (")
+;;       (cond
+;;        ;; a "let fun" or "let val"
+;;        ((looking-at "let \\(fun\\|val\\)\\>")
+;;         (+ (current-column) 4 sml-indent-level))
+;;        ;; Started val/fun/structure...
+;;        ((looking-at sml-indent-starters-reg)
+;;         (+ (current-column) sml-indent-level))
+;;        ;; Indent after "=>" pattern, but only if its not an fn _ =>
+;;        ;; (890726)
+;;        ((looking-at ".*=>")
+;;         (if (looking-at ".*\\<fn\\>.*=>")
+;;             indent
+;;           (+ indent sml-indent-case-arm)))
+;;        ;; else keep the same indentation as previous line
+;;        (t indent)))))))
+
+;; (defun sml-get-paren-indent ()
+;;   (save-excursion
+;;     (condition-case ()
+;;     (progn
+;;       (up-list -1)
+;;       (if (save-excursion
+;;             (forward-char 1)
+;;             (looking-at sml-indent-starters-reg))
+;;           (1+ (+ (current-column) sml-indent-level))
+;;         (1+ (current-column))))
+;;       (error 0))))
+
+;; (defun sml-inside-comment-or-string-p ()
+;;   (let ((start (point)))
+;;     (if (save-excursion
+;;           (condition-case ()
+;;               (progn
+;;                 (search-backward "(*")
+;;                 (search-forward "*)")
+;;                 (forward-char -1)       ; A "*)" is not inside the comment
+;;                 (> (point) start))
+;;             (error nil)))
+;;         t
+;;       (let ((numb 0))
+;;         (save-excursion
+;;           (save-restriction
+;;             (narrow-to-region (progn (beginning-of-line) (point)) start)
+;;             (condition-case ()
+;;                 (while t
+;;                   (search-forward "\"")
+;;                   (setq numb (1+ numb)))
+;;               (error (if (and (not (zerop numb))
+;;                               (not (zerop (% numb 2))))
+;;                          t nil)))))))))
+
+;; (defun sml-find-match-backward (unquoted-this this match)
+;;   (let ((case-fold-search nil)
+;;     (level 1)
+;;     (pattern (concat this "\\|" match)))
+;;     (while (not (zerop level))
+;;       (if (sml-re-search-backward pattern)
+;;       (setq level (cond
+;;                    ((looking-at this) (1+ level))
+;;                    ((looking-at match) (1- level))))
+;;     ;; The right match couldn't be found
+;;     (error (concat "Unbalanced: " unquoted-this))))))
+
+(defun sml-find-match-indent (this match &optional indented)

   (save-excursion
   (save-excursion

-    (sml-find-match-backward unquoted-this this match)
-    (if (or sml-type-of-indent indented)
+    (sml-find-match-backward this match)
+    (if (or indented (not (sml-dangling-sym)))

         (current-column)
         (current-column)

-      (if (progn
-            (beginning-of-line)
-            (skip-chars-forward "\t ")
-            (looking-at "|"))
-          (- (current-indentation) sml-pipe-indent)
-        (current-indentation)))))
+      (sml-indent-default 'noindent))))

 
 

-(defun sml-find-matching-starter (regexp)
-  (sml-backward-sexp)
+(defun sml-find-matching-starter (regexp &optional prec)
+  (sml-backward-sexp prec)

   (while (not (or (looking-at regexp) (bobp)))
   (while (not (or (looking-at regexp) (bobp)))

-    (sml-backward-sexp))
+    (sml-backward-sexp prec))

   (not (bobp)))
 
   (not (bobp)))
 

-(defun sml-re-search-backward (regexpr)
-  (let ((case-fold-search nil) (found t))
-    (if (re-search-backward regexpr nil t)
-        (progn
-          (condition-case ()
-              (while (sml-inside-comment-or-string-p)
-                (re-search-backward regexpr))
-            (error (setq found nil)))
-          found)
-      nil)))
-
-(defun sml-up-list ()
-  (save-excursion
-    (condition-case ()
-        (progn
-          (up-list 1)
-          (point))
-      (error 0))))
-
-
-(defun sml-forward-word ()
-  (sml-skip-spaces)
-  (forward-word 1))
-
-;; should skip comments, deal with "let", "local" and such expressions
-(defun sml-forward-sexp ()
-  (condition-case ()
-      (forward-sexp 1)
-    (error (forward-char 1))))
-
-;; the terminators should be chosen more carefully:
-;; `let' isn't one while `=' may be
-(defun sml-forward-sexps (&optional end)
-  (sml-skip-spaces)
-  (while (not (looking-at (or end (concat sml-keywords-regexp "\\|[])}|:;]"))))
-      (sml-forward-sexp)
-      (sml-skip-spaces)))
-
-(defun sml-skip-spaces (&optional reg)
-  (let ((parse-sexp-ignore-comments nil))
-    (skip-syntax-forward " ")
-    (while (looking-at (or reg comment-start-skip))
-      (forward-sexp 1)
-      (skip-syntax-forward " "))))
-
-;; maybe we should do sml-backward-sexps and use it if we try to
-;; backward-sexp over a semi-colon ??
-;; return nil if it had to "move out"
-(defun sml-backward-sexp ()
-  (condition-case ()
-      (progn
-       (backward-sexp 1)
-       (while (and (looking-at comment-start-skip) (not (bobp)))
-            (backward-sexp 1))
-       (if (looking-at "end\\>")
-           (progn
-             (sml-find-match-backward "end" "\\<end\\>" sml-end-starters-reg)
-             t)
-         (not (looking-at sml-end-starters-reg))))
-    (error (forward-char -1) nil)))
+;; (defun sml-re-search-backward (regexpr)
+;;   (let ((case-fold-search nil) (found t))
+;;     (if (re-search-backward regexpr nil t)
+;;         (progn
+;;           (condition-case ()
+;;               (while (sml-inside-comment-or-string-p)
+;;                 (re-search-backward regexpr))
+;;             (error (setq found nil)))
+;;           found)
+;;       nil)))

 
 (defun sml-comment-indent ()
   (if (looking-at "^(\\*")              ; Existing comment at beginning
 
 (defun sml-comment-indent ()
   (if (looking-at "^(\\*")              ; Existing comment at beginning


@@ -1364,3 +1224,4 @@ should specify \":\" or \":>\" and the constraining signature."
 (run-hooks 'sml-load-hook)
 
 ;;; sml-mode.el has just finished.
 (run-hooks 'sml-load-hook)
 
 ;;; sml-mode.el has just finished.

+(provide 'sml-mode)

diff --git a/sml-mode.texi b/sml-mode.texi
index 58c3e4c5123aa2808af2bcb331c0564a08b29bb1..6c93986f08d627c433a49ab1388adb1ec95e2039 100644 (file)
--- a/sml-mode.texi
+++ b/sml-mode.texi
@@ -1,11 +1,33 @@
 \input texinfo @c -*-texinfo-*-
 
 \input texinfo @c -*-texinfo-*-
 

-@c $Id$        
+@comment "@(#)$Name$:$Id$"
+
+@comment Documentation for the GNU Emacs SML mode.
+@comment Copyright (C) 1999 (Anon)
+
+@comment This file is part of the pcl-cvs distribution.
+
+@comment sml-mode is free software; you can redistribute it and/or modify
+@comment it under the terms of the GNU General Public License as published by
+@comment the Free Software Foundation; either version 2 of the License,
+@comment or (at your option) any later version.
+
+@comment sml-mode is distributed in the hope that it will be useful,
+@comment but WITHOUT ANY WARRANTY; without even the implied warranty of
+@comment MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+@comment GNU General Public License for more details.
+
+@comment You should have received a copy of the GNU General Public License
+@comment along with sml-mode; see the file COPYING.  If not, write to
+@comment the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

 
 

-@c %**start of header

 @setfilename sml-mode.info
 @setfilename sml-mode.info

-@settitle @it{SML mode, Version 3.3}
-@c %**end of header
+@settitle SML mode - The Emacs SML editing mode
+@dircategory Editors
+@direntry
+* sml:(sml-mode).      Emacs mode for editing SML
+@end direntry
+@setchapternewpage on

 
 @titlepage
 @sp 5
 
 @titlepage
 @sp 5

diff --git a/sml-move.el b/sml-move.el
new file mode 100644 (file)
index 0000000..1393d25
--- /dev/null
+++ b/sml-move.el
@@ -0,0 +1,349 @@
+;;; sml-move.el
+
+(defconst rcsid-sml-move "@(#)$Name$:$Id$")
+
+;; Copyright (C) 1999-1999  Stefan Monnier <monnier@cs.yale.edu>
+;;
+;; This program 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 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(require 'cl)
+(require 'sml-util)
+(require 'sml-defs)
+
+;;
+
+(defsyntax sml-internal-syntax-table
+  '((?_  . "w")
+    (?'  . "w")
+    (?.  . "w")
+    ;; treating `~' as a word constituent is not quite right, but
+    ;; close enough.  Think about 12.3E~2 for example.  Also `~' on its
+    ;; own *is* a nonfix symbol.
+    (?~  . "w"))
+  "Syntax table used for internal sml-mode operation."
+  :copy sml-mode-syntax-table)
+
+(defun sml-op-prec (op dir)
+  "return the precedence of OP or nil if it's not an infix.
+DIR should be set to BACK if you want to precedence w.r.t the left side
+    and to FORW for the precedence w.r.t the right side.
+This assumes that we are looking-at the OP."
+  (cond
+   ((not op) nil)
+   ;;((or (string-match (sml-syms-re (appen
+   ((or (string-equal ";" op) (string-equal "," op)) 10)
+   ((or (string-equal "=>" op)
+       (and (string-equal "=" op)
+            ;; not the polymorphic equlity
+            (> (sml-point-after (re-search-backward sml-=-starter-re nil 'top))
+               (sml-point-after (re-search-backward "=" nil 'top)))))
+    ;; depending on the direction
+    (if (eq dir 'back) 65 40))
+   ((or (string-match (sml-syms-re "case" "of" "fn") op)) 45)
+   ((or (string-equal "|" op)) (if (eq dir 'back) 47 30))
+   ((or (string-match (sml-syms-re "if" "then" "else" "while" "do" "raise") op)) 50)
+   ((or (string-equal "handle" op)) 60)
+   ((or (string-equal "orelse" op)) 70)
+   ((or (string-equal "andalso" op)) 80)
+   ((or (string-equal ":" op) (string-equal ":>" op)) 90)
+   ((or (string-equal "->" op)) 95)
+   ;; standard infix ops: 10*(10 + prec) as defined in `the definition of SML'
+   ((or (string-equal "!" op)) nil)
+   ((or (string-equal "~" op)) nil)
+   ((or (string-equal ":=" op)) 130)
+   ((or (string-match "\\`[<>]?=?\\'" op)) 140)
+   ((or (string-equal "::" op)) 150)
+   ((or (string-equal "+" op) (string-equal "-" op)) 160)
+   ((or (string-equal "/" op) (string-equal "*" op)
+       (string-equal "div" op) (string-equal "mod" op)) 170)
+   ;; default heuristic: alphanum symbols are not infix
+   ((or (string-match "\\sw" op)) nil)
+   (t 100)))
+
+
+(defmacro sml-with-ist (&rest r)
+  `(let ((sml-ost (syntax-table))
+        (case-fold-search nil))
+     (unwind-protect
+        (progn (set-syntax-table sml-internal-syntax-table) . ,r)
+       (set-syntax-table sml-ost))))
+(def-edebug-spec sml-with-ist t)
+
+(defmacro sml-move-if (f &optional c)
+  `(let* ((-sml-move-if-pt (point))
+         (-sml-move-if-res ,f))
+     (or ,(or c '-sml-move-if-res) (progn (goto-char -sml-move-if-pt) nil))))
+(def-edebug-spec sml-move-if t)
+
+(defmacro sml-move-read (&rest body)
+  `(let ((-sml-move-read-pt (point)))
+     ,@body
+     (when (/= (point) -sml-move-read-pt)
+       (buffer-substring (point) -sml-move-read-pt))))
+(def-edebug-spec sml-move-read t)
+
+(defmacro sml-point-after (&rest body)
+  `(save-excursion
+     ,@body
+     (point)))
+(def-edebug-spec sml-point-after t)
+
+;;
+
+(defun sml-forward-spaces ()
+  (let ((parse-sexp-lookup-properties t))
+    (forward-comment 100000)))
+
+
+(defun sml-looking-back-at (re)
+  (save-excursion
+    (when (= 0 (skip-syntax-backward "w")) (backward-char))
+    (looking-at re)))
+
+;;
+;; moving forward around sexps
+;;
+
+(defun sml-find-match-forward (this match)
+  "Only works for word matches"
+  (let ((case-fold-search nil)
+       (parse-sexp-lookup-properties t)
+       (parse-sexp-ignore-comments t)
+       (level 1)
+       (either (concat this "\\|" match)))
+    (while (> level 0)
+      (forward-sexp 1)
+      (while (not (or (eobp) (sml-looking-back-at either)))
+       (condition-case () (forward-sexp 1) (error (forward-char 1))))
+      (setq level
+           (cond
+            ((sml-looking-back-at this) (1+ level))
+            ((sml-looking-back-at match) (1- level))
+            (t (error "Unbalanced")))))
+    t))
+
+;; (defun sml-forward-sexp (&optional count strict)
+;;   "Moves one sexp forward if possible, or one char else.
+;; Returns T if the move indeed moved through one sexp and NIL if not."
+;;   (let ((parse-sexp-lookup-properties t)
+;;     (parse-sexp-ignore-comments t))
+;;     (condition-case ()
+;;     (progn
+;;       (forward-sexp 1)
+;;       (cond
+;;        ((sml-looking-back-at
+;;          (if strict sml-begin-symbols-re sml-user-begin-symbols-re))
+;;         (sml-find-match-forward sml-begin-symbols-re "\\<end\\>") t)
+;;        ((sml-looking-back-at "\\<end\\>") nil)
+;;        (t t)))
+;;       (error (forward-char 1) nil))))
+
+;; the terminators should be chosen more carefully:
+;; `let' isn't one while `=' may be
+;; (defun sml-forward-sexps (&optional end)
+;;   (sml-forward-sexp)
+;;   (while (not (sml-looking-back-at (or end (concat sml-keywords-regexp "\\|[])}|:;]"))))
+;;       (sml-forward-sexp)))
+
+;;
+;; now backwards
+;;
+
+(defun sml-backward-spaces ()
+  (let ((parse-sexp-lookup-properties t))
+    (forward-comment -100000)))
+
+(defun sml-find-match-backward (this match)
+  (let ((parse-sexp-lookup-properties t)
+       (parse-sexp-ignore-comments t)
+       (level 1)
+       (either (concat this "\\|" match)))
+    (while (> level 0)
+      (backward-sexp 1)
+      (while (not (or (bobp) (looking-at either)))
+       (condition-case () (backward-sexp 1) (error (backward-char 1))))
+      (setq level
+           (cond
+            ((looking-at this) (1+ level))
+            ((looking-at match) (1- level))
+            (t (error "Unbalanced")))))
+    t))
+
+(defun sml-forward-sym ()
+  (or (/= 0 (skip-syntax-forward ".'"))
+      (/= 0 (skip-syntax-forward "'w_"))))
+
+(defun sml-backward-sym ()
+  (or (/= 0 (skip-syntax-backward ".'"))
+      (/= 0 (skip-syntax-backward "'w_"))))
+
+(defun sml-backward-sexp (prec)
+  "Moves one sexp backward if possible, or one char else.
+Returns T if the move indeed moved through one sexp and NIL if not."
+  (let ((parse-sexp-lookup-properties t)
+       (parse-sexp-ignore-comments t))
+    (sml-backward-spaces)
+    (let* ((point (point))
+          (op (sml-move-read (sml-backward-sym)))
+          (op-prec (sml-op-prec op 'back)))
+      (cond
+       ((not op)
+       (let ((point (point)))
+         (ignore-errors (backward-sexp 1))
+         (if (/= point (point)) t (backward-char 1) nil)))
+       ;; let...end atoms
+       ((or (string-equal "end" op)
+           (and (not prec)
+                (or (string-equal "in" op) (string-equal "with" op))))
+       (sml-find-match-backward "\\<end\\>" sml-begin-symbols-re))
+       ;; don't forget the `op' special keyword
+       ((sml-move-if (progn (sml-backward-spaces) (skip-syntax-backward "w_"))
+                    (looking-at "\\<op\\>")) t)
+       ;; special rules for nested constructs like if..then..else
+       ((and (or (not prec) (and prec op-prec (< prec op-prec)))
+            (string-match (sml-syms-re sml-exptrail-syms) op))
+       (cond
+        ((or (string-equal "else" op) (string-equal "then" op))
+         (sml-find-match-backward "\\<else\\>" "\\<if\\>"))
+        ((string-equal "of" op)
+         (sml-find-match-backward "\\<of\\>" "\\<case\\>"))
+        ((string-equal "do" op)
+         (sml-find-match-backward "\\<do\\>" "\\<while\\>"))
+        (t prec)))
+       ;; infix ops precedence
+       ((and prec op-prec) (< prec op-prec))
+       ;; [ prec = nil ]  a new operator, let's skip the sexps until the next
+       (op-prec (while (sml-move-if (sml-backward-sexp op-prec))) t)
+       ;; special symbols indicating we're getting out of a nesting level
+       ((string-match sml-sexp-head-symbols-re op) nil)
+       ;; if the op was not alphanum, then we still have to do the backward-sexp
+       ;; this reproduces the usual backward-sexp, but it might be bogus
+       ;; in this case since !@$% is a perfectly fine symbol
+       (t t))))) ;(or (string-match "\\sw" op) (sml-backward-sexp prec))
+
+(defun sml-forward-sexp (prec)
+  "Moves one sexp forward if possible, or one char else.
+Returns T if the move indeed moved through one sexp and NIL if not."
+  (let ((parse-sexp-lookup-properties t)
+       (parse-sexp-ignore-comments t))
+    (sml-forward-spaces)
+    (let* ((point (point))
+          (op (sml-move-read (sml-forward-sym)))
+          (op-prec (sml-op-prec op 'forw)))
+      (cond
+       ((not op)
+       (let ((point (point)))
+         (ignore-errors (forward-sexp 1))
+         (if (/= point (point)) t (forward-char 1) nil)))
+       ;; let...end atoms
+       ((or (string-match sml-begin-symbols-re op)
+           (and (not prec)
+                (or (string-equal "in" op) (string-equal "with" op))))
+       (sml-find-match-forward sml-begin-symbols-re "\\<end\\>"))
+       ;; don't forget the `op' special keyword
+       ((string-equal "op" op) (sml-forward-sym))
+       ;; infix ops precedence
+       ((and prec op-prec) (< prec op-prec))
+       ;; [ prec = nil ]  if...then...else
+       ;; ((or (string-equal "else" op) (string-equal "then" op))
+       ;;  (sml-find-match-backward "\\<else\\>" "\\<if\\>"))
+       ;; [ prec = nil ]  case...of
+       ;; ((string-equal "of" op)
+       ;;  (sml-find-match-backward "\\<of\\>" "\\<case\\>"))
+       ;; [ prec = nil ]  while...do
+       ;; ((string-equal "do" op)
+       ;;  (sml-find-match-backward "\\<do\\>" "\\<while\\>"))
+       ;; [ prec = nil ]  a new operator, let's skip the sexps until the next
+       (op-prec (while (sml-move-if (sml-forward-sexp op-prec))) t)
+       ;; special symbols indicating we're getting out of a nesting level
+       ((string-match sml-sexp-head-symbols-re op) nil)
+       ;; if the op was not alphanum, then we still have to do the backward-sexp
+       ;; this reproduces the usual backward-sexp, but it might be bogus
+       ;; in this case since !@$% is a perfectly fine symbol
+       (t t))))) ;(or (string-match "\\sw" op) (sml-backward-sexp prec))
+
+(defun sml-in-word-p ()
+  (and (eq ?w (char-syntax (char-before)))
+       (eq ?w (char-syntax (char-after)))))
+
+(defun sml-user-backward-sexp (&optional count)
+  "Like `backward-sexp' but tailored to the SML syntax."
+  (interactive "p")
+  (unless count (setq count 1))
+  (sml-with-ist
+   (let ((point (point)))
+     (if (< count 0) (sml-user-forward-sexp (- count))
+       (when (sml-in-word-p) (forward-word 1))
+       (dotimes (i count)
+        (unless (sml-backward-sexp nil)
+          (goto-char point)
+          (error "Containing expression ends prematurely")))))))
+
+(defun sml-user-forward-sexp (&optional count)
+  "Like `forward-sexp' but tailored to the SML syntax."
+  (interactive "p")
+  (unless count (setq count 1))
+  (sml-with-ist
+   (let ((point (point)))
+     (if (< count 0) (sml-user-backward-sexp (- count))
+       (when (sml-in-word-p) (backward-word 1))
+       (dotimes (i count)
+        (unless (sml-forward-sexp nil)
+          (goto-char point)
+          (error "Containing expression ends prematurely")))))))
+
+;;(defun sml-forward-thing ()
+;;  (if (= ?w (char-syntax (char-after))) (forward-word 1) (forward-char 1)))
+
+(defun sml-backward-arg () (sml-backward-sexp 1000))
+(defun sml-forward-arg () (sml-forward-sexp 1000))
+
+;; (defun sml-backward-arg ()
+;;   "Moves one sexp backward (and return T) if it is an argument."
+;;   (let* ((point (point))
+;;      (argp (and (sml-backward-sexp t)
+;;                 (not (looking-at sml-not-arg-re))
+;;                 (save-excursion
+;;                   (sml-forward-sexp 1 t)
+;;                   (sml-forward-spaces)
+;;                   (>= (point) point)))))
+;;     (unless argp (goto-char point))
+;;     argp))
+
+;; (defun sml-backward-sexps (&optional end)
+;;   (sml-backward-spaces)
+;;   (let ((eos (point)))
+;;     (sml-backward-sexp t)
+;;     (while (not (save-restriction
+;;               (narrow-to-region (point) eos)
+;;               (looking-at (or end sml-keywords-regexp))))
+;;       (sml-backward-spaces)
+;;       (setq eos (point))
+;;       (sml-backward-sexp t))
+;;     (if (looking-at "\\sw")
+;;     (forward-word 1)
+;;       (forward-char))
+;;     (sml-forward-spaces)))
+
+;; (defun sml-up-list ()
+;;   (save-excursion
+;;     (condition-case ()
+;;         (progn
+;;           (up-list 1)
+;;           (point))
+;;       (error 0))))
+
+;;
+(provide 'sml-move)

diff --git a/sml-proc.el b/sml-proc.el
index 6b77042acc52e0a467442a1a24a2a369311cf0a6..a3605498457f3f0a78e11ddb3a05c189c3e15b62 100644 (file)
--- a/sml-proc.el
+++ b/sml-proc.el
@@ -365,7 +365,12 @@ inferior-sml-mode-hook.
 
 ;;; CODE
 
 
 ;;; CODE
 

-(defvar inferior-sml-mode-map nil)
+(defmap inferior-sml-mode-map
+  '(("\C-c\C-s"        . run-sml)
+    ("\t"      . comint-dynamic-complete))
+  "Keymap for inferior-sml mode"
+  :inherit (list sml-bindings comint-mode-map))
+

 
 ;; buffer-local
 
 
 ;; buffer-local
 


@@ -662,6 +667,12 @@ With a prefix argument switch to the sml buffer as well
     (sml-send-region (point) (mark)))
   (if and-go (switch-to-sml nil)))
 
     (sml-send-region (point) (mark)))
   (if and-go (switch-to-sml nil)))
 

+(defvar sml-source-modes '(sml-mode) 
+  "*Used to determine if a buffer contains ML source code. 
+If it's loaded into a buffer that is in one of these major modes, it's
+considered an ML source file by `sml-load-file'. Used by these commands
+to determine defaults.")
+

 ;;;###autoload 
 (defun sml-send-buffer (&optional and-go)
   "Send buffer to inferior shell running ML process. 
 ;;;###autoload 
 (defun sml-send-buffer (&optional and-go)
   "Send buffer to inferior shell running ML process. 


@@ -695,20 +706,6 @@ With a prefix argument switch to the sml buffer as well
   (let ((buffer (sml-proc-buffer)))
     (window-frame (display-buffer buffer))))
 
   (let ((buffer (sml-proc-buffer)))
     (window-frame (display-buffer buffer))))
 

-;;(defun sml-pop-to-buffer (warp)
-;;  "(Towards) handling multiple frames properly.
-;;Raises the frame, and warps the mouse over there, only if WARP is non-nil."
-;;  (let ((current (window-frame (selected-window)))
-;;        (buffer  (sml-proc-buffer)))
-;;    (let ((frame (sml-proc-frame)))
-;;      (if (eq current frame)
-;;          (pop-to-buffer buffer)           ; stay on the same frame.
-;;        (select-frame frame)               ; XEmacs sometimes moves focus.
-;;        (select-window (get-buffer-window buffer)) ; necc. for XEmacs
-;;        ;; (raise-frame frame)
-;;        (if warp (sml-warp-mouse frame))))))
-
-

 ;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S
 
 ;; Only these two functions have to dance around the inane differences 
 ;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S
 
 ;; Only these two functions have to dance around the inane differences 


@@ -762,12 +759,6 @@ undisturbed once this operation is completed."
 
 ;;; LOADING AND IMPORTING SOURCE FILES:
 
 
 ;;; LOADING AND IMPORTING SOURCE FILES:
 

-(defvar sml-source-modes '(sml-mode) 
-  "*Used to determine if a buffer contains ML source code. 
-If it's loaded into a buffer that is in one of these major modes, it's
-considered an ML source file by `sml-load-file'. Used by these commands
-to determine defaults.")
-

 (defvar sml-prev-l/c-dir/file nil
   "Caches the (directory . file) pair used in the last `sml-load-file'
 or `sml-cd' command. Used for determining the default in the next one.")
 (defvar sml-prev-l/c-dir/file nil
   "Caches the (directory . file) pair used in the last `sml-load-file'
 or `sml-cd' command. Used for determining the default in the next one.")


@@ -895,7 +886,7 @@ the output\) of the last error. This odd behaviour may have a use...?"
   (error msg))
 
 (defun sml-do-next-error ()
   (error msg))
 
 (defun sml-do-next-error ()

-  "The buisiness end of `sml-next-error' (qv)"
+  "The business end of `sml-next-error' (qv)"

   (let ((case-fold-search nil)
         ;; set this variable iff we called sml-next-error in a SML buffer
         (sml-window (if (memq major-mode sml-source-modes) (selected-window)))
   (let ((case-fold-search nil)
         ;; set this variable iff we called sml-next-error in a SML buffer
         (sml-window (if (memq major-mode sml-source-modes) (selected-window)))


@@ -969,14 +960,6 @@ the output\) of the last error. This odd behaviour may have a use...?"
   (sml-update-cursor (sml-proc-buffer))
   (if (eq major-mode 'sml-inferior-mode) (goto-char (point-max))))
 
   (sml-update-cursor (sml-proc-buffer))
   (if (eq major-mode 'sml-inferior-mode) (goto-char (point-max))))
 

-;;; Set up the inferior mode keymap, using sml-mode bindings...
-
-(cond ((not inferior-sml-mode-map)
-       (setq inferior-sml-mode-map (nconc (make-sparse-keymap) comint-mode-map))
-       (install-sml-keybindings inferior-sml-mode-map)
-       (define-key inferior-sml-mode-map "\C-c\C-s" 'run-sml)
-       (define-key inferior-sml-mode-map "\t"       'comint-dynamic-complete)))
-

 ;;; H A C K   A T T A C K !   X E M A C S   /   E M A C S   K E Y S
 
 (if window-system
 ;;; H A C K   A T T A C K !   X E M A C S   /   E M A C S   K E Y S
 
 (if window-system

diff --git a/sml-smlnj.el b/sml-smlnj.el
new file mode 100644 (file)
index 0000000..59f3782
--- /dev/null
+++ b/sml-smlnj.el
@@ -0,0 +1,172 @@
+;;; sml-nj.el: Modifies inferior-sml-mode defaults for SML/NJ.
+
+;; Copyright (C) 1997, Matthew J. Morley
+
+;; $Revision$
+;; $Date$
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; ====================================================================
+
+;; This program 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 2, or (at
+;; your option) any later version.
+
+;; This program 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.
+
+;; ====================================================================
+
+;;; DESCRIPTION
+
+;; To use this library just put
+
+;;(autoload 'sml-smlnj "sml-nj" "Set up and run SML/NJ." t)
+
+;; in your .emacs file. If you only ever use the New Jersey compiler
+;; then you might as well put something like
+
+;;(setq sml-mode-hook
+;;      '(lambda() "SML mode defaults to SML/NJ"
+;;      (define-key  sml-mode-map "\C-cp" 'sml-smlnj)))
+
+;; for your sml-mode-hook. The command prompts for the program name 
+;; and any command line options. 
+
+;; If you need to reset the default value of sml-program-name, or any
+;; of the other compiler variables, put something like
+
+;;(eval-after-load "sml-nj" '(setq sml-program-name "whatever"))
+
+;; in your .emacs -- or (better) you can use the inferior-sml-{load,
+;; mode}-hooks to achieve the same ends.
+
+;;; CODE
+
+(require 'sml-proc)
+
+;; 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).")
+
+(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))))))))
+
+;;;###autoload
+(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    \"OS.FileSys.chDir \\\"%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    "OS.FieSys.chDir \"%s\""
+                   sml-prompt-regexp "^[\-=] *"
+                   sml-error-regexp  sml-smlnj-error-regexp
+                   sml-error-parser  'sml-smlnj-error-parser)
+     (sml-run cmd sml-default-arg)))
+
+;;; Do the default setup on loading this file.
+
+;; setqing these two may override user's hooked defaults. users
+;; therefore need load this file before setting sml-program-name or
+;; sml-default-arg in their inferior-sml-load-hook. sorry.
+
+(setq         sml-program-name  "sml"
+              sml-default-arg   "")
+
+;; same sort of problem here too: users should to setq-default these
+;; after this file is loaded, on inferior-sml-load-hook. as these are
+;; buffer-local, users can instead set them on inferior-sml-mode-hook.
+
+(setq-default sml-use-command   "use \"%s\""
+              sml-cd-command    "OS.FileSys.chDir \"%s\""
+              sml-prompt-regexp "^[\-=] *"
+              sml-error-regexp  sml-smlnj-error-regexp
+              sml-error-parser  'sml-smlnj-error-parser)
+
+;;; sml-nj.el endeded

diff --git a/sml-util.el b/sml-util.el
new file mode 100644 (file)
index 0000000..4a691c4
--- /dev/null
+++ b/sml-util.el
@@ -0,0 +1,82 @@
+;;; sml-util.el
+
+(defconst rcsid-sml-util "@(#)$Name$:$Id$")
+
+;; Copyright (C) 1999-1999  Stefan Monnier <monnier@cs.yale.edu>
+;;
+;; This program 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 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(require 'cl)
+(require 'sml-compat)
+
+;;
+
+(defmacro concatq (&rest ss)
+  "Concatenate all the arguments and make the result a string.
+As opposed to `concat', `concatq' does not evaluate its arguments
+and is hence executed at macro-expansion-time."
+  (apply 'concat ss))
+
+(defun flatten (ls &optional acc)
+  (if (null ls) acc
+    (let ((rest (flatten (cdr ls) acc))
+         (head (car ls)))
+      (if (listp head)
+         (flatten head rest)
+       (cons head rest)))))
+
+(defun custom-create-map (m bs args)
+  (unless (keymapp m)
+    (setq bs (append m bs))
+    (setq m (make-sparse-keymap)))
+  (dolist (b bs)
+    (let ((key (car b))
+         (binding (cdr b)))
+      (cond
+       ((symbolp key)
+       (substitute-key-definition key binding m global-map))
+       ((not (lookup-key m key))
+       (define-key m key binding)))))
+  (while args
+    (let ((key (first args))
+         (val (second args)))
+      (cond
+       ((eq key :inherit)
+       (cond
+        ((keymapp val) (set-keymap-parent m val))
+        (t (set-keymap-parents m val))))
+       (t (error "Uknown argument %s in defmap" key))))
+    (setq args (cddr args))))
+
+(defmacro defmap (m bs doc &rest args)
+  `(progn
+     (defvar ,m (make-sparse-keymap) ,doc)
+     (custom-create-map ,m ,bs ,(cons 'list args))))
+
+(defmacro defsyntax (st css doc &rest args)
+  `(defvar ,st
+     (let ((st (make-syntax-table ,(cadr (memq :copy args)))))
+       (dolist (cs ,css)
+        (let ((char (car cs))
+              (syntax (cdr cs)))
+          (if (sequencep char)
+              (mapcar* (lambda (c) (modify-syntax-entry c syntax st))
+                       char)
+            (modify-syntax-entry char syntax st))))
+       st)
+     doc))
+
+;;
+(provide 'sml-util)