(* $I1: Unison file synchronizer: src/main.ml $ *)
(* $I2: Last modified by vouillon on Wed, 17 Apr 2002 12:03:26 -0400 $ *)
(* $I3: Copyright 1999-2002 (see COPYING for details) $ *)

(* ---------------------------------------------------------------------- *)

(* This is the main program -- the thing that gets executed first when
   unison is run.

   The Main module is actually a functor that takes the user interface
   (e.g., Uitext or Uigtk) as a parameter.  This allows us to build with
   just one user interface at a time, which avoids having to always link
   in all the libraries needed by all the user interfaces. *)

(* ---------------------------------------------------------------------- *)

module Body = functor(Ui : Uicommon.UI) -> struct

(* This code snippet tests for presence of potential stack overflows (e.g.
   from use of non-tail-recursive list operations on large lists)
   by setting the stack limit very small.  Uncomment it when you want
   to stress-test the code. *)
(*
let _ = 
  Gc.set {(Gc.get ()) with Gc.stack_limit = 1 * 1024 / 4; Gc.verbose = 12}
in Util.msg "REMEMBER TO REMOVE GC DEBUGGING STUFF!!\n" ;;
*)
let _ = Gc.set {(Gc.get ()) with Gc.max_overhead = 50}

(* Some command-line arguments are handled specially during startup, e.g.
       -doc
       -version
       -server
       -socket
       -ui
   They are expected to appear on the command-line only, not in a
   profile. In particular, -version and -doc will print to the
   standard output, so they only make sense if invoked from the
   command-line (and not a click-launched gui that has no standard
   output).

   Furthermore, the actions associated with these command-line
   arguments are executed without loading a profile or doing the usual
   command-line parsing. This is because we want to run the actions
   without loading a profile; and then we can't do command-line
   parsing because it is intertwined with profile loading.
*)

let versionPrefName = "version"
let printVersionAndExit =
  Prefs.createBool versionPrefName false "print version and exit"
    ("Print the current version number and exit.  "
     ^ "(This option only makes sense on the command line.)")

let docsPrefName = "doc"
let docs =
  Prefs.createString docsPrefName ""
    "show documentation ('-doc topics' lists topics)"
    (  "The command-line argument \\texttt{-doc \\ARG{secname}} causes unison to "
       ^ "display section  \\ARG{secname} of the manual on the standard output "
       ^ "and then exit.   Use \\verb|-doc all| to display the whole manual, "
       ^ "which includes exactly the same information as the printed and HTML "
       ^ "manuals, modulo "
       ^ "formatting.  Use \\verb|-doc topics| to obtain a list of the "
       ^ "names of the various sections that can be printed.")

let prefsdocsPrefName = "prefsdocs"
let prefsdocs =
  Prefs.createBool prefsdocsPrefName false
    "*show full documentation for all preferences (and then exit)"
    ""

let serverPrefName = "server"
let server =
  Prefs.createBool serverPrefName false "*normal or server mode" ""

let socketPrefName = "socket"
let socket =
  Prefs.create socketPrefName None "act as a server on a socket" ""
    (fun _ -> fun i ->
      (try
         Some(int_of_string i)
       with Failure "int_of_string" ->
         raise(Prefs.IllegalValue "-socket must be followed by a number")))
    (function None -> [] | Some(i) -> [string_of_int i]) ;;

(* User preference for which UI to use if there is a choice *)
let uiPrefName = "ui"
let interface =
  Prefs.create uiPrefName Uicommon.Graphic
    "select user interface ('text' or 'graphic')"
    ("This preference selects either the graphical or the textual user "
     ^ "interface.  Legal values are \\verb|graphic| or \\verb|text|.  \n\nIf "
     ^ "the Unison executable was compiled with only a textual interface, "
     ^ "this option has "
     ^ "no effect.  (The pre-compiled binaries are all compiled with both "
     ^ "interfaces available.)")
    (fun _ -> function
        "text" -> Uicommon.Text
      | "graphic" -> Uicommon.Graphic
      | other ->
          raise (Prefs.IllegalValue ("option ui :\n\
                                      text -> textual user interface\n\
                                      graphic -> graphic user interface\n"
                                      ^other^ " is not a legal value")))
    (function Uicommon.Text -> ["text"] | Uicommon.Graphic -> ["graphic"]);;

let argv = Prefs.scanCmdLine Uicommon.usageMsg;;

let catch_all f =
  try f () with e -> Util.msg "%s\n" (Uicommon.exn2string e); exit 1;;

(* Print version if requested *)
if Util.StringMap.mem versionPrefName argv then begin
  Printf.printf "%s version %s\n" Uutil.myName Uutil.myVersion;
  exit 0
end;

(* Print docs for all preferences if requested (this is used when building
   the manual) *)
if Util.StringMap.mem prefsdocsPrefName argv then begin
  Prefs.printFullDocs();
  exit 0
end;;

(* Display documentation if requested *)
begin try
  begin match Util.StringMap.find docsPrefName argv with
    [] ->
      assert false
  | "topics"::_ ->
      Printf.printf "Documentation topics:\n";
      Safelist.iter
        (fun (sn,(n,doc)) ->
          if sn<>"" then Printf.printf "   %12s %s\n" sn n)
        Strings.docs;
      Printf.printf
        "\nType \"%s -doc <topic>\" for detailed information about <topic>\n"
        Uutil.myName;
      Printf.printf
        "or \"%s -doc all\" for the whole manual\n\n"
        Uutil.myName
  | "all"::_ ->
      Printf.printf "\n";
      Safelist.iter
        (fun (sn,(n,doc)) -> if n<>"Junk" then Printf.printf "%s\n" doc)
        Strings.docs
  | topic::_ ->
      (try
        let (_,d) = Safelist.assoc topic Strings.docs in
        Printf.printf "\n%s\n" d
      with
        Not_found ->
          Printf.printf "Documentation topic %s not recognized:"
            topic;
          Printf.printf "\nType \"%s -doc topics\" for a list\n"
            Uutil.myName)
  end;
  exit 0
with Not_found -> () end;;

(* Install an appropriate function for finding preference files.  (We put
   this in Util just because the Prefs module lives below the Os module in the
   dependency hierarchy, so Prefs can't call Os directly.) *)
Util.supplyFileInUnisonDirFn 
  (fun n -> Fspath.toString (Os.fileInUnisonDir(n)));

(* Start a server if requested *)
if Util.StringMap.mem serverPrefName argv then begin
  catch_all (fun () ->
    Os.createUnisonDir();
    Remote.beAServer();
    exit 0)
end;

(* Start a socket server if requested *)
begin try
  let i =
    match Util.StringMap.find socketPrefName argv with
      [] ->
        assert false
    | i::_ ->
        try int_of_string i with Failure _ ->
          Util.msg "-socket must be followed by a number\n";
          exit 1
  in
  catch_all (fun () ->
    Os.createUnisonDir();
    Remote.waitOnPort i);
  exit 0
with Not_found -> () end;

(* Otherwise, start a ui *)
match try Util.StringMap.find uiPrefName argv
      with Not_found -> ["graphic"]
with
    "text"::_    -> Ui.start Uicommon.Text
  | "graphic"::_ -> Ui.start Uicommon.Graphic
  | _            -> Prefs.printUsage Uicommon.usageMsg; exit 1

end
