src/gtk/newgui/gui_uploads.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 (** The box with uploads info *)
  21 open Printf2
  22 open Options
  23 open Md4
  24 open GMain
  25
  26 open Gettext
  27 open CommonTypes
  28 open GuiTypes
  29 open GuiProto
  30
  31
  32 module M = Gui_messages
  33 module P = Gpattern
  34 module O = Gui_options
  35 module C = Gui_columns
  36
  37 let (!!) = Options.(!!)
  38
  39 class box columns () =
  40   object (self)
  41     inherit [GuiTypes.shared_info] Gpattern.plist `SINGLE
  42       (List.map C.Shared_files_up.string_of_column !!columns)
  43     true  (fun si -> si.shared_num) as pl
  44
  45     (*  inherit Gui_uploads_base.box () *)
  46
  47     val mutable clipboard = ""
  48     val mutable columns = columns
  49
  50     method set_list_bg bg font =
  51       let wlist = self#wlist in
  52       let style = wlist#misc#style#copy in
  53       style#set_base [ (`NORMAL, bg)];
  54       style#set_font font;
  55       wlist#misc#set_style style;
  56       wlist#columns_autosize ()
  57
  58     method set_columns l =
  59       columns <- l;
  60       self#set_titles
  61         (List.map C.Shared_files_up.string_of_column !!columns);
  62       self#update;
  63       self#set_list_bg (`NAME !!O.color_list_bg) (Gdk.Font.load_fontset !!O.font_list)
  64
  65     method column_menu  i =
  66       [
  67         `I (M.mAutosize, fun _ -> self#wlist#columns_autosize ());
  68         `I (M.mSort, self#resort_column i);
  69         `I (M.mRemove_column,
  70           (fun _ ->
  71               match !!columns with
  72                 _ :: _ :: _ ->
  73
  74                   (let l = !!columns in
  75                     match List2.cut i l with
  76                       l1, _ :: l2 ->
  77                         columns =:= l1 @ l2;
  78                         self#set_columns columns
  79                     | _ -> ())
  80               | _ -> ()
  81           )
  82         );
  83         `M (M.mAdd_column_after, (
  84             List.map (fun (c,s,_) ->
  85                 (`I (s, (fun _ ->
  86                         let c1, c2 = List2.cut (i+1) !!columns in
  87                         columns =:= c1 @ [c] @ c2;
  88                         self#set_columns columns
  89                     )))
  90             ) Gui_columns.Shared_files_up.column_strings));
  91         `M (M.mAdd_column_before, (
  92             List.map (fun (c,s,_) ->
  93                 (`I (s, (fun _ ->
  94                         let c1, c2 = List2.cut i !!columns in
  95                         columns =:= c1 @ [c] @ c2;
  96                         self#set_columns columns
  97                     )))
  98             ) Gui_columns.Shared_files_up.column_strings));
  99       ];
 100
 101     (* method box = wf_upstats#coerce *)
 102
 103     method compare_by_col col si1 si2 =
 104       match col with
 105         C.Col_shared_file ->
 106           compare si1.shared_filename si2.shared_filename
 107       | C.Col_shared_requests ->
 108           compare si1.shared_requests si2.shared_requests
 109       | C.Col_shared_upsize ->
 110           compare si1.shared_uploaded si2.shared_uploaded
 111       | C.Col_shared_size ->
 112           compare si1.shared_size si2.shared_size
 113
 114     method compare si1 si2 =
 115       let abs = if current_sort >= 0 then current_sort else - current_sort in
 116       let col =
 117         try List.nth !!columns (abs - 1)
 118         with _ -> C.Col_shared_file
 119       in
 120       let res = self#compare_by_col col si1 si2 in
 121       current_sort * res
 122
 123     method content_by_col si col =
 124       match col with
 125         C.Col_shared_file -> si.shared_filename
 126       | C.Col_shared_requests -> string_of_int si.shared_requests
 127       | C.Col_shared_upsize ->
 128           Gui_misc.size_of_int64 si.shared_uploaded
 129       | C.Col_shared_size ->
 130           Gui_misc.size_of_int64 si.shared_size
 131
 132     method content si =
 133       let strings = List.map
 134           (fun col -> P.String (self#content_by_col si col))
 135         !!columns
 136       in
 137       (strings, None)
 138
 139     method menu =
 140
 141 (* fuck the object oriented style: how do I copy something to the
 142 console ???? *)
 143
 144       let copy_ed2k_links list _ =
 145         let buf = Buffer.create 100 in
 146         List.iter (fun s ->
 147     match s.shared_uids with
 148         uid :: _ -> (
 149           match (Uid.to_uid uid) with
 150               Ed2k md4 ->
 151                 begin
 152                   let link = Printf.sprintf "ed2k://|file|%s|%Ld|%s|"
 153                              (Url.encode (Filename.basename s.shared_filename))
 154                              s.shared_size
 155                              (Md4.to_string md4)
 156                   in
 157                   Printf.bprintf buf "%s\n" link;
 158                 end
 159             | _ -> ())
 160
 161       | _ -> ()
 162         ) list;
 163         let link = Buffer.contents buf in
 164         !Gui_global.console_message link;
 165         clipboard <- link;
 166
 167 (*
 168         ignore (self#misc#grab_selection `PRIMARY);
 169         self#misc#add_selection_target ~target:"string" `PRIMARY;
 170         ignore (self#misc#connect#selection_get (fun sel ~info ~time ->
 171               lprintf "request selection"; lprint_newline ();
 172               sel#return clipboard
 173           ));
 174         ignore (self#event#connect#selection_clear (fun sel ~info ~time ->
 175               lprintf "request selection"; lprint_newline ();
 176               sel#return clipboard
 177           ));
 178 *)
 179       in
 180       match self#selection with
 181         [] -> []
 182       | list ->
 183           [ `I ((M.uT_me_copy_ed2k), copy_ed2k_links list)
 184           ]
 185
 186     method find_file num = self#find num
 187
 188     method h_shared_file_info si =
 189       try
 190         let _,s_old = self#find_file si.shared_num in
 191         s_old.shared_filename <- si.shared_filename
 192       with Not_found ->
 193           self#add_item si
 194
 195     method h_shared_file_upload num upsize requests =
 196       try
 197         let (row, si) = self#find_file num in
 198         si.shared_uploaded <- upsize;
 199         si.shared_requests <- requests ;
 200         self#update_row si row
 201       with
 202         Not_found ->
 203           lprintf "Shared file %d not found" num; lprint_newline ();
 204 (*
 205     initializer
 206       wf_upstats#add pl#box;
 207 *)
 208
 209 end
 210
 211 let refresh_timerID =
 212   ref (Timeout.add ~ms:2000
 213         ~callback:(fun _ -> true))
 214
 215 class upstats_box () =
 216   let wl_status = GMisc.label ~text: "" ~show: true () in
 217   let upstats = new box O.shared_files_up_columns () in
 218   let uploaders = new Gui_friends.box_list false in
 219   object (self)
 220     inherit Gui_uploads_base.upstats_box () as upsb
 221
 222     method wl_status = wl_status
 223     method box = upsb#vbox
 224     method box_upstats = upstats
 225     method box_uploaders = uploaders
 226
 227     method set_list_bg bg font =
 228       upstats#set_list_bg bg font;
 229       uploaders#set_list_bg bg font
 230
 231     method clear =
 232       wl_status#set_text "";
 233       upstats#clear ;
 234       uploaders#clear
 235
 236     method h_update_client c =
 237       uploaders#update_client c
 238
 239     method h_update_client_state (num , state) =
 240       uploaders#update_client_state (num , state)
 241
 242     method h_update_client_type (num , friend_kind) =
 243       uploaders#update_client_type (num , friend_kind)
 244
 245     method clean_table clients =
 246       uploaders#clean_table clients
 247
 248     method h_update_uploaders l =
 249       uploaders#update_uploaders l
 250
 251     method h_update_pending_slots l =
 252       uploaders#update_pending_slots l
 253
 254     method refresh () =
 255       Gui_com.send GuiProto.RefreshUploadStats
 256
 257     method h_shared_file_info =
 258       upstats#h_shared_file_info
 259
 260     method h_shared_file_upload =
 261       upstats#h_shared_file_upload
 262
 263     method c_update_icons b =
 264       uploaders#update_icons b
 265
 266     method set_tb_style tb =
 267       uploaders#set_tb_style tb;
 268       if Options.(!!) Gui_options.mini_toolbars then
 269         (wtool1#misc#hide (); wtool2#misc#show ()) else
 270         (wtool2#misc#hide (); wtool1#misc#show ());
 271       wtool1#set_style tb;
 272       wtool2#set_style tb
 273
 274     (* we add a timer to refresh automatically the shared files rows
 275     when the uploads tab is visible. This will relief the
 276     user to do it : IMHO it is annoying. *)
 277     method is_visible b =
 278       if b then begin
 279         self#refresh ();
 280         refresh_timerID :=
 281           (Timeout.add ~ms:6000
 282              ~callback:(fun _ ->
 283                self#refresh ();
 284                true))
 285         end else
 286           Timeout.remove (!refresh_timerID)
 287
 288     initializer
 289
 290       vpaned#add1 upstats#box;
 291       hbox_uploaders#add uploaders#coerce;
 292
 293       let style = evbox1#misc#style#copy in
 294       style#set_bg [ (`NORMAL, (`NAME "#494949"))];
 295       evbox1#misc#set_style style;
 296       let style = label_shared_files#misc#style#copy in
 297       style#set_fg [ (`NORMAL, `WHITE)];
 298       label_shared_files#misc#set_style style;
 299
 300       Gui_misc.insert_buttons wtool1 wtool2
 301         ~text: (M.uT_lb_add_shared_directory)
 302         ~tooltip: (M.uT_ti_add_shared_directory)
 303         ~icon: M.o_xpm_add_shared_directory
 304         ~callback: (fun _ ->
 305           let module C = Configwin in
 306           let prio = ref 0 in
 307           let dir = ref "" in
 308           let params = [
 309               C.string ~f: (fun p -> prio := int_of_string(p)) (M.uT_lb_priority) "0";
 310               C.filename ~f: (fun d -> dir := d) (M.uT_lb_directory) ""]
 311           in
 312           match C.simple_edit (M.uT_wt_add_new_directory)
 313                    ~with_apply:false
 314                    params with
 315             C.Return_apply ->
 316               if !dir <> "" && !dir <> "/" then
 317                 Gui_com.send (Command (Printf.sprintf "share %d '%s'" !prio !dir))
 318           | C.Return_ok -> ()
 319           | C.Return_cancel -> ()
 320       )
 321       ()
 322
 323
 324   end