Improved Emacs mode, with standard library 'keyword' table generated automatically...

[hcoop/domtool2.git] / src / autodoc.sml

diff --git a/src/autodoc.sml b/src/autodoc.sml
index b342e6e..640012c 100644 (file)
--- a/src/autodoc.sml
+++ b/src/autodoc.sml
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2007, Adam Chlipala
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -41,8 +41,8 @@ fun check' G fname =
 
 fun autodoc {outdir, infiles} =
     let
-       val (prov, infiles) = Order.order infiles
-       val _ = HtmlPrint.setProviders prov
+       val (prov, infiles) = Order.order NONE infiles
+       val _ = HtmlPrintArg.setProviders prov
 
        val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles
 
@@ -187,4 +187,72 @@ fun autodoc {outdir, infiles} =
        app doFile infiles
     end
 
+fun makeEmacsKeywords infiles =
+    let
+       val (_, infiles) = Order.order NONE infiles
+       val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles       
+
+       fun annotate_decl d =
+           case d of
+               DVal (name, NONE, e) =>
+               (case Env.lookupVal G name of
+                    NONE => d
+                  | SOME t => DVal (name, SOME t, e))
+             | _ => d
+
+       fun doFile (file, acc) =
+           let
+               val (_, decls, _) = Parse.parse file
+
+               fun isAction evs (t, _) =
+                   case t of
+                       TAction (_, r1, r2) =>
+                       let
+                           fun enrich (r, evs) =
+                               StringMap.foldli (fn (ev, _, evs) =>
+                                                    StringSet.add (evs, ev))
+                                     evs r
+                       in
+                           SOME (enrich (r2, enrich (r1, evs)))
+                       end
+                     | TArrow (_, t) => isAction evs t
+                     | TNested (_, t) => isAction evs t
+                     | TUnif (_, ref (SOME t)) => isAction evs t
+                     | _ => NONE
+           in
+               foldl (fn ((d, _, _), (types, contexts, actions, vals, evs)) =>
+                         case annotate_decl d of
+                             DExternType s => (s :: types, contexts, actions, vals, evs)
+                           | DExternVal (s, t) =>
+                             (case isAction evs t of
+                                  SOME evs => (types, contexts, s :: actions, vals, evs)
+                                | NONE => (types, contexts, actions, s :: vals, evs))
+                           | DVal (s, NONE, _) => (types, contexts, actions, s :: vals, evs)
+                           | DVal (s, SOME t, _) =>
+                             (case isAction evs t of
+                                  SOME evs => (types, contexts, s :: actions, vals, evs)
+                                | NONE => (types, contexts, actions, s :: vals, evs))
+                           | DContext s => (types, s :: contexts, actions, vals, evs))
+                     acc decls
+           end
+
+       val (types, contexts, actions, vals, evs) =
+           foldl doFile ([], [], [], [], StringSet.empty) infiles
+
+       fun printKind (ident, syms) =
+           (print "(defconst domtool-";
+            print ident;
+            print "-regexp\n  (domtool-syms-re";
+            app (fn s => (print " \""; print s; print "\"")) syms;
+            print ")\n  \"A regexp that matches Domtool ";
+            print ident;
+            print " from the standard library.\")\n\n")
+    in
+       printKind ("types", types);
+       printKind ("contexts", contexts);
+       printKind ("actions", actions);
+       printKind ("vals", vals);
+       printKind ("env-vars", StringSet.listItems evs)
+    end
+
 end