# 
# add_file "glib/ocaml-misc.c"
# 
# add_file "glib/viz_gmisc.ml"
# 
# patch "Makefile"
#  from [955871eb9f150270818844a8e968cca2025f2a29]
#    to [7276fb0499e1a5216a187fa10b1bea46aadaef74]
# 
# patch "agraph.ml"
#  from [43224748d96e15241ae74b68ddd5e538158c78fc]
#    to [3720c75f76f3cefce06caf6dbc4ec724dc3507bc]
# 
# patch "agraph.mli"
#  from [1d7a0b49f88ba46b8eb32138705e04da348bef7f]
#    to [f6eccc6f52c059e695a6b07aa56275714c923b6a]
# 
# patch "database.ml"
#  from [99e4716a7708554fb354c9d365237844831a9e12]
#    to [a9be75cba7c3959bb719bddc6c16845ccc7f9d7f]
# 
# patch "database.mli"
#  from [cf83c69520e679903cc25bd22aaf4093e4535ebb]
#    to [c3b6e7bc7329e3085ebb84fc66917fb0bf32b932]
# 
# patch "glib/gspawn.ml"
#  from [bfd9e189f852d27c821ac88b0e77d3485f2716c1]
#    to [f8846574d6e8653113237244b5f3ed22319dc9d0]
# 
# patch "glib/gspawn.mli"
#  from [c43ee9e417dfec498f6b7fa63bfb6ba98257b410]
#    to [eeca332ea1074a25ab360aa96419094f6b8c3103]
# 
# patch "glib/ocaml-gspawn.c"
#  from [d7971112446d9d6b160a5ba3d902a6b32a256122]
#    to [0f9699de08507b50e004ccefdd8f513ce6c1f07d]
# 
# patch "glib/ocaml-misc.c"
#  from []
#    to [44a042feff4c65e0bb261283254171cb5692b205]
# 
# patch "glib/viz_gmisc.ml"
#  from []
#    to [c5db1d58e138a0daf67bfb1fdeeca789fcac0c28]
# 
# patch "query.ml"
#  from [97fa8ac5a8cb5475ab17904e9721d53b9dd5f680]
#    to [256e656a8beb50a97b7a1b7216c8d07693d9e554]
# 
# patch "view.ml"
#  from [ef71335aa33860ed09179219898da53d7256f4d4]
#    to [93359e592e49c18a122c0fe1d2ce4ad103481fd9]
# 
# patch "view.mli"
#  from [2e44176961f054a130b1abd7cb28dface0b26ac4]
#    to [ea0d6527fe87a36240b73f80ceb15dd2f256baee]
# 
# patch "viz_misc.ml"
#  from [3239ead06c767d585cb8579ffa802b6267d3f0eb]
#    to [e4da8d228a71dca79261bf14be9db15399c6de74]
# 
# patch "viz_style.ml"
#  from [6cf212b3f5a006c0e1272df3e0d8548e8bc2945d]
#    to [72c4f46ab2286a2da56f910a2db3c408bf8b4b47]
# 
# patch "viz_style.mli"
#  from [1141a3e066bd93d8d5d275b8e35ae162aeec955f]
#    to [1bbbbfca7c1ba5360b0612375445623a7549a033]
# 
========================================================================
--- Makefile	955871eb9f150270818844a8e968cca2025f2a29
+++ Makefile	7276fb0499e1a5216a187fa10b1bea46aadaef74
@@ -12,7 +12,7 @@
 
 
 SRC = base64.ml base64.mli sqlite3.ml sqlite3.mli IO.mli IO.ml unzip.ml unzip.mli \
-      gspawn.ml gspawn.mli giochannel.ml giochannel.mli \
+      gspawn.ml gspawn.mli giochannel.ml giochannel.mli viz_gmisc.ml \
       crypto.ml crypto.mli \
       viz_misc.ml viz_misc.mli viz_types.ml viz_types.mli \
       q.ml q.mli heap.ml heap.mli \
@@ -26,7 +26,7 @@
       view.ml view.mli query.ml ui.ml main.ml
 
 C_OBJ = mlsqlite/ocaml-sqlite3.o \
-        glib/ocaml-gspawn.o glib/ocaml-giochannel.o \
+        glib/ocaml-gspawn.o glib/ocaml-giochannel.o glib/ocaml-misc.o \
         crypto/ocaml-openssl.o \
         gnomecanvas_hack.o
 
@@ -48,7 +48,8 @@
           ocamlnet-0.97.1/base64.ml ocamlnet-0.97.1/base64.mli ocamlnet-0.97.1/LICENSE \
           extlib-1.3/IO.ml extlib-1.3/IO.mli extlib-1.3/unzip.ml extlib-1.3/unzip.mli \
           glib/gspawn.ml glib/gspawn.mli glib/giochannel.ml glib/giochannel.mli \
-          glib/ocaml-gspawn.c glib/ocaml-giochannel.c \
+          glib/viz_gmisc.ml \
+          glib/ocaml-gspawn.c glib/ocaml-giochannel.c glib/ocaml-misc.c \
           glib/gspawn_tags.var glib/giochannel_tags.var \
           crypto/ocaml-openssl.c crypto/crypto.ml crypto/crypto.mli
 
========================================================================
--- agraph.ml	43224748d96e15241ae74b68ddd5e538158c78fc
+++ agraph.ml	3720c75f76f3cefce06caf6dbc4ec724dc3507bc
@@ -9,7 +9,6 @@
     dot_program : string ;
   }
 type t = {
-    db     : Database.t ;
     query  : Viz_types.query ;
     agraph : Viz_types.agraph ;
     layout_params  : layout_params ;
@@ -255,11 +254,8 @@
 
 type done_cb = [`LAYOUT_DONE | `LAYOUT_ERROR of string] -> unit
 
-let make db query layout_params (done_cb : done_cb) =
-  (* Query the SQL database *)
-  let agraph = Database.fetch_ancestry_graph db query in
+let make agraph query layout_params (done_cb : done_cb) =
   let graph = {
-    db = db ;
     query = query ;
     agraph = agraph ;
     layout_params = { layout_params with 
@@ -284,7 +280,6 @@
       g.dot_subproc <- None
 
 let get_query { query = q } = q
-let get_db { db = db } = db
 
 let mem { agraph = g } id = 
   NodeMap.mem id g.nodes
========================================================================
--- agraph.mli	1d7a0b49f88ba46b8eb32138705e04da348bef7f
+++ agraph.mli	f6eccc6f52c059e695a6b07aa56275714c923b6a
@@ -10,15 +10,14 @@
 type t
 
 type done_cb = [`LAYOUT_DONE | `LAYOUT_ERROR of string] -> unit
-val make : Database.t -> query -> layout_params -> done_cb -> t
-    (* SQL: fetch ancestry graph, determine node kind (NORMAL, MERGE, DISAPPROVE), spawn dot *)
+val make : agraph -> query -> layout_params -> done_cb -> t
+    (* spawn dot *)
 
 exception Not_yet
 val get_layout : t -> layout
 val abort_layout : t -> unit
 
 val get_query : t -> query
-val get_db : t -> Database.t
 
 val mem : t -> string -> bool
 val get_ancestors : t -> string -> string list
========================================================================
--- database.ml	99e4716a7708554fb354c9d365237844831a9e12
+++ database.ml	a9be75cba7c3959bb719bddc6c16845ccc7f9d7f
@@ -326,6 +326,11 @@
 let close_db { db = db } =
   Sqlite3.close_db db
 
+let with_progress prg f db =
+  Sqlite3.progress_handler_set db.db 5000 prg ;
+  try let r = f db in Sqlite3.progress_handler_unset db.db ; r
+  with exn -> Sqlite3.progress_handler_unset db.db ; raise exn
+
 let get_filename d = d.filename
 
 let fetch_branches db =
========================================================================
--- database.mli	cf83c69520e679903cc25bd22aaf4093e4535ebb
+++ database.mli	c3b6e7bc7329e3085ebb84fc66917fb0bf32b932
@@ -7,6 +7,8 @@
 val open_db    : string -> t
 val close_db   : t -> unit
 
+val with_progress : (unit -> unit) -> (t -> 'a) -> t -> 'a
+
 val get_filename : t -> string
 
 val fetch_branches : t -> string list
========================================================================
--- glib/gspawn.ml	bfd9e189f852d27c821ac88b0e77d3485f2716c1
+++ glib/gspawn.ml	f8846574d6e8653113237244b5f3ed22319dc9d0
@@ -88,5 +88,3 @@
 type source_id
 external add_child_watch : ?prio:int -> pid -> (int -> unit) -> source_id = "ml_g_add_child_watch_full"
 external remove_watch : source_id -> unit = "ml_g_source_remove"
-
-external get_home_dir : unit -> string = "_ml_g_get_home_dir"
========================================================================
--- glib/gspawn.mli	c43ee9e417dfec498f6b7fa63bfb6ba98257b410
+++ glib/gspawn.mli	eeca332ea1074a25ab360aa96419094f6b8c3103
@@ -78,6 +78,3 @@
 type source_id
 external add_child_watch : ?prio:int -> pid -> (int -> unit) -> source_id = "ml_g_add_child_watch_full"
 external remove_watch : source_id -> unit = "ml_g_source_remove"
-
-(* not present in lablgtk 2.4.0 *)
-external get_home_dir : unit -> string = "_ml_g_get_home_dir"
========================================================================
--- glib/ocaml-gspawn.c	d7971112446d9d6b160a5ba3d902a6b32a256122
+++ glib/ocaml-gspawn.c	0f9699de08507b50e004ccefdd8f513ce6c1f07d
@@ -314,10 +314,3 @@
 			       ml_global_root_destroy);
   return Val_long (id);
 }
-
-CAMLprim value
-_ml_g_get_home_dir (value unit)
-{
-  G_CONST_RETURN gchar *dir = g_get_home_dir ();
-  return copy_string (dir ? dir : "");
-}
========================================================================
--- glib/ocaml-misc.c	
+++ glib/ocaml-misc.c	44a042feff4c65e0bb261283254171cb5692b205
@@ -0,0 +1,21 @@
+#include <gtk/gtk.h>
+
+#include <caml/alloc.h>
+
+#include "wrappers.h"
+#include "ml_glib.h"
+#include "ml_gtk.h"
+
+
+CAMLprim value
+_ml_g_get_home_dir (value unit)
+{
+  G_CONST_RETURN gchar *dir = g_get_home_dir ();
+  return copy_string (dir ? dir : "");
+}
+
+CAMLprim value
+_ml_gtk_invisible_new (value unit)
+{
+  return Val_GtkWidget_sink (gtk_invisible_new ());
+}
========================================================================
--- glib/viz_gmisc.ml	
+++ glib/viz_gmisc.ml	c5db1d58e138a0daf67bfb1fdeeca789fcac0c28
@@ -0,0 +1,4 @@
+(* not present in lablgtk 2.4.0 *)
+external get_home_dir : unit -> string = "_ml_g_get_home_dir"
+
+external invisible_new : unit -> [Gtk.widget|`invisible] Gtk.obj = "_ml_gtk_invisible_new"
========================================================================
--- query.ml	97fa8ac5a8cb5475ab17904e9721d53b9dd5f680
+++ query.ml	256e656a8beb50a97b7a1b7216c8d07693d9e554
@@ -13,22 +13,25 @@
 let do_query ~cert_name ~cert_value v =
   match v.View.db, v.View.agraph with
   | Some db, Some g when cert_name <> "" && cert_value <> "" ->
-      let ids = 
-	Database.query_certs 
-	  db (Agraph.get_query g)
-	  cert_name cert_value in
+      View.nice_fetch
+	(fun db ->
+	  let ids = 
+	    Database.query_certs 
+	      db (Agraph.get_query g)
+	      cert_name cert_value in
 
-      let fetch_first_cert id c =
-	match Database.fetch_cert_value db id c with
-	| h :: _ -> h
-	| [] -> "" in
+	  let fetch_first_cert id c =
+	    match Database.fetch_cert_value db id c with
+	    | h :: _ -> h
+	    | [] -> "" in
 
-      List.map
-	(fun id ->
-	  let date = fetch_first_cert id "date" in
-	  let author = fetch_first_cert id "author" in
-	  id, date, author)
-	ids
+	  List.map
+	    (fun id ->
+	      let date = fetch_first_cert id "date" in
+	      let author = fetch_first_cert id "author" in
+	      id, date, author)
+	    ids)
+	db
 
   | _ ->
       []
========================================================================
--- view.ml	ef71335aa33860ed09179219898da53d7256f4d4
+++ view.ml	93359e592e49c18a122c0fe1d2ce4ad103481fd9
@@ -21,9 +21,22 @@
 let error_notice_f ~parent fmt =
   Printf.kprintf (error_notice ~parent) fmt
 
+let with_grab f = 
+  let w = Viz_gmisc.invisible_new () in
+  GtkMain.Grab.add w ;
+  try let r = f () in GtkMain.Grab.remove w ; r
+  with exn -> GtkMain.Grab.remove w ; raise exn
 
+let nice_fetch f db =
+  with_grab (fun () ->
+    Database.with_progress
+      (fun () -> 
+	while Glib.Main.iteration false do () done)
+      f
+      db)
 
 
+
 type info_display = {
     revision_label  : GMisc.label ;
     empty_label     : string ;
@@ -368,7 +381,8 @@
 	sub = checkb ; branches = [||] ; 
 	select_signal = Signal.make () } in
     begin
-      let callback () = select_branch c in
+      let callback () = 
+	ignore (Glib.Idle.add (fun () -> select_branch c ; false)) in
       let (combo, _) = combo in
       c.combo_signal <- Some (combo#connect#changed ~callback) ;
       ignore (checkb#connect#toggled ~callback)
@@ -712,7 +726,7 @@
     let font_size = get_font_size font in
     let font_desc = get_pango_font_descr v in
 
-    let match_style = Viz_style.match_style v.prefs graph in
+    let match_style = Viz_style.match_style v.prefs graph db in
     
     let node_item id node () =
       let g = GnoCanvas.group ~x:node.n_x ~y:node.n_y nodes_group in
@@ -885,13 +899,14 @@
 
   let locate_with_db v f =
     let g = some v.agraph in
+    let db = some v.db in
     List.map
       (fun (id, _) -> id, get_cnode v id)
       (List.sort
 	 (fun (_,a) (_,b) -> compare a b)
 	 (List.filter
 	    (fun (id, _) -> Agraph.mem g id)
-	    (f (Agraph.get_db g))))
+	    (f db)))
 
   let locate_date v date_prefix =
     locate_with_db v
@@ -949,7 +964,12 @@
       may Agraph.abort_layout v.agraph ;
       Canvas.clear v ;
       v.agraph <- Some (
-	Agraph.make db query (layout_params v) (function
+	Agraph.make 
+	  (nice_fetch 
+	     (fun db -> Database.fetch_ancestry_graph db query)
+	     db)
+	  query
+	  (layout_params v) (function
 	  | `LAYOUT_ERROR msg ->
 	      error_notice ~parent:v.canvas.w msg
 	  | `LAYOUT_DONE ->
@@ -1041,7 +1061,8 @@
   try
     let db = Database.open_db fname in
     v.db <- Some db ;
-    Branch_selector.populate v (Database.fetch_branches db) ;
+    Branch_selector.populate v 
+      (nice_fetch Database.fetch_branches db) ;
     may (Branch_selector.set_branch v) branch ;
     Signal.emit v.event_signal `OPEN_DB
   with Viz_types.Error msg ->
========================================================================
--- view.mli	2e44176961f054a130b1abd7cb28dface0b26ac4
+++ view.mli	ea0d6527fe87a36240b73f80ceb15dd2f256baee
@@ -1,7 +1,9 @@
 val error_notice : parent:#GObj.widget -> string -> unit
 
 val wrap_in_scroll_window : (GObj.widget -> unit) -> GObj.widget -> unit
 
+val nice_fetch : (Database.t -> 'a) -> Database.t -> 'a
+
 type info_display
 type branch_selector
 type event =
========================================================================
--- viz_misc.ml	3239ead06c767d585cb8579ffa802b6267d3f0eb
+++ viz_misc.ml	e4da8d228a71dca79261bf14be9db15399c6de74
@@ -130,7 +130,7 @@
   end ;
   Buffer.contents buff
 
-let get_home_dir = Gspawn.get_home_dir
+let get_home_dir = Viz_gmisc.get_home_dir
 
 let debug_kwd =
   try 
========================================================================
--- viz_style.ml	6cf212b3f5a006c0e1272df3e0d8548e8bc2945d
+++ viz_style.ml	72c4f46ab2286a2da56f910a2db3c408bf8b4b47
@@ -90,8 +90,7 @@
   | `FONT of string
   | `WEIGHT of int]
 
-let match_style { autocolor = autocolor_pref ; style = style } g =
-  let db    = Agraph.get_db g in
+let match_style { autocolor = autocolor_pref ; style = style } g db =
   let autocolor = Autocolor.autocolor autocolor_pref db in
 
   fun id (default_rect_props, default_txt_props) ->
========================================================================
--- viz_style.mli	1141a3e066bd93d8d5d275b8e35ae162aeec955f
+++ viz_style.mli	1bbbbfca7c1ba5360b0612375445623a7549a033
@@ -27,6 +27,7 @@
 val match_style : 
   prefs -> 
   Agraph.t -> 
+  Database.t ->
   string -> 
   shape_props list * text_props list -> 
   [> shape_props | `FILL_COLOR_RGBA of int32] list * [> text_props] list