The unified diff between revisions [72490f7f..] and [f94da9bd..] is displayed below. It can also be downloaded as a raw diff.
#
#
# 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