X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fapplications%2Funison%2Fuigtk.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fapplications%2Funison%2Fuigtk.ml;h=0000000000000000000000000000000000000000;hb=c7514aaa249a96c5fdd39b1123fbdb38d92f20b6;hp=6efacd63095afbfc2527220cecc42ce95a39972c;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff;p=helm.git

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/unison/uigtk.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/unison/uigtk.ml
deleted file mode 100644
index 6efacd630..000000000
--- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/unison/uigtk.ml
+++ /dev/null
@@ -1,1434 +0,0 @@
-(* $Id$ *)
-
-open Util
-open Os
-open Common
-open Uicommon
-open Printf
-open Trace
-
-(**********************************************************************)
-(*                           GRAPHICAL INTERFACE                      *)
-(**********************************************************************)
-
-module Private : Uicommon.UI = struct
-
-open GMain
-open GdkKeysyms
-
-let debugprogress = Trace.debug "progress"
-
-(**********************************************************************)
-(* UI preferences                                                     *)
-(**********************************************************************)
-
-let fontMonospaceMedium =
-  if Sys.os_type = "Win32" then
-    lazy (Gdk.Font.load "-*-Courier New-Medium-R-Normal--*-110-*-*-*-*-*-*")
-  else
-    lazy (Gdk.Font.load "-*-Clean-Medium-R-Normal--*-130-*-*-*-*-*-*")
-let fontMonospaceBold =
-  if Sys.os_type = "Win32" then
-    lazy (Gdk.Font.load "-*-Courier New-Bold-R-Normal--*-110-*-*-*-*-*-*")
-  else
-    lazy (Gdk.Font.load "-*-Courier-Bold-R-Normal--*-120-*-*-*-*-*-*")
-
-(**********************************************************************)
-(* UI state variables                                                 *)
-(**********************************************************************)
-
-type stateItem = { ri : reconItem;
-                   mutable bytesTransferred : int;
-                   mutable whatHappened : unit confirmation option }
-let theState = ref [||]
-
-let current = ref None
-
-let currentWindow = ref None
-let grabFocus t =
-  match !currentWindow with
-    Some w -> t#set_transient_for w;
-              w#misc#set_sensitive false
-  | None   -> ()
-let releaseFocus () =
-  begin match !currentWindow with
-    Some w -> w#misc#set_sensitive true
-  | None   -> ()
-  end
-
-(**********************************************************************)
-(*                         Lock management                            *)
-(**********************************************************************)
-
-let busy = ref false
-
-let getLock f =
-  if !busy then
-    Trace.message "Synchronizer is busy, please wait..\n"
-  else begin
-    busy := true; f (); busy := false
-  end
-
-(**********************************************************************)
-(* Some widgets							      *)
-(**********************************************************************)
-
-class scrolled_text ?editable ?word_wrap ?width ?height ?packing ?show
-    () =
-  let sw =
-    GBin.scrolled_window ?width ?height ?packing ~show:false
-      ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC ()
-  in
-  let text = GEdit.text ?editable ?word_wrap ~packing:sw#add () in
-  object
-    inherit GObj.widget_full sw#as_widget
-    method text = text
-    method insert ?(font=fontMonospaceMedium) s =
-      text#freeze ();
-      text#delete_text ~start:0 ~stop:text#length;
-      text#insert ~font:(Lazy.force font) s;
-      text#thaw ()
-    method show () = sw#misc#show ()
-    initializer
-      if show <> Some false then sw#misc#show ()
-  end
-
-let gtk_sync () = while Glib.Main.iteration false do () done
-
-(**********************************************************************)
-(*                           YES OR NO FUNCTION                       *)
-(**********************************************************************)
-(* val yesOrNo : string -> string -> (unit -> unit) -> (unit -> unit) *)
-(*                      -> unit                                       *)
-(* Displays a window with two buttons : YES and NO                    *)
-(* yesOrNo title message yesFunction noFunction open the title        *)
-(* window in which is displayed message. yesFunction and noFunctions  *)
-(* are the functions associated two the two buttons                   *)
-(**********************************************************************)
-let yesOrNo ~title ~message ~yes:yesFunction ~no:noFunction =
-  let t = GWindow.dialog ~title ~wm_name:title ~modal:true ~position:`CENTER () in
-  grabFocus t;
-  let theLabel = GMisc.label ~text:message
-      ~packing:(t#vbox#pack ~padding:4) () in
-  let yes = GButton.button ~label:"Yes" ~packing:t#action_area#add ()
-  and no = GButton.button ~label:"No" ~packing:t#action_area#add () in
-  no#grab_default ();
-  ignore
-    (yes#connect#clicked ~callback:(fun () -> t#destroy (); yesFunction ()));
-  ignore
-    (no#connect#clicked  ~callback:(fun () -> t#destroy (); noFunction ()));
-  t#show ();
-  ignore (t#connect#destroy ~callback:Main.quit);
-  Main.main ();
-  releaseFocus ()
-
-(**********************************************************************)
-(*                         SAFE EXIT FUNCTION                         *)
-(**********************************************************************)
-
-(* Avoid recursive invocations of the function below
-   (a window receives delete events even when it is not sensitive) *)
-let inExit = ref false
-
-let safeExit () =
-  if not !inExit then begin
-    inExit := true;
-    if not !busy then exit 0 else
-    yesOrNo ~title:"Premature exit"
-      ~message:"Unison is working, exit anyway ?"
-      ~yes:(fun () -> exit 0) ~no:(fun () -> ());
-    inExit := false
-  end
-
-(**********************************************************************)
-(* okBox: Display a message in a window and wait for the user         *)
-(* to hit the "OK" button.                                            *)
-(**********************************************************************)
-let okBox ~title ~message =
-  let t = GWindow.dialog ~title ~wm_name:title ~modal:true ~position:`CENTER () in
-  grabFocus t;
-  let theLabel = GMisc.label ~text:message
-      ~packing:(t#vbox#pack ~padding:4) () in
-  let ok = GButton.button ~label:"OK" ~packing:t#action_area#add () in
-  ok#grab_default ();
-  ignore (ok#connect#clicked ~callback:(fun () -> t#destroy()));
-  t#show ();
-  (* Do nothing until user destroys window *)
-  ignore (t#connect#destroy ~callback:Main.quit);
-  Main.main ();
-  releaseFocus ()
-
-(**********************************************************************)
-(* warnBox: Display a warning message in a window and wait for the    *)
-(* user to hit "OK" or "Exit".                                        *)
-(**********************************************************************)
-let warnBox ~title ~message =
-  inExit := true;
-  let t = GWindow.dialog ~title ~wm_name:title ~modal:true ~position:`CENTER () in
-  grabFocus t;
-  let theLabel =
-    GMisc.label ~text:message
-      ~packing:(t#vbox#pack ~padding:4) () in
-  let ok = GButton.button ~label:"OK" ~packing:t#action_area#add () in
-  ok#grab_default ();
-  ignore (ok#connect#clicked ~callback:(fun () -> t#destroy()));
-  let exi = GButton.button ~label:"Exit" ~packing:t#action_area#add () in
-  ignore (exi#connect#clicked ~callback:(fun () -> exit 0));
-  t#show ();
-  (* Do nothing until user destroys window *)
-  ignore (t#connect#destroy ~callback:Main.quit);
-  Main.main ();
-  releaseFocus ();
-  inExit := false
-
-(**********************************************************************)
-(* Standard file dialog                                               *)
-(**********************************************************************)
-let file_dialog ~title ~callback ?filename () =
-  let sel = GWindow.file_selection ~title ~modal:true ?filename () in
-  grabFocus sel;
-  ignore (sel#cancel_button#connect#clicked ~callback:sel#destroy);
-  ignore (sel#ok_button#connect#clicked ~callback:
-            (fun () ->
-               let name = sel#get_filename in
-               sel#destroy ();
-               callback name));
-  sel#show ();
-  Main.main ();
-  releaseFocus ()
-
-(**********************************************************************)
-(* The root selection dialog                                          *)
-(**********************************************************************)
-let rootSelect cont =
-  let t = GWindow.dialog ~title:"Root selection" ~wm_name:"Root selection"
-      ~modal:true ~allow_grow:true () in
-  t#misc#grab_focus ();
-  
-  let makeGetRoot title =
-    let fr =
-      GBin.frame ~label:title ~border_width:2 ~packing:(t#vbox#add) () in
-
-    let vb = GPack.vbox ~border_width:4 ~packing:fr#add () in
-  
-    let f = GPack.vbox ~packing:(vb#add) () in
-    let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in
-    ignore (GMisc.label ~text:"Host:" ~packing:f0#pack ());
-    let localB = GButton.radio_button ~packing:f0#pack
-        ~label:"Local" () in
-    let remoteB = GButton.radio_button ~group:localB#group
-        ~packing:f0#pack ~label:"Remote" () in
-    let hostE = GEdit.entry ~packing:f0#add () in
-    let f1 = GPack.hbox ~spacing:4 ~packing:f#add () in
-    ignore (GMisc.label ~text:"File:" ~packing:f1#pack ());
-    let fileE = GEdit.entry ~packing:f1#add () in
-    let browseCommand() =
-      file_dialog ~title:"Select a local file"
-        ~callback:(fun file -> fileE#set_text file) ~filename:fileE#text ()
-    in
-    let b = GButton.button ~label:"Browse"
-        ~packing:f1#pack () in
-    ignore (b#connect#clicked ~callback:browseCommand);
-    let varLocalRemote = ref (`Local : [`Local|`Remote]) in
-    let localState() =
-      varLocalRemote := `Local;
-      hostE#misc#set_sensitive false;
-      b#misc#set_sensitive true
-    in
-    let remoteState() =
-      varLocalRemote := `Remote;
-      hostE#misc#set_sensitive true;
-      b#misc#set_sensitive false
-    in
-    ignore (localB#connect#clicked ~callback:localState);
-    ignore (remoteB#connect#clicked ~callback:remoteState);
-    localState();
-    let getRoot() =
-      let filePart = fileE#text in
-      let remoteHost = hostE#text in
-      (* FIX: should do sanity checking here *)
-      match !varLocalRemote with
-        `Local -> filePart
-      | `Remote -> "//"^remoteHost^"/"^filePart in
-    getRoot
-  in
-  
-  let getRoot1 = makeGetRoot "Root 1" in
-  let getRoot2 = makeGetRoot "Root 2" in
-  
-  let f3 = t#action_area in
-  let okCommand() =
-    let root1 = getRoot1() in
-    let root2 = getRoot2() in
-    Prefs.setPref Uicommon.roots Prefs.TempSetting [root1;root2];
-    t#destroy ();
-    cont ()
-  in
-  let okButton = GButton.button ~label:"OK" ~packing:f3#add () in
-  ignore (okButton#connect#clicked ~callback:okCommand);
-  okButton#grab_default ();
-  let cancelButton = GButton.button ~label:"Cancel" ~packing:f3#add () in
-  ignore (cancelButton#connect#clicked ~callback:safeExit);
-  
-  (* The profile editing dialog has been installed into the Gtk
-     main interaction loop; wait until it completes. *)
-  t#show ();
-  ignore (t#connect#destroy ~callback:Main.quit);
-  Main.main ()
-
-(**********************************************************************)
-(* The root selection dialog                                          *)
-(**********************************************************************)
-let editProfile prof =
-  (* FIX:
-     Scan the profile (if it is defined)
-     Extract the roots
-     Modifications
-     Save with new roots *)
-  let t = GWindow.dialog ~title:"Edit profile" ~wm_name:"Edit profile"
-      ~modal:true ~allow_grow:true () in
-  t#misc#grab_focus ();
-  
-  let vb = GPack.vbox ~border_width:4 ~packing:t#vbox#add () in
-  
-  let makeGetRoot() =
-    let f = GPack.vbox ~packing:(vb#pack ~expand:true ~padding:4) () in
-    let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in
-    ignore (GMisc.label ~text:"Host:" ~packing:f0#pack ());
-    let localB = GButton.radio_button ~packing:f0#pack ~label:"Local" () in
-    let remoteB = GButton.radio_button ~group:localB#group
-        ~packing:f0#pack ~label:"Remote" () in
-    let hostE = GEdit.entry ~packing:f0#add () in
-    let f1 = GPack.hbox ~spacing:4 ~packing:f#add () in
-    ignore (GMisc.label ~text:"File:" ~packing:f1#pack ());
-    let fileE = GEdit.entry ~packing:f1#add () in
-    let browseCommand() =
-      file_dialog ~title:"Select a local file"
-        ~callback:(fun file -> fileE#set_text file) ()
-    in
-    let b = GButton.button ~label:"Browse" ~packing:f1#pack () in
-    ignore (b#connect#clicked ~callback:browseCommand);
-    let varLocalRemote = ref (`Local : [`Local|`Remote]) in
-    let localState() =
-      varLocalRemote := `Local;
-      hostE#set_editable false;
-      b#misc#set_state `NORMAL
-    in
-    let remoteState() =
-      varLocalRemote := `Remote;
-      hostE#set_editable true;
-      b#misc#set_state `INSENSITIVE
-    in
-    ignore (localB#connect#clicked ~callback:localState);
-    ignore (remoteB#connect#clicked ~callback:remoteState);
-    localState();
-    let getRoot() =
-      let filePart = fileE#text in
-      let remoteHost = hostE#text in
-      (* FIX: should do sanity checking here *)
-      match !varLocalRemote with
-        `Local -> filePart
-      | `Remote -> "//"^remoteHost^"/"^filePart in
-    getRoot
-  in
-  
-  
-  ignore (GMisc.label ~text:"Root 1:" ~xalign:0.
-            ~packing:(vb#pack ~expand:true ~padding:4) ());
-  let getRoot1 = makeGetRoot() in
-  
-  ignore (GMisc.label ~text:"Root 2:" ~xalign:0.
-            ~packing:(vb#pack ~expand:true ~padding:4) ());
-  let getRoot2 = makeGetRoot() in
-  
-  let f3 = t#action_area in
-  let okCommand() =
-    let root1 = getRoot1() in
-    let root2 = getRoot2() in
-    Prefs.setPref Uicommon.roots Prefs.PermanentSetting [root1;root2];
-    Globals.savePrefs();
-    t#destroy () in
-  let okButton = GButton.button ~label:"OK" ~packing:f3#add () in
-  ignore (okButton#connect#clicked ~callback:okCommand);
-  let cancelCommand() =
-    t#destroy ()
-  in
-  let cancelButton = GButton.button ~label:"Cancel" ~packing:f3#add () in
-  ignore (cancelButton#connect#clicked ~callback:cancelCommand);
-  
-  (* The profile editing dialog has been installed into the Gtk
-     main interaction loop; wait until it completes. *)
-  t#show ();
-  ignore (t#connect#destroy ~callback:Main.quit);
-  Main.main ()
-
-(**********************************************************************)
-(*                        Documentation window                        *)
-(**********************************************************************)
-let documentation sect =
-  let title = "Documentation" in
-  let t = GWindow.dialog ~title ~wm_name:title () in
-  let t_dismiss =
-    GButton.button ~label:"dismiss" ~packing:t#action_area#add () in
-  t_dismiss#grab_default ();
-  let dismiss () = t#destroy () in
-  ignore (t_dismiss#connect#clicked ~callback:dismiss);
-  ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true));
-
-  let (name, docstr) = List.assoc sect Strings.docs in
-  let hb = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:2) () in
-  let optionmenu =
-    GMenu.option_menu ~packing:(hb#pack ~fill:false) () in
-
-  let charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in
-  let charH = 16 in
-  let t_text =
-    new scrolled_text ~editable:false
-      ~width:(charW * 80) ~height:(charH * 20) ~packing:t#vbox#add ()
-  in
-  t_text#insert docstr;
-
-  let sect_idx = ref 0 in
-  let idx = ref 0 in
-  let menu = GMenu.menu () in
-  let addDocSection (shortname, (name, docstr)) =
-    if shortname <> "" && name <> "" then begin
-      if shortname = sect then sect_idx := !idx;
-      incr idx;
-      let item = GMenu.menu_item ~label:name ~packing:menu#append () in
-      ignore
-        (item#connect#activate ~callback:(fun () -> t_text#insert docstr))
-    end
-  in
-  Safelist.iter addDocSection Strings.docs;
-  optionmenu#set_menu menu;
-  optionmenu#set_history !sect_idx;
-
-  t#show ()
-
-(**********************************************************************)
-(* The profile selection dialog                                       *)
-(**********************************************************************)
-let profileSelect cont =
-(* FIX:
-  - Choix du profil par defaut
-*)
-  let profilesAndRoots =
-    ref
-      (Safelist.map
-         (fun f ->
-            let filename = fspath2string (Os.fileInUnisonDir f) in
-            let roots =
-              Safelist.map snd
-                (Safelist.filter (fun (n, v) -> n = "root")
-                   (Prefs.scanPreferencesFile filename))
-            in
-            (Filename.chop_suffix f ".prf", roots))
-         (Files.ls (fspath2string Os.synchronizerFspath) "*.prf")) in
-
-  (* The selected profile *)
-  let selection = ref None in
-  
-  (* Build the dialog *)
-  let t = GWindow.dialog ~title:"Profiles" ~wm_name:"Profiles" () in
-  
-  let okCommand() =
-    match !selection with
-      Some profile ->
-        Globals.prefsFileName := profile ^ ".prf";
-        currentWindow := None;
-        t#destroy ();
-        cont ()
-    | _ ->
-        ()
-  in
-  let okButton = GButton.button ~label:"OK" ~packing:t#action_area#add () in
-  ignore (okButton#connect#clicked ~callback:okCommand);
-  okButton#misc#set_sensitive false;
-  okButton#grab_default ();
-  let cancelCommand() = t#destroy (); Main.quit () in
-  let cancelButton = GButton.button ~label:"Cancel"
-      ~packing:t#action_area#add () in
-  ignore (cancelButton#connect#clicked ~callback:cancelCommand);
-  cancelButton#misc#set_can_default true;
-  
-  let vb = t#vbox in
-  
-  ignore (GMisc.label
-            ~text:"Select an existing profile or create a new one"
-            ~xpad:2 ~ypad:2 ~packing:vb#pack ());
-  
-  let sw =
-    GBin.scrolled_window ~packing:vb#add ~height:100
-      ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
-  in
-  let lst = GList.clist ~selection_mode:`BROWSE ~packing:(sw#add) () in
-  let fillLst default =
-    lst#freeze ();
-    lst#clear ();
-    let selRow = ref 0 in
-    let i = ref 0 in (* FIX: Work around a lablgtk bug *)
-    Safelist.iter
-      (fun (profile, roots) ->
-         ignore (lst#append [profile]);
-         if profile = default then selRow := !i;
-         lst#set_row_data !i (profile, roots);
-         incr i)
-      (List.sort (fun (p, _) (p', _) -> compare p p') !profilesAndRoots);
-    let r = lst#rows in
-    let p = if r < 2 then 0. else float !selRow /. float (r - 1) in
-    lst#scroll_vertical `JUMP p;
-    lst#thaw ()
-  in
-  let tbl =
-    GPack.table ~rows:2 ~columns:2 ~packing:vb#pack ()
-  in
-  tbl#misc#set_sensitive false;
-  ignore (GMisc.label ~text:"Root 1:" ~xpad:2
-            ~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
-  ignore (GMisc.label ~text:"Root 2:" ~xpad:2
-            ~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
-  let root1 =
-    GEdit.entry ~packing:(tbl#attach ~left:1 ~top:0) ~editable:false () in
-  let root2 =
-    GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1) ~editable:false () in
-  root1#misc#set_can_focus false;
-  root2#misc#set_can_focus false;
-  let hb =
-    GPack.hbox ~border_width:2 ~spacing:2 ~packing:(vb#pack ~expand:false) ()
-  in
-  let nw =
-    GButton.button ~label:"Create new profile"
-      ~packing:hb#pack () in
-  ignore (nw#connect#clicked ~callback:(fun () ->
-    let t =
-      GWindow.dialog ~title:"New profile" ~wm_name:"New profile" ~modal:true ()
-    in
-    let vb = GPack.vbox ~border_width:4 ~packing:t#vbox#add () in
-    let f = GPack.vbox ~packing:(vb#pack ~expand:true ~padding:4) () in
-    let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in
-    ignore (GMisc.label ~text:"Profile name:"
-              ~packing:f0#pack ());
-    let prof = GEdit.entry ~packing:f0#add () in
-    prof#misc#grab_focus ();
-
-    let exit () = t#destroy (); Main.quit () in
-    ignore (t#event#connect#delete ~callback:(fun _ -> exit (); true));
-
-    let f3 = t#action_area in
-    let okCommand () =
-      let profile = prof#text in
-      if profile <> "" then
-        let file = profile ^ ".prf" in
-        let fspath = Os.fileInUnisonDir file in
-        let filename = fspath2string fspath in
-        if Sys.file_exists filename then
-          okBox (myName ^ " error")
-            ("Profile \""
-             ^ profile
-             ^ "\" already exists!\nPlease select another name.")
-        else
-          (* Make an empty file *)
-          let ch =
-            open_out_gen
-              [Open_wronly; Open_creat; Open_trunc] 0o600 filename in
-          close_out ch;
-          profilesAndRoots := (profile, [])::!profilesAndRoots;
-          fillLst profile;
-          exit ()
-    in
-    let okButton = GButton.button ~label:"OK" ~packing:f3#add () in
-    ignore (okButton#connect#clicked ~callback:okCommand);
-    okButton#grab_default ();
-    let cancelButton = GButton.button ~label:"Cancel" ~packing:f3#add () in
-    ignore (cancelButton#connect#clicked ~callback:exit);
-
-    t#show ();
-    grabFocus t;
-    Main.main ();
-    releaseFocus ()));
-  let ed =
-    GButton.button ~label:"Edit" (*~packing:(hb#pack ~expand:false)*) () in
-  let sd =
-    GButton.button ~label:"Set default" (*~packing:(hb#pack ~expand:false)*) ()
-  in
-  let hlp =
-    GButton.button ~label:"Help"
-      ~packing:(hb#pack ~expand:false ~from:`END) () in
-  ignore (hlp#connect#clicked ~callback:(fun () -> documentation "tutorial"));
-
-  ignore (lst#connect#unselect_row ~callback:(fun _ _ _ ->
-    root1#set_text ""; root2#set_text "";
-    selection := None;
-    tbl#misc#set_sensitive false;
-    okButton#misc#set_sensitive false;
-    ed#misc#set_sensitive false;
-    sd#misc#set_sensitive false));
-  ignore (lst#connect#select_row ~callback:(fun i _ _ ->
-    (* Inserting the first row trigger the signal, even before the row
-       data is set. So, we need to catch the corresponding exception *)
-    try
-      let (profile, roots) = lst#get_row_data i in
-      selection := Some profile;
-      begin match roots with
-        [r1; r2] -> root1#set_text r1; root2#set_text r2;
-                    tbl#misc#set_sensitive true
-      | _        -> root1#set_text ""; root2#set_text "";
-                    tbl#misc#set_sensitive false
-      end;
-      okButton#misc#set_sensitive true;
-      ed#misc#set_sensitive true;
-      sd#misc#set_sensitive true
-    with Gpointer.Null -> ()));
-  ignore (lst#event#connect#button_press ~callback:(fun ev ->
-    match GdkEvent.get_type ev with
-      `TWO_BUTTON_PRESS ->
-        okCommand ();
-        true
-    | _ ->
-        false));
-  fillLst "default";
-  lst#misc#grab_focus ();
-  currentWindow := Some (t :> GWindow.window);
-  ignore (t#event#connect#delete ~callback:(fun _ -> Main.quit (); true));
-  t#show ()
-
-(**********************************************************************)
-(* Function to display a message in a new window                      *)
-(**********************************************************************)
-let messageBox ~title ?(label = "Dismiss") ?(action = fun t -> t#destroy)
-    ?(modal = false) message =
-  let t = GWindow.dialog ~title ~wm_name:title ~modal ~position:`CENTER () in
-  let t_dismiss = GButton.button ~label ~packing:t#action_area#add () in
-  t_dismiss#grab_default ();
-  ignore (t_dismiss#connect#clicked ~callback:(action t));
-  let charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in
-  let charH = 16 in
-  let t_text =
-    new scrolled_text ~editable:false
-      ~width:(charW * 80) ~height:(charH * 20) ~packing:t#vbox#add ()
-  in
-  t_text#insert message;
-  ignore (t#event#connect#delete ~callback:(fun _ -> action t (); true));
-  t#show ();
-  if modal then begin
-    grabFocus t;
-    Main.main ();
-    releaseFocus ()
-  end
-
-(**********************************************************************)
-(* Fatal error handling                                               *)
-(**********************************************************************)
-let fatalError =
-  messageBox ~title:"Fatal Error" ~label:"Exit" ~modal:true
-    ~action:(fun t () -> exit 1)
-
-
-(**********************************************************************)
-(*                      Toplevel window                               *)
-(**********************************************************************)
-let createToplevelWindow () =
-  let toplevelWindow = GWindow.window ~wm_name:myName () in
-  let toplevelVBox = GPack.vbox ~packing:toplevelWindow#add () in
-
-  (**********************************************************************)
-  (* Groups of same sensitivity                                         *)
-  (**********************************************************************)
-  let grAction = ref [] in
-  let grDiff = ref [] in
-  let grProceed = ref [] in
-  let grRestart = ref [] in
-  let grAdd gr w = gr := w#misc::!gr in
-  let grSet gr st = List.iter (fun x -> x#set_sensitive st) !gr in
-
-  (**********************************************************************)
-  (* Create the menu bar                                                *)
-  (**********************************************************************)
-  let menuBar =
-    GMenu.menu_bar ~border_width:2 ~packing:toplevelVBox#pack ()
-  in
-  let menus = new GMenu.factory ~accel_modi:[] menuBar in
-  let accel_group = menus#accel_group in
-  toplevelWindow#add_accel_group accel_group;
-  let add_submenu ?(modi=[]) ~label () =
-    new GMenu.factory ~accel_group ~accel_modi:modi (menus#add_submenu label)
-  in
-  
-  (**********************************************************************)
-  (* Create the menus                                                   *)
-  (**********************************************************************)
-  let fileMenu = add_submenu ~label:"Synchronization" ()
-  and actionsMenu = add_submenu ~label:"Actions" ()
-  and ignoreMenu = add_submenu ~modi:[`SHIFT] ~label:"Ignore" ()
-  and helpMenu = add_submenu ~label:"Help" () in
-
-  (**********************************************************************)
-  (* Create the main window                                             *)
-  (**********************************************************************)
-  let mainWindow =
-    let sw =
-      GBin.scrolled_window ~packing:(toplevelVBox#add)
-        ~height:(Prefs.readPref mainWindowHeight * 12)
-        ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
-    in
-    GList.clist
-      ~columns:5 ~titles_show:true ~selection_mode:`BROWSE ~packing:sw#add ()
-  in
-  mainWindow#misc#grab_focus ();
-  (* FIX: roots2string should return a pair *)
-  let s = roots2string () in
-  Array.iteri
-    (fun i data ->
-       mainWindow#set_column
-         ~title_active:false ~auto_resize:true ~title:data i)
-    [| " " ^ String.sub s ~pos:0 ~len:12 ^ " "; "  Action  ";
-       " " ^ String.sub s ~pos:15 ~len:12 ^ " "; "  Status  "; " Path" |];
-  let status_width =
-    let font = mainWindow#misc#style#font in
-    4 + max (Gdk.Font.string_width font "working")
-            (Gdk.Font.string_width font "skipped")
-  in
-  mainWindow#set_column ~justification:`CENTER 1;
-  mainWindow#set_column
-    ~justification:`CENTER ~auto_resize:false ~width:status_width 3;
-
-  (**********************************************************************)
-  (* Create the details window                                          *)
-  (**********************************************************************)
-
-  let charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in
-  let charH = if Sys.os_type = "Win32" then 20 else 16 in
-
-  let detailsWindow =
-    let sw =
-      GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:false)
-        ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
-    in
-    GEdit.text ~editable:false ~height:(3 * charH) ~width: (96 * charW)
-      ~line_wrap:false ~packing:sw#add () in
-  detailsWindow#misc#set_can_focus false;
-  let style = detailsWindow#misc#style#copy in
-  style#set_font (Lazy.force fontMonospaceMedium);
-  detailsWindow#misc#set_style style;
-  let updateButtons () =
-    match !current with
-      None ->
-        grSet grAction false;
-        grSet grDiff false
-    | Some row ->
-        let (activate1, activate2) =
-          match !theState.(row).whatHappened, !theState.(row).ri.replicas with
-            Some _, _                                    -> (false, false)
-          | None,   Different((FILE,_, _),(FILE,_, _),_) -> (true, true)
-          | None,   _                                    -> (true, false)
-        in
-        grSet grAction activate1;
-        grSet grDiff activate2
-  in
-
-  let makeRowVisible row =
-    if mainWindow#row_is_visible row <> `FULL then begin
-      let adj = mainWindow#vadjustment in
-      let current = adj#value
-      and upper = adj#upper and lower = adj#lower in
-      let v =
-        float row /. float (mainWindow#rows + 1) *. (upper-.lower) +. lower
-      in
-      adj#set_value (min v (upper -. adj#page_size))
-    end
-  in
-
-  let updateDetails () =
-    detailsWindow#freeze ();
-    detailsWindow#delete_text ~start:0 ~stop:detailsWindow#length;
-    begin match !current with
-      None ->
-        ()
-    | Some row ->
-        makeRowVisible row;
-        let details =
-          match !theState.(row).whatHappened with
-            None -> details2string !theState.(row).ri "  "
-          | Some(Succeeded(_)) -> details2string !theState.(row).ri "  "
-          | Some(Failed(s)) -> s in
-        detailsWindow#insert (path2string !theState.(row).ri.path);
-        detailsWindow#insert "\n";
-        detailsWindow#insert details
-    end;
-    (* Display text *)
-    detailsWindow#thaw ();
-    updateButtons ()
-  in
-
-  (**********************************************************************)
-  (*                       CREATE THE STATUS WINDOW                     *)
-  (**********************************************************************)
-
-  let statusWindow =
-    GMisc.statusbar ~packing:toplevelVBox#pack () in
-  let statusContext = statusWindow#new_context ~name:"status" in
-  ignore (statusContext#push "");
-
-  let displayStatus s1 s2 =
-    Threads.do_on_main_thread (fun () ->
-      (* Concatenate the new message *)
-      let m =
-        s1 ^ (String.make (max 2 (30 - String.length s1)) ' ') ^ s2 in
-      statusContext#pop ();
-      ignore (statusContext#push m);
-      (* Force message to be displayed immediately *)
-      gtk_sync ())
-  in
-
-  (* Tell the Trace module about the status printer *)
-  Trace.statusPrinter := Some displayStatus;
-
-  (**********************************************************************)
-  (*            FUNCTIONS USED TO PRINT IN THE MAIN WINDOW              *)
-  (**********************************************************************)
-
-  let select i =
-    let r = mainWindow#rows in
-    let p = if r < 2 then 0. else (float i +. 0.5) /. float (r - 1) in
-    mainWindow#scroll_vertical `JUMP (min p 1.)
-  in
-
-  ignore (mainWindow#connect#unselect_row ~callback:
-      (fun ~row ~column ~event -> current := None; updateDetails ()));
-  ignore (mainWindow#connect#select_row ~callback:
-      (fun ~row ~column ~event -> current := Some row; updateDetails ()));
-
-  let nextInteresting () =
-    let l = Array.length !theState in
-    let start = match !current with Some i -> i + 1 | None -> 0 in
-    let rec loop i =
-      if i < l then
-        match !theState.(i).ri.replicas with
-          Different (_, _, dir)
-              when not (Prefs.readPref auto) || !dir = Conflict ->
-            select i
-        | _ ->
-            loop (i + 1)
-    in
-    loop start
-  in
-  let selectSomethingIfPossible () =
-    if !current=None then nextInteresting ()
-  in
-
-  let columnsOf i =
-    let oldPath = if i = 0 then emptypath else !theState.(i-1).ri.path in
-    let status =
-      match !theState.(i).whatHappened with
-        None -> "      "
-      | Some conf ->
-          match !theState.(i).ri.replicas with
-            Different(_,_,{contents=Conflict}) | Problem _ ->
-              "      "
-          | _ ->
-              match conf with
-                Succeeded _ -> "done  "
-              | Failed _    -> "failed"
-    in
-    let s = reconItem2string oldPath !theState.(i).ri status in
-    (* FIX: This is ugly *)
-    (String.sub s ~pos:0 ~len:8,
-     String.sub s ~pos:9 ~len:5,
-     String.sub s ~pos:15 ~len:8,
-     String.sub s ~pos:25 ~len:6,
-     String.sub s ~pos:32 ~len:(String.length s - 32))
-  in
-
-  let rightArrow =
-    GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:Pixmaps.copyAB () in
-  let leftArrow =
-    GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:Pixmaps.copyBA () in
-  let rightArrowBlack =
-    GDraw.pixmap_from_xpm_d
-      ~window:toplevelWindow ~data:Pixmaps.copyABblack () in
-  let leftArrowBlack =
-    GDraw.pixmap_from_xpm_d
-      ~window:toplevelWindow ~data:Pixmaps.copyBAblack () in
-  let ignoreAct =
-    GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:Pixmaps.ignore () in
-  let doneIcon = 
-    GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:Pixmaps.success () in
-  let failedIcon = 
-    GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:Pixmaps.failure () in
-
-  let displayArrow i action =
-    match action with
-      "<-?->" -> mainWindow#set_cell ~pixmap:ignoreAct i 1
-    | "---->" -> mainWindow#set_cell ~pixmap:rightArrow i 1
-    | "<----" -> mainWindow#set_cell ~pixmap:leftArrow i 1
-    | "error" -> mainWindow#set_cell ~pixmap:failedIcon i 1
-    |    _    -> assert false
-  in
-
-  let displayStatusIcon i status =
-    match status with
-    | "failed" -> mainWindow#set_cell ~pixmap:failedIcon i 3
-    | "done  " -> mainWindow#set_cell ~pixmap:doneIcon i 3
-    | _        -> mainWindow#set_cell ~text:status i 3
-  in
-
-  let displayMain() =
-    mainWindow#freeze ();
-    mainWindow#clear ();
-    for i = 0 to Array.length !theState - 1 do
-      let (r1, action, r2, status, path) = columnsOf i in
-      ignore (mainWindow#append [ r1; ""; r2; status; path ]);
-      displayArrow i action
-    done;
-    selectSomethingIfPossible ();
-    begin match !current with Some idx -> select idx | None -> () end;
-    mainWindow#thaw ();
-    updateDetails ()
-  in
-
-  let redisplay i =
-    let (r1, action, r2, status, path) = columnsOf i in
-    mainWindow#freeze ();
-    mainWindow#set_cell ~text:r1     i 0;
-    displayArrow i action;
-    mainWindow#set_cell ~text:r2     i 2;
-    displayStatusIcon i status;
-    mainWindow#set_cell ~text:path   i 4;
-    if status = " failed " then mainWindow#set_row ~foreground:(`NAME"red") i;
-    mainWindow#thaw ();
-    if !current = Some i then updateDetails ();
-    updateButtons ()
-  in
-
-  let showProgress i bytes =
-    !theState.(i).bytesTransferred <- !theState.(i).bytesTransferred + bytes;
-    let b = !theState.(i).bytesTransferred in
-    let len = Common.riLength !theState.(i).ri in
-    let newstatus =
-      if b=0 || len = 0 then "working "
-      else if len = 0 then sprintf "%8d" b 
-      else
-        let percentage = (int_of_float ((float b) *. 100.0 /. (float len))) in
-        if percentage > 100 then
-          debugprogress (fun() -> errmsg "Progress amount miscalculated for %s\n"
-                                    (path2string (!theState.(i).ri.path)));
-        sprintf "  %3d%%  " (max 100 percentage) in
-    Threads.do_on_main_thread (fun () ->
-      mainWindow#set_cell ~text:newstatus i 3;
-      gtk_sync ())
-  in
-
-  (* Install showProgress so that we get called back by low-level
-     file transfer stuff *)
-  Util.progressPrinter := Some(showProgress);
-
-  (* Apply new ignore patterns to the current state, expecting that the
-     number of reconitems will grow smaller. Adjust the display, being
-     careful to keep the cursor as near as possible to its position
-     before the new ignore patterns take effect. *)
-  let ignoreAndRedisplay () =
-    let lst = Array.to_list !theState in
-    (* FIX: we should actually test whether any prefix is now ignored *)
-    let keep sI = not (Pred.test Globals.ignore (path2string sI.ri.path)) in
-    begin match !current with
-      None ->
-        theState := Array.of_list (Safelist.filter keep lst)
-    | Some index ->
-        let i = ref index in
-        let l = ref [] in
-        Array.iteri
-          (fun j sI -> if keep sI then l := sI::!l
-                       else if j < !i then decr i)
-          !theState;
-        current := if !l = [] then None else Some !i;
-        theState := Array.of_list (Safelist.rev !l)
-    end;
-    displayMain();
-  in
-  
-  (**********************************************************************)
-  (*                         FUNCTION DETECT UPDATES                    *)
-  (**********************************************************************)
-
-  let detectUpdatesAndReconcile () =
-    grSet grAction false;
-    grSet grDiff false;
-    grSet grProceed false;
-    grSet grRestart false;
-
-    let (r1,r2) = Globals.getReplicaRoots () in
-    let t = Trace.startTimer "Checking for updates" in
-    let findUpdates () =
-      let updates = Update.findUpdates () in
-      Trace.showTimer t;
-      updates
-    in
-    let reconcile updates =
-      let t = Trace.startTimer "Reconciling" in
-      Recon.reconcileAll updates
-    in
-    let reconItemList = reconcile (findUpdates ()) in
-    Trace.showTimer t;
-    if reconItemList = [] then
-      Trace.status "Everything is up to date"
-    else
-      Trace.status ("Check and/or adjust selected actions; "
-                    ^ "then press Proceed");
-    theState :=
-      Array.of_list
-         (Safelist.map
-            (fun ri -> { ri = ri; bytesTransferred = 0; whatHappened = None })
-            reconItemList);
-    current := None;
-    displayMain();
-    grSet grProceed (Array.length !theState > 0);
-    grSet grRestart true
-  in
-
-  (**********************************************************************)
-  (* The ignore dialog                                                  *)
-  (**********************************************************************)
-
-  let ignoreDialog () =
-    let t = GWindow.dialog ~title: "Ignore" ~wm_name: "Ignore" () in
-    let hbox = GPack.hbox ~packing:t#vbox#add () in
-    let sb = GRange.scrollbar `VERTICAL
-        ~packing:(hbox#pack ~from:`END) () in
-    let regExpWindow =
-      GList.clist ~columns:1 ~titles_show:false ~packing:hbox#add
-        ~vadjustment:sb#adjustment ~width:400 ~height:150 () in
-    
-    (* Local copy of the regular expressions; the global copy will
-       not be changed until the Apply button is pressed *)
-    let theRegexps = Pred.extern Globals.ignore in
-    Safelist.iter (fun r -> ignore (regExpWindow#append [r])) theRegexps;
-    let maybeGettingBigger = ref false in
-    let maybeGettingSmaller = ref false in
-    let selectedRow = ref None in
-    ignore
-      (regExpWindow#connect#select_row ~callback:
-         (fun ~row ~column ~event -> selectedRow := Some row));
-    ignore
-      (regExpWindow#connect#unselect_row ~callback:
-         (fun ~row ~column ~event -> selectedRow := None));
-    
-    (* Configure the add frame *)
-    let hbox = GPack.hbox ~spacing:4 ~packing:t#vbox#pack () in
-    ignore (GMisc.label ~text: "Regular expression:"
-              ~packing:(hbox#pack ~padding:2) ());
-    let entry = GEdit.entry ~packing:hbox#add () in
-    let add () =
-      let theRegExp = entry#text in
-      if theRegExp<>"" then begin
-        entry#set_text "";
-        regExpWindow#unselect_all ();
-        ignore (regExpWindow#append [theRegExp]);
-        maybeGettingSmaller := true
-      end
-    in
-    let addButton = GButton.button ~label:"Add"
-        ~packing:hbox#pack () in
-    ignore (addButton#connect#clicked ~callback:add);
-    ignore (entry#connect#activate ~callback:add);
-    entry#misc#grab_focus ();
-    
-    (* Configure the delete button *)
-    let delete () =
-      match !selectedRow with
-        Some x ->
-          (* After a deletion, updates must be detected again *)
-          maybeGettingBigger := true;
-          (* Delete xth regexp *)
-          regExpWindow#unselect_all ();
-          regExpWindow#remove ~row:x
-      | None ->
-          ()
-    in
-    let deleteButton = GButton.button ~label:"Delete"
-        ~packing:hbox#pack () in
-    ignore (deleteButton#connect#clicked ~callback:delete);
-    
-    ignore
-      (regExpWindow#event#connect#after#key_press ~callback:
-         begin fun ev ->
-           let key = GdkEvent.Key.keyval ev in
-           if key = _Up || key = _Down || key = _Prior || key = _Next ||
-           key = _Page_Up || key = _Page_Down then begin
-             regExpWindow#select (regExpWindow#focus_row) 0;
-             true
-           end else if key = _Delete then begin
-             delete (); true
-           end else
-             false
-         end);
-    
-    (* A function to refresh the state and ignore list *)
-    let refresh () =
-      let theRegexps = ref [] in
-      for i = regExpWindow#rows - 1 downto 0 do
-        theRegexps := regExpWindow#cell_text i 0 :: !theRegexps
-      done;
-      Pred.intern Globals.ignore (!theRegexps);
-      if !maybeGettingBigger || !maybeGettingSmaller then begin
-        Globals.savePrefs();
-        Globals.propagatePrefs()
-      end;
-      if !maybeGettingBigger then detectUpdatesAndReconcile ()
-      else if !maybeGettingSmaller then ignoreAndRedisplay();
-      maybeGettingBigger := false;
-      maybeGettingSmaller := false;
-    in
-    
-    (* Install the main buttons *)
-    let applyButton =
-      GButton.button ~label:"Apply" ~packing:t#action_area#add () in
-    ignore (applyButton#connect#clicked ~callback:refresh);
-    let cancelButton =
-      GButton.button ~label:"Cancel" ~packing:t#action_area#add () in
-    ignore (cancelButton#connect#clicked ~callback:(t#destroy));
-    let okButton =
-      GButton.button ~label:"OK" ~packing:t#action_area#add () in
-    ignore
-      (okButton#connect#clicked
-         ~callback:(fun () -> refresh (); t#destroy ()));
-    ignore (t#connect#destroy ~callback:Main.quit);
-    grabFocus t;
-    t#show ();
-    Main.main ();
-    releaseFocus ()
-  in
-
-  (**********************************************************************)
-  (* Add entries to the Help menu                                       *)
-  (**********************************************************************)
-  let addDocSection (shortname, (name, docstr)) =
-    if shortname <> "" && name <> "" then
-      ignore (helpMenu#add_item
-		~callback:(fun () -> documentation shortname)
-                name)
-  in
-  Safelist.iter addDocSection Strings.docs;
-
-  (**********************************************************************)
-  (* Add entries to the Ignore menu                                     *)
-  (**********************************************************************)
-  let addRegExpByPath pathfunc =
-    match !current with
-      Some i ->
-        addIgnorePattern (pathfunc !theState.(i).ri.path);
-        ignoreAndRedisplay ()
-    | None ->
-        ()
-  in
-  grAdd grAction
-    (ignoreMenu#add_item ~key:_i
-       ~callback:(fun () -> getLock (fun () -> addRegExpByPath ignorePath))
-       "Ignore this file permanently");
-  grAdd grAction
-    (ignoreMenu#add_item ~key:_E
-       ~callback:(fun () -> getLock (fun () -> addRegExpByPath ignoreExt))
-       "Ignore files with this extension");
-  grAdd grAction
-    (ignoreMenu#add_item ~key:_N
-       ~callback:(fun () -> getLock (fun () -> addRegExpByPath ignoreName))
-       "Ignore files with this name");
-
-(*
-  grAdd grRestart
-    (ignoreMenu#add_item ~callback:
-       (fun () -> getLock ignoreDialog) "Edit ignore patterns");
-*)
-
-  (**********************************************************************)
-  (*                       MAIN FUNCTION : SYNCHRONIZE                  *)
-  (**********************************************************************)
-  let synchronize () =
-    if Array.length !theState = 0 then
-      Trace.status "Nothing to synchronize"
-    else begin
-      grSet grAction false;
-      grSet grDiff false;
-      grSet grProceed false;
-      grSet grRestart false;
-
-      Trace.status "Propagating changes";
-      let t = Trace.startTimer "Propagating changes" in
-      let (start, wait) = Threads.thread_maker () in
-      let background = let i = 55000 in `RGB (i, i, i) in
-      let finish i =
-        redisplay i;
-        mainWindow#set_row ~background:`WHITE i;
-        gtk_sync ()
-      in
-      for i = 0 to Array.length !theState - 1 do
-        let theSI = !theState.(i) in
-        assert (theSI.whatHappened = None);
-        start
-          (fun () ->
-             Threads.do_on_main_thread (fun () ->
-               mainWindow#set_row ~background i;
-               makeRowVisible i);
-             theSI.whatHappened <- Some (Transport.transportItem theSI.ri i);
-             i)
-          finish
-      done;
-      wait finish;
-      
-      Trace.showTimer t;
-      Trace.status "Updating synchronizer state";
-      let t = Trace.startTimer "Updating synchronizer state" in
-      Update.commitUpdates();
-      Trace.showTimer t;
-      Trace.status "Synchronization complete";
-
-      grSet grRestart true
-    end
-  in
-
-  (**********************************************************************)
-  (*                  CREATE THE ACTION BAR                             *)
-  (**********************************************************************)
-  let actionBar =
-    GButton.toolbar
-      ~orientation:`HORIZONTAL ~tooltips:true ~space_size:10
-      ~packing:toplevelVBox#pack () in
-
-  (**********************************************************************)
-  (*         CREATE AND CONFIGURE THE QUIT BUTTON                       *)
-  (**********************************************************************)
-  actionBar#insert_space ();
-  ignore (actionBar#insert_button ~text:"Quit" ~callback:safeExit ());
-
-  (**********************************************************************)
-  (*         CREATE AND CONFIGURE THE PROCEED BUTTON                    *)
-  (**********************************************************************)
-  actionBar#insert_space ();
-  grAdd grProceed
-    (actionBar#insert_button ~text:"Proceed"
-       (* tooltip:"Proceed with displayed actions" *)
-       ~callback:(fun () ->
-                    getLock synchronize) ());
-
-  (**********************************************************************)
-  (*           CREATE AND CONFIGURE THE RESCAN BUTTON                   *)
-  (**********************************************************************)
-  let detectCmdName = "Restart" in
-  let detectCmd () =
-    getLock detectUpdatesAndReconcile;
-    if Prefs.readPref batch then begin
-      Prefs.setPref batch Prefs.TempSetting false; synchronize()
-    end
-  in
-  actionBar#insert_space ();
-  grAdd grRestart
-    (actionBar#insert_button ~text:detectCmdName ~callback:detectCmd ());
-
-  (**********************************************************************)
-  (* Buttons for <--, -->, Skip                                         *)
-  (**********************************************************************)
-  let doAction f =
-    match !current with
-      Some i ->
-        let theSI = !theState.(i) in
-        begin match theSI.whatHappened, theSI.ri.replicas with
-          None, Different(_, _, dir) ->
-            f dir;
-            redisplay i;
-            nextInteresting ()
-        | _ ->
-            ()
-        end
-    | None ->
-        ()
-  in
-  let leftAction     _ = doAction (fun dir -> dir := Replica2ToReplica1) in
-  let rightAction    _ = doAction (fun dir -> dir := Replica1ToReplica2) in
-  let questionAction _ = doAction (fun dir -> dir := Conflict) in
-
-  (**********************************************************************)
-  (*             CREATE AND CONFIGURE THE DIFF BUTTON and KEY           *)
-  (**********************************************************************)
-  let diffCmd () =
-    match !current with
-      Some i ->
-        getLock (fun () ->
-          showDiffs !theState.(i).ri
-            (fun title text -> messageBox ~title text)
-            Trace.status i)
-    | None ->
-        ()
-  in
-
-  actionBar#insert_space ();
-  grAdd grAction
-    (actionBar#insert_button
-       ~icon:((GMisc.pixmap leftArrowBlack ())#coerce)
-       ~callback:leftAction ());
-  actionBar#insert_space ();
-  grAdd grAction
-    (actionBar#insert_button
-       ~icon:((GMisc.pixmap rightArrowBlack ())#coerce)
-       ~callback:rightAction ());
-  actionBar#insert_space ();
-  grAdd grAction
-    (actionBar#insert_button ~text:"Skip" ~callback:questionAction ());
-  actionBar#insert_space ();
-  grAdd grDiff (actionBar#insert_button ~text:"Diff" ~callback:diffCmd ());
-
-  (**********************************************************************)
-  (* Configure keyboard commands                                        *)
-  (**********************************************************************)
-  ignore
-    (mainWindow#event#connect#key_press ~callback:
-       begin fun ev ->
-         let key = GdkEvent.Key.keyval ev in
-         if key = _Left then begin
-           leftAction (); GtkSignal.stop_emit (); true
-         end else if key = _Right then begin
-           rightAction (); GtkSignal.stop_emit (); true
-         end else
-           false
-       end);
-
-  (**********************************************************************)
-  (* Add entries to the Action menu                                     *)
-  (**********************************************************************)
-  let (root1,root2) = Globals.getReplicaRoots () in
-  let loc1 = root2hostname root1 in
-  let loc2 = root2hostname root2 in
-  let descr =
-    if loc1 = loc2 then "left to right" else
-    Printf.sprintf "from %s to %s" loc1 loc2
-  in
-  let left =
-    actionsMenu#add_item ~key:_greater ~callback:rightAction
-      ("Propagate " ^ descr) in
-  grAdd grAction left;
-  left#add_accelerator ~group:accel_group ~modi:[`SHIFT] _greater;
-  
-  let descl =
-    if loc1 = loc2 then "right to left" else
-    Printf.sprintf "from %s to %s" loc2 loc1
-  in
-  let right =
-    actionsMenu#add_item ~key:_less ~callback:leftAction
-      ("Propagate " ^ descl) in
-  grAdd grAction right;
-  right#add_accelerator ~group:accel_group ~modi:[`SHIFT] _less;
- 
-  grAdd grAction
-    (actionsMenu#add_item ~key:_slash ~callback:questionAction
-       "Do not propagate changes");
-
-  ignore (actionsMenu#add_separator ());
-  grAdd grDiff (actionsMenu#add_item ~key:_d ~callback:diffCmd "Show diffs");
-
-  (**********************************************************************)
-  (* Add commands to the Synchronization menu                           *)
-  (**********************************************************************)
-  grAdd grProceed
-    (fileMenu#add_item ~key:_g
-       ~callback:(fun () ->
-                    getLock synchronize)
-       "Proceed");
-  grAdd grRestart (fileMenu#add_item ~key:_r ~callback:detectCmd detectCmdName);
-  grAdd grRestart
-    (fileMenu#add_item ~key:_a
-       ~callback:(fun () ->
-                    getLock detectUpdatesAndReconcile; 
-                    getLock synchronize)
-       "Atomically detect updates and proceed");
-  ignore (fileMenu#add_separator ());
-  let cm =
-    fileMenu#add_check_item ~active:(Prefs.readPref Transport.backups)
-      ~callback:(fun b -> Prefs.setPref Transport.backups Prefs.TempSetting b)
-      "Make backups"
-  in
-  cm#set_show_toggle true;
-  grAdd grRestart cm;
-  ignore (fileMenu#add_separator ());
-  ignore (fileMenu#add_item ~key:_q ~callback:safeExit "Quit");
-
-  grSet grAction false;
-  grSet grDiff false;
-  grSet grProceed false;
-  grSet grRestart false;
-
-  ignore (toplevelWindow#event#connect#delete ~callback:
-            (fun _ -> safeExit (); true));
-  toplevelWindow#show ();
-  currentWindow := Some toplevelWindow;
-  detectCmd ()
-
-(**********************************************************************)
-(* Starting up...                                                     *)
-(**********************************************************************)
-let start _ =
-  begin try
-    (* Initialize the library *)
-    ignore (Main.init ());
-
-    Util.warnPrinter := Some (warnBox "Warning");
-    (* Ask the Remote module to call us back at regular intervals during
-       long network operations. *)
-    Threads.tickProc := Some gtk_sync;
-
-    (**********************************************************************)
-    (* Set things up to initialize the client/server connection and       *)
-    (* detect updates after the ui is displayed.                          *)
-    (* This makes a difference when the replicas are large and it takes   *)
-    (* a lot of time to detect updates.                                   *)
-    (**********************************************************************)
-    let msg = ref None in
-    Uicommon.uiInit
-      profileSelect
-      rootSelect
-      (fun () ->
-         let w =
-           GWindow.window ~kind:`TOPLEVEL ~position:`CENTER
-             ~wm_name:"Unison" ~border_width:16 () in
-         ignore (GMisc.label ~text: "Contacting server..."
-                   ~packing:(w#add) ());
-         w#show ();
-         ignore (w#event#connect#delete ~callback:(fun _ -> exit 0));
-         msg := Some w)
-      (fun () ->
-         begin match !msg with
-           None   -> ()
-         | Some w -> w#destroy ()
-         end;
-         createToplevelWindow ());
-
-    (**********************************************************************)
-    (* Display the ui                                                     *)
-    (**********************************************************************)
-    ignore (Timeout.add 500 (fun _ -> true));
-              (* Hack: this allows signals such as SIGINT to be
-                 handled even when Gtk is waiting for events *)
-    Main.main ()
-  with exn ->
-    fatalError (exn2string exn)
-  end
-
-end (* module Private *)
-
-(**********************************************************************)
-(*                               MODULE MAIN                          *)
-(**********************************************************************)
-
-module Body : Uicommon.UI = struct
-
-let start = function
-    Text -> Uitext.Body.start Text
-  | Graphic -> Private.start Graphic
-
-end (* module Body *)
-
-(*
-FIX:
-- Édition (minimale) et création des profiles
-- Profile par défaut
-- Sanity checks pour "Root selection"
-- Edition du filtrage
-*)