diff options
Diffstat (limited to 'gui.ml')
| -rw-r--r-- | gui.ml | 117 |
1 files changed, 106 insertions, 11 deletions
@@ -1,9 +1,80 @@ type debuglog_type = [`read | `write | `status] + + +class loginwin mainwin = + (* window & layout *) + let g_win = GWindow.window ~modal:true ~type_hint:`DIALOG ~position:`CENTER + ~title:"Serika Login" ~border_width:5 ~width:400 ~resizable:false () in + let _ = g_win#set_transient_for mainwin in + let _ = g_win#set_destroy_with_parent true in + let g_hbox = GPack.hbox ~packing:g_win#add () in + let _ = GMisc.image ~stock:`DIALOG_AUTHENTICATION ~icon_size:`DIALOG ~yalign:0.2 ~packing:(g_hbox#pack ~expand:false) () in + 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 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_pas#set_visibility false 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 + + (* buttons *) + let g_but = GPack.button_box `HORIZONTAL ~spacing:10 ~layout:`END ~packing:(g_vbox#pack ~expand:false) () in + let g_but_con = GButton.button ~stock:`CONNECT ~packing:g_but#add () in + let g_but_can = GButton.button ~stock:`CANCEL ~packing:g_but#add () in + let _ = g_but_can#connect#clicked g_win#misc#hide in + let _ = g_but_con#misc#set_can_default true in + let _ = g_but_con#misc#grab_default () in + + (* set user/pass sensitivity *) + let _ = g_frm_ano#connect#toggled (fun () -> + g_frm_usr#misc#set_sensitive (not g_frm_ano#active); + g_frm_ulb#misc#set_sensitive (not g_frm_ano#active); + g_frm_pas#misc#set_sensitive (not g_frm_ano#active); + g_frm_plb#misc#set_sensitive (not g_frm_ano#active) + ) in + + (* the object *) + object (self) + method private statusmsg img msg = + g_nfo_img#set_stock img; + g_nfo_lbl#set_text msg + 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 (); + g_win#show () + ) + method hide = g_win#misc#hide () + 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 + )) + 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; + g_frm#misc#set_sensitive true; + g_frm_usr#misc#grab_focus () + end + + + class mainwin () = (* main window layout *) - let g_win = GWindow.window ~wm_name:"Serika" ~wm_class:"serika" ~position:`CENTER () in + let g_win = GWindow.window ~title:"Serika" ~position:`CENTER () in let _ = g_win#connect#destroy GMain.Main.quit in let _ = g_win#set_default_width 640 and _ = g_win#set_default_height 480 in let g_vbox = GPack.vbox ~packing:g_win#add () in @@ -21,28 +92,52 @@ class mainwin () = (* status bar *) let g_status = GMisc.statusbar ~packing:(g_vbox#pack ~expand:false) () in let g_statuscontext = g_status#new_context ~name:"Meh" in - let g_bandwidth = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~width:70 ~text:"0.0 kB" () in - let g_cmd_count = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~width:25 ~text:"0" () in + let g_bandwidth = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~width:80 ~text:"0.0 kB" () in + let g_cmd_count = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~width:30 ~text:"0" () in + let g_loggedinusr = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~text:"-" () in (* coloring and marking for the debug textview *) - let _ = g_debug#buffer#create_tag ~name:"read" [`FOREGROUND "#cc6666"] in - let _ = g_debug#buffer#create_tag ~name:"write" [`FOREGROUND "#6666cc"] in - let _ = g_debug#buffer#create_tag ~name:"prefix" [`WEIGHT `LIGHT] in + let _ = g_debug#buffer#create_tag ~name:"read" [`FOREGROUND "#cc6666"] in + let _ = g_debug#buffer#create_tag ~name:"write" [`FOREGROUND "#6666cc"] in + let _ = g_debug#buffer#create_tag ~name:"prefix" [`WEIGHT `LIGHT] in let _ = g_debug#buffer#create_mark ~name:"end" ~left_gravity:false g_debug#buffer#end_iter in + (* login window *) + let login = new loginwin g_win#as_window in + (* the object *) object (self) val mutable bandwidth = 0 val mutable cmd_count = 0 - val mutable laststatusmsg = g_statuscontext#push "Welcome to Serika!" + val mutable laststatusmsg = g_statuscontext#push "Not connected." - method show = g_win#show () + method show = + self#set_sensitive false; + g_win#show (); + login#show - method set_debug_docmd f = + method set_on_debug_cmd f = ignore (g_debug_send#connect#clicked (fun () -> f (g_debug_cmd#text) )) + method login = login + + method set_sensitive b = + g_debug_send#misc#set_sensitive b + + method set_loggedin user = + login#hide; + self#statusmsg "Login successful."; + g_loggedinusr#set_text user; + self#set_sensitive true + + method set_loggedout () = + login#show; + self#statusmsg "Not connected."; + g_loggedinusr#set_text "-"; + self#set_sensitive false + method statusmsg str = let msg = g_statuscontext#push str in g_statuscontext#remove laststatusmsg; @@ -72,11 +167,11 @@ class mainwin () = method set_throttled sec (cb : (unit -> unit)) = let togo = ref sec in - g_debug_send#misc#set_sensitive false; + self#set_sensitive false; let secfunc () = togo := !togo - 1; if !togo < 1 then ( - g_debug_send#misc#set_sensitive true; + self#set_sensitive true; cb (); false ) else ( |