* sml-mode.el (sml-mark-function): New implementation using SMIE.

* sml-defs.el (sml-mode-map): Use backtab.
Remove leftover unused sml-drag-region binding.

5 files changed, 303 insertions, 161 deletions

diff --git a/ChangeLog b/ChangeLog
index 49ed5755c86..dab2de7f5a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2012-04-11  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* sml-mode.el (sml-mark-function): New implementation using SMIE.
+	* sml-defs.el (sml-mode-map): Use backtab.
+	Remove leftover unused sml-drag-region binding.
+
+2012-04-11  Stefan Monnier  <monnier@iro.umontreal.ca>
+
 	Use SMIE by default and make sml-oldindent optional.
 	* sml-mode.el: Only load sml-oldindent if necessary.
 	(sml-use-smie): Default to t.
diff --git a/NEWS b/NEWS
index 62902935f62..e0c16b5a1bf 100644
--- a/NEWS
+++ b/NEWS
@@ -2,8 +2,12 @@ Changes since 4.1:
 
 * New indentation code using SMIE when available.
 
+* sml-back-to-outer-indent is now on S-tab (aka `backtab') rather than M-tab.
+
 * Support for electric-layout-mode and electric-indent-mode.
 
+* sml-mark-defun tries to be more clever.
+
 Changes since 4.0:
 
 * Switch to GPLv3+.
diff --git a/sml-defs.el b/sml-defs.el
index b095bedec0b..c8094d93ab0 100644
--- a/sml-defs.el
+++ b/sml-defs.el
@@ -49,14 +49,13 @@ notion of \"the end of an outline\".")
     (define-key map "\M-|" 'sml-electric-pipe)
     (define-key map "\M-\ " 'sml-electric-space)
     (define-key map "\;" 'sml-electric-semi)
-    (define-key map "\M-\t" 'sml-back-to-outer-indent)
-    ;; Process commands added to sml-mode-map -- these should autoload
+    (define-key map [backtab] 'sml-back-to-outer-indent)
+    ;; 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\C-c" 'sml-compile)
     (define-key map "\C-c\C-s" 'switch-to-sml)
     (define-key map "\C-c\C-r" 'sml-send-region)
     (define-key map "\C-c\C-b" 'sml-send-buffer)
-    (define-key map [(meta shift down-mouse-1)] 'sml-drag-region)
     map)
   "The keymap used in `sml-mode'.")
 
diff --git a/sml-mode.el b/sml-mode.el
index c1c85178867..767b0c7c235 100644
--- a/sml-mode.el
+++ b/sml-mode.el
@@ -792,13 +792,24 @@ a newline, and indent."
   (if sml-electric-semi-mode
       (reindent-then-newline-and-indent)))
 
-;;; INDENTATION !!!
+;;; Misc
 
 (defun sml-mark-function ()
-  "Synonym for `mark-paragraph' -- sorry.
-If anyone has a good algorithm for this..."
+  "Mark the surrounding function.  Or try to at least."
   (interactive)
-  (mark-paragraph))
+  (if (not (fboundp 'smie-setup))
+      (mark-paragraph)
+    ;; FIXME: Provide beginning-of-defun-function so mark-defun "just works".
+    (let ((start (point)))
+      (sml-beginning-of-defun)
+      (let ((beg (point)))
+        (smie-forward-sexp 'halfsexp)
+        (if (or (< start beg) (> start (point)))
+            (progn
+              (goto-char start)
+              (mark-paragraph))
+          (push-mark nil t t)
+          (goto-char beg))))))
 
 (defun sml-back-to-outer-indent ()
   "Unindents to the next outer level of indentation."
diff --git a/testcases.sml b/testcases.sml
index 2bc4b73d6f2..12bf18abb81 100644
--- a/testcases.sml
+++ b/testcases.sml
@@ -1,147 +1,269 @@
-(* Copyright 1999, 2004, 2007, 2010 Stefan Monnier <monnier@gnu.org> *)
+(* Copyright 1999,2004,2007,2010-2012 Stefan Monnier <monnier@gnu.org> *)
 
-(let val a = 1 val b = 2
-     val c = 3
- in 1
- end);
-
-(* From "Christopher Dutchyn" <cdutchyn@cs.ubc.ca> *)
-(case foo of
-  (* FIXME: The line gets unindented by 2 every time you hit TAB :-( *)
-  | BAR => baz)
-
-(* sml-mode here treats the second `=' as an equal op because it assumes
- * that the first is the definitional equal for the structure.  FIXME!  *)
+(* sml-mode here treats the second `=' as an equal op because it
+ * thinks it's seeing something like "... type t = (s.t = ...)".  FIXME!  *)
 functor foo (structure s : S) where type t = s.t =
-struct
-val bar = 0
+struct                          (* fixindent *)
+val bar = fn a1 a2 a3
+	     a5 a6
+	     a4 => 1
+val rec bar =
+ fn a1 a2 a3
+    a5 a6 a4 => 1
+val bar =
+ fn a1 a2 a3
+    a5 a6
+    a4 => (1
+          ;(
+              w
+            ,
+              s
+            ,
+              s
+            , s , a ,
+              a
+            , s , a ,
+              a
+          )
+          ;(
+              w
+             ,s
+             ,a
+          )
+          ;(
+              w
+          ,   s
+          ,   a
+          )
+          ;(   w
+           ,   s
+           ,   a
+           )
+          ;( w
+            ,s
+            ,a
+           )
+          ;3
+           + a
+             * 4
+           + let val x = 3
+             in toto
+             end
+           + if a then
+                 b
+             else
+                 c
+          ;4)
+
 val ber = 1;
 val sdfg = 1
 val tut = fn (x,y) z y e r =>
              body
-end
+val tut = fn (x,y) => fn z y => fn e r =>
+             body
+val tut = fn (x,y)
+             z
+             y e
+             r =>
+             body
+val tut =
+    (let
+        local
+            val x = 1 in val x = x end
+        val a = 1 val b = 2
+        local val x = 1 in val x = x end
+        local val x = 1 in val x = x end
+            local val x = 1 in val x = x end (* fixindent *)
+            local val x = 1 in val x = x end
+            val c = 3
+    in
+	let
+            val x = 3
+	in
+            x +   a * b
+                  * c
+	end
+    end)
+
+val x =
+    (* From "Christopher Dutchyn" <cdutchyn@cs.ubc.ca> *)
+    (case foo of
+       (* This is actually not valid SML anyway.  *)
+       | BAR => baz
+       | BAR => baz)
+
 
+val x =
+    (x := 1;
+     x := 2;
+       (* Testing obedience to user overrides: *)
+       x := 3;                  (* fixindent *)
+       case x of
+           FOO => 1
+         | BAR =>
+           2;
+       case x of
+           FOO => 1
+         | BAR =>
+           case y of
+	       FAR => 2
+	     | FRA => 3;
+       hello);
 
-(x := 1;
- case x of
-     FOO => 1
-   | BAR =>
-     2;
- case x of
-     FOO => 1
-   | BAR =>
-     (case y of
-	  FAR => 2
-	| FRA => 3);
- hello);
-
-let datatype foobar
-      = FooB of int
-      | FooA of bool * int
-    datatype foo = FOO | BAR of baz
-	 and baz = BAZ | QUUX of foo
-
-    datatype foo = FOO
-                 | BAR of baz
-      and baz = BAZ			(* fixindent *)
-	      | QUUX of foo
-      and b = g
-
-    datatype foo = datatype M.foo
-    val _ = 42 val x = 5
-		       
-    signature S = S' where type foo = int
-    val _ = 42
-
-    val foo = [
-	"blah"
-      , let val x = f 42 in g (x,x,44) end
+datatype foobar
+  = FooB of int
+  | FooA of bool * int
+datatype foo = FOO | BAR of baz
+     and baz = BAZ | QUUX of foo
+
+fun toto = if a
+           then
+               b
+           else c
+
+datatype foo = FOO
+             | BAR of baz
+  and baz = BAZ			(* fixindent *)
+	  | QUUX of foo
+  and b = g
+
+datatype foo = datatype M.foo
+val _ = 42 val x = 5
+
+signature S = S' where type foo = int
+val _ = 42
+
+val foo = [
+    "blah"
+  , let val x = f 42 in g (x,x,44) end
+]
+
+val foo = [
+    "blah",
+    let val x = f 42 in g (x,x,44) end
+]
+
+val foo =
+    [
+      "blah",
+      let val x = f 42 in g (x,x,44) end
     ]
-	      
-    val foo = [ "blah"
-	      , let val x = f 42 in g (x,x,44) end
-	      , foldl (fn ((p,q),s) => g (p,q,Vector.length q) ^ ":" ^ s)
-                      "" (Beeblebrox.masterCountList mlist2)
-              , if null mlist2 then ";" else ""
-	      ]
-	      
-    fun foo (true::rest)
-      = 1 + 2 * foo rest
-      | foo (false::rest)
-      = let val _ = 1 in 2 end
-	+ 2 * foo rest
-
-    val x = if foo then
-		1
-	    else if bar then
-		2
-	    else
-		3
-    val y = if foo
-	    then 1
-	    else if foo
-	    then 2
-	    else 3
-
-  ; val yt = 4
 
-in
-    if a then b else c;
-    case M.find(m,f)
-     of SOME(fl, filt) =>
-	F.APP(F.VAR fl, OU.filter filt vs)
-      | NONE => le;
-    x := x + 1;
-    (case foo
-      of a => f
-    )
-end;
+val foo = [ "blah"
+	  , let val x = f 42 in g (x,x,44) end
+	  , foldl (fn ((p,q),s) => g (p,q,Vector.length q) ^ ":" ^ s)
+                  "" (Beeblebrox.masterCountList mlist2)
+          , if null mlist2 then ";" else ""
+	  ]
 
-let
-in a;
-   foo("(*")
-   * 2;
-end;
+fun foo (true::rest) = 1 + 2 * foo rest
+  | foo (false::rest)
+    = let val _ = 1 in 2 end
+      + 2
+        * foo rest
 
-let
-in a
- ; b
-end;
+val x = if foo then
+	    1
+	else if bar then
+	    2
+	else
+	    3
+val y = if foo
+	then 1
+	else if foo
+	then 2              (* Could also be indented by a basic offset.  *)
+	else 3
 
-let
-in
-    a
-  ; b
-end;
+val yt = 4
 
-let
-in if a then
-       b
-   else
-       c
-end;
+val x =
+    (if a then b else c;
+     case M.find(m,f)
+      of SOME(fl, filt) =>
+         F.APP(F.VAR fl, OU.filter filt vs)
+       | NONE
+         => le
+       | NONE =>
+         le
+       | NONE => le;
+     x := x + 1;
+     (case foo
+       of a => f
+    ))
 
-let
-in case a of
-       F => 1
-     | D => 2
-end;
+val y = (
+    let fun f1 =
+            let fun g1 x = 2
+                fun g2 y = 4
+                local fun toto y = 1
+                (* val x = 5 *)
+                in
+                fun g3 z = z
+                end
+            in toto
+            end
+    in a;( ( let
+               val f =1
+           in
+               toto
+           end
+           )
+         )
+             foo("(*")
+         * 2;
+    end;
 
-let
-in case a
- of F => 1
-  | D => 2
-end;
+    let
+    in a
+     ; b
+    end;
+
+    let
+    in
+        a +
+        b +
+        c
+      ; b
+    end;
+
+    let
+    in if a then
+           b
+       else
+           c
+    end;
+
+    let
+    in case a of
+           F => 1
+         | D => 2
+    end;
 
-let
-in if a then b else
-   c
+    let
+    in case a
+        of F => 1
+         | D => 2
+    end;
+
+    let
+    in if a then b else
+       c
+    end;
+
+    let
+    in if a then b
+       else
+           c
+    end)
 end;
 
 structure Foo = struct
 val x = 1
 end
 
+structure Foo = struct val x = 1
+                end
+
 signature FSPLIT =
 sig
     type flint = FLINT.prog
@@ -169,23 +291,23 @@ fun bug msg = ErrorMsg.impossible ("FSplit: "^msg)
 fun buglexp (msg,le) = (say "\n"; PP.printLexp le; say " "; bug msg)
 fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg)
 fun assert p = if p then () else bug ("assertion failed")
-				 
+
 type flint = F.prog
 val mklv = LambdaVar.mkLvar
 val cplv = LambdaVar.dupLvar
-	   
+
 fun S_rmv(x, s) = S.delete(s, x) handle NotFound => s
-						    
+
 fun addv (s,F.VAR lv) = S.add(s, lv)
   | addv (s,_) = s
 fun addvs (s,vs) = foldl (fn (v,s) => addv(s, v)) s vs
 fun rmvs (s,lvs) = foldl (fn (l,s) => S_rmv(l, s)) s lvs
-		   
+
 exception Unknown
-	  
+
 fun split (fdec as (fk,f,args,body)) = let
     val {getLty,addLty,...} = Recover.recover (fdec, false)
-			      
+
     val m = Intmap.new(64, Unknown)
     fun addpurefun f = Intmap.add m (f, false)
     fun funeffect f = (Intmap.map m f) handle Uknown => true
@@ -207,7 +329,7 @@ fun split (fdec as (fk,f,args,body)) = let
  *   mistakenly adding anything to leI.
  *)
 fun sexp env lexp =			(* fixindent *)
-    let 
+    let
 	(* non-side effecting binds are copied to leI if exported *)
 	fun let1 (le,lewrap,lv,vs,effect) =
 	    let val (leE,leI,fvI,leRet) = sexp (S.add(env, lv)) le
@@ -216,7 +338,7 @@ fun sexp env lexp =			(* fixindent *)
 	       then (leE, leI, fvI, leRet)
 	       else (leE, lewrap leI, addvs(S_rmv(lv, fvI), vs), leRet)
 	    end
-	    
+
     in case lexp
 	(* we can completely move both RET and TAPP to the I part *)
 	of F.RECORD (rk,vs,lv,le as F.RET [F.VAR lv']) =>
@@ -227,11 +349,11 @@ fun sexp env lexp =			(* fixindent *)
 	   (fn e => e, lexp, addvs(S.empty, vs), lexp)
 	 | F.TAPP (F.VAR tf,tycs) =>
 	   (fn e => e, lexp, S.singleton tf, lexp)
-	   
+
 	 (* recursive splittable lexps *)
 	 | F.FIX (fdecs,le) => sfix env (fdecs, le)
 	 | F.TFN (tfdec,le) => stfn env (tfdec, le)
-			       
+
 	 (* binding-lexps *)
 	 | F.CON (dc,tycs,v,lv,le) =>
 	   let1(le, fn e => F.CON(dc, tycs, v, lv, e), lv, [v], false)
@@ -241,33 +363,33 @@ fun sexp env lexp =			(* fixindent *)
 	   let1(le, fn e => F.SELECT(v, i, lv, e), lv, [v], false)
 	 | F.PRIMOP (po,vs,lv,le) =>
 	   let1(le, fn e => F.PRIMOP(po, vs, lv, e), lv, vs, PO.effect(#2 po))
-	   
+
 	 (* IMPROVEME: lvs should not be restricted to [lv] *)
 	 | F.LET(lvs as [lv],body as F.TAPP (v,tycs),le) =>
 	   let1(le, fn e => F.LET(lvs, body, e), lv, [v], false)
 	 | F.LET (lvs as [lv],body as F.APP (v as F.VAR f,vs),le) =>
 	   let1(le, fn e => F.LET(lvs, body, e), lv, v::vs, funeffect f)
-	   
+
 	 | F.SWITCH (v,ac,[(dc as F.DATAcon(_,_,lv),le)],NONE) =>
 	   let1(le, fn e => F.SWITCH(v, ac, [(dc, e)], NONE), lv, [v], false)
-	   
+
 	 | F.LET (lvs,body,le) =>
 	   let val (leE,leI,fvI,leRet) = sexp (S.union(S.addList(S.empty, lvs), env)) le
 	   in (fn e => F.LET(lvs, body, leE e), leI, fvI, leRet)
 	   end
-	   
+
 	 (* useless sophistication *)
 	 | F.APP (F.VAR f,args) =>
 	   if funeffect f
 	   then (fn e => e, F.RET[], S.empty, lexp)
 	   else (fn e => e, lexp, addvs(S.singleton f, args), lexp)
-		
+
 	 (* other non-binding lexps result in unsplittable functions *)
 	 | (F.APP _ | F.TAPP _) => bug "strange (T)APP"
 	 | (F.SWITCH _ | F.RAISE _ | F.BRANCH _ | F.HANDLE _) =>
 	   (fn e => e, F.RET[], S.empty, lexp)
     end
-    
+
 (* Functions definitions fall into the following categories:
  * - inlinable:  if exported, copy to leI
  * - (mutually) recursive:  don't bother
@@ -288,10 +410,10 @@ and sfix env (fdecs,le) =
 	   end
 	 | [fdec as (fk as {cconv=F.CC_FCT,...},_,_,_)] =>
 	   sfdec env (leE,leI,fvI,leRet) fdec
-	   
+
 	 | _ => (nleE, leI, fvI, leRet)
     end
-    
+
 and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =
     let val benv = S.union(S.addList(S.empty, map #1 args), env)
 	val (bodyE,bodyI,fvbI,bodyRet) = sexp benv body
@@ -302,7 +424,7 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =
 	 | _ =>
 	   let val fvbIs = S.listItems(S.difference(fvbI, benv))
 	       val (nfk,fkE) = OU.fk_wrap(fk, NONE)
-			       
+
 	       (* fdecE *)
 	       val fE = cplv f
 	       val fErets = (map F.VAR fvbIs)
@@ -313,7 +435,7 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =
 	       val fdecE = (fkE, fE, args, bodyE)
 	       val fElty = LT.ltc_fct(map #2 args, map getLty fErets)
 	       val _ = addLty(fE, fElty)
-		       
+
 	       (* fdecI *)
 	       val fkI = {inline=F.IH_ALWAYS, cconv=F.CC_FCT,
 			  known=true, isrec=NONE}
@@ -321,7 +443,7 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =
 		   (map (fn lv => (lv, getLty(F.VAR lv))) fvbIs) @ args
 	       val fdecI as (_,fI,_,_) = FU.copyfdec(fkI,f,argsI,bodyI)
 	       val _ = addpurefun fI
-		       
+
 	       (* nfdec *)
 	       val nargs = map (fn (v,t) => (cplv v, t)) args
 	       val argsv = map (fn (v,t) => F.VAR v) nargs
@@ -335,11 +457,11 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =
 			   F.APP(F.VAR fI, (F.VAR lv)::argsv))
 		  end *)
 	       val nfdec = (nfk, f, nargs, nbody)
-			   
+
 	       (* and now, for the whole F.FIX *)
 	       fun nleE e =
 		   F.FIX([fdecE], F.FIX([fdecI], F.FIX([nfdec], leE e)))
-		   
+
 	   in if not(S.member(fvI, f)) then (nleE, leI, fvI, leRet)
 	      else (nleE,
 		    F.FIX([fdecI], F.FIX([nfdec], leI)),
@@ -347,7 +469,7 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =
 		    leRet)
 	   end
     end
-    
+
 (* TFNs are kinda like FIX except there's no recursion *)
 and stfn env (tfdec as (tfk,tf,args,body),le) =
     let val (bodyE,bodyI,fvbI,bodyRet) =
@@ -376,7 +498,7 @@ and stfn env (tfdec as (tfk,tf,args,body),le) =
 	       val bodyE = bodyE(F.RET tfEvs)
 	       val tfElty = LT.lt_nvpoly(args, map getLty tfEvs)
 	       val _ = addLty(tfE, tfElty)
-		       
+
 	       (* tfdecI *)
 	       val tfkI = {inline=F.IH_ALWAYS}
 	       val argsI = map (fn (v,k) => (cplv v, k)) args
@@ -390,7 +512,7 @@ and stfn env (tfdec as (tfk,tf,args,body),le) =
 	       fun nleE e =
 		   F.TFN((tfk, tfE, args, bodyE),
 			 F.TFN((tfkI, tf, argsI, bodyI), leE e))
-		   
+
 	   in if not(S.member(fvI, tf)) then (nleE, leI, fvI, leRet)
 	      else (nleE,
 		    F.TFN((tfkI, tf, argsI, bodyI), leI),
@@ -398,7 +520,7 @@ and stfn env (tfdec as (tfk,tf,args,body),le) =
 		    leRet)
 	   end
     end
-    
+
 (* here, we use B-decomposition, so the args should not be
  * considered as being in scope *)
 val (bodyE,bodyI,fvbI,bodyRet) = sexp S.empty body
@@ -406,11 +528,11 @@ in case (bodyI, bodyRet)
     of (F.RET _,_) => ((fk, f, args, bodyE bodyRet), NONE)
      | (_,F.RECORD (rk,vs,lv,F.RET[lv'])) =>
        let val fvbIs = S.listItems fvbI
-		       
+
 	   (* fdecE *)
 	   val bodyE = bodyE(F.RECORD(rk, vs@(map F.VAR fvbIs), lv, F.RET[lv']))
 	   val fdecE as (_,fE,_,_) = (fk, cplv f, args, bodyE)
-				     
+
 	   (* fdecI *)
 	   val argI = mklv()
 	   val argLtys = (map getLty vs) @ (map (getLty o F.VAR) fvbIs)
@@ -419,7 +541,7 @@ in case (bodyI, bodyRet)
 				  (n+1, F.SELECT(F.VAR argI, n, lv, le)))
 				 (length vs, bodyI) fvbIs
 	   val fdecI as (_,fI,_,_) = FU.copyfdec (fk, f, argsI, bodyI)
-				     
+
 	   val nargs = map (fn (v,t) => (cplv v, t)) args
        in
 	   (fdecE, SOME fdecI)
@@ -431,11 +553,11 @@ in case (bodyI, bodyRet)
 			      F.APP(F.VAR fI, [F.VAR argI]))))),
 	   NONE) *)
        end
-       
+
      | _ => (fdec, NONE)		(* sorry, can't do that *)
 (* (PPFlint.printLexp bodyRet; bug "couldn't find the returned record") *)
-	    
+
 end
-				       
+
 end
 end