(* $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
*)