From b3a6f44f87f5946267d59176d3c7b024bf39b1d0 Mon Sep 17 00:00:00 2001
From: Stefano Zacchiroli <zack@upsilon.cc>
Date: Thu, 6 Oct 2005 09:50:12 +0000
Subject: [PATCH] in the end: ... proper handling of multiple bindings of the
 same key, all "set_*" methods now replace the previous binding

---
 helm/ocaml/registry/helm_registry.ml | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
index d1f4b1f92..35726d4c9 100644
--- a/helm/ocaml/registry/helm_registry.ml
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -117,10 +117,11 @@ let key_is_valid key =
   if not (Str.string_match valid_key_rex key 0) then
     raise (Malformed_key key)
 
-let set' registry ~key ~value =
-  debug_print (lazy (sprintf "Setting %s = %s" key value));
+let set' ?(replace=false) registry ~key ~value =
+  debug_print (lazy(sprintf "Setting (replace: %b) %s = %s" replace key value));
   key_is_valid key;
-  Hashtbl.add registry key value
+  let add_fun = if replace then Hashtbl.replace else Hashtbl.add in
+  add_fun registry key value
 
 let unset registry = Hashtbl.remove registry
 
@@ -163,8 +164,6 @@ let get registry key =
   in
   List.map strip_blanks (aux [] key)
 
-let set = set'
-
 let has registry key = Hashtbl.mem registry key
 
 let get_typed registry unmarshaller key =
@@ -172,7 +171,7 @@ let get_typed registry unmarshaller key =
   unmarshaller value
 
 let set_typed registry marshaller ~key ~value =
-  set registry ~key ~value:(marshaller value)
+  set' ~replace:true registry ~key ~value:(marshaller value)
 
 let get_opt registry unmarshaller key =
   try
@@ -187,7 +186,7 @@ let get_opt_default registry unmarshaller ~default key =
 let set_opt registry marshaller ~key ~value =
   match value with
   | None -> unset registry key
-  | Some value -> set registry ~key ~value:(marshaller value)
+  | Some value -> set' ~replace:true registry ~key ~value:(marshaller value)
 
 let get_list registry unmarshaller key =
   try
@@ -201,8 +200,9 @@ let get_pair registry fst_unmarshaller snd_unmarshaller key =
   | _ -> raise (Type_error "not a pair")
 
 let set_list registry marshaller ~key ~value =
+  Hashtbl.remove registry key;
   List.iter
-    (fun v -> set registry ~key ~value:(marshaller v))
+    (fun v -> set' ~replace:false registry ~key ~value:(marshaller v))
     value
 
 type xml_tree =
@@ -288,7 +288,7 @@ let rec load_from_absolute ?path registry fname =
     | "section" -> pop_path ()
     | "key" ->
         let key = String.concat "." (List.rev !_path) in
-        set registry ~key ~value:!cdata;
+        set' registry ~key ~value:!cdata;
         cdata := "";
         in_key := false;
         pop_path ()
@@ -389,7 +389,7 @@ let ls registry prefix =
 let default_registry = Hashtbl.create magic_size
 
 let get key = singleton (get default_registry key)
-let set = set default_registry
+let set = set' ~replace:true default_registry
 let has = has default_registry
 let fold ?prefix ?interpolate f init =
   fold default_registry ?prefix ?interpolate f init
-- 
2.39.2