/[mldonkey]/mldonkey/src/gtk2/gui/guiServers.ml
ViewVC logotype

Diff of /mldonkey/src/gtk2/gui/guiServers.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by spiralvoice, Tue Apr 26 11:02:21 2005 UTC revision 1.3 by spiralvoice, Mon Oct 31 18:34:02 2005 UTC
# Line 75  let (view_context : GPango.context optio Line 75  let (view_context : GPango.context optio
75    
76  (*************************************************************************)  (*************************************************************************)
77  (*                                                                       *)  (*                                                                       *)
78    (*                         server_num                                    *)
79    (*                                                                       *)
80    (*************************************************************************)
81    
82    let server_num key =
83      try int_of_string key with _ -> raise Not_found
84    
85    (*************************************************************************)
86    (*                                                                       *)
87    (*                         server_of_key                                 *)
88    (*                                                                       *)
89    (*************************************************************************)
90    
91    let server_of_key key =
92      try
93        let num = server_num key in
94        Hashtbl.find G.servers num
95      with _ -> raise Not_found
96    
97    (*************************************************************************)
98    (*                                                                       *)
99    (*                         keys_to_servers                               *)
100    (*                                                                       *)
101    (*************************************************************************)
102    
103    let keys_to_servers keys =
104      let l = ref [] in
105      List.iter (fun k ->
106        try
107          let s = server_of_key k in
108          l := s :: !l
109        with _ -> ()) keys;
110      !l
111    
112    (*************************************************************************)
113    (*                                                                       *)
114    (*                         server_key                                    *)
115    (*                                                                       *)
116    (*************************************************************************)
117    
118    let server_key server_num =
119      Printf.sprintf "%d" server_num
120    
121    (*************************************************************************)
122    (*                                                                       *)
123  (*                         Templates                                     *)  (*                         Templates                                     *)
124  (*                                                                       *)  (*                                                                       *)
125  (*************************************************************************)  (*************************************************************************)
# Line 95  module Servers = GuiTemplates.Gview(stru Line 140  module Servers = GuiTemplates.Gview(stru
140    module Column = GuiColumns.Server    module Column = GuiColumns.Server
141    
142    type item = server_info    type item = server_info
   type key = int  
143    
144    let columns = O.servers_columns    let columns = O.servers_columns
145    let get_key = (fun s -> s.server_num)    let get_key = (fun s -> server_key s.server_num)
146    let module_name = "Servers"    let module_name = "Servers"
147    
148  end)  end)
# Line 232  class g_server () = Line 276  class g_server () =
276                            (fun path name ->                            (fun path name ->
277                               try                               try
278                                 let iter = self#get_iter path in                                 let iter = self#get_iter path in
279                                 let s = self#get_item iter in                                 let k = self#find_model_key iter in
280                                 GuiCom.send (ServerRename (s.server_num, name));                                 let s = server_of_key k in
281                                   GuiCom.send (ServerRename (server_num k, name));
282                                 let row = self#convert_iter_to_child_iter iter in                                 let row = self#convert_iter_to_child_iter iter in
283                                 store#set ~row ~column:server_name s.server_name                                 store#set ~row ~column:server_name s.server_name
284                               with _ -> ()                               with _ -> ()
# Line 308  class g_server () = Line 353  class g_server () =
353               (fun path ->               (fun path ->
354                  try                  try
355                    let iter = self#get_iter path in                    let iter = self#get_iter path in
356                    let s = self#get_item iter in                    let k = self#find_key iter in
357                    GuiCom.send (ServerSetPreferred (s.server_num, not s.server_preferred));                    let s = server_of_key k in
358                      GuiCom.send (ServerSetPreferred (server_num k, not s.server_preferred));
359                    let row = self#convert_iter_to_child_iter iter in                    let row = self#convert_iter_to_child_iter iter in
360                    store#set ~row ~column:server_preferred s.server_preferred                    store#set ~row ~column:server_preferred s.server_preferred
361                  with _ -> ()                  with _ -> ()
# Line 322  class g_server () = Line 368  class g_server () =
368  (*                                                                       *)  (*                                                                       *)
369  (*************************************************************************)  (*************************************************************************)
370    
371    method sort_items c s1 s2 =    method sort_items c k1 k2 =
372      match c with      try
373          let s1 = server_of_key k1 in
374          let s2 = server_of_key k2 in
375          match c with
376          Col_server_address ->          Col_server_address ->
377            begin            begin
378              let i = compare s1.server_addr s2.server_addr in              let i = compare s1.server_addr s2.server_addr in
# Line 343  class g_server () = Line 392  class g_server () =
392                                     (String.lowercase s2.server_name)                                     (String.lowercase s2.server_name)
393        | Col_server_tags -> compare s1.server_tags s2.server_tags        | Col_server_tags -> compare s1.server_tags s2.server_tags
394        | Col_server_preferred -> compare s1.server_preferred s2.server_preferred        | Col_server_preferred -> compare s1.server_preferred s2.server_preferred
395      with _ -> 0
396    
397  (*************************************************************************)  (*************************************************************************)
398  (*                                                                       *)  (*                                                                       *)
# Line 351  class g_server () = Line 401  class g_server () =
401  (*************************************************************************)  (*************************************************************************)
402    
403      method force_update_icons () =      method force_update_icons () =
404        List.iter (fun s ->        List.iter (fun k ->
405          try          try
406            let (row, _) = self#find_item s.server_num in            let row = self#find_row k in
407              let s = server_of_key k in
408            store#set ~row ~column:server_network_pixb (Mi.network_pixb s.server_network ~size:A.SMALL ());            store#set ~row ~column:server_network_pixb (Mi.network_pixb s.server_network ~size:A.SMALL ());
409            store#set ~row ~column:server_state_pixb   (Mi.server_state_of_server s.server_network s.server_state ~size:A.SMALL)            store#set ~row ~column:server_state_pixb   (Mi.server_state_of_server s.server_network s.server_state ~size:A.SMALL)
410          with _ -> ()          with _ -> ()
# Line 409  let update_users_label () = Line 460  let update_users_label () =
460  (*************************************************************************)  (*************************************************************************)
461    
462  let remove sel () =  let remove sel () =
463      let l = keys_to_servers sel in
464    List.iter (fun s ->    List.iter (fun s ->
465      GuiCom.send (RemoveServer_query s.server_num)      GuiCom.send (RemoveServer_query s.server_num)
466    ) sel    ) l
467    
468  let connect_to sel () =  let connect_to sel () =
469      let l = keys_to_servers sel in
470    List.iter (fun s ->    List.iter (fun s ->
471      GuiCom.send (ConnectServer s.server_num)      GuiCom.send (ConnectServer s.server_num)
472    ) sel    ) l
473    
474  let disconnect sel () =  let disconnect sel () =
475      let l = keys_to_servers sel in
476    List.iter (fun s ->    List.iter (fun s ->
477      GuiCom.send (DisconnectServer s.server_num)      GuiCom.send (DisconnectServer s.server_num)
478    ) sel    ) l
479    
480  let view_users sel () =  let view_users sel () =
481      let l = keys_to_servers sel in
482    List.iter (fun s ->    List.iter (fun s ->
483      GuiCom.send (ViewUsers s.server_num)      GuiCom.send (ViewUsers s.server_num)
484    ) sel    ) l
485    
486  let add_new_server entry_addr entry_port () =  let add_new_server entry_addr entry_port () =
487    try    try
# Line 443  let remove_old_servers () = Line 498  let remove_old_servers () =
498    GuiCom.send CleanOldServers    GuiCom.send CleanOldServers
499    
500  let clear_users sel () =  let clear_users sel () =
501      let l = keys_to_servers sel in
502    List.iter (fun s ->    List.iter (fun s ->
503      match s.server_users with      match s.server_users with
504          None -> ()          None -> ()
# Line 451  let clear_users sel () = Line 507  let clear_users sel () =
507              List.iter (fun user_num ->              List.iter (fun user_num ->
508                Hashtbl.remove G.users user_num                Hashtbl.remove G.users user_num
509              ) l;              ) l;
510              let (row, s) = serverstore#find_item s.server_num in              s.server_users <- None
             serverstore#update_item row s {s with server_users = None}  
511            end            end
512    ) sel;    ) l;
513    userstore#clear (); (* if we call clear_users there is a good chance that some users are currently displaied *)    userstore#clear (); (* if we call clear_users there is a good chance that some users are currently displaied *)
514    update_users_label ()    update_users_label ()
515    
# Line 462  let get_user_info user_num = Line 517  let get_user_info user_num =
517    GuiCom.send (GetUser_info user_num)    GuiCom.send (GetUser_info user_num)
518    
519  let server_set_preferred sel b () =  let server_set_preferred sel b () =
520      let l = keys_to_servers sel in
521    List.iter (fun s ->    List.iter (fun s ->
522      GuiCom.send (ServerSetPreferred (s.server_num, b))      GuiCom.send (ServerSetPreferred (s.server_num, b))
523    ) sel    ) l
524    
525  let server_rename s name () =  let server_rename s name () =
526    GuiCom.send (ServerRename (s.server_num, name))    GuiCom.send (ServerRename (s.server_num, name))
# Line 475  let server_rename s name () = Line 531  let server_rename s name () =
531  (*                                                                       *)  (*                                                                       *)
532  (*************************************************************************)  (*************************************************************************)
533    
534  let server_menu (sel : server_info list) =  let server_menu sel =
535    let l =    let l =
536      match sel with      match sel with
537          [] -> []          [] -> []
# Line 501  let server_menu (sel : server_info list) Line 557  let server_menu (sel : server_info list)
557  (*                                                                       *)  (*                                                                       *)
558  (*************************************************************************)  (*************************************************************************)
559    
560  let on_select_server (sel : server_info list) =  let on_select_server sel =
561    userstore#clear ();    userstore#clear ();
562    update_users_label ();    update_users_label ();
563    match sel with    match sel with
564        [] -> ()        [] -> ()
565      | s :: tail ->      | k :: tail ->
566          begin          begin
567            match s.server_users with            try
568                None -> (if !!verbose then lprintf' "No user for server %s\n" s.server_name)              let s = server_of_key k in
569                match s.server_users with
570              | Some l ->                  None -> (if !!verbose then lprintf' "No user for server %s\n" s.server_name)
571                  begin                | Some l ->
572                    List.iter (fun user_num ->                    begin
573                      try                      List.iter (fun user_num ->
574                        (if !!verbose then lprintf' "Add user %d to list of server %s\n" user_num s.server_name);                        try
575                        let u = Hashtbl.find G.users user_num in                          (if !!verbose then lprintf' "Add user %d to list of server %s\n" user_num s.server_name);
576                        ignore (userstore#add_item u)                          let u = Hashtbl.find G.users user_num in
577                      with _ -> get_user_info user_num                          ignore (userstore#add_item u)
578                    ) l;                        with _ -> get_user_info user_num
579                    update_users_label ()                      ) l;
580                  end                      update_users_label ()
581                      end
582              with _ -> ()
583          end          end
584    
585  (*************************************************************************)  (*************************************************************************)
# Line 532  let on_select_server (sel : server_info Line 590  let on_select_server (sel : server_info
590    
591  let filter_disconnected_servers = ref false  let filter_disconnected_servers = ref false
592    
593  let filter_server s = not (  let filter_server k =
594    (!filter_disconnected_servers && (match s.server_state with    try
595          NotConnected _      let s = server_of_key k in
596        | NewHost -> true | _ -> false)) ||      not ((!filter_disconnected_servers &&
597    List.memq s.server_network !G.networks_filtered             (match s.server_state with
598    )                  NotConnected _
599                  | NewHost -> true | _ -> false)) ||
600             List.memq s.server_network !G.networks_filtered)
601      with _ -> true
602    
603  (*************************************************************************)  (*************************************************************************)
604  (*                                                                       *)  (*                                                                       *)
# Line 568  let clear () = Line 629  let clear () =
629  (*                                                                       *)  (*                                                                       *)
630  (*************************************************************************)  (*************************************************************************)
631    
632    let hashtbl_server_update s s_new =
633      s.server_addr <- s_new.server_addr;
634      s.server_port <- s_new.server_port;
635      s.server_realport <- s_new.server_realport;
636      s.server_score <- s_new.server_score;
637      s.server_tags <- s_new.server_tags;
638      s.server_nusers <- s_new.server_nusers;
639      s.server_nfiles <- s_new.server_nfiles;
640      s.server_state <- s_new.server_state;
641      s.server_name <- s_new.server_name;
642      s.server_description <- s_new.server_description;
643      s.server_users <- s_new.server_users;
644      s.server_banner <- s_new.server_banner;
645      s.server_preferred <- s_new.server_preferred
646    
647  let remove_server server_num =  let remove_server server_num =
648    try    try
649      let (_, s) = serverstore#find_item server_num in      let s = Hashtbl.find G.servers server_num in
650      let _ =      let _ =
651        match s.server_users with        match s.server_users with
652            None -> ()            None -> ()
# Line 579  let remove_server server_num = Line 655  let remove_server server_num =
655                Hashtbl.remove G.users user_num                Hashtbl.remove G.users user_num
656              ) l              ) l
657      in      in
658      serverstore#remove_item s;      Hashtbl.remove G.servers server_num;
659        serverstore#remove_item (server_key server_num);
660      decr G.nservers;      decr G.nservers;
661      update_servers_labels ()      update_servers_labels ()
662    with _ -> ()    with _ -> ()
663    
664  let update_server serv =  let update_server serv =
665    try    try
666      let (row, s) = serverstore#find_item serv.server_num in      let s = Hashtbl.find G.servers serv.server_num in
667        let row = serverstore#find_row (server_key serv.server_num) in
668      let s_new = {serv with server_users = s.server_users} in      let s_new = {serv with server_users = s.server_users} in
669      let _ =      let _ =
670        match Mi.is_connected s_new.server_state, Mi.is_connected s.server_state with        match Mi.is_connected s_new.server_state, Mi.is_connected s.server_state with
# Line 595  let update_server serv = Line 673  let update_server serv =
673          | _ -> ()          | _ -> ()
674      in      in
675      serverstore#update_item row s s_new;      serverstore#update_item row s s_new;
676        hashtbl_server_update s s_new;
677      update_servers_labels ()      update_servers_labels ()
678    with Not_found ->    with Not_found ->
679      begin      begin
# Line 604  let update_server serv = Line 683  let update_server serv =
683            incr G.nconnected_servers            incr G.nconnected_servers
684          end;          end;
685        incr G.nservers;        incr G.nservers;
686          Hashtbl.add G.servers serv.server_num serv;
687        update_servers_labels ()        update_servers_labels ()
688      end      end
689    
# Line 615  let server_info s = Line 695  let server_info s =
695      | _  ->      | _  ->
696          update_server s          update_server s
697    
698  let h_server_update_state num state =  let h_server_update_state server_num state =
699    try    try
700      let (row, s) = serverstore#find_item num in      let s = Hashtbl.find G.servers server_num in
701        let row = serverstore#find_row (server_key server_num) in
702      if state = RemovedHost      if state = RemovedHost
703        then remove_server s.server_num        then remove_server server_num
704        else begin        else begin
705          let s_new = {s with server_state = state} in          let s_new = {s with server_state = state} in
706          let _ =          let _ =
# Line 629  let h_server_update_state num state = Line 710  let h_server_update_state num state =
710              | _ -> ()              | _ -> ()
711          in          in
712          serverstore#update_item row s s_new;          serverstore#update_item row s s_new;
713            s.server_state <- s_new.server_state;
714          update_servers_labels ()          update_servers_labels ()
715        end        end
716    
717    with Not_found -> GuiCom.send (GetServer_info num)    with Not_found -> GuiCom.send (GetServer_info server_num)
718        
719  let h_server_busy num nusers nfiles =  let h_server_busy server_num nusers nfiles =
720    try    try
721      let (row, s) = serverstore#find_item num in      let s = Hashtbl.find G.servers server_num in
722        let row = serverstore#find_row (server_key server_num) in
723      let s_new = {s with server_nusers = nusers;      let s_new = {s with server_nusers = nusers;
724                          server_nfiles = nfiles}                          server_nfiles = nfiles}
725      in      in
726      serverstore#update_item row s s_new      serverstore#update_item row s s_new;
727        s.server_nusers <- s_new.server_nusers;
728    with Not_found -> GuiCom.send (GetServer_info num)      s.server_nfiles <- s_new.server_nfiles
729      with Not_found -> GuiCom.send (GetServer_info server_num)
730    
731  let h_server_update_users num user =  let h_server_update_users server_num user =
732    try    try
733      let (row, s) = serverstore#find_item num in      let s = Hashtbl.find G.servers server_num in
734        let row = serverstore#find_row (server_key server_num) in
735      match s.server_users with      match s.server_users with
736          None ->          None ->
737            begin            begin
738              let s_new = {s with server_users = Some [user]} in              s.server_users <- Some [user]
             serverstore#update_item row s s_new  
739            end            end
740        | Some list ->        | Some list ->
741            if not (List.mem user list)            if not (List.mem user list)
742              then begin              then begin
743                let s_new = {s with server_users = Some (user :: list)} in                s.server_users <- Some (user :: list)
               serverstore#update_item row s s_new  
744              end              end
745    
746    with Not_found ->    with Not_found ->
747      if num <> 0      if server_num <> 0
748        then begin        then begin
749          Hashtbl.remove G.users num;       (* Anyway remove the user. Will be sent back by the core *)          Hashtbl.remove G.users user;       (* Anyway remove the user. Will be sent back by the core *)
750          GuiCom.send (GetServer_info num);          GuiCom.send (GetServer_info server_num);
751          GuiCom.send (GetServer_users num)          GuiCom.send (GetServer_users server_num)
752        end        end
753    
754  let clean_servers_table servers =  let clean_servers_table servers =
755    let l = serverstore#all_items () in    let l = serverstore#all_items () in
756    (if !!verbose then lprintf' "Cleaning servers\n   servers table : %d\n   new servers   : %d\n"    (if !!verbose then lprintf' "Cleaning servers\n   servers table : %d\n   new servers   : %d\n"
757       (List.length l) (List.length servers));       (List.length l) (List.length servers));
758    List.iter (fun s ->                                              (* the core sends more servers than what the GUI displays.    List.iter (fun k ->                                              (* the core sends more servers than what the GUI displays.
759                                                                      * better to do it this way.                                                                      * better to do it this way.
760                                                                      *)                                                                      *)
761      if not (List.mem s.server_num servers)      try
762        then remove_server s.server_num        let s = server_of_key k in
763          if not (List.mem s.server_num servers)
764            then remove_server s.server_num
765        with _ -> ()
766    ) l;    ) l;
767    if !!verbose    if !!verbose
768      then begin      then begin
# Line 690  let clean_servers_table servers = Line 776  let clean_servers_table servers =
776  (*                                                                       *)  (*                                                                       *)
777  (*************************************************************************)  (*************************************************************************)
778    
779  let clean_servers num net_enabled =  let clean_servers net_num net_enabled =
780    if not net_enabled    if not net_enabled
781      then begin      then begin
782        let l = serverstore#all_items () in        let l = serverstore#all_items () in
783        List.iter (fun s ->        List.iter (fun k ->
784          if s.server_network = num          try
785            then remove_server s.server_num            let s = server_of_key k in
786              if s.server_network = net_num
787                then remove_server s.server_num
788            with _ -> ()
789        ) l        ) l
790      end      end
791    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26