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 (* Domain
-related primitive actions
*)
21 structure Domain
:> DOMAIN
= struct
25 val befores
= ref (fn (_
: string) => ())
26 val afters
= ref (fn (_
: string) => ())
28 fun registerBefore f
=
32 befores
:= (fn x
=> (old x
; f x
))
39 afters
:= (fn x
=> (old x
; f x
))
43 val currentPath
= ref
""
45 fun currentDomain () = !current
47 fun domainFile name
= TextIO.openOut (!currentPath ^ name
)
51 val toks
= String.fields (fn ch
=> ch
= #
".") domain
53 val elems
= foldr (fn (piece
, elems
) =>
55 val elems
= piece
:: elems
56 val path
= String.concatWith
"/" (Config
.configRoot
:: rev elems
)
58 (if Posix
.FileSys
.ST
.isDir
59 (Posix
.FileSys
.stat path
) then
62 (OS
.FileSys
.remove path
;
63 OS
.FileSys
.mkDir path
))
64 handle OS
.SysErr _
=> OS
.FileSys
.mkDir path
;
68 String.concatWith
"/" (Config
.configRoot
:: rev elems
)
71 val _
= Env
.registerContainer ("domain",
72 fn (_
, [(EString dom
, _
)]) => (current
:= dom
;
73 currentPath
:= getPath dom
;
76 | _
=> Env
.badArgs
"domain",
77 fn () => !afters (!current
))