53 |
let (dialogs : (int * GuiTemplates.chat_buffer) list ref) = ref [] |
let (dialogs : (int * GuiTemplates.chat_buffer) list ref) = ref [] |
54 |
let source_has_file = ref [] |
let source_has_file = ref [] |
55 |
|
|
56 |
|
module H = Weak.Make(struct |
57 |
|
type t = g_file_tree |
58 |
|
|
59 |
|
let hash ft = Hashtbl.hash ft.g_file_tree_num |
60 |
|
let equal x y = x.g_file_tree_num = y.g_file_tree_num |
61 |
|
|
62 |
|
end) |
63 |
|
|
64 |
|
let ft_by_num = H.create 107 |
65 |
|
|
66 |
(*************************************************************************) |
(*************************************************************************) |
67 |
(* *) |
(* *) |
68 |
(* Global variables *) |
(* Global variables *) |
84 |
then Some (A.get_icon ~icon:M.icon_stock_directory ~size:A.SMALL ()) |
then Some (A.get_icon ~icon:M.icon_stock_directory ~size:A.SMALL ()) |
85 |
else None |
else None |
86 |
|
|
87 |
|
let dummy_ft = |
88 |
|
{ |
89 |
|
g_file_tree_num = 0; |
90 |
|
g_file_tree_name = ""; |
91 |
|
g_file_tree_list = []; |
92 |
|
g_file_tree_pixb = None; |
93 |
|
} |
94 |
|
|
95 |
|
(*************************************************************************) |
96 |
|
(* *) |
97 |
|
(* friend_num *) |
98 |
|
(* *) |
99 |
|
(*************************************************************************) |
100 |
|
|
101 |
|
let friend_num key = |
102 |
|
try int_of_string key with _ -> raise Not_found |
103 |
|
|
104 |
|
(*************************************************************************) |
105 |
|
(* *) |
106 |
|
(* friend_of_key *) |
107 |
|
(* *) |
108 |
|
(*************************************************************************) |
109 |
|
|
110 |
|
let friend_of_key key = |
111 |
|
try |
112 |
|
let num = friend_num key in |
113 |
|
Hashtbl.find G.sources num |
114 |
|
with _ -> raise Not_found |
115 |
|
|
116 |
|
(*************************************************************************) |
117 |
|
(* *) |
118 |
|
(* keys_to_friends *) |
119 |
|
(* *) |
120 |
|
(*************************************************************************) |
121 |
|
|
122 |
|
let keys_to_friends keys = |
123 |
|
let l = ref [] in |
124 |
|
List.iter (fun k -> |
125 |
|
try |
126 |
|
let s = friend_of_key k in |
127 |
|
l := s :: !l |
128 |
|
with _ -> ()) keys; |
129 |
|
!l |
130 |
|
|
131 |
|
(*************************************************************************) |
132 |
|
(* *) |
133 |
|
(* friend_key *) |
134 |
|
(* *) |
135 |
|
(*************************************************************************) |
136 |
|
|
137 |
|
let friend_key friend_num = |
138 |
|
Printf.sprintf "%d" friend_num |
139 |
|
|
140 |
|
(*************************************************************************) |
141 |
|
(* *) |
142 |
|
(* folder_num *) |
143 |
|
(* *) |
144 |
|
(*************************************************************************) |
145 |
|
|
146 |
|
let folder_num key = |
147 |
|
try int_of_string key with _ -> raise Not_found |
148 |
|
|
149 |
|
(*************************************************************************) |
150 |
|
(* *) |
151 |
|
(* folder_of_key *) |
152 |
|
(* *) |
153 |
|
(*************************************************************************) |
154 |
|
|
155 |
|
let folder_of_key key = |
156 |
|
try |
157 |
|
let num = folder_num key in |
158 |
|
H.find ft_by_num {dummy_ft with g_file_tree_num = num} |
159 |
|
with _ -> raise Not_found |
160 |
|
|
161 |
|
(*************************************************************************) |
162 |
|
(* *) |
163 |
|
(* keys_to_folders *) |
164 |
|
(* *) |
165 |
|
(*************************************************************************) |
166 |
|
|
167 |
|
let keys_to_folders keys = |
168 |
|
let l = ref [] in |
169 |
|
List.iter (fun k -> |
170 |
|
try |
171 |
|
let s = friend_of_key k in |
172 |
|
l := s :: !l |
173 |
|
with _ -> ()) keys; |
174 |
|
!l |
175 |
|
|
176 |
|
(*************************************************************************) |
177 |
|
(* *) |
178 |
|
(* folder_key *) |
179 |
|
(* *) |
180 |
|
(*************************************************************************) |
181 |
|
|
182 |
|
let folder_key ft_num = |
183 |
|
Printf.sprintf "%d" ft_num |
184 |
|
|
185 |
(*************************************************************************) |
(*************************************************************************) |
186 |
(* *) |
(* *) |
187 |
(* Templates *) |
(* Templates *) |
193 |
module Column = GuiColumns.Friend |
module Column = GuiColumns.Friend |
194 |
|
|
195 |
type item = source_info |
type item = source_info |
|
type key = int |
|
196 |
|
|
197 |
let columns = O.friends_columns |
let columns = O.friends_columns |
198 |
let get_key = (fun s -> s.source_num) |
let get_key = (fun s -> friend_key s.source_num) |
199 |
let module_name = "Friends" |
let module_name = "Friends" |
200 |
|
|
201 |
end) |
end) |
313 |
(* *) |
(* *) |
314 |
(*************************************************************************) |
(*************************************************************************) |
315 |
|
|
316 |
method sort_items c s1 s2 = |
method sort_items c k1 k2 = |
317 |
match c with |
try |
318 |
|
let s1 = friend_of_key k1 in |
319 |
|
let s2 = friend_of_key k2 in |
320 |
|
match c with |
321 |
Col_friend_network -> compare s1.source_network s2.source_network |
Col_friend_network -> compare s1.source_network s2.source_network |
322 |
| Col_friend_name -> compare s1.source_name s2.source_name |
| Col_friend_name -> compare s1.source_name s2.source_name |
323 |
|
with _ -> 0 |
324 |
|
|
325 |
(*************************************************************************) |
(*************************************************************************) |
326 |
(* *) |
(* *) |
329 |
(*************************************************************************) |
(*************************************************************************) |
330 |
|
|
331 |
method force_update_icons () = |
method force_update_icons () = |
332 |
List.iter (fun s -> |
List.iter (fun k -> |
333 |
try |
try |
334 |
let (row, _) = self#find_item s.source_num in |
let s = friend_of_key k in |
335 |
|
let row = self#find_row k in |
336 |
store#set ~row ~column:friend_network_pixb (Mi.network_pixb s.source_network ~size:A.SMALL ()); |
store#set ~row ~column:friend_network_pixb (Mi.network_pixb s.source_network ~size:A.SMALL ()); |
337 |
store#set ~row ~column:friend_type_pixb (Mi.source_type_to_icon s.source_type ~size:A.SMALL); |
store#set ~row ~column:friend_type_pixb (Mi.source_type_to_icon s.source_type ~size:A.SMALL); |
338 |
store#set ~row ~column:friend_state_pixb (Mi.client_state_to_icon false ~size:A.SMALL); |
store#set ~row ~column:friend_state_pixb (Mi.client_state_to_icon false ~size:A.SMALL); |
376 |
module Column = GuiColumns.Directory |
module Column = GuiColumns.Directory |
377 |
|
|
378 |
type item = g_file_tree |
type item = g_file_tree |
|
type key = int |
|
379 |
|
|
380 |
let columns = O.friends_dirs_columns |
let columns = O.friends_dirs_columns |
381 |
let get_key = (fun ft -> ft.g_file_tree_num) |
let get_key = (fun ft -> folder_key ft.g_file_tree_num) |
382 |
let module_name = "FriendFolders" |
let module_name = "FriendFolders" |
383 |
|
|
384 |
end) |
end) |
437 |
(* *) |
(* *) |
438 |
(*************************************************************************) |
(*************************************************************************) |
439 |
|
|
440 |
method sort_items _ ft1 ft2 = |
method sort_items _ k1 k2 = 0 |
|
compare ft1.g_file_tree_name ft2.g_file_tree_name |
|
441 |
|
|
442 |
end |
end |
443 |
|
|
522 |
(* *) |
(* *) |
523 |
(*************************************************************************) |
(*************************************************************************) |
524 |
|
|
525 |
let remove sel () = |
let remove sel () = |
526 |
List.iter (fun s -> |
List.iter (fun k -> |
527 |
GuiCom.send (RemoveFriend s.source_num); |
try |
528 |
(* there is a #bug here or is it volontary ? The core doesn't send back the updated client_type !!! *) |
GuiCom.send (RemoveFriend (friend_num k)); |
529 |
GuiCom.send (GuiProto.GetClient_info s.source_num) |
(* there is a #bug here or is it volontary ? The core doesn't send back the updated client_type !!! *) |
530 |
|
GuiCom.send (GuiProto.GetClient_info (friend_num k)) |
531 |
|
with _ -> () |
532 |
) sel |
) sel |
533 |
|
|
534 |
let remove_all_friends () = |
let remove_all_friends () = |
535 |
GuiCom.send RemoveAllFriends; |
GuiCom.send RemoveAllFriends; |
536 |
(* there is a #bug here or is it volontary ? The core doesn't send back the updated client_type !!! *) |
(* there is a #bug here or is it volontary ? The core doesn't send back the updated client_type !!! *) |
537 |
List.iter (fun s -> |
List.iter (fun k -> |
538 |
GuiCom.send (GuiProto.GetClient_info s.source_num) |
try |
539 |
|
GuiCom.send (GuiProto.GetClient_info (friend_num k)) |
540 |
|
with _ -> () |
541 |
) (friendstore#all_items ()) |
) (friendstore#all_items ()) |
542 |
|
|
543 |
|
|
549 |
let on_entry_return num s = |
let on_entry_return num s = |
550 |
GuiCom.send (MessageToClient (num, s)) |
GuiCom.send (MessageToClient (num, s)) |
551 |
|
|
552 |
let download_selected_dir (sel : g_file_tree list) () = |
let download_selected_dir sel () = |
553 |
match sel with |
match sel with |
554 |
[] -> () |
[] -> () |
555 |
| ft :: tail -> |
| k :: tail -> |
556 |
begin |
begin |
557 |
let files = Mi.list_files ft in |
try |
558 |
let len = List.length files in |
let ft = folder_of_key k in |
559 |
match (GToolbox.question_box |
let files = Mi.list_files ft in |
560 |
(!M.qT_wt_download_selected_dir) |
let len = List.length files in |
561 |
[ !M.pW_lb_ok ; !M.pW_lb_cancel] |
match (GToolbox.question_box |
562 |
(U.utf8_of (Printf.sprintf !M.qT_lb_confirm_download_dir |
(!M.qT_wt_download_selected_dir) |
563 |
len ft.g_file_tree_name))) |
[ !M.pW_lb_ok ; !M.pW_lb_cancel] |
564 |
with |
(U.utf8_of (Printf.sprintf !M.qT_lb_confirm_download_dir |
565 |
1 -> |
len ft.g_file_tree_name))) |
566 |
List.iter (fun r -> |
with |
567 |
GuiCom.send (Download_query ([r.res_name], r.res_num, false)) |
1 -> |
568 |
) files |
List.iter (fun r -> |
569 |
| _ -> () |
GuiCom.send (Download_query ([r.res_name], r.res_num, false)) |
570 |
|
) files |
571 |
|
| _ -> () |
572 |
|
with _ -> () |
573 |
end |
end |
574 |
|
|
575 |
let show_details s () = |
let show_details k () = |
576 |
let item = Source (s, 0) in |
try |
577 |
GuiInfoWindow.window item () |
let s = friend_of_key k in |
578 |
|
let item = Source (s, 0) in |
579 |
|
GuiInfoWindow.window item () |
580 |
|
with _ -> () |
581 |
|
|
582 |
(*************************************************************************) |
(*************************************************************************) |
583 |
(* *) |
(* *) |
585 |
(* *) |
(* *) |
586 |
(*************************************************************************) |
(*************************************************************************) |
587 |
|
|
588 |
let friend_menu (sel : source_info list) = |
let friend_menu sel = |
589 |
[ |
[ |
590 |
`I (!M.fT_me_find_friend, find_friend) ; |
`I (!M.fT_me_find_friend, find_friend) ; |
591 |
`I (!M.fT_me_remove_all_friends, remove_all_friends) |
`I (!M.fT_me_remove_all_friends, remove_all_friends) |
592 |
] @ |
] @ |
593 |
(match sel with |
(match sel with |
594 |
[] -> [] |
[] -> [] |
595 |
| s :: tail -> |
| k :: tail -> |
596 |
[ |
[ |
597 |
`S; |
`S; |
598 |
`I ((!M.dT_me_show_source_details), show_details s) ; |
`I ((!M.dT_me_show_source_details), show_details k) ; |
599 |
`I (!M.fT_me_remove, remove sel) ; |
`I (!M.fT_me_remove, remove sel) ; |
600 |
]) |
]) |
601 |
|
|
608 |
let rec insert_dir ft id ?parent () = |
let rec insert_dir ft id ?parent () = |
609 |
ft.g_file_tree_num <- !id; |
ft.g_file_tree_num <- !id; |
610 |
let parent = folderstore#add_item ft ?parent () in |
let parent = folderstore#add_item ft ?parent () in |
611 |
|
H.add ft_by_num ft; |
612 |
incr id; |
incr id; |
613 |
match ft.g_file_tree_list with |
match ft.g_file_tree_list with |
614 |
[] -> () |
[] -> () |
619 |
| GTreeDirectory d -> insert_dir d id ~parent () |
| GTreeDirectory d -> insert_dir d id ~parent () |
620 |
) ft.g_file_tree_list |
) ft.g_file_tree_list |
621 |
|
|
622 |
let on_select_friend (sel : source_info list) = |
let on_select_friend sel = |
623 |
|
H.clear ft_by_num; |
624 |
resultstore#clear (); |
resultstore#clear (); |
625 |
folderstore#clear (); |
folderstore#clear (); |
626 |
update_results_label (); |
update_results_label (); |
627 |
match sel with |
match sel with |
628 |
[] -> () |
[] -> () |
629 |
| s :: tail -> |
| k :: tail -> |
630 |
match s.source_files with |
begin |
631 |
None -> (GuiCom.send (GetClient_files s.source_num)) |
try |
632 |
| Some ft -> |
let s = friend_of_key k in |
633 |
begin |
match s.source_files with |
634 |
let id = ref 1 in |
None -> (GuiCom.send (GetClient_files s.source_num)) |
635 |
insert_dir ft id () |
| Some ft -> |
636 |
end |
begin |
637 |
|
let id = ref 1 in |
638 |
|
insert_dir ft id () |
639 |
|
end |
640 |
|
with _ -> () |
641 |
|
end |
642 |
|
|
643 |
(*************************************************************************) |
(*************************************************************************) |
644 |
(* *) |
(* *) |
646 |
(* *) |
(* *) |
647 |
(*************************************************************************) |
(*************************************************************************) |
648 |
|
|
649 |
let on_double_click_friend (s : source_info) = |
let on_double_click_friend k = |
650 |
match !wnote_chat with |
try |
651 |
Some w when not (List.mem_assoc s.source_num !dialogs) -> |
let s = friend_of_key k in |
652 |
begin |
match !wnote_chat with |
653 |
let buffer = GuiTemplates.chat_buffer ~on_entry:(on_entry_return s.source_num) () in |
Some w when not (List.mem_assoc s.source_num !dialogs) -> |
654 |
let chat = GuiTemplates.chat_view ~buffer ~my_name:!G.client_name () in |
begin |
655 |
dialogs := (s.source_num, buffer) :: !dialogs; |
let buffer = GuiTemplates.chat_buffer ~on_entry:(on_entry_return s.source_num) () in |
656 |
add_chat w s chat |
let chat = GuiTemplates.chat_view ~buffer ~my_name:!G.client_name () in |
657 |
end |
dialogs := (s.source_num, buffer) :: !dialogs; |
658 |
| _ -> () |
add_chat w s chat |
659 |
|
end |
660 |
|
| _ -> () |
661 |
|
with _ -> () |
662 |
|
|
663 |
(*************************************************************************) |
(*************************************************************************) |
664 |
(* *) |
(* *) |
666 |
(* *) |
(* *) |
667 |
(*************************************************************************) |
(*************************************************************************) |
668 |
|
|
669 |
let filter_friend s = not ( |
let filter_friend k = |
670 |
List.memq s.source_network !G.networks_filtered |
try |
671 |
) |
let s = friend_of_key k in |
672 |
|
not (List.memq s.source_network !G.networks_filtered) |
673 |
|
with _ -> true |
674 |
|
|
675 |
(*************************************************************************) |
(*************************************************************************) |
676 |
(* *) |
(* *) |
678 |
(* *) |
(* *) |
679 |
(*************************************************************************) |
(*************************************************************************) |
680 |
|
|
681 |
let folder_menu (sel : g_file_tree list) = |
let folder_menu sel = |
682 |
match sel with |
match sel with |
683 |
[] -> [] |
[] -> [] |
684 |
| _ -> |
| _ -> |
692 |
(* *) |
(* *) |
693 |
(*************************************************************************) |
(*************************************************************************) |
694 |
|
|
695 |
let on_select_folder (sel : g_file_tree list) = |
let on_select_folder sel = |
696 |
resultstore#clear (); |
resultstore#clear (); |
697 |
update_results_label (); |
update_results_label (); |
698 |
match sel with |
match sel with |
699 |
[] -> () |
[] -> () |
700 |
| ft :: tail -> |
| k :: tail -> |
701 |
begin |
begin |
702 |
List.iter (fun tree_item -> |
try |
703 |
match tree_item with |
let ft = folder_of_key k in |
704 |
GTreeFile r -> ignore (resultstore#add_item r) |
List.iter (fun tree_item -> |
705 |
| _ -> () |
match tree_item with |
706 |
) ft.g_file_tree_list; |
GTreeFile r -> ignore (resultstore#add_item r) |
707 |
update_results_label () |
| _ -> () |
708 |
|
) ft.g_file_tree_list; |
709 |
|
update_results_label () |
710 |
|
with _ -> () |
711 |
end |
end |
712 |
|
|
713 |
(*************************************************************************) |
(*************************************************************************) |
716 |
(* *) |
(* *) |
717 |
(*************************************************************************) |
(*************************************************************************) |
718 |
|
|
719 |
let on_expanded_folder path (ft : g_file_tree) = |
let on_expanded_folder path k = |
720 |
let (row, _) = folderstore#find_item ft.g_file_tree_num in |
try |
721 |
let ft_new = {ft with g_file_tree_pixb = folder_opened ()} in |
let row = folderstore#find_row k in |
722 |
folderstore#update_item row ft ft_new |
let ft = folder_of_key k in |
723 |
|
let ft_new = {ft with g_file_tree_pixb = folder_opened ()} in |
724 |
|
folderstore#update_item row ft ft_new; |
725 |
|
ft.g_file_tree_pixb <- ft_new.g_file_tree_pixb |
726 |
|
with _ -> () |
727 |
|
|
728 |
(*************************************************************************) |
(*************************************************************************) |
729 |
(* *) |
(* *) |
731 |
(* *) |
(* *) |
732 |
(*************************************************************************) |
(*************************************************************************) |
733 |
|
|
734 |
let on_collapsed_folder path (ft : g_file_tree) = |
let on_collapsed_folder path k = |
735 |
let (row, _) = folderstore#find_item ft.g_file_tree_num in |
try |
736 |
let ft_new = {ft with g_file_tree_pixb = folder_closed ()} in |
let row = folderstore#find_row k in |
737 |
folderstore#update_item row ft ft_new |
let ft = folder_of_key k in |
738 |
|
let ft_new = {ft with g_file_tree_pixb = folder_closed ()} in |
739 |
|
folderstore#update_item row ft ft_new; |
740 |
|
ft.g_file_tree_pixb <- ft_new.g_file_tree_pixb |
741 |
|
with _ -> () |
742 |
|
|
743 |
(*************************************************************************) |
(*************************************************************************) |
744 |
(* *) |
(* *) |
772 |
in |
in |
773 |
dialogs := []; |
dialogs := []; |
774 |
source_has_file := []; |
source_has_file := []; |
775 |
|
H.clear ft_by_num; |
776 |
resultstore#clear (); |
resultstore#clear (); |
777 |
folderstore#clear (); |
folderstore#clear (); |
778 |
friendstore#clear (); |
friendstore#clear (); |
786 |
(*************************************************************************) |
(*************************************************************************) |
787 |
|
|
788 |
let remove_friend s = |
let remove_friend s = |
789 |
friendstore#remove_item s; |
friendstore#remove_item (friend_key s.source_num); |
790 |
update_friends_label (); |
update_friends_label (); |
791 |
if List.mem_assoc s.source_num !source_has_file |
if List.mem_assoc s.source_num !source_has_file |
792 |
then source_has_file := List.remove_assoc s.source_num !source_has_file |
then source_has_file := List.remove_assoc s.source_num !source_has_file |
793 |
|
|
794 |
let h_update_friend s_new = |
let h_update_friend s s_new = |
795 |
try |
try |
796 |
let (row, s) = friendstore#find_item s_new.source_num in |
let row = friendstore#find_row (friend_key s_new.source_num) in |
797 |
if client_browsed_tag land s_new.source_type = 0 |
if client_browsed_tag land s_new.source_type = 0 |
798 |
then remove_friend s |
then remove_friend s |
799 |
else friendstore#update_item row s s_new |
else friendstore#update_item row s s_new |
808 |
try |
try |
809 |
let r = Hashtbl.find G.results result_num in |
let r = Hashtbl.find G.results result_num in |
810 |
try |
try |
811 |
let (_, s_new) = friendstore#find_item source_num in |
let s = Hashtbl.find G.sources source_num in |
812 |
let tree = |
let tree = |
813 |
match s_new.source_files with |
match s.source_files with |
814 |
None -> {g_file_tree_num = 0; g_file_tree_list = []; g_file_tree_name = ""; g_file_tree_pixb = folder_closed ()} |
None -> {g_file_tree_num = 0; g_file_tree_list = []; g_file_tree_name = ""; g_file_tree_pixb = folder_closed ()} |
815 |
| Some tree -> { tree with g_file_tree_list = tree.g_file_tree_list } |
| Some tree -> {tree with g_file_tree_list = tree.g_file_tree_list } |
816 |
in |
in |
817 |
Mi.add_file tree dirname r; |
Mi.add_file tree dirname r; |
818 |
s_new.source_files <- Some tree; |
let s_new = {s with source_files = Some tree} in |
819 |
Hashtbl.remove G.results result_num; |
Hashtbl.remove G.results result_num; |
820 |
(if not (List.mem_assoc source_num !source_has_file) |
(if not (List.mem_assoc source_num !source_has_file) |
821 |
then source_has_file := (source_num, false) :: !source_has_file); |
then source_has_file := (source_num, false) :: !source_has_file); |
822 |
h_update_friend s_new; |
h_update_friend s s_new; |
823 |
|
s.source_files <- s_new.source_files; |
824 |
if not (List.assoc source_num !source_has_file) |
if not (List.assoc source_num !source_has_file) |
825 |
then begin |
then begin |
826 |
source_has_file := List.remove_assoc source_num !source_has_file; |
source_has_file := List.remove_assoc source_num !source_has_file; |