blob: 5c1c84c31f4f89ef337af6c42a5c345e28f02690 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
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 ~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
let g_tabs = GPack.notebook ~packing:g_vbox#add () in
(* debug tab *)
let g_debug_tbl = GPack.table ~rows:2 ~columns:2 () in
let g_debug_scroll = GBin.scrolled_window ~vpolicy:`ALWAYS ~hpolicy:`AUTOMATIC ~packing:(g_debug_tbl#attach ~left:0 ~top:0 ~right:2 ~expand:`BOTH) () in
let g_debug = GText.view ~editable:false ~wrap_mode:`CHAR ~packing:g_debug_scroll#add () in
let g_debug_cmd = GEdit.entry ~activates_default:true ~packing:(g_debug_tbl#attach ~left:0 ~top:1 ~expand:`X) () in
let g_debug_send = GButton.button ~label:"_Send command" ~use_mnemonic:true ~packing:(g_debug_tbl#attach ~left:1 ~top:1 ~expand:`NONE) () in
let _ = g_tabs#append_page ~tab_label:((GMisc.label ~text:"Debug" ())#coerce) g_debug_tbl#coerce in
let _ = g_debug_cmd#connect#activate (fun () -> ignore (g_debug_send#misc#activate ())) in
(* 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) ~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_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 "Not connected."
method show =
self#set_sensitive false;
g_win#show ();
login#show
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;
laststatusmsg <- msg;
self#add_debuglog `status str
method add_bandwidth s =
bandwidth <- bandwidth+s;
g_bandwidth#set_text (Printf.sprintf "%.1f kB" ((float bandwidth) /. 1024.0))
method incr_cmd_count =
cmd_count <- cmd_count+1;
g_cmd_count#set_text (string_of_int cmd_count)
method add_debuglog (t : debuglog_type) str =
let tm = Unix.localtime (Unix.time ()) in
let time = Printf.sprintf "[%02d:%02d:%02d] " tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in
let tags, prefix = match t with
| `read -> (["read"], "< ")
| `write -> (["write"], "> ")
| `status -> ([], "= ") in
let buf = g_debug#buffer in
buf#insert ~iter:buf#end_iter ~tag_names:["prefix"] (time ^ prefix);
buf#insert ~iter:buf#end_iter ~tag_names:tags str;
buf#insert ~iter:buf#end_iter "\n";
g_debug#scroll_mark_onscreen (`NAME "end")
method set_throttled sec (cb : (unit -> unit)) =
let togo = ref sec in
self#set_sensitive false;
let secfunc () =
togo := !togo - 1;
if !togo < 1 then (
self#set_sensitive true;
cb ();
false
) else (
g_statuscontext#flash ~delay:1000 ("Throttled. Waiting "
^(string_of_int !togo)^" seconds before continuing...");
true
)
in
ignore (GMain.Timeout.add ~ms:1000 ~callback:secfunc)
end
|
