1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006-2007, Adam Chlipala
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
.
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
.
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
.
19 (* Generating HTML documentation automatically
*)
21 structure Autodoc
:> AUTODOC
= struct
23 open Ast HTML HtmlPrint
29 | _
=> str (Char.toUpper (String.sub (s
, 0)))
30 ^
String.extract (s
, 1, NONE
)
34 val prog
= Parse
.parse fname
36 if !ErrorMsg
.anyErrors
then
39 Tycheck
.checkFile G prog
42 fun autodoc
{outdir
, infiles
} =
44 val (prov
, infiles
) = Order
.order NONE infiles
45 val _
= HtmlPrintArg
.setProviders prov
47 val G
= foldl (fn (fname
, G
) => check
' G fname
) Env
.empty infiles
51 DVal (name
, NONE
, e
) =>
52 (case Env
.lookupVal G name
of
54 | SOME t
=> DVal (name
, SOME t
, e
))
59 val file
' = #
file (OS
.Path
.splitDirFile file
)
60 val file
' = #
base (OS
.Path
.splitBaseExt file
')
67 val (desc
, decls
, _
) = Parse
.parse file
69 val file
' = modify file
71 val title
= "Domtool Module " ^ uppercase file
'
73 val outf
= TextIO.openOut (outdir ^
"/" ^ file
' ^
".html")
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
*)
80 val body
= case desc
of
82 | SOME desc
=> P
{align
= NONE
,
83 content
= PCDATA desc
}
85 val body
= BlockList
[body
,
86 TextBlock (BR
{clear
= SOME TextFlowCtl
.all
})]
89 val summaries
= foldr (fn ((d
, desc
, _
), summaries
) =>
90 HtmlPrint
.output (p_decl_fref (annotate_decl d
))
95 val entries
= map (fn (d
, desc
, _
) =>
97 val cblock
= HtmlPrint
.output (p_decl (annotate_decl d
))
99 val dblock
= case desc
of
100 NONE
=> TextBlock (PCDATA
"")
101 | SOME desc
=> BLOCKQUOTE (TextBlock (PCDATA desc
))
103 BlockList
[P
{align
= NONE
,
104 content
= TT cblock
},
108 val body
= BlockList (body
113 :: TextBlock (TT (TextList summaries
))
120 val html
= HTML
{version
= NONE
,
121 head
= [Head_TITLE title
,
122 Head_LINK
{id
= NONE
,
123 href
= SOME Config
.Autodoc
.stylesheet
,
124 rel
= SOME
"stylesheet",
127 body
= BODY
{background
= NONE
,
133 content
= BlockList
[TextBlock (PCDATA (Config
.Autodoc
.htmlHeader title
)),
135 TextBlock (PCDATA Config
.Autodoc
.htmlFooter
)]}}
137 PrHTML
.prHTML
{putc
= (fn ch
=> TextIO.output1 (outf
, ch
)),
138 puts
= (fn s
=> TextIO.output (outf
, s
))} html
;
142 val title
= "Domtool Module Index"
144 val items
= map (fn file
=>
146 val file
' = modify file
147 val (desc
, _
, _
) = Parse
.parse file
152 [TextBlock (A
{name
= NONE
,
153 href
= SOME (file
' ^
".html"),
157 content
= PCDATA (uppercase file
')}),
158 TextBlock (PCDATA (Option
.getOpt (desc
, "")))]}
161 val index
= HTML
{version
= NONE
,
162 head
= [Head_TITLE title
,
163 Head_LINK
{id
= NONE
,
164 href
= SOME Config
.Autodoc
.stylesheet
,
165 rel
= SOME
"stylesheet",
168 body
= BODY
{background
= NONE
,
174 content
= BlockList
[TextBlock (PCDATA (Config
.Autodoc
.htmlHeader title
)),
175 TextBlock (BR
{clear
= SOME TextFlowCtl
.all
}),
179 TextBlock (PCDATA Config
.Autodoc
.htmlFooter
)]}}
181 val outf
= TextIO.openOut (outdir ^
"/index.html")
183 PrHTML
.prHTML
{putc
= (fn ch
=> TextIO.output1 (outf
, ch
)),
184 puts
= (fn s
=> TextIO.output (outf
, s
))} index
;
185 TextIO.closeOut outf
;
190 fun makeEmacsKeywords infiles
=
192 val (_
, infiles
) = Order
.order NONE infiles
193 val G
= foldl (fn (fname
, G
) => check
' G fname
) Env
.empty infiles
195 fun annotate_decl d
=
197 DVal (name
, NONE
, e
) =>
198 (case Env
.lookupVal G name
of
200 | SOME t
=> DVal (name
, SOME t
, e
))
203 fun doFile (file
, acc
) =
205 val (_
, decls
, _
) = Parse
.parse file
207 fun isAction
evs (t
, _
) =
209 TAction (_
, r1
, r2
) =>
211 fun enrich (r
, evs
) =
212 StringMap
.foldli (fn (ev
, _
, evs
) =>
213 StringSet
.add (evs
, ev
))
216 SOME (enrich (r2
, enrich (r1
, evs
)))
218 |
TArrow (_
, t
) => isAction evs t
219 |
TNested (_
, t
) => isAction evs t
220 |
TUnif (_
, ref (SOME t
)) => isAction evs t
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
))
236 (types
, contexts
, actions
, vals
, StringSet
.add (evs
, s
))
237 | DContext s
=> (types
, s
:: contexts
, actions
, vals
, evs
))
241 val (types
, contexts
, actions
, vals
, evs
) =
242 foldl
doFile ([], [], [], [], StringSet
.empty
) infiles
244 fun printKind (ident
, syms
) =
245 (print
"(defconst domtool-";
247 print
"-regexp\n (domtool-syms-re";
248 app (fn s
=> (print
" \""; print s
; print
"\"")) syms
;
249 print
")\n \"A regexp that matches Domtool ";
251 print
" from the standard library.\")\n\n")
253 printKind ("types", types
);
254 printKind ("contexts", contexts
);
255 printKind ("actions", actions
);
256 printKind ("vals", vals
);
257 printKind ("env-vars", StringSet
.listItems evs
);
258 print
"(provide 'domtool-tables)\n"