(* 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
if !ErrorMsg.anyErrors then
G
else
- Tycheck.checkFile G (Defaults.tInit ()) prog
+ Tycheck.checkFile G prog
end
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
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))
:: 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;
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
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);
+ print "(provide 'domtool-tables)\n"
+ end
+
end
HCoop / hcoop / domtool2.git / blobdiff