From: Stefano Zacchiroli <zack@upsilon.cc>
Date: Tue, 24 Feb 2004 13:15:48 +0000 (+0000)
Subject: - added support for boolean parameters
X-Git-Tag: v0_0_4~93
X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=27ebca99c83f84c5a3915695e3f78b36c4fbcedf;p=helm.git

- added support for boolean parameters
- added support for optional parameters
---

diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
index 969644b01..91fcb67b5 100644
--- a/helm/ocaml/registry/helm_registry.ml
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -69,6 +69,11 @@ let dot_rex = Str.regexp "\\."
 let spaces_rex = Str.regexp "[ \t\n\r]+"
 let heading_spaces_rex = Str.regexp "^[ \t\n\r]+"
 
+let split s =
+  (* trailing blanks are removed per default by split *)
+  Str.split spaces_rex (Str.global_replace heading_spaces_rex "" s)
+let merge l = String.concat " " l
+
   (* escapes for xml configuration file *)
 let (escape, unescape) =
   let (in_enc, out_enc) = (`Enc_utf8, `Enc_utf8) in
@@ -93,6 +98,8 @@ let set' registry ~key ~value =
   value_is_valid ~key ~value;
   Hashtbl.replace registry key value
 
+let unset = Hashtbl.remove registry
+
 let env_var_of_key key =
 (*   Pcre.replace ~rex:dot_rex ~templ:"__" (String.uppercase key) *)
   Str.global_replace dot_rex "__" (String.uppercase key)
@@ -135,12 +142,6 @@ let get key =
 
 let set = set' registry
 
-let string_list_of_string s =
-  (* trailing blanks are removed per default by split *)
-(*   Pcre.split ~res:spaces_rex (Pcre.replace ~rex:heading_spaces_rex s) *)
-  Str.split spaces_rex (Str.global_replace heading_spaces_rex "" s)
-let string_of_string_list l = String.concat " " l
-
 let mk_get_set type_name (from_string: string -> 'a) (to_string: 'a -> string) =
   let getter key =
     let value = get key in
@@ -155,8 +156,17 @@ let mk_get_set type_name (from_string: string -> 'a) (to_string: 'a -> string) =
 let (get_string, set_string) = (get, set)
 let (get_int, set_int) = mk_get_set "int" int_of_string string_of_int
 let (get_float, set_float) = mk_get_set "float" float_of_string string_of_float
-let (get_string_list, set_string_list) =
-  mk_get_set "string list" string_list_of_string string_of_string_list
+let (get_bool, set_bool) = mk_get_set "bool" bool_of_string string_of_bool
+let (get_string_list, set_string_list) = mk_get_set "string list" split merge
+
+let get_opt getter key =
+  try
+    Some (getter key)
+  with Key_not_found _ -> None
+let set_opt setter ~key ~value =
+  match value with
+  | None -> unset key
+  | Some value -> setter ~key ~value
 
 (*
 let save_to =
diff --git a/helm/ocaml/registry/helm_registry.mli b/helm/ocaml/registry/helm_registry.mli
index 76c5d6f16..f50d9b4a9 100644
--- a/helm/ocaml/registry/helm_registry.mli
+++ b/helm/ocaml/registry/helm_registry.mli
@@ -97,22 +97,43 @@ exception Invalid_value of (string * string) * string
 val get: string -> string
 val set: key:string -> value:string -> unit
 
+  (** remove a key from the current environment, next get over this key will
+   * raise Key_not_found until the key will be redefined *)
+val unset: string -> unit
+
 (** {2 Typed interface}
  * Three basic types are supported: strings, int and strings list. Strings
  * correspond literally to what is written inside double quotes; int to the
  * parsing of an integer number from ; strings list to the splitting at blanks
  * of it (heading and trailing blanks are removed before splitting) *)
 
-val get_string: string -> string  (* alias for bare "get" above *)
-val get_int: string -> int
-val get_float: string -> float
-val get_string_list: string -> string list
+val get_string:       string -> string  (* alias for bare "get" above *)
+val get_int:          string -> int
+val get_float:        string -> float
+val get_bool:         string -> bool
+val get_string_list:  string -> string list
 
   (* alias for bare "set" above *)
-val set_string: key:string -> value:string -> unit
-val set_int: key:string -> value:int -> unit
-val set_float: key:string -> value:float -> unit
-val set_string_list: key:string -> value:string list -> unit
+val set_string:       key:string -> value:string      -> unit
+val set_int:          key:string -> value:int         -> unit
+val set_float:        key:string -> value:float       -> unit
+val set_bool:         key:string -> value:bool        -> unit
+val set_string_list:  key:string -> value:string list -> unit
+
+(** {3 Optional values interface}
+ * Functions below took as first argument respectively a "getter" and a "setter"
+ * function. A getter is one of the get_* function above, a setter is one of the
+ * set_* function above. Returned value is a get (set) function typed as the
+ * given getter (setter) whith optional values. None is returned for missing
+ * keys and None can be assigned to a key removing it from the registry.
+ *)
+
+val get_opt:
+  (string -> 'a) (* getter *) ->
+    string -> 'a option
+val set_opt:
+  (key:string -> value:'a -> unit) (* setter *) ->
+    key:string -> value:'a option -> unit
 
 (** {2 Validators}
  * Each key may have zero or more associated validators, that are predicates