# 
# 
# patch "app.ml"
#  from [1684eb27e8ef243f7c213acdb1eda2765549f067]
#    to [44ab6019fec74978ba42fcdc4416d70b10eeb8d9]
# 
# patch "database.ml"
#  from [54bf28e264209b1f14b9c4c0044963f3555e7a03]
#    to [8c08bb817a74bf03d5b94175ea4db8fbe9a9d9ba]
# 
# patch "database.mli"
#  from [e94e03fdf58c03a0229b72f1ff1bfcf7533afb65]
#    to [adea7c4edcb55913177145025fc45d57bad3c1b0]
# 
# patch "ui.ml"
#  from [149a93e54cb48f3458c6c937dc22d024240286e8]
#    to [5d2ebd801054b92512d011851d90237dcbc33ab5]
# 
# patch "ui.mli"
#  from [616701fcf70199bc40d48051187777b1f55e632d]
#    to [d25fe1553276726e4cd998b1010d280139e5534b]
# 
============================================================
--- app.ml	1684eb27e8ef243f7c213acdb1eda2765549f067
+++ app.ml	44ab6019fec74978ba42fcdc4416d70b10eeb8d9
@@ -89,9 +89,12 @@
       prefs <- new_prefs ;
       Ui.Prefs.update_prefs self old_prefs new_prefs
 
+    method private locked_db _ =
+      Ui.LockedDB.show self
+
     method open_db ?id ?branch fname = 
       self#close_db () ;
-      let m_db = Database.open_db fname in
+      let m_db = Database.open_db ~busy_handler:self#locked_db fname in
       db <- Some m_db ;
       View.open_db view self ;
       Ui.open_db manager self ;
============================================================
--- database.ml	54bf28e264209b1f14b9c4c0044963f3555e7a03
+++ database.ml	8c08bb817a74bf03d5b94175ea4db8fbe9a9d9ba
@@ -17,12 +17,15 @@
 
 
 
-let setup_sqlite db = 
+let setup_sqlite ?busy_handler db = 
   if Viz_misc.debug "sql"
   then
     Sqlite3.trace_set db
       (fun s -> prerr_string "### sql: " ; prerr_endline s) ;
-  Sqlite3.exec db "PRAGMA temp_store = MEMORY"
+  Sqlite3.exec db "PRAGMA temp_store = MEMORY" ;
+  may
+    (Sqlite3.busy_set db)
+    busy_handler
 
 let schema_id db =
   let lines =
@@ -443,7 +446,7 @@
 
 
 
-let open_db fname =
+let open_db ?busy_handler fname =
   if not (Sys.file_exists fname)
   then Viz_types.errorf "No such file: %s" fname ;
   let db = 
@@ -452,7 +455,7 @@
       Viz_types.errorf "Could not open database %s:\n%s" fname msg in
   let pubkeys = Hashtbl.create 17 in
   try
-    setup_sqlite db ;
+    setup_sqlite ?busy_handler db ;
     let stmts = [| prepare_fetch_one_cert_signer db ; 
                    prepare_fetch_one_cert_value db |] in
     let rostered = has_rosters db in
============================================================
--- database.mli	e94e03fdf58c03a0229b72f1ff1bfcf7533afb65
+++ database.mli	adea7c4edcb55913177145025fc45d57bad3c1b0
@@ -1,10 +1,10 @@
 open Viz_types
 
 type t
 
 (** Any of these function can raise Viz_types.Error *)
 
-val open_db    : string -> t
+val open_db    : ?busy_handler:(int -> [`FAIL | `RETRY]) -> string -> t
 val close_db   : t -> unit
 
 val with_progress : (unit -> unit) -> (t -> 'a) -> t -> 'a
============================================================
--- ui.ml	149a93e54cb48f3458c6c937dc22d024240286e8
+++ ui.ml	5d2ebd801054b92512d011851d90237dcbc33ab5
@@ -288,8 +288,57 @@
     resp
 end
 
+module LockedDB = struct
 
+  let message ctrl =
+    let db_fname = 
+      Database.get_filename
+	(some ctrl#get_db) in
+    Printf.sprintf
+      "<big>Database <tt>%s</tt> is currently in use by another process.</big>"
+      (Glib.Markup.escape_text db_fname)
 
+  let show ctrl =
+    (* for some reason GtkMessageDialog looks ugly here, so I rool my own GtkDialog *)
+    let dialog = 
+      GWindow.dialog 
+	~no_separator:true
+	~parent:ctrl#get_toplevel
+	~destroy_with_parent:true
+	~title:"Monotone-viz: database locked"
+	~modal:true () in
+    begin
+      let vbox = dialog#vbox in
+      vbox#set_border_width 12 ;
+      let hbox = GPack.hbox ~spacing:12 ~border_width:12 ~packing:vbox#pack () in
+      ignore (GMisc.image
+		~stock:`DIALOG_INFO
+		~icon_size:`DIALOG
+		~yalign:0.
+		~packing:hbox#pack
+		()) ;
+      ignore (GMisc.label 
+		~markup:(message ctrl) 
+		~line_wrap:true ~selectable:true
+		~xalign:0. ~yalign:0.
+		~packing:(hbox#pack ~expand:true)
+		())
+    end ;
+    begin
+      dialog#add_button_stock `CANCEL `CANCEL ;
+      dialog#add_button "Retry" `RETRY
+    end ;
+    let resp =
+      match dialog#run () with
+      | `CANCEL | `DELETE_EVENT -> `FAIL
+      | `RETRY -> `RETRY in
+    dialog#destroy () ;
+    resp
+
+end
+
+  
+
 
 let ui_info = "\
   <ui>\
============================================================
--- ui.mli	616701fcf70199bc40d48051187777b1f55e632d
+++ ui.mli	d25fe1553276726e4cd998b1010d280139e5534b
@@ -41,6 +41,9 @@
   val show : t -> string option
 end
 
+module LockedDB : sig
+  val show : #App.t -> [`FAIL | `RETRY]
+end
 
 type manager
 val make  : unit -> manager * GObj.widget * GObj.widget