#
#
# patch "monotone.ml"
#  from [e1b9ed8c02efd09b06573d7b10fbe2af61ced66c]
#    to [9fa93c28a72357c18adcafd38846c461a6be6845]
# 
# patch "monotone.mli"
#  from [841d81a6923af9acbb6560c7e62238fa0a309d96]
#    to [a629c1ce8cc72db8296bc3dc8433f1f2ce8ead9e]
# 
# patch "view.ml"
#  from [88b66de3800bbfc18f6663a9d753cf87f071a885]
#    to [60ed1b72ef4581b1b5bd247f86c921b877ca2384]
# 
# patch "viz_misc.ml"
#  from [c0708bf649892dfa41344e195aa1698a8e3f9d9a]
#    to [962f45ead1ad16c50548c9a69a360d70940d195e]
# 
# patch "viz_misc.mli"
#  from [6bf31ab3f93e482daf9cfd055d89aaebe571baa4]
#    to [1ab258dd15c9db682622c137aa1bb2db6b903ee4]
#
============================================================
--- monotone.ml	e1b9ed8c02efd09b06573d7b10fbe2af61ced66c
+++ monotone.ml	9fa93c28a72357c18adcafd38846c461a6be6845
@@ -5,6 +5,9 @@ let exit = Automate.exit
 let make = Automate.make
 let exit = Automate.exit
 
+let report_error cb fmt =
+  Printf.kprintf (fun s -> cb (`SUB_PROC_ERROR s)) fmt
+
 let spawn_monotone mtn cmd input status cb =
   let mtn_exe, db_fname = Automate.get_info mtn in
   let cmd = mtn_exe :: "--db" :: db_fname :: cmd in
@@ -17,15 +20,16 @@ let spawn_monotone mtn cmd input status 
 	if status = 0 
 	then
 	  cb (`OUTPUT stdout)
-	else
-	  let error fmt =
-	    Printf.kprintf (fun s -> cb (`SUB_PROC_ERROR s)) fmt in
-	  if stderr = ""
-	  then 
-	    error "Monotone exited with status %d:\n%s" status 
-	      (String.concat "\n" (List.map Printexc.to_string exceptions))
-	  else 
-	    error "Monotone error:\n%s" stderr)
+	else if stderr = ""
+	then 
+	  report_error cb
+            "Monotone exited with status %d:\n%s" 
+            status 
+	    (String.concat "\n" (List.map Printexc.to_string exceptions))
+	else 
+	   report_error cb
+            "Monotone error:\n%s" 
+            stderr)
   with Gspawn.Error (_, msg) ->
     Viz_types.errorf "Could not execute monotone:\n%s" msg
 
@@ -39,13 +43,61 @@ let run_monotone_diff mtn status cb (old
 
 
 
+let decode_count_branches d =
+  match Viz_misc.string_split '\n' d with
+  | _ :: l ->
+      let re = Str.regexp "\\([0-9]+\\) | \\(.*\\)" in
+      List.map
+        (fun r ->
+          if Str.string_match re r 0
+          then begin
+            let b = Str.matched_group 2 r
+            and n = Str.matched_group 1 r in
+            b, int_of_string n
+          end
+          else failwith "Monotone.decode_count_branches: bad format")
+        l
+  | _ ->
+      failwith "Monotone.decode_count_branches: bad format"
 
+let fake_status () =
+  object
+    method push _ = ()
+    method pop () = ()
+  end
 
+let wait_subproc mtn args =
+  let output = ref None
+  and exit_loop = ref false in
+  let cb v = output := Some v ; exit_loop := true in
+  ignore (spawn_monotone mtn args None (fake_status ()) cb) ;
+  while not !exit_loop do
+    ignore (Glib.Main.iteration true)
+  done ;
+  Viz_misc.some !output
 
 
+let run_monotone_count_branches mtn =
+  let counts =
+    let args = [ "db" ; "execute" ;
+                 "SELECT COUNT(*), value FROM revision_certs WHERE name = 'branch' GROUP BY value" ] in
+    match wait_subproc mtn args with
+    | `SUB_PROC_ERROR _ -> []
+    | `OUTPUT d -> 
+        try decode_count_branches d 
+        with Failure _ -> [] in
+  match counts with
+  | [] -> fun b -> 0
+  | _  ->
+      let tbl = Viz_misc.hashtbl_of_list counts in
+      fun b -> try Hashtbl.find tbl b with Not_found -> 0
 
 
 
+
+
+
+
 let escape_selector s =
   let len = String.length s in
   let nb_escp = ref 0 in
@@ -73,8 +125,7 @@ let decode_branches msg =
 let ( +> ) x f = f x
 
 let decode_branches msg =
-  let l = Viz_misc.string_split '\n' msg in
-  List.map (fun l -> l, 0) l
+  Viz_misc.string_split '\n' msg
 
 let branches mtn =
   Automate.submit_sync
============================================================
--- monotone.mli	841d81a6923af9acbb6560c7e62238fa0a309d96
+++ monotone.mli	a629c1ce8cc72db8296bc3dc8433f1f2ce8ead9e
@@ -10,9 +10,11 @@ val run_monotone_diff : 
   ([>`SUB_PROC_ERROR of string | `OUTPUT of string] -> unit) ->
   string * string -> unit
 
+val run_monotone_count_branches : t -> (string -> int)
+
 val escape_selector : string -> string
 
-val branches : t -> (string * int) list
+val branches : t -> string list
 val get_revision : t -> string -> Viz_types.node_data
 val get_certs_and_revision : t -> string -> Viz_types.node_data
 val cert_value : t -> string -> string -> string list
============================================================
--- view.ml	88b66de3800bbfc18f6663a9d753cf87f071a885
+++ view.ml	60ed1b72ef4581b1b5bd247f86c921b877ca2384
@@ -1456,7 +1456,10 @@ let open_db v ctrl =
   Branch_selector.populate 
     v.selector 
     (Ui.with_grab (fun () ->
-      Monotone.branches (some ctrl#get_mtn)))
+      let mtn = some ctrl#get_mtn in
+      let b = Monotone.branches mtn
+      and c = Monotone.run_monotone_count_branches mtn in
+      List.map (fun b -> b, c b) b))
 
 let update v ctrl id =
   Canvas.update_graph v.canvas ctrl id
============================================================
--- viz_misc.ml	c0708bf649892dfa41344e195aa1698a8e3f9d9a
+++ viz_misc.ml	962f45ead1ad16c50548c9a69a360d70940d195e
@@ -211,3 +211,10 @@ let make_cache g =
       let v = g k in
       Hashtbl.add tbl k v ;
       v
+
+let hashtbl_of_list l =
+  let tbl = Hashtbl.create (List.length l) in
+  List.iter
+    (fun (k, v) -> Hashtbl.add tbl k v)
+    l ;
+  tbl
============================================================
--- viz_misc.mli	6bf31ab3f93e482daf9cfd055d89aaebe571baa4
+++ viz_misc.mli	1ab258dd15c9db682622c137aa1bb2db6b903ee4
@@ -42,3 +42,5 @@ val make_cache : ('a -> 'b) -> 'a -> 'b
 val hex_enc : string -> string
 
 val make_cache : ('a -> 'b) -> 'a -> 'b
+
+val hashtbl_of_list : ('a * 'b) list -> ('a, 'b) Hashtbl.t