src/gtk/gui/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
  25 open Gettext
  26 open CommonTypes
  27 open GuiTypes
  28 open GuiProto
  29
  30
  31 module M = Gui_messages
  32 module P = Gpattern
  33 module O = Gui_options
  34 module C = Gui_columns
  35
  36 let (!!) = Options.(!!)
  37
  38
  39
  40 class box columns () =
  41   object (self)
  42     inherit [GuiTypes.shared_info] Gpattern.plist `SINGLE
  43       (List.map C.Shared_files_up.string_of_column !!columns)
  44     true  (fun si -> si.shared_num) as pl
  45       inherit Gui_uploads_base.box ()
  46
  47     val mutable clipboard = ""
  48     val mutable columns = columns
  49     method set_columns l =
  50       columns <- l;
  51       self#set_titles
  52         (List.map C.Shared_files_up.string_of_column !!columns);
  53       self#update
  54
  55     method column_menu  i =
  56       [
  57         `I ("Autosize", fun _ -> self#wlist#columns_autosize ());
  58         `I ("Sort", self#resort_column i);
  59         `I ("Remove Column",
  60           (fun _ ->
  61               match !!columns with
  62                 _ :: _ :: _ ->
  63
  64                   (let l = !!columns in
  65                     match List2.cut i l with
  66                       l1, _ :: l2 ->
  67                         columns =:= l1 @ l2;
  68                         self#set_columns columns
  69                     | _ -> ())
  70               | _ -> ()
  71           )
  72         );
  73         `M ("Add Column After", (
  74             List.map (fun (c,s) ->
  75                 (`I (s, (fun _ ->
  76                         let c1, c2 = List2.cut (i+1) !!columns in
  77                         columns =:= c1 @ [c] @ c2;
  78                         self#set_columns columns
  79                     )))
  80             ) Gui_columns.Shared_files_up.column_strings));
  81         `M ("Add Column Before", (
  82             List.map (fun (c,s) ->
  83                 (`I (s, (fun _ ->
  84                         let c1, c2 = List2.cut i !!columns in
  85                         columns =:= c1 @ [c] @ c2;
  86                         self#set_columns columns
  87                     )))
  88             ) Gui_columns.Shared_files_up.column_strings));
  89       ]
  90
  91     method box = wf_upstats#coerce
  92
  93     method compare_by_col col si1 si2 =
  94       match col with
  95         C.Col_shared_file ->
  96           compare si1.shared_filename si2.shared_filename
  97       | C.Col_shared_requests ->
  98           compare si1.shared_requests si2.shared_requests
  99       | C.Col_shared_upsize ->
 100           compare si1.shared_uploaded si2.shared_uploaded
 101       | C.Col_shared_size ->
 102           compare si1.shared_size si2.shared_size
 103
 104     method compare si1 si2 =
 105       let abs = if current_sort >= 0 then current_sort else - current_sort in
 106       let col =
 107         try List.nth !!columns (abs - 1)
 108         with _ -> C.Col_shared_file
 109       in
 110       let res = self#compare_by_col col si1 si2 in
 111       current_sort * res
 112
 113     method content_by_col si col =
 114       match col with
 115         C.Col_shared_file -> si.shared_filename
 116       | C.Col_shared_requests -> string_of_int si.shared_requests
 117       | C.Col_shared_upsize ->
 118           Gui_misc.size_of_int64 si.shared_uploaded
 119       | C.Col_shared_size ->
 120           Gui_misc.size_of_int64 si.shared_size
 121
 122     method content si =
 123       let strings = List.map
 124           (fun col -> P.String (self#content_by_col si col))
 125         !!columns
 126       in
 127       (strings, None)
 128
 129     method menu =
 130
 131 (* fuck the object oriented style: how do I copy something to the
 132 console ???? *)
 133
 134       let copy_ed2k_links list _ =
 135         let buf = Buffer.create 100 in
 136         List.iter (fun s ->
 137     match s.shared_uids with
 138         uid :: _ -> (
 139           match (Uid.to_uid uid) with
 140               Ed2k md4 ->
 141                 begin
 142                   let link = Printf.sprintf "ed2k://|file|%s|%Ld|%s|"
 143                              (Url.encode (Filename.basename s.shared_filename))
 144                              s.shared_size
 145                              (Md4.to_string md4)
 146                   in
 147                   Printf.bprintf buf "%s\n" link;
 148                 end
 149             | _ -> ())
 150
 151       | _ -> ()
 152         ) list;
 153         let link = Buffer.contents buf in
 154         !Gui_global.console_message link;
 155         clipboard <- link;
 156
 157 (*
 158         ignore (self#misc#grab_selection `PRIMARY);
 159         self#misc#add_selection_target ~target:"string" `PRIMARY;
 160         ignore (self#misc#connect#selection_get (fun sel ~info ~time ->
 161               lprintf "request selection"; lprint_newline ();
 162               sel#return clipboard
 163           ));
 164         ignore (self#event#connect#selection_clear (fun sel ~info ~time ->
 165               lprintf "request selection"; lprint_newline ();
 166               sel#return clipboard
 167           ));
 168 *)
 169       in
 170       match self#selection with
 171         [] -> []
 172       | list ->
 173           [ `I (("Copy ed2k link to console/clipboard"), copy_ed2k_links list)
 174           ]
 175
 176     method find_file num = self#find num
 177
 178     method h_shared_file_info si =
 179       try
 180         let _,s_old = self#find_file si.shared_num in
 181         s_old.shared_filename <- si.shared_filename
 182       with Not_found ->
 183           self#add_item si
 184
 185     method h_shared_file_upload num upsize requests =
 186       try
 187         let (row, si) = self#find_file num in
 188         si.shared_uploaded <- upsize;
 189         si.shared_requests <- requests ;
 190         self#update_row si row
 191       with
 192         Not_found ->
 193           lprintf "Shared file %d not found" num; lprint_newline ();
 194
 195     initializer
 196       wf_upstats#add pl#box;
 197
 198 end
 199
 200 class upstats_box () =
 201   let wl_status = GMisc.label ~text: "" ~show: true () in
 202   let upstats = new box O.shared_files_up_columns () in
 203   object (self)
 204     inherit Gui_uploads_base.upstats_box () as upsb
 205
 206     method wl_status = wl_status
 207     method box = upsb#vbox
 208     method upstats_box= upstats
 209
 210     method clear =
 211       wl_status#set_text "";
 212       upstats#clear
 213
 214     method refresh () =
 215       Gui_com.send GuiProto.RefreshUploadStats
 216
 217     method h_shared_file_info =
 218       upstats#h_shared_file_info
 219
 220     method h_shared_file_upload =
 221       upstats#h_shared_file_upload
 222
 223     method set_tb_style tb =
 224       if Options.(!!) Gui_options.mini_toolbars then
 225         (wtool1#misc#hide (); wtool2#misc#show ()) else
 226         (wtool2#misc#hide (); wtool1#misc#show ());
 227       wtool1#set_style tb;
 228       wtool2#set_style tb
 229
 230     initializer
 231       vbox#pack ~expand: true ~padding: 2 upstats#box;
 232
 233       Gui_misc.insert_buttons wtool1 wtool2
 234         ~text: (gettext M.refresh)
 235       ~tooltip: (gettext M.refresh)
 236       ~icon: M.o_xpm_refresh
 237         ~callback: self#refresh
 238         ();
 239
 240       (*
 241       Gui_misc.insert_buttons wtool1 wtool2
 242         ~text: "Edit Shared Directories"
 243         ~tooltip: "Edit Shared Directories"
 244         ~icon: M.o_xpm_verify_chunks
 245         ~callback: (fun _ ->
 246           let module C = Configwin in
 247           let params = [
 248               C.filenames ~f: (fun _ -> ()) "Shared Directories:" []] in
 249           match C.simple_edit "Add New Directory" params with
 250             C.Return_apply -> ()
 251           | C.Return_ok -> ()
 252           | C.Return_cancel -> ()
 253       )
 254       ()
 255 *)
 256
 257       Gui_misc.insert_buttons wtool1 wtool2
 258         ~text: "Add Shared Directory"
 259         ~tooltip: "Add Shared Directory"
 260         ~icon: M.o_xpm_verify_chunks
 261         ~callback: (fun _ ->
 262           let module C = Configwin in
 263           let prio = ref 0 in
 264           let dir = ref "" in
 265           let params = [
 266               C.string ~f: (fun p -> prio := int_of_string(p)) "Prio:" "0";
 267               C.filename ~f: (fun d -> dir := d) "Directory:" ""] in
 268           match C.simple_edit "Add New Directory" ~with_apply: false
 269             params with
 270             C.Return_apply ->
 271               if !dir <> "" && !dir <> "/" then
 272                 Gui_com.send (Command (Printf.sprintf "share %d '%s'" !prio !dir))
 273           | C.Return_ok -> ()
 274           | C.Return_cancel -> ()
 275       )
 276       ()
 277
 278   end