Allow all users to use "nogroup" as `your_group'
[hcoop/domtool2.git] / src / autodoc.sml
CommitLineData
3196000d 1(* HCoop Domtool (http://hcoop.sourceforge.net/)
ef18a741 2 * Copyright (c) 2006-2007, Adam Chlipala
3196000d
AC
3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19(* Generating HTML documentation automatically *)
20
21structure Autodoc :> AUTODOC = struct
22
23open Ast HTML HtmlPrint
24open PD
25
26fun uppercase s =
27 case s of
28 "" => s
29 | _ => str (Char.toUpper (String.sub (s, 0)))
30 ^ String.extract (s, 1, NONE)
31
32fun check' G fname =
33 let
34 val prog = Parse.parse fname
35 in
36 if !ErrorMsg.anyErrors then
37 G
38 else
e140629f 39 Tycheck.checkFile G prog
3196000d
AC
40 end
41
42fun autodoc {outdir, infiles} =
43 let
c53e82e4 44 val (prov, infiles) = Order.order NONE infiles
9b7ee2b2 45 val _ = HtmlPrintArg.setProviders prov
3196000d
AC
46
47 val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles
48
49 fun annotate_decl d =
50 case d of
51 DVal (name, NONE, e) =>
52 (case Env.lookupVal G name of
53 NONE => d
54 | SOME t => DVal (name, SOME t, e))
55 | _ => d
56
57 fun modify file =
58 let
59 val file' = #file (OS.Path.splitDirFile file)
60 val file' = #base (OS.Path.splitBaseExt file')
61 in
62 file'
63 end
64
65 fun doFile file =
66 let
67 val (desc, decls, _) = Parse.parse file
68
69 val file' = modify file
70
71 val title = "Domtool Module " ^ uppercase file'
72
73 val outf = TextIO.openOut (outdir ^ "/" ^ file' ^ ".html")
74
75 (*fun doDecl (d, desc, _) =
76 Option.app (fn desc => (TextIO.output (outf, "<p>");
77 TextIO.output (outf, desc);
78 TextIO.output (outf, "</p>\n"))) desc*)
79
3196000d 80 val body = case desc of
7d5aaf7b
AC
81 NONE => BlockList []
82 | SOME desc => P {align = NONE,
83 content = PCDATA desc}
84
85 val body = BlockList [body,
86 TextBlock (BR {clear = SOME TextFlowCtl.all})]
87
3196000d 88
c2ce01bd
AC
89 val summaries = foldr (fn ((d, desc, _), summaries) =>
90 HtmlPrint.output (p_decl_fref (annotate_decl d))
91 :: BR {clear = NONE}
92 :: summaries)
93 [] decls
94
3196000d
AC
95 val entries = map (fn (d, desc, _) =>
96 let
97 val cblock = HtmlPrint.output (p_decl (annotate_decl d))
98
99 val dblock = case desc of
100 NONE => TextBlock (PCDATA "")
101 | SOME desc => BLOCKQUOTE (TextBlock (PCDATA desc))
102 in
103 BlockList [P {align = NONE,
104 content = TT cblock},
105 dblock]
106 end) decls
107
c2ce01bd
AC
108 val body = BlockList (body
109 :: HR {align = NONE,
110 noshade = false,
111 size = NONE,
112 width = NONE}
113 :: TextBlock (TT (TextList summaries))
114 :: HR {align = NONE,
115 noshade = false,
116 size = NONE,
117 width = NONE}
118 :: entries)
3196000d
AC
119
120 val html = HTML {version = NONE,
7d5aaf7b
AC
121 head = [Head_TITLE title,
122 Head_LINK {id = NONE,
123 href = SOME Config.Autodoc.stylesheet,
124 rel = SOME "stylesheet",
125 rev = NONE,
126 title = NONE}],
3196000d
AC
127 body = BODY {background = NONE,
128 bgcolor = NONE,
129 text = NONE,
130 link = NONE,
131 vlink = NONE,
132 alink = NONE,
7d5aaf7b
AC
133 content = BlockList[TextBlock (PCDATA (Config.Autodoc.htmlHeader title)),
134 body,
135 TextBlock (PCDATA Config.Autodoc.htmlFooter)]}}
3196000d 136 in
3196000d
AC
137 PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
138 puts = (fn s => TextIO.output (outf, s))} html;
139 TextIO.closeOut outf
140 end
141
c2ce01bd
AC
142 val title = "Domtool Module Index"
143
144 val items = map (fn file =>
145 let
146 val file' = modify file
6bb366c5 147 val (desc, _, _) = Parse.parse file
c2ce01bd
AC
148 in
149 LI {ty = NONE,
150 value = NONE,
6bb366c5
AC
151 content = BlockList
152 [TextBlock (A {name = NONE,
153 href = SOME (file' ^ ".html"),
154 rel = NONE,
155 rev = NONE,
156 title = NONE,
157 content = PCDATA (uppercase file')}),
158 TextBlock (PCDATA (Option.getOpt (desc, "")))]}
c2ce01bd
AC
159 end) infiles
160
161 val index = HTML {version = NONE,
7d5aaf7b
AC
162 head = [Head_TITLE title,
163 Head_LINK {id = NONE,
164 href = SOME Config.Autodoc.stylesheet,
165 rel = SOME "stylesheet",
166 rev = NONE,
167 title = NONE}],
c2ce01bd
AC
168 body = BODY {background = NONE,
169 bgcolor = NONE,
170 text = NONE,
171 link = NONE,
172 vlink = NONE,
173 alink = NONE,
7d5aaf7b
AC
174 content = BlockList[TextBlock (PCDATA (Config.Autodoc.htmlHeader title)),
175 TextBlock (BR {clear = SOME TextFlowCtl.all}),
176 UL {ty = NONE,
177 compact = false,
178 content = items},
179 TextBlock (PCDATA Config.Autodoc.htmlFooter)]}}
c2ce01bd 180
3196000d
AC
181 val outf = TextIO.openOut (outdir ^ "/index.html")
182 in
c2ce01bd
AC
183 PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
184 puts = (fn s => TextIO.output (outf, s))} index;
3196000d
AC
185 TextIO.closeOut outf;
186
187 app doFile infiles
188 end
189
ef18a741
AC
190fun makeEmacsKeywords infiles =
191 let
192 val (_, infiles) = Order.order NONE infiles
193 val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles
194
195 fun annotate_decl d =
196 case d of
197 DVal (name, NONE, e) =>
198 (case Env.lookupVal G name of
199 NONE => d
200 | SOME t => DVal (name, SOME t, e))
201 | _ => d
202
203 fun doFile (file, acc) =
204 let
205 val (_, decls, _) = Parse.parse file
206
207 fun isAction evs (t, _) =
208 case t of
209 TAction (_, r1, r2) =>
210 let
211 fun enrich (r, evs) =
212 StringMap.foldli (fn (ev, _, evs) =>
213 StringSet.add (evs, ev))
214 evs r
215 in
216 SOME (enrich (r2, enrich (r1, evs)))
217 end
218 | TArrow (_, t) => isAction evs t
219 | TNested (_, t) => isAction evs t
220 | TUnif (_, ref (SOME t)) => isAction evs t
221 | _ => NONE
222 in
223 foldl (fn ((d, _, _), (types, contexts, actions, vals, evs)) =>
224 case annotate_decl d of
225 DExternType s => (s :: types, contexts, actions, vals, evs)
226 | DExternVal (s, t) =>
227 (case isAction evs t of
228 SOME evs => (types, contexts, s :: actions, vals, evs)
229 | NONE => (types, contexts, actions, s :: vals, evs))
230 | DVal (s, NONE, _) => (types, contexts, actions, s :: vals, evs)
231 | DVal (s, SOME t, _) =>
232 (case isAction evs t of
233 SOME evs => (types, contexts, s :: actions, vals, evs)
234 | NONE => (types, contexts, actions, s :: vals, evs))
235 | DContext s => (types, s :: contexts, actions, vals, evs))
236 acc decls
237 end
238
239 val (types, contexts, actions, vals, evs) =
240 foldl doFile ([], [], [], [], StringSet.empty) infiles
241
242 fun printKind (ident, syms) =
243 (print "(defconst domtool-";
244 print ident;
245 print "-regexp\n (domtool-syms-re";
246 app (fn s => (print " \""; print s; print "\"")) syms;
247 print ")\n \"A regexp that matches Domtool ";
248 print ident;
249 print " from the standard library.\")\n\n")
250 in
251 printKind ("types", types);
252 printKind ("contexts", contexts);
253 printKind ("actions", actions);
254 printKind ("vals", vals);
03b14a21
AC
255 printKind ("env-vars", StringSet.listItems evs);
256 print "(provide 'domtool-tables)\n"
ef18a741
AC
257 end
258
3196000d 259end