The unified diff between revisions [8e3895a7..] and [0d39e850..] is displayed below. It can also be downloaded as a raw diff.
#
#
# patch "git.ml"
# from [70d3e1cbbf278f880d0aa022142bf241adb0f8f9]
# to [2d5174877cd92be4f90003777cb2cabd2f243047]
#
# patch "subprocess.ml"
# from [e047bb5bcd5ea674256397d3f8ea0b5c2ce3f919]
# to [108e578184541d73e6e98b98624c5bdaf4de0134]
#
# patch "subprocess.mli"
# from [b509614ed2a16c4c0f88a299484cc5bb3a9adeae]
# to [62bcdc81b9d9f88301f0e7b4cf99219da81ffba0]
#
============================================================
--- git.ml 70d3e1cbbf278f880d0aa022142bf241adb0f8f9
+++ git.ml 2d5174877cd92be4f90003777cb2cabd2f243047
@@ -143,8 +143,8 @@ let open_db db_name =
let ds = Filename.concat db_name ".git" in
try
let d, kind =
- if Sys.file_exists dl then dl, `LINUS else
- if Sys.file_exists ds then ds, `PASKY else failwith "unknown" in
+ if Sys.file_exists ds then ds, `PASKY else
+ if Sys.file_exists dl then dl, `LINUS else failwith "unknown" in
let head = with_file_in input_channel (Filename.concat d "HEAD") in
let get_commit = Viz_misc.make_cache (get_commit_object db_name) in
let get_changeset = Viz_misc.make_cache (get_changeset kind db_name get_commit) in
@@ -164,14 +164,18 @@ let fetch_ancestry_graph d _ =
let fetch_ancestry_graph d _ =
let rec proc ag id =
- let c = d.get_commit id in
- let node = { id = id ;
- kind = if List.length c.parents > 1 then MERGE else REGULAR ;
- family = List.map (fun i -> i, PARENT) c.parents } in
- let n_ag =
- { ag with nodes = NodeMap.add id node ag.nodes ;
- ancestry = List.fold_left (fun e p -> EdgeMap.add (p, id) SAME_BRANCH e) ag.ancestry c.parents } in
- List.fold_left proc n_ag c.parents in
+ if NodeMap.mem id ag.nodes
+ then ag
+ else begin
+ let c = d.get_commit id in
+ let node = { id = id ;
+ kind = if List.length c.parents > 1 then MERGE else REGULAR ;
+ family = List.map (fun i -> i, PARENT) c.parents } in
+ let n_ag =
+ { ag with nodes = NodeMap.add id node ag.nodes ;
+ ancestry = List.fold_left (fun e p -> EdgeMap.add (p, id) SAME_BRANCH e) ag.ancestry c.parents } in
+ List.fold_left proc n_ag c.parents
+ end in
proc Viz_types.empty_agraph d.head
@@ -227,6 +231,7 @@ let run_monotone_diff d exe (parent, chi
status#push "Running git diff ..." ;
ignore (
Subprocess.spawn_out
+ ~working_directory:d.base
~encoding:`LOCALE ~cmd
~reap_callback:status#pop
(fun ~exceptions ~stdout ~stderr status ->
============================================================
--- subprocess.ml e047bb5bcd5ea674256397d3f8ea0b5c2ce3f919
+++ subprocess.ml 108e578184541d73e6e98b98624c5bdaf4de0134
@@ -131,7 +131,7 @@ type t = {
mutable status : int ;
}
-let spawn encoding input_opt cmd reap_callback done_callback =
+let spawn ?working_directory encoding input_opt cmd reap_callback done_callback =
let has_input = input_opt <> None in
let spawn_flags =
[ `PIPE_STDOUT ; `PIPE_STDERR ;
@@ -139,7 +139,8 @@ let spawn encoding input_opt cmd reap_ca
let child_info =
Gspawn.async_with_pipes
- (if has_input then `PIPE_STDIN :: spawn_flags else spawn_flags)
+ ?working_directory
+ ~flags:(if has_input then `PIPE_STDIN :: spawn_flags else spawn_flags)
cmd in
let state = { watches = [] ; aborted = false ; status = -1 } in
@@ -205,11 +206,11 @@ type callback =
int -> unit
(* spawn a process and grab its stdout and stderr *)
-let spawn_out ~encoding ~cmd ~reap_callback done_callback =
+let spawn_out ?working_directory ~encoding ~cmd ~reap_callback done_callback =
spawn encoding None cmd reap_callback done_callback
(* spawn a process, feed it a string and grab its stdout and stderr *)
-let spawn_inout ~encoding ~cmd ~input ~reap_callback done_callback =
+let spawn_inout ?working_directory ~encoding ~cmd ~input ~reap_callback done_callback =
spawn encoding (Some input) cmd reap_callback done_callback
let abort sub_data =
============================================================
--- subprocess.mli b509614ed2a16c4c0f88a299484cc5bb3a9adeae
+++ subprocess.mli 62bcdc81b9d9f88301f0e7b4cf99219da81ffba0
@@ -9,12 +9,14 @@ val spawn_out :
int -> unit
val spawn_out :
+ ?working_directory:string ->
encoding:encoding ->
cmd:string list ->
reap_callback:(unit -> unit) ->
callback -> t
val spawn_inout :
+ ?working_directory:string ->
encoding:encoding ->
cmd:string list ->
input:string ->