diff options
Diffstat (limited to 'gui.ml')
-rw-r--r-- | gui.ml | 91 |
1 files changed, 83 insertions, 8 deletions
@@ -14,18 +14,32 @@ class loginwin mainwin = let g_vbox = GPack.vbox ~packing:g_hbox#add () in (* input fields *) - let g_frm = GPack.table ~rows:3 ~columns:2 ~col_spacings:3 ~packing:g_vbox#add () in + let inputfield (tbl:GPack.table) top label entry = + let align = GBin.alignment ~xscale:0.0 ~xalign:0.0 ~packing:(tbl#attach ~left:1 ~top:top ~expand:`X ~fill:`X) () in + let lbl = GMisc.label ~width:80 ~text:label ~xalign:1.0 ~mnemonic_widget:entry ~packing:(tbl#attach ~left:0 ~top:top ~expand:`NONE) () in + align#add entry#coerce; + (entry, lbl) + in + let g_frm = GPack.table ~rows:4 ~columns:2 ~col_spacings:3 ~packing:g_vbox#add () in let g_frm_ano = GButton.check_button ~label:"Connect anonymously" ~packing:(g_frm#attach ~left:0 ~top:0 ~right:2) () in - let g_frm_usr = GEdit.entry ~activates_default:true ~packing:(g_frm#attach ~left:1 ~top:1 ~expand:`NONE) () in - let g_frm_ulb = GMisc.label ~text:"Username:" ~xalign:1.0 ~mnemonic_widget:g_frm_usr ~packing:(g_frm#attach ~left:0 ~top:1 ~expand:`NONE) () in - let g_frm_pas = GEdit.entry ~activates_default:true ~packing:(g_frm#attach ~left:1 ~top:2 ~expand:`NONE) () in - let g_frm_plb = GMisc.label ~text:"Password:" ~xalign:1.0 ~mnemonic_widget:g_frm_pas ~packing:(g_frm#attach ~left:0 ~top:2 ~expand:`NONE) () in + let (g_frm_usr, g_frm_ulb) = inputfield g_frm 1 "Username:" (GEdit.entry ~activates_default:true ()) in + let (g_frm_pas, g_frm_plb) = inputfield g_frm 2 "Password:" (GEdit.entry ~activates_default:true ~visibility:false ()) in + (* advanced *) + let g_frm_exp = GBin.expander ~expanded:false ~label:"Advanced" ~packing:(g_frm#attach ~left:0 ~top:3 ~right:2 ~ypadding:5) () in + let g_frm_atb = GPack.table ~rows:4 ~columns:2 ~col_spacings:3 ~packing:g_frm_exp#add () in + let (g_frm_ser, _) = inputfield g_frm_atb 0 "Server:" (GEdit.entry ~activates_default:true ()) in + let (g_frm_por, _) = inputfield g_frm_atb 1 "Port:" (GEdit.spin_button ~snap_to_ticks:true ()) in + let g_frm_rem = GButton.check_button ~label:"Remember login settings (except password)" ~packing:(g_frm_atb#attach ~left:0 ~top:2 ~right:2) () in + let g_frm_aut = GButton.check_button ~label:"Automatically login on startup" ~packing:(g_frm_atb#attach ~left:0 ~top:3 ~right:2) () in + (* some input settings *) let _ = g_frm_pas#set_visibility false in + let g_frm_port = g_frm_por#adjustment in + let _ = g_frm_port#set_bounds ~lower:1.0 ~upper:65535.0 ~step_incr:1.0 () in (* info part *) let g_nfo = GPack.hbox ~spacing:5 ~packing:(g_vbox#pack ~expand:false ~padding:5) () in let g_nfo_img = GMisc.image ~stock:`DIALOG_WARNING ~packing:(g_nfo#pack ~expand:false) () in - let g_nfo_lbl = GMisc.label ~line_wrap:true ~xalign:0.0 ~packing:(g_nfo#pack ~expand:true) () in + let g_nfo_lbl = GMisc.label ~line_wrap:true ~selectable:true ~xalign:0.0 ~packing:(g_nfo#pack ~expand:true ~fill:true) () in (* buttons *) let g_but = GPack.button_box `HORIZONTAL ~spacing:10 ~layout:`END ~packing:(g_vbox#pack ~expand:false) () in @@ -43,26 +57,87 @@ class loginwin mainwin = g_frm_plb#misc#set_sensitive (not g_frm_ano#active) ) in + (* set autologin sensitivity *) + let _ = g_frm_aut#misc#set_sensitive false in + let _ = g_frm_rem#connect#toggled (fun () -> + g_frm_aut#misc#set_sensitive g_frm_rem#active; + if not g_frm_rem#active then g_frm_aut#set_active false + ) in + + (* warn about saving password *) + let g_warnpass_d = GWindow.message_dialog ~message:("Your password will be" + ^" saved without encryption and could possibly be read by other users on" + ^" this computer. Are you sure you want to enable auto-connect?") + ~title:"Confirm saving your password" ~buttons:GWindow.Buttons.yes_no + ~parent:g_win ~message_type:`WARNING () in + let g_warnpass_block = ref false in + let g_warnpass () = + if not !g_warnpass_block && g_frm_aut#active && not g_frm_ano#active then ( + g_warnpass_block := true; + g_frm_aut#set_active ((g_warnpass_d#run ()) = `YES); + g_warnpass_block := false; + g_warnpass_d#misc#hide () + ) + in + let _ = g_frm_aut#connect#toggled g_warnpass in + let _ = g_frm_ano#connect#toggled g_warnpass in + (* the object *) object (self) + val mutable defaults = (false, "", "", "api.vndb.org", 19534, false, false) + method private statusmsg img msg = g_nfo_img#set_stock img; g_nfo_lbl#set_text msg + + method set_defaults d = defaults <- d + + method apply_defaults = + match defaults with + | (anon, user, pass, serv, port, remem, auto) -> + g_warnpass_block := true; + g_frm_ano#set_active anon; + g_frm_usr#set_text user; + g_frm_pas#set_text pass; + g_frm_ser#set_text serv; + g_frm_port#set_value (float port); + g_frm_rem#set_active remem; + g_frm_aut#set_active auto; + g_warnpass_block := false + method show = if not g_win#misc#visible then ( self#statusmsg `DIALOG_WARNING "Note: The application might hang while connecting. Feel free to kill it when it takes too long."; - g_frm_usr#misc#grab_focus (); + if String.length g_frm_usr#text = 0 then + g_frm_usr#misc#grab_focus () + else + g_frm_pas#misc#grab_focus (); g_win#show () ) + method hide = g_win#misc#hide () + + method do_connect = + match defaults with + | (_,_,_,_,_,_,true) -> g_but_con#clicked () + | _ -> () + method set_on_connect f = ignore (g_but_con#connect#clicked (fun () -> g_but_con#misc#set_sensitive false; g_frm#misc#set_sensitive false; ignore (self#statusmsg `DIALOG_INFO "Connecting..."); - f g_frm_ano#active g_frm_usr#text g_frm_pas#text + f (g_frm_ano#active, + g_frm_usr#text, + g_frm_pas#text, + g_frm_ser#text, + (int_of_float g_frm_port#value), + g_frm_rem#active, + g_frm_aut#active) )) + method set_connected = self#statusmsg `DIALOG_INFO "Connected, logging in..." + method failed msg = self#statusmsg `DIALOG_ERROR msg; g_but_con#misc#set_sensitive true; |