src/gtk/newgui/gui_friends.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 (** GUI for the lists of files. *)
  21
  22 open Printf2
  23 open Options
  24 open Gettext
  25 open CommonTypes
  26 open GuiTypes
  27 open Gui_types
  28 open Gui_columns
  29 open GMain
  30
  31 module M = Gui_messages
  32 module P = Gpattern
  33 module O = Gui_options
  34 module Mi = Gui_misc
  35 module G = Gui_global
  36
  37 let (!!) = Options.(!!)
  38
  39
  40 let string_color_of_state state =
  41   match state with
  42   | Connected_downloading _ -> M.fT_tx_downloading, Some !!O.color_downloading
  43   | Connected (-1)
  44   | Connected (-2) -> M.fT_tx_connected, Some !!O.color_connected
  45   | Connecting  -> M.fT_tx_connecting, Some !!O.color_connecting
  46   | NewHost -> M.fT_tx_new_host, None
  47   | Connected_initiating -> M.fT_tx_initiating, Some !!O.color_not_connected
  48   | Connected 0 -> M.fT_tx_queued, Some !!O.color_connected
  49   | Connected n -> Printf.sprintf Gui_messages.fT_tx_ranked n, Some !!O.color_connected
  50   | ServerFull -> "", None
  51   | NotConnected (_,n) ->
  52       if n = -1 then
  53         "", None
  54       else
  55       if n = 0 then
  56         M.fT_tx_queued_out,  Some !!O.color_not_connected
  57       else
  58       if n > 0 then
  59         Printf.sprintf Gui_messages.fT_tx_ranked_out n,  Some !!O.color_not_connected
  60       else
  61         Printf.sprintf Gui_messages.fT_tx_failed (- n - 1), Some !!O.color_not_connected
  62   | RemovedHost -> M.fT_tx_removed, Some !!O.color_not_connected
  63   | BlackListedHost -> M.fT_tx_black_listed, Some !!O.color_not_connected
  64
  65 let string_color_of_client friend_tab c =
  66   match c.gclient_files with
  67     Some _ when friend_tab ->
  68       M.fT_tx_files_listed, Some !!O.color_files_listed
  69   | _ -> string_color_of_state c.gclient_state
  70
  71 let shorten maxlen s =
  72   let len = String.length s in
  73   if len > maxlen then
  74     (String.sub s 0 (maxlen-3)) ^ "..."
  75   else if s = "" then
  76       "http://www.mldonkey.org/"
  77   else s
  78
  79 let state_pix state =
  80     match state with
  81         Connected_downloading _ -> O.gdk_pix M.o_xpm_downloading
  82       | Connecting  -> O.gdk_pix M.o_xpm_connect_m
  83       | NewHost -> O.gdk_pix M.o_xpm_connect_n
  84       | Connected_initiating -> O.gdk_pix M.o_xpm_connect_m
  85       | Connected n -> O.gdk_pix M.o_xpm_connect_y
  86       | ServerFull -> O.gdk_pix M.o_xpm_connect_n
  87       | NotConnected (_,n) -> O.gdk_pix M.o_xpm_connect_n
  88       | RemovedHost -> O.gdk_pix M.o_xpm_removedhost
  89       | BlackListedHost -> O.gdk_pix M.o_xpm_blacklistedhost
  90
  91 let client_pix c =
  92   state_pix c.client_state
  93
  94
  95 let type_pix t =
  96   if t land client_friend_tag <> 0 then O.gdk_pix M.o_xpm_friend_user else
  97   if t land client_contact_tag <> 0 then  O.gdk_pix M.o_xpm_contact_user else
  98     O.gdk_pix M.o_xpm_normal_user
  99
 100
 101 let get_friend_pix c =
 102   let pix1 = type_pix c.client_type in
 103   let pix2 = client_pix c in
 104   let pixmap = GDraw.pixmap ~width:32 ~height:16 ~mask:true
 105                  ~colormap:(Gdk.Color.get_system_colormap ()) ()
 106   in
 107   let mask = match pixmap#mask with Some m -> m | None -> assert false in
 108   let wmask = new GDraw.drawable mask in
 109   let _ = match  pix1#mask with
 110               Some m ->
 111                   let image = Gdk.Image.get m ~x:0 ~y:0 ~width:16 ~height:16 in
 112                   let pixel = Gdk.Color.pixel (GDraw.color `BLACK) in
 113                   for i = 0 to 15 do
 114                     for j = 0 to 15 do
 115                       let col =
 116                         if Gdk.Image.get_pixel image ~x:i ~y:j  = pixel then
 117                           `BLACK
 118                           else `WHITE
 119                       in
 120                       wmask#set_foreground col;
 121                       wmask#point ~x:i ~y:j
 122                     done
 123                   done
 124             | None -> ()
 125   in
 126   let _ = match  pix2#mask with
 127               Some m ->
 128                   let image = Gdk.Image.get m ~x:0 ~y:0 ~width:16 ~height:16 in
 129                   let pixel = Gdk.Color.pixel (GDraw.color `BLACK) in
 130                   for i = 0 to 15 do
 131                     for j = 0 to 15 do
 132                       let col =
 133                         if Gdk.Image.get_pixel image ~x:i ~y:j  = pixel then
 134                           `BLACK
 135                           else `WHITE
 136                       in
 137                       wmask#set_foreground col;
 138                       wmask#point ~x:(i + 16) ~y:j
 139                     done
 140                   done
 141             | None -> ()
 142   in
 143   pixmap#put_pixmap ~x:0 ~y:0 ~xsrc:0 ~ysrc:0 ~width:16 ~height:16 pix1#pixmap;
 144   pixmap#put_pixmap ~x:16 ~y:0 ~xsrc:0 ~ysrc:0 ~width:16 ~height:16 pix2#pixmap;
 145   pixmap
 146
 147
 148
 149 class dialog friend =
 150   object (self)
 151     inherit Gui_friends_base.dialog ()
 152
 153     val mutable name = friend.gclient_name
 154     method name =  name
 155     method friend = friend
 156     method num = friend.gclient_num
 157
 158     method send s =
 159       Gui_com.send (GuiProto.MessageToClient (friend.gclient_num, s))
 160
 161     method handle_message mes =
 162       wt_dialog#insert ~foreground: (Gui_misc.color_of_name name) name;
 163       wt_dialog#insert (" : "^mes^"\n");
 164       wt_dialog#set_position (wt_dialog#length - 1)
 165
 166     initializer
 167     let return () =
 168       let s = wt_input#get_chars 0 wt_input#length in
 169       let len = String.length s in
 170       let s2 =
 171         if len <= 0 then s
 172         else
 173         match s.[0] with
 174           '\n' -> String.sub s 1 (len - 1)
 175         | _ -> s
 176       in
 177       self#send s2;
 178       wt_dialog#insert
 179         ~foreground: (Gui_misc.color_of_name !Gui_options.client_name)
 180       !Gui_options.client_name;
 181       wt_dialog#insert (" : "^s2^"\n") ;
 182       wt_input#delete_text ~start: 0 ~stop: wt_input#length
 183
 184     in
 185     Okey.add wt_input ~mods: [] GdkKeysyms._Return return;
 186     Okey.add_list wt_input ~mods: [`CONTROL]
 187       [GdkKeysyms._c; GdkKeysyms._C]
 188       box#destroy;
 189     Okey.add_list wt_dialog ~mods: [`CONTROL]
 190       [GdkKeysyms._c; GdkKeysyms._C]
 191       box#destroy;
 192
 193 end
 194
 195
 196
 197 class box columns friend_tab =
 198   let titles = List.map Gui_columns.Client.string_of_column !!columns in
 199   object (self)
 200     inherit [gui_client_info] Gpattern.filtered_plist `EXTENDED titles true (fun c -> c.gclient_num) as pl
 201       inherit Gui_friends_base.box () as box
 202
 203     val mutable columns = columns
 204
 205     method filter = (fun _ -> false)
 206
 207     method set_list_bg bg font =
 208       let wlist = self#wlist in
 209       let style = wlist#misc#style#copy in
 210       style#set_base [ (`NORMAL, bg)];
 211       style#set_font font;
 212       wlist#misc#set_style style;
 213       wlist#set_row_height 18;
 214       wlist#columns_autosize ()
 215
 216     method set_columns l =
 217       columns <- l;
 218       self#set_titles (List.map Gui_columns.Client.string_of_column !!columns);
 219       self#update;
 220       self#set_list_bg (`NAME !!O.color_list_bg)
 221         (Gdk.Font.load_fontset !!O.font_list)
 222
 223     method column_menu  i =
 224       [
 225         `I (M.mAutosize, fun _ -> self#wlist#columns_autosize ());
 226         `I (M.mSort, self#resort_column i);
 227         `I (M.mRemove_column,
 228           (fun _ ->
 229               match !!columns with
 230                 _ :: _ :: _ ->
 231                                                       (let l = !!columns in
 232                     match List2.cut i l with
 233                       l1, _ :: l2 ->
 234                         columns =:= l1 @ l2;
 235                         self#set_columns columns
 236                     | _ -> ())
 237
 238
 239               | _ -> ()
 240           )
 241         );
 242         `M (M.mAdd_column_after, (
 243             List.map (fun (c,s,_) ->
 244                 (`I (s, (fun _ ->
 245                         let c1, c2 = List2.cut (i+1) !!columns in
 246                         columns =:= c1 @ [c] @ c2;
 247                         self#set_columns columns
 248                     )))
 249             ) Gui_columns.Client.column_strings));
 250         `M (M.mAdd_column_before, (
 251             List.map (fun (c,s,_) ->
 252                 (`I (s, (fun _ ->
 253                         let c1, c2 = List2.cut i !!columns in
 254                         columns =:= c1 @ [c] @ c2;
 255                         self#set_columns columns
 256                     )))
 257             ) Gui_columns.Client.column_strings));
 258       ]
 259
 260     method coerce = box#vbox#coerce
 261
 262     method compare_by_col col f1 f2 =
 263       match col with
 264         Col_client_name -> compare f1.gclient_name f2.gclient_name
 265       | Col_client_state -> compare f1.gclient_state f2.gclient_state
 266       | Col_client_kind -> compare f1.gclient_kind f2.gclient_kind
 267       | Col_client_network -> compare f1.gclient_network f2.gclient_network
 268       | Col_client_type -> compare f1.gclient_type f2.gclient_type
 269       | Col_client_rating -> compare f1.gclient_rating f2.gclient_rating
 270       | Col_client_connect_time -> compare f1.gclient_connect_time f2.gclient_connect_time
 271       | Col_client_software -> compare f1.gclient_software f2.gclient_software
 272       | Col_client_release -> compare f1.gclient_release f2.gclient_release
 273       | Col_client_emulemod -> compare f1.gclient_emulemod f2.gclient_emulemod
 274       | Col_client_downloaded -> compare f1.gclient_downloaded f2.gclient_downloaded
 275       | Col_client_uploaded -> compare f1.gclient_uploaded f2.gclient_uploaded
 276       | Col_client_upload -> compare f1.gclient_upload f2.gclient_upload
 277       | Col_client_sock_addr -> compare f1.gclient_sock_addr f2.gclient_sock_addr
 278
 279     method compare f1 f2 =
 280       let abs = if current_sort >= 0 then current_sort else - current_sort in
 281       let col =
 282         try List.nth !!columns (abs - 1)
 283         with _ -> Col_client_name
 284       in
 285       let res = self#compare_by_col col f1 f2 in
 286       res * current_sort
 287
 288     method content_by_col f col =
 289       match col with
 290         Col_client_name -> shorten !!O.max_client_name_len f.gclient_name
 291       | Col_client_state -> fst (string_color_of_client friend_tab f)
 292       | Col_client_type -> (let t =  f.gclient_type in
 293             if t land client_friend_tag <> 0 then M.fT_tx_friend else
 294             if t land client_contact_tag <> 0 then M.fT_tx_contact else
 295               M.fT_tx_normal)
 296       | Col_client_network -> Gui_global.network_name f.gclient_network
 297       | Col_client_kind -> (
 298           match f.gclient_kind with
 299             Known_location _ -> M.fT_tx_direct
 300           | _ -> "")
 301       | Col_client_rating -> string_of_int f.gclient_rating
 302       | Col_client_connect_time -> Date.time_to_string (f.gclient_connect_time) "long"
 303       | Col_client_software -> f.gclient_software
 304       | Col_client_release -> f.gclient_release
 305       | Col_client_emulemod -> f.gclient_emulemod
 306       | Col_client_downloaded -> Gui_misc.size_of_int64 f.gclient_downloaded
 307       | Col_client_uploaded -> Gui_misc.size_of_int64 f.gclient_uploaded
 308       | Col_client_upload -> (match f.gclient_upload with
 309                                  Some s -> s
 310                                | _ -> "")
 311       | Col_client_sock_addr -> f.gclient_sock_addr
 312
 313     method content f =
 314       let strings = List.map
 315           (fun col -> match col with
 316                Col_client_name ->
 317                  (match f.gclient_pixmap with
 318                      Some pixmap -> P.Pixtext (self#content_by_col f col, pixmap)
 319                    | _ -> P.String (self#content_by_col f col))
 320              | Col_client_network ->
 321                  (match f.gclient_net_pixmap with
 322                      Some pixmap -> P.Pixmap (pixmap)
 323                    | _ -> P.String (self#content_by_col f col))
 324              | _ -> P.String (self#content_by_col f col))
 325           !!columns
 326       in
 327       let col_opt =
 328         match snd (string_color_of_client friend_tab f) with
 329           None -> Some `BLACK
 330         | Some c -> Some (`NAME c)
 331       in
 332       (strings, col_opt)
 333
 334     method find_client num = self#find num
 335
 336     method set_tb_style tb =
 337         if Options.(!!) Gui_options.mini_toolbars then
 338           (wtool1#misc#hide (); wtool2#misc#show ()) else
 339           (wtool2#misc#hide (); wtool1#misc#show ());
 340       wtool1#set_style tb;
 341       wtool2#set_style tb
 342
 343     initializer
 344       box#vbox#pack ~expand: true pl#box
 345   end
 346
 347
 348 let is_filtered c =
 349   List.memq c.gclient_network !Gui_global.networks_filtered
 350
 351 class box_friends box_files friend_tab =
 352   object (self)
 353     inherit box O.friends_columns friend_tab
 354
 355     val mutable box_friends_is_visible = (false : bool)
 356     val mutable icons_are_used = (!!O.use_icons : bool)
 357
 358
 359     method filter = is_filtered
 360
 361     method filter_networks = self#refresh_filter
 362
 363     method remove () =
 364       List.iter
 365         (fun c -> Gui_com.send (GuiProto.RemoveFriend c.gclient_num))
 366       self#selection
 367
 368     method remove_all_friends () =
 369       self#clear;
 370       box_files#clear;
 371       Gui_com.send GuiProto.RemoveAllFriends
 372
 373     method find_friend () =
 374       match GToolbox.input_string (M.fT_wt_find_friend) (M.fT_lb_name)with
 375         None -> ()
 376       | Some s ->
 377           Gui_com.send (GuiProto.FindFriend s)
 378
 379     method on_select c =
 380       if c = List.hd (List.rev self#selection) then
 381         match c.gclient_files with
 382           None ->
 383 (*          lprintf "No file for friend %d" c.client_num; lprint_newline (); *)
 384             Gui_com.send (GuiProto.GetClient_files c.gclient_num)
 385
 386         |       Some tree ->
 387 (*          lprintf "%d files for friend %d" (List.length l) c.client_num;
 388           lprint_newline (); *)
 389             begin
 390               let (row, fi) = self#find_client c.gclient_num in
 391               let f = self#to_core_client fi in
 392               fi.gclient_pixmap <-
 393               if icons_are_used then
 394                 Some (get_friend_pix f)
 395               else None;
 396               self#update_row fi row;
 397               box_files#update_tree (Some tree)
 398             end
 399
 400     method on_deselect f =
 401 (* Printf.printf "Gui_friends on_deselect %d\n" f.gclient_num;
 402       flush stdout;*)
 403       box_files#update_tree None
 404
 405     val mutable on_double_click = (fun _ -> ())
 406
 407     method set_on_double_click f = on_double_click <- f
 408
 409     method on_double_click f = on_double_click f
 410
 411     method menu =
 412       match self#selection with
 413         [] -> [ `I (M.fT_me_find_friend, self#find_friend) ;
 414             `I (M.fT_me_remove_all_friends, self#remove_all_friends)]
 415       | _ -> [ `I (M.fT_me_find_friend, self#find_friend) ;
 416             `I (M.fT_me_remove, self#remove) ;
 417             `I (M.fT_me_remove_all_friends, self#remove_all_friends)]
 418
 419     method to_core_client c =
 420       {
 421         client_num = c.gclient_num;
 422         client_network = c.gclient_network;
 423         client_kind = c.gclient_kind;
 424         client_state = c.gclient_state;
 425         client_type = c.gclient_type;
 426         client_tags = c.gclient_tags;
 427         client_name = c.gclient_name;
 428         client_country_code = None;
 429         client_rating = c.gclient_rating;
 430         client_chat_port = 0;
 431         client_connect_time = c.gclient_connect_time;
 432         client_software = c.gclient_software;
 433         client_os = None;
 434         client_release = c.gclient_release;
 435         client_emulemod = c.gclient_emulemod;
 436         client_total_downloaded = c.gclient_downloaded;
 437         client_total_uploaded = c.gclient_uploaded;
 438         client_session_downloaded = 0L;
 439         client_session_uploaded = 0L;
 440         client_upload = c.gclient_upload;
 441         client_sui_verified = None;
 442         client_file_queue = [];
 443 (*        client_sock_addr = c.gclient_sock_addr;*)
 444       }
 445
 446     method to_gui_client c =
 447       {
 448         gclient_num = c.client_num;
 449         gclient_network = c.client_network;
 450         gclient_kind = c.client_kind;
 451         gclient_state = c.client_state;
 452         gclient_type = c.client_type;
 453         gclient_tags = c.client_tags;
 454         gclient_name = c.client_name;
 455         gclient_files = None;
 456         gclient_rating = c.client_rating;
 457         gclient_connect_time = (BasicSocket.last_time () - c.client_connect_time);
 458         gclient_software = c.client_software;
 459         gclient_release = c.client_release;
 460         gclient_emulemod = c.client_emulemod;
 461         gclient_downloaded = c.client_total_downloaded;
 462         gclient_uploaded = c.client_total_uploaded;
 463         gclient_upload = c.client_upload;
 464         gclient_sock_addr = string_of_kind c.client_kind;
 465         gclient_net_pixmap =
 466         if icons_are_used then
 467           Some (Gui_options.network_pix
 468               (Gui_global.network_name c.client_network))
 469         else None;
 470         gclient_pixmap =
 471         if icons_are_used then
 472           Some (get_friend_pix c)
 473         else None;
 474       }
 475
 476     method update_friend f_new =
 477       if (client_friend_tag lor client_contact_tag) land f_new.client_type = 0 then
 478         self#h_remove_friend f_new.client_num
 479       else
 480       try
 481         begin
 482           let (row, f) = self#find_client f_new.client_num in
 483           f.gclient_state <- f_new.client_state;
 484           f.gclient_type <- f_new.client_type;
 485           f.gclient_pixmap <-
 486             if icons_are_used then
 487               Some (get_friend_pix f_new)
 488               else None;
 489           f.gclient_name <- f_new.client_name;
 490           f.gclient_kind <- f_new.client_kind;
 491           (* added *)
 492           f.gclient_tags <- f_new.client_tags;
 493           f.gclient_rating <- f_new.client_rating;
 494           f.gclient_connect_time <-  (BasicSocket.last_time () - f_new.client_connect_time);
 495           f.gclient_software <- f_new.client_software;
 496           f.gclient_release <- f_new.client_release;
 497           f.gclient_emulemod <- f_new.client_emulemod;
 498           f.gclient_downloaded <- f_new.client_total_downloaded;
 499           f.gclient_uploaded <- f_new.client_total_uploaded;
 500           f.gclient_upload <- f_new.client_upload;
 501           f.gclient_sock_addr <- string_of_kind f_new.client_kind;
 502           if box_friends_is_visible then self#update_row f row
 503         end
 504       with
 505         Not_found ->
 506           let fi = self#to_gui_client f_new in
 507           self#add_item fi
 508
 509     method is_visible b =
 510       box_friends_is_visible <- b
 511
 512     method h_remove_friend num =
 513       try
 514         let (row, i) = self#find_client num in
 515         self#remove_item row i
 516       with
 517         Not_found -> ()
 518
 519     method update_friend_state (num, state) =
 520       try
 521         let (row, fi) = self#find_client num in
 522         fi.gclient_state <- state;
 523         fi.gclient_pixmap <-
 524         if icons_are_used then
 525           Some (get_friend_pix (self#to_core_client fi))
 526         else None;
 527         if box_friends_is_visible then self#update_row fi row
 528       with
 529         Not_found -> ()
 530
 531     method update_friend_type (num, friend_kind) =
 532       try
 533         let (row, fi) = self#find_client num in
 534         if (client_friend_tag lor client_contact_tag) land friend_kind = 0 then
 535           self#h_remove_friend num
 536           else begin
 537             fi.gclient_type <- friend_kind;
 538             fi.gclient_pixmap <-
 539             if icons_are_used then
 540               Some (get_friend_pix (self#to_core_client fi))
 541               else None;
 542             if box_friends_is_visible then self#update_row fi row
 543           end
 544       with
 545         Not_found -> ()
 546
 547     method add_friend_files (num , dirname, file_num) =
 548       try
 549         let file = Hashtbl.find G.results file_num in
 550           try
 551             let (_, c) = self#find_client num in
 552               try
 553                 let tree = match c.gclient_files with
 554                     None -> { file_tree_list = []; file_tree_name = "" }
 555                   | Some tree -> { tree with file_tree_list = tree.file_tree_list }
 556                 in
 557                 add_file tree dirname file;
 558                 c.gclient_files <- Some tree
 559               with _ ->
 560 (*                  lprintf "File already there"; lprint_newline (); *)
 561                   ()
 562             with _ ->
 563 (*                lprintf "Unknown client %d" num; lprint_newline (); *)
 564                 (* Gui_com.send (GuiProto.GetClient_info num); *)
 565                 ()
 566           with _ ->
 567 (*              lprintf "Unknown file %d" file_num;
 568               lprint_newline (); *)
 569               ()
 570
 571     method update_icons b =
 572       icons_are_used <- b;
 573       let (f, label, step) =
 574         if b then
 575           ((fun c ->
 576             c.gclient_net_pixmap <-
 577               Some (Gui_options.network_pix
 578                      (Gui_global.network_name c.gclient_network));
 579             c.gclient_pixmap <-
 580               Some (get_friend_pix (self#to_core_client c));
 581           ), M.pW_lb_friends_add_icons, 1)
 582           else
 583             ((fun c ->
 584               c.gclient_net_pixmap <- None;
 585               c.gclient_pixmap <- None;
 586             ), M.pW_lb_friends_remove_icons, 1)
 587       in
 588       Gui_options.generate_with_progress label self#get_all_items f step
 589
 590 end
 591
 592 let is_filtered2 c l b =
 593   if b
 594     then begin
 595       (List.memq c.gclient_network !G.networks_filtered)
 596     end else begin
 597       (List.memq c.gclient_network !G.networks_filtered) ||
 598       (List.memq c.gclient_num l)
 599     end
 600
 601 class box_list friend_tab =
 602   let vbox_list = GPack.vbox () in
 603
 604   object (self)
 605     inherit box O.file_locations_columns friend_tab as prebox
 606
 607     val mutable c_to_update = ([] : int list)
 608     val mutable current_uploaders = ([] : int list)
 609     val mutable current_pending_slots = ([] : int list)
 610     val mutable show_pending_slots = (false : bool)
 611
 612     val mutable icons_are_used = (!!O.use_icons : bool)
 613
 614     method filter c = is_filtered2 c current_pending_slots show_pending_slots
 615
 616     method coerce = vbox_list#coerce
 617
 618     method add_to_friends () =
 619       List.iter
 620         (fun c ->
 621           if c.gclient_name <> "" then
 622             Gui_com.send (GuiProto.AddClientFriend c.gclient_num))
 623       self#selection
 624
 625     method menu =
 626       match self#selection with
 627         [] -> []
 628       | _ -> [ `I (M.uT_me_add_to_friends, self#add_to_friends) ]
 629
 630     method to_core_client c =
 631       {
 632         client_num = c.gclient_num;
 633         client_network = c.gclient_network;
 634         client_kind = c.gclient_kind;
 635         client_state = c.gclient_state;
 636         client_type = c.gclient_type;
 637         client_tags = c.gclient_tags;
 638         client_name = c.gclient_name;
 639         client_country_code = None;
 640         client_rating = c.gclient_rating;
 641         client_chat_port = 0;
 642         client_connect_time = c.gclient_connect_time;
 643         client_software = c.gclient_software;
 644         client_os = None;
 645         client_release = c.gclient_release;
 646         client_emulemod = c.gclient_emulemod;
 647         client_total_downloaded = c.gclient_downloaded;
 648         client_total_uploaded = c.gclient_uploaded;
 649         client_session_downloaded = 0L;
 650         client_session_uploaded = 0L;
 651         client_upload = c.gclient_upload;
 652         client_sui_verified = None;
 653         client_file_queue = [];
 654 (*        client_sock_addr = string_of_kind c.gclient_kind; *)
 655       }
 656
 657     method to_gui_client c =
 658       {
 659         gclient_num = c.client_num;
 660         gclient_network = c.client_network;
 661         gclient_kind = c.client_kind;
 662         gclient_state = c.client_state;
 663         gclient_type = c.client_type;
 664         gclient_tags = c.client_tags;
 665         gclient_name = c.client_name;
 666         gclient_files = None;
 667         gclient_rating = c.client_rating;
 668         gclient_connect_time =  (BasicSocket.last_time () - c.client_connect_time);
 669         gclient_software = c.client_software;
 670         gclient_release = c.client_release;
 671         gclient_emulemod = c.client_emulemod;
 672         gclient_downloaded = c.client_total_downloaded;
 673         gclient_uploaded = c.client_total_uploaded;
 674         gclient_upload = c.client_upload;
 675         gclient_sock_addr = string_of_kind c.client_kind;
 676         gclient_net_pixmap =
 677           if icons_are_used then
 678             Some (Gui_options.network_pix (Gui_global.network_name c.client_network))
 679             else None;
 680         gclient_pixmap =
 681           if icons_are_used then
 682             Some (type_pix c.client_type)
 683             else None;
 684       }
 685
 686     (* the core does not treat client_downloaded & client_uploaded changes as event
 687     As a consequence to display correctly these values we need to ask the core to
 688     send them again. We will fill a list of clients to be updated. This list will be
 689     sent every 6 seconds *)
 690     method fill_c_to_update cnum =
 691       if not (List.mem cnum c_to_update) then
 692         c_to_update <- cnum::c_to_update
 693
 694     method send_and_flush =
 695       List.iter (fun num ->
 696         Gui_com.send (GuiProto.GetClient_info num)
 697       ) c_to_update;
 698       c_to_update <- []
 699
 700     method update_client c_new =
 701       let _ =
 702         match c_new.client_state with
 703             Connected_downloading _ -> self#fill_c_to_update c_new.client_num
 704           | _ -> ()
 705       in
 706       if (List.memq c_new.client_num current_uploaders) ||
 707          (List.memq c_new.client_num current_pending_slots)
 708         then begin
 709           try
 710                     let (row, c) = self#find_client c_new.client_num in
 711                     c.gclient_state <- c_new.client_state;
 712                     c.gclient_rating <- c_new.client_rating;
 713                     c.gclient_connect_time <- (BasicSocket.last_time () - c_new.client_connect_time);
 714                     c.gclient_name <- c_new.client_name;
 715                     c.gclient_kind <- c_new.client_kind;
 716                     c.gclient_tags <- c_new.client_tags;
 717                     c.gclient_software <- c_new.client_software;
 718                     c.gclient_downloaded <- c_new.client_total_downloaded;
 719                     c.gclient_emulemod <- c_new.client_emulemod;
 720                     c.gclient_uploaded <- c_new.client_total_uploaded;
 721                     c.gclient_upload <- c_new.client_upload;
 722                     c.gclient_sock_addr <- string_of_kind c_new.client_kind;
 723             (if icons_are_used && (c.gclient_type <> c_new.client_type)
 724                then c.gclient_pixmap <- Some (type_pix c_new.client_type));
 725                     c.gclient_type <- c_new.client_type;
 726                     self#refresh_item row c;
 727                   with Not_found -> (
 728                     let ci = self#to_gui_client c_new in
 729                     self#add_item ci)
 730         end else begin
 731           try
 732              let (row, c) = self#find_client c_new.client_num in
 733              self#remove_item row c
 734             with _ -> ()
 735         end
 736
 737     method update_client_state (num, state) =
 738       let _ =
 739         match state with
 740             Connected_downloading _ -> self#fill_c_to_update num
 741           | _ -> ()
 742       in
 743       if (List.memq num current_uploaders) ||
 744          (List.memq num current_pending_slots)
 745         then begin
 746            try
 747              let (row, c) = self#find_client num in
 748              c.gclient_state <- state;
 749              self#refresh_item row c
 750           with _ -> self#fill_c_to_update num
 751         end else
 752           try
 753             let (row, c) = self#find_client num in
 754             self#remove_item row c
 755           with _ -> ()
 756
 757     method update_client_type (num, friend_kind) =
 758       try
 759         let (row, c) = self#find_client num in
 760         c.gclient_type <- friend_kind;
 761         c.gclient_pixmap <-
 762           if icons_are_used && (not (self#filter c)) then
 763             Some (type_pix c.gclient_type)
 764             else None;
 765         self#refresh_item row c
 766
 767       with Not_found -> ()
 768
 769     method clean_table clients =
 770       (* Printf.printf "Gui_friends Clean Table\n";
 771       flush stdout; *)
 772       let data = ref [] in
 773       List.iter (fun (c_num :int) ->
 774           try
 775             let row, c = self#find_client c_num in
 776             data := c :: !data
 777           with _ -> ()
 778       ) clients;
 779       self#reset_data !data
 780
 781     method update_uploaders l =
 782       current_uploaders <- l;
 783       List.iter (fun n ->
 784         self#fill_c_to_update n
 785       ) l
 786
 787     method update_pending_slots l =
 788       current_pending_slots <- l;
 789       List.iter (fun n ->
 790         self#fill_c_to_update n
 791       ) l
 792
 793     method show_pending_slots () =
 794       show_pending_slots <- not show_pending_slots;
 795       let l = self#get_all_items in
 796       self#reset_data l
 797
 798     method update_icons b =
 799       icons_are_used <- b;
 800       let (f, label, step) =
 801         if b then
 802           ((fun c ->
 803             if (not (self#filter c)) then
 804               begin
 805                 c.gclient_net_pixmap <-
 806                   Some (Gui_options.network_pix
 807                           (Gui_global.network_name c.gclient_network));
 808                 c.gclient_pixmap <-
 809                   Some (type_pix c.gclient_type)
 810               end
 811           ), M.pW_lb_uploads_add_icons, 1)
 812           else
 813             ((fun c ->
 814               c.gclient_net_pixmap <- None;
 815               c.gclient_pixmap <- None;
 816             ), M.pW_lb_uploads_remove_icons, 1)
 817       in
 818       Gui_options.generate_with_progress label self#get_all_items f step
 819
 820     initializer
 821
 822       label#set_text ( M.sT_lb_users);
 823       let style = evbox#misc#style#copy in
 824       style#set_bg [ (`NORMAL, (`NAME "#494949"))];
 825       evbox#misc#set_style style;
 826       let style = label#misc#style#copy in
 827       style#set_fg [ (`NORMAL, `WHITE)];
 828       label#misc#set_style style;
 829
 830       vbox_list#pack ~expand: true prebox#coerce;
 831       Gui_com.send (GuiProto.GetUploaders);
 832       Gui_com.send (GuiProto.GetPending);
 833
 834       ignore(Timeout.add ~ms:6000 ~callback:(fun _ ->
 835         Gui_com.send GuiProto.GetUploaders;
 836         Gui_com.send GuiProto.GetPending;
 837         if c_to_update <> [] then self#send_and_flush;
 838         true));
 839
 840       Gui_misc.insert_buttons wtool1 wtool2
 841         ~text: (M.uT_lb_show_pending_slots)
 842         ~tooltip: (M.uT_ti_show_pending_slots)
 843         ~icon: (M.o_xpm_view_pending_slots)
 844         ~callback: (self#show_pending_slots)
 845         ()
 846
 847   end
 848
 849
 850 class pane_friends () =
 851   let files = new Gui_results.box_dir_files () in
 852   let friends = new box_friends files true in
 853   let wnote_chat =
 854     GPack.notebook ~homogeneous_tabs:false ~show_border:true
 855       ~scrollable:true ~popup:false ()
 856   in
 857   object (self)
 858     (** The list of open chat dialogs *)
 859     val mutable dialogs = ([] : dialog list)
 860
 861     (** Remove the dialog with the given client num from the list of dialogs. *)
 862     method remove_dialog c_num =
 863       (
 864        try
 865          let d = List.find (fun d -> d#num = c_num) dialogs in
 866          dialogs <- List.filter (fun d -> not (d#num = c_num)) dialogs;
 867          let n = wnote_chat#page_num d#coerce in
 868          wnote_chat#remove_page n
 869        with
 870          Not_found ->
 871            ()
 872       );
 873
 874     (** Find the window and dialog with the given client. If
 875        it was not found, create it and add it to the list of dialogs.*)
 876     method get_dialog client =
 877       try
 878         let d = List.find
 879             (fun d -> d#num = client.gclient_num)
 880             dialogs
 881         in
 882         d#wt_input#misc#grab_focus ();
 883         d
 884       with
 885         Not_found ->
 886           let dialog = new dialog client in
 887           let hbox = GPack.hbox ~homogeneous:false ~spacing:5 () in
 888           let wl =
 889             GMisc.label ~text: client.gclient_name
 890               ~packing:(hbox#pack ~expand:true ~fill:true) ()
 891           in
 892           let hbox1 =
 893             GPack.hbox ~homogeneous:false
 894               ~packing:(hbox#pack ~expand:false ~fill:false) () in
 895           let button = GButton.button ~packing:(hbox1#pack ~expand:false ~fill:false) () in
 896           let close_pix =
 897             GMisc.pixmap (O.gdk_pix M.o_xpm_mini_close_search)
 898                 ~packing:(button#add) ()
 899           in
 900           ignore (button#connect#clicked ~callback:(fun _ -> dialog#box#destroy ()));
 901           wnote_chat#append_page ~tab_label: hbox#coerce dialog#coerce;
 902           ignore (dialog#box#connect#destroy
 903                     (fun () -> dialogs <- List.filter (fun d -> not (d#num = client.gclient_num)) dialogs));
 904           dialogs <- dialog :: dialogs;
 905           dialog#wt_input#misc#grab_focus ();
 906           dialog
 907
 908     inherit Gui_friends_base.paned ()
 909
 910     method box_friends = friends
 911     method box_files = files
 912     method hpaned = wpane
 913     method vpaned = wpane2
 914
 915     method is_visible b = friends#is_visible b
 916
 917     method h_add_friend_files (num , dirname, file_num) =
 918       friends#add_friend_files (num , dirname, file_num)
 919
 920     method h_update_friend_state (num, state) =
 921       friends#update_friend_state (num, state)
 922
 923     method h_update_friend_type (num, friend_kind) =
 924       friends#update_friend_type (num, friend_kind)
 925
 926     method h_update_friend c =
 927       friends#update_friend c
 928
 929     method c_update_icons b =
 930       friends#update_icons b ;
 931       files#c_update_icons b
 932
 933     method clear =
 934       files#clear ;
 935       friends#clear
 936
 937     method set_tb_style tb =
 938       files#set_tb_style tb ;
 939       friends#set_tb_style tb
 940
 941     method set_list_bg bg font =
 942       files#set_list_bg bg font;
 943       friends#set_list_bg bg font
 944
 945     initializer
 946
 947       friends#set_on_double_click (fun f -> ignore (self#get_dialog f));
 948
 949       wpane#add1 friends#coerce;
 950       vbox2#pack wnote_chat#coerce ~expand:true ~fill:true;
 951       wpane2#add1 files#coerce;
 952
 953       let style = evbox1#misc#style#copy in
 954       style#set_bg [ (`NORMAL, (`NAME "#494949"))];
 955       evbox1#misc#set_style style;
 956       let style = label#misc#style#copy in
 957       style#set_fg [ (`NORMAL, `WHITE)];
 958       label#misc#set_style style
 959
 960   end