(************************************************************
   mbiff.ml		Created      : Sun Mar  2 16:54:37 2003
  			Last modified: Sun Mar 09 15:10:32 2003
  Compile: ocamlc -g -thread -I +labltk str.cma /usr/local/lib/ocaml/unix.cma threads.cma labltk.cma mytcp.ml pop.ml mbiff.ml -o mbiff #
  FTP Directory: sources/ocaml #
************************************************************)
(**

  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>
   パスワードを再入力できるようにした。
   そしてSTATのループ前にあらかじめチェックすることにした。
   複数アカウントの biff
   パスワードダイアログに exit の追加。アプリケーション即終了
   パスワードを入れるテキストエントリに最初にフォーカスがいくようにした

   TODO 
   POPError を正しくハンドルできていないようである。直すべし
   メールが来たらいつも読むのは面倒。スパムや特に興味のないメールのためにメーラーを
   触るのは嫌。多分新着メールのタイトルやFromを表示するとよい。
 *)

open Tk

module Unix = Mytcp.Unix

let color_changed = `Red
let color_unchanged = `Black
let color_background_when_connecting = `Color("AliceBlue")
let color_background_normal = `Color("LightGray")
(*let default_password_geometry = "+0+0"*)
(*let default_mbiff_geometry = "+0+0"*)

let pop_port = 110
let wait_time = 60.0 *. 10.0
(*let wait_time = 20.0*)
let width = 43
let height = 19 

type result_of_password = Password of string | Exit

let get_password message passref ~window =
  let label = Label.create ~text:message window in
  let e = Entry.create ~show:'*' ~width:10 ~state:`Normal window in
  let exit_button = Button.create ~text:"Exit" ~command:(fun () -> closeTk(); exit 1) window in
  let end_function event =  
    passref := Entry.get e; destroy window in
  begin
(*    キーの名前は /usr/include/X11/keysymdef.h を参考にする*)
    Wm.title_set window message;
    bind ~events:[`KeyPressDetail("Return")] 
      ~extend:false ~action:end_function e;
    pack ~side:`Top [label];
    pack ~side:`Top [e];
    pack ~side:`Top [exit_button];
    (* テキストエントリーにフォーカスをもっていく *)
    bind ~events:[`Visibility] ~extend:false ~action:(fun x -> Focus.force e) e
  end

let wait_reconnect = 60.0 *. 3.0 

let biff_thread_function (account, login_f, connect_f, label) =
  let prev_n = ref 0 in
  let new_n = ref 0 in
  let rec iter () =
    let _ = Label.configure ~background:color_background_when_connecting label in
    let _ = 
      let s = connect_f () in
      begin
	ignore (login_f s);
	new_n :=  Pop.state s;
(*	let result = Pop.get_title s !new_n in*)
(*	begin*)
	Unix.close s;
(*	  result*)
(*	end*)
      end in
    let color = 
      if !new_n = !prev_n || !new_n = 0 then color_unchanged 
      else color_changed in
    let nstr = Printf.sprintf " %s %2d " account !new_n in
    let _ = Label.configure ~background:color_background_normal label in
    begin
      bind ~events:[`ButtonPressDetail(1)] ~extend:false 
	~action:(fun e -> prev_n := !new_n;
	  Label.configure ~foreground:color_unchanged label)
	label;
      Label.configure ~text:nstr ~foreground:color label;
      Thread.delay wait_time;
      iter ()
    end in
  let rec try_iter () =
    try 
      iter ()
    with Pop.POPError e ->
      begin
	print_endline (e ^ "but continue"); flush stdout;
	try_iter ()
      end in
  try_iter ()
    

(* account, user, host *)
let mbiff accounts ~window =
  let times = 3 in
  let rec try_connect host port =
    try
      Mytcp.connect host port
    with Not_found ->
      begin
	Thread.delay wait_reconnect;
	try_connect host port
      end in
  let rec login_iter account user host port login_f n = 
    if n = 0 then
      begin
	prerr_endline "failed to login";
	exit 1
      end
    else
      let password = ref "" in
      let password_dialog = Toplevel.create window in
      let s = try_connect host port in
      begin
	Toplevel.configure ~height ~width window;
	(* visible になってからかな? *)
(*	Wm.geometry_set window default_password_geometry;*)
	get_password ("Enter password for "^account)
	  password ~window:password_dialog;
	Tkwait.window password_dialog;
	if login_f ~user:user ~password:!password ~socket:s then
	  begin Unix.close s; !password end
	else
	  begin
	    Unix.close s;
	    login_iter account user host port login_f (n-1)
	  end
      end in
  let handlers =
    List.map (fun (account, user, host, port, protocol) -> 
      let login_f = Pop.login_function_of_protocol protocol in
      let password = login_iter account user host port login_f times in
      let label = Label.create ~text:"How many mails?" window in
      begin
	pack ~side:`Top ~fill:`X [label];
	(account, (fun s -> login_f user password s),
	  (fun () -> try_connect host port), label)
      end)
      accounts in
  let thrs = 
    List.map (fun x -> Thread.create biff_thread_function x) handlers in
  ()

let _ =
  let title = "multiple biffs" in
  let window = openTk () in
  begin
    Wm.title_set window title;
    (* visible になってからかな? *)
(*    Wm.geometry_set window default_mbiff_geometry;*)
    Sys.set_signal Sys.sigint (Sys.Signal_handle (fun i -> closeTk ()));
    mbiff [("so-net", "mamewo", "pop.dk9.so-net.ne.jp", 110, Pop.POP3);
	   ("lab", "tak", "venus.is.s.u-tokyo.ac.jp", 110, Pop.APOP);
	   ("work", "a_masuyama", "mail.aknow.co.jp", 110, Pop.POP3) ] window;
    mainLoop()
  end