X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/c2ce01bde477e5b32bd287ca34beecc8d490e7e7..d300166d083192ef3d4242013adcef345b0126f3:/src/autodoc.sml

diff --git a/src/autodoc.sml b/src/autodoc.sml
index 71ff33d..640012c 100644
--- 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
 
@@ -77,15 +77,14 @@ fun autodoc {outdir, infiles} =
 					    TextIO.output (outf, desc);
 					    TextIO.output (outf, "</p>\n"))) desc*)
 
-		val body = Hn {n = 1,
-			       align = NONE,
-			       content = PCDATA title}
-
 		val body = case desc of
-			       NONE => body
-			     | SOME desc => BlockList [body,
-						       P {align = NONE,
-							  content = PCDATA desc}]
+			       NONE => BlockList []
+			     | SOME desc => P {align = NONE,
+					       content = PCDATA desc}
+
+		val  body = BlockList [body,
+				       TextBlock (BR {clear = SOME TextFlowCtl.all})]
+
 
 		val summaries = foldr (fn ((d, desc, _), summaries) =>
 					HtmlPrint.output (p_decl_fref (annotate_decl d))
@@ -119,14 +118,21 @@ fun autodoc {outdir, infiles} =
 				      :: entries)
 
 		val html = HTML {version = NONE,
-				 head = [Head_TITLE title],
+				 head = [Head_TITLE title,
+					 Head_LINK {id = NONE,
+						    href = SOME Config.Autodoc.stylesheet,
+						    rel = SOME "stylesheet",
+						    rev = NONE,
+						    title = NONE}],
 				 body = BODY {background = NONE,
 					      bgcolor = NONE,
 					      text = NONE,
 					      link = NONE,
 					      vlink = NONE,
 					      alink = NONE,
-					      content = body}}
+					      content = BlockList[TextBlock (PCDATA (Config.Autodoc.htmlHeader title)),
+								  body,
+								  TextBlock (PCDATA Config.Autodoc.htmlFooter)]}}
 	    in
 		PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
 			       puts = (fn s => TextIO.output (outf, s))} html;
@@ -138,28 +144,39 @@ fun autodoc {outdir, infiles} =
 	val items = map (fn file =>
 			    let
 				val file' = modify file
+				val (desc, _, _) = Parse.parse file
 			    in
 				LI {ty = NONE,
 				    value = NONE,
-				    content = TextBlock (A {name = NONE,
-							    href = SOME (file' ^ ".html"),
-							    rel = NONE,
-							    rev = NONE,
-							    title = NONE,
-							    content = PCDATA (uppercase file')})}
+				    content = BlockList
+						  [TextBlock (A {name = NONE,
+								 href = SOME (file' ^ ".html"),
+								 rel = NONE,
+								 rev = NONE,
+								 title = NONE,
+								 content = PCDATA (uppercase file')}),
+						   TextBlock (PCDATA (Option.getOpt (desc, "")))]}
 			    end) infiles
 
 	val index = HTML {version = NONE,
-			  head = [Head_TITLE title],
+			  head = [Head_TITLE title,
+				  Head_LINK {id = NONE,
+					     href = SOME Config.Autodoc.stylesheet,
+					     rel = SOME "stylesheet",
+					     rev = NONE,
+					     title = NONE}],
 			  body = BODY {background = NONE,
 				       bgcolor = NONE,
 				       text = NONE,
 				       link = NONE,
 				       vlink = NONE,
 				       alink = NONE,
-				       content = UL {ty = NONE,
-						     compact = false,
-						     content = items}}}
+				       content = BlockList[TextBlock (PCDATA (Config.Autodoc.htmlHeader title)),
+							   TextBlock (BR {clear = SOME TextFlowCtl.all}),
+							   UL {ty = NONE,
+							       compact = false,
+							       content = items},
+							   TextBlock (PCDATA Config.Autodoc.htmlFooter)]}}
 
 	val outf = TextIO.openOut (outdir ^ "/index.html")
     in
@@ -170,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