open Tk
open Unix
open Mmm

(* we expect HOME to be defined... *)
let user_file name =
  Filename.concat (Filename.concat (Sys.getenv "HOME") ".mmm") name

(* External requests *)
let init_external () =
 let file = user_file "remote" in
 try
  let socket = socket PF_UNIX SOCK_STREAM 0 in
    bind socket (ADDR_UNIX file);                  ;
    listen socket 5;
    Fileevent.add_fileinput socket
      	(fun () -> 
	  try 
      	   let fd,_ = accept socket in
	   let request = Munix.read_line fd in
	     close fd; 
	     navigator false (Lexurl.make request);
	     ()
	  with _ -> ());
    at_exit (fun () -> Msys.rm file)
 with
   _ ->
     Error.default#f (I18n.sprintf "Can't initialize %s" file)


let rec safe_loop() =
  try
    Printexc.print mainLoop () (* prints and reraises *)
  with
     Out_of_memory -> raise Out_of_memory
   | Sys.Break -> raise Sys.Break
   | e -> flush Pervasives.stderr; safe_loop()


(* Initial modules  *)
let load_initial_modules () =
  try
    let dir = Filename.concat (Sys.getenv "HOME") ".mmm" in
    let dh = opendir dir in
    try
      while true do
	let f = readdir dh in
	if Filename.check_suffix f ".cmo" then
	  Dload.load_local (Filename.concat dir f)
      done
    with
        End_of_file -> closedir dh
     |  e -> closedir dh; raise e
  with
    Unix_error _ ->
      Error.f (I18n.sprintf "Error during loading of initial modules")


let main () =
 (* As always, we must parse argument first, using references... *)
  let display = ref (try Sys.getenv("DISPLAY") with Not_found -> "")
  and sufxfile = ref (user_file "mime.types")
  and init_urls = ref [] 
  and accept_external = ref false
  and preffile = ref (user_file "prefs")
  and palette = ref None
  and modules = ref true
  and clicktofocus = ref false
  in
  Arg.parse [
  "-proxy", Arg.String (fun s -> Http.proxy := s), 
  "<hostname>\tProxy host";
  "-port", Arg.Int (fun i -> Http.proxy_port := i),
  "<port>\t\tProxy port";
  "-d", Arg.String (fun s -> display := s),
  "<foo:0>\t\tDisplay";
  "-display", Arg.String (fun s -> display := s),
  "<foo:0>\tDisplay";
  "-suffixes", Arg.String (fun s -> sufxfile := s),
  "<file>\tSuffix file";
  "-external", Arg.Unit (fun () -> accept_external := true),
  "\t\tAccept remote command (mmm_remote <url>)";
  "-lang", Arg.String (fun s -> I18n.language := s),
  "<lang>\t\tI18n language";
  "-msgfile", Arg.String (fun s -> I18n.message_file := s),
  "<file>\tI18n message file";
  "-prefs", Arg.String (fun s -> preffile := s),
  "<file>\t\tPreference File";
  "-helpurl", Arg.String (fun s -> Mmm.helpurl := Lexurl.make s),
  "<url>\tHelp URL";
  "-palette", Arg.String (fun s -> palette := Some s),
  "<color>\tTk Palette";
  "-nomodule", Arg.Unit (fun () -> modules := false),
  "\t\tDon't load initial modules";
  "-clicktofocus", Arg.Unit (fun () -> clicktofocus := true),
  "\tClick to Focus mode (default is Focus Follows Mouse)";
  "-geometry", Arg.String (fun s -> Mmm.initial_geom := Some s),
  "<wxh+x+y>\tInitial geometry for the first navigator"
     ]
     (fun s -> init_urls := s :: !init_urls)
     "Usage: meuh <opts> <initial url>";

  Sys.catch_break true;
  (* Avoid SIGPIPE completely, in favor of write() errors *)
  Sys.signal Sys.sigpipe Sys.Signal_ignore;
  let top = openTkDisplayClass !display "mmm" in
    Wm.withdraw top;
    (* Default values for navigator window *)
    Resource.add "*MMM.Width" "640" WidgetDefault;
    Resource.add "*MMM.Height" "480" WidgetDefault;
    (* Resources *)
    let resfile = user_file "MMM.ad" in
    if Sys.file_exists resfile then Resource.readfile resfile Interactive;
    begin match !palette with
       None -> ()
     | Some bg -> try Palette.set_background (NamedColor bg) with _ -> ()
    end;
    (* Initialisations in frx library *)
    Frx_text.init ();
    (* Initialisations in jpf's balloon library *)
    Balloon.init ();
    (* Initialisations in jpf's GIF ANIMATION library *)
    Tkaniminit.f ();
    (* Local initialisations *)
    Munix.full_random_init();
    Auth.init();   (* start expiration timer *)
    Debug.init();
    Styles.init "helvetica" "o";  (* "new century schoolbook", "times", ... *)
    if !accept_external then init_external();
    (* Our internal viewers *)
    if Sys.file_exists !sufxfile then Http_headers.read_suffix_file !sufxfile;
    Viewers.add_viewer ("text","html") Htmlw.display_html;
    Viewers.add_viewer ("text","plain") Plain.display_plain;
    (* Preferences *)
    begin
      if Sys.file_exists !preffile then Prefs.init (Some !preffile)
      else Prefs.init None
    end;
    Cache.init();
    Hr.init !Textw_fo.html_bg;	   (* built the HR image *)
    Attrs.init !Textw_fo.html_bg; (* built the bullet images *)
    (* Initialization of Japanese stuff *)
    Html.init !Version.japan;
    if not !clicktofocus then Focus.follows_mouse();
    (* Home page *)
    Mmm.home := (
         try Sys.getenv "WWW_HOME"
         with Not_found -> (Version.initurl (Version.i18n ()))
	 );
    (* Dynamic linking *)
    Dynlink.init();
    Dynlink.add_available_units Crcs.crc_unit_list;
    (* Load local applets *)
    if !modules then load_initial_modules();
    (* Start the initial navigator *)
    navigator true (
       match !init_urls with
      	[] -> Lexurl.make !Mmm.home
     | x::_ -> Lexurl.make x);
    safe_loop();
    if !Log.debug_mode then begin
      Cache.postmortem();
      Gcache.postmortem()
     end
      

let postmortem () =
  try 
    main ()
  with
    e -> Cache.postmortem(); Gcache.postmortem(); raise e

let _ = Printexc.catch postmortem ()
