1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006, 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 (* Pretty
-printing Domtool configuration file ASTs for HTML
*)
21 signature HTML_PRINT_ARG
= sig
22 include PRINTFN_INPUT
where type rendering
= HTML
.text
24 val setProviders
: Order
.providers
-> unit
27 structure HtmlPrintArg
:> HTML_PRINT_ARG
= struct
31 structure TextToken
= struct
33 type style
= HTMLDev
.style
35 fun style t
= HTMLDev
.styleTT
36 fun size t
= String.size t
39 structure SM
= PPStreamFn(structure Token
= TextToken
40 structure Device
= HTMLDev
)
42 structure PD
= PPDescFn(SM
)
45 fun keyword s
= style (HTMLDev
.styleB
, [string s
])
51 val prov
: providers option ref
= ref NONE
52 fun setProviders p
= prov
:= SOME p
56 val file
' = #
file (OS
.Path
.splitDirFile file
)
57 val file
' = #
base (OS
.Path
.splitBaseExt file
')
63 case providesContext (valOf (!prov
), s
) of
65 | SOME m
=> style (HTMLDev
.link (modify m ^
".html#C_" ^ s
), [string s
])
67 case providesType (valOf (!prov
), s
) of
69 | SOME m
=> style (HTMLDev
.link (modify m ^
".html#T_" ^ s
), [string s
])
71 case providesValue (valOf (!prov
), s
) of
73 | SOME m
=> style (HTMLDev
.link (modify m ^
".html#V_" ^ s
), [string s
])
75 fun anchor (s
, d
) = style (HTMLDev
.anchor s
, [d
])
76 fun link (s
, d
) = style (HTMLDev
.link s
, [d
])
78 type rendering
= HTML
.text
81 val dev
= HTMLDev
.openDev
{wid
= 80,
86 fun closeStream s
= HTMLDev
.done (SM
.getDevice s
)
90 structure HtmlPrint
= PrintFn(HtmlPrintArg
)