src/gtk/newgui/gui_misc.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 open CommonTypes
  21 (** Misc. functions. *)
  22 module O = Gui_options
  23 module G = Gui_global
  24
  25
  26 open GuiProto
  27
  28 let ko = 1024l
  29 let mo = Int32.mul ko ko
  30
  31 let unit_of_string s =
  32   match String.lowercase s with
  33     "mo" -> mo
  34   | "ko" -> ko
  35   | _ -> Int32.one
  36
  37 let ko = 1024.0
  38 let mo = ko *. ko
  39 let go = mo *. ko
  40
  41
  42 let (!!) = Options.(!!)
  43 let (=:=) = Options.(=:=)
  44
  45 let short_name n =
  46   let n = if n="" then
  47      "http://www.mldonkey.org"
  48   else n
  49   in
  50   let len = String.length n in
  51   if len > !!O.max_file_name_len then
  52     Printf.sprintf "%s...%s" (String.sub n 0 (!!O.max_file_name_len - 5)) (String.sub n (len-5) 5)
  53     else n
  54
  55 let is_connected state =
  56   match state with
  57   | Connected_initiating
  58   | Connected_downloading _
  59   | Connected _ -> true
  60   | NotConnected _
  61   | Connecting
  62   | RemovedHost
  63   | ServerFull
  64   | BlackListedHost
  65   | NewHost -> false
  66
  67 let save_gui_options gui =
  68   (* Compute layout *)
  69   (
  70    match gui#window#children with
  71      [] -> ()
  72    | w :: _ ->
  73        O.last_tab =:= gui#current_page;
  74        let (w,h) = Gdk.Window.get_size w#misc#window in
  75        O.gui_width =:= w;
  76        O.gui_height =:= h
  77   );
  78   Options.save_with_help Gui_options.mldonkey_gui_ini
  79
  80 let set_hpaned (hpaned : GPack.paned) prop =
  81   let (w1,_) = Gdk.Window.get_size hpaned#misc#window in
  82   let ndx1 = (w1 * !!prop) / 100 in
  83   hpaned#child1#misc#set_geometry ~width: ndx1 ()
  84
  85 let set_vpaned (hpaned : GPack.paned) prop =
  86   let (_,h1) = Gdk.Window.get_size hpaned#misc#window in
  87   let ndy1 = (h1 * !!prop) / 100 in
  88   hpaned#child1#misc#set_geometry ~height: ndy1 ()
  89
  90
  91 let get_hpaned gui (hpaned: GPack.paned) prop =
  92
  93   ignore (hpaned#child1#coerce#misc#connect#size_allocate
  94       ~callback: (fun r ->
  95         let (w1,_) = Gdk.Window.get_size hpaned#misc#window in
  96         prop =:= r.Gtk.width * 100 / (max 1 (w1 - hpaned#handle_size));
  97         save_gui_options gui
  98     ))
  99
 100 let get_vpaned gui (hpaned: GPack.paned) prop =
 101
 102   ignore (hpaned#child1#coerce#misc#connect#size_allocate
 103       ~callback: (fun r ->
 104         let (_,h1) = Gdk.Window.get_size hpaned#misc#window in
 105         prop =:= r.Gtk.height * 100 / (max 1 (h1 - hpaned#handle_size));
 106         save_gui_options gui
 107     ))
 108
 109 let create_search query_entry max_hits net search_type =
 110   let s = {
 111       GuiTypes.search_num = !Gui_global.search_counter ;
 112       GuiTypes.search_query = query_entry ;
 113       GuiTypes.search_max_hits = max_hits ;
 114       GuiTypes.search_type = search_type;
 115       GuiTypes.search_network = net;
 116   }
 117   in
 118   incr Gui_global.search_counter;
 119   s
 120
 121 let rec rec_description_of_query q =
 122   match q with
 123   | Q_HIDDEN l
 124   | Q_AND l
 125   | Q_OR l -> List.flatten (List.map rec_description_of_query l)
 126
 127   | Q_ANDNOT (q1, q2) -> rec_description_of_query q1
 128   | Q_MODULE (_,q) -> rec_description_of_query q
 129
 130   | Q_KEYWORDS (_,s) -> [s]
 131   | Q_MINSIZE _
 132   | Q_MAXSIZE _ -> []
 133   | Q_FORMAT (_,s)
 134   | Q_MEDIA  (_,s)
 135   | Q_MP3_ARTIST (_,s)
 136   | Q_MP3_TITLE (_,s)
 137   | Q_MP3_ALBUM (_,s) -> [s]
 138
 139   | Q_COMBO _ -> []
 140
 141   | Q_MP3_BITRATE _ -> []
 142
 143
 144 (** Summarize a request in a few words *)
 145 let description_of_query q =
 146   match rec_description_of_query q with
 147     [] -> "stupid query"
 148   | [s] -> s
 149   | [s1 ; s2] -> s1^" "^s2
 150   | s1 :: s2 :: s3 :: _ -> s1^" "^s2^" "^s3
 151
 152
 153 (** To pretty-print a file size (int32) *)
 154 let size_of_int32 size =
 155   if !!Gui_options.use_size_suffixes then
 156     let f = Int32.to_float size in
 157     if f > go then
 158       Printf.sprintf "%.2fG" (f /. go)
 159     else
 160       if f > mo then
 161       Printf.sprintf "%.1fM" (f /. mo)
 162       else
 163         if f > ko then
 164           Printf.sprintf "%.1fk" (f /. ko)
 165         else
 166           Int32.to_string size
 167   else
 168     Int32.to_string size
 169
 170 (** To pretty-print a file size (int64) *)
 171 let size_of_int64 size =
 172   if !!Gui_options.use_size_suffixes then
 173     let f = Int64.to_float size in
 174     if f > go then
 175       Printf.sprintf "%.2fG" (f /. go)
 176     else
 177       if f > mo then
 178       Printf.sprintf "%.1fM" (f /. mo)
 179       else
 180         if f > ko then
 181           Printf.sprintf "%.1fk" (f /. ko)
 182         else
 183           Int64.to_string size
 184   else
 185     Int64.to_string size
 186
 187 (** Return a color for a given name. *)
 188 let color_of_name name =
 189   let accs = [| ref 0 ; ref 0 ; ref 0 |] in
 190   for i = 0 to (String.length name) - 1 do
 191     let m = i mod 3 in
 192     accs.(m) := !(accs.(m)) + Char.code name.[i]
 193   done;
 194   let r = !(accs.(0)) mod 210 in
 195   let g = !(accs.(1)) mod 210 in
 196   let b = !(accs.(2)) mod 210 in
 197   let s = Printf.sprintf "#%02X%02X%02X" r g b in
 198   `NAME s
 199
 200 let insert_buttons (wtool1: GButton.toolbar) (wtool2 : GButton.toolbar)
 201   ~text ~tooltip ~icon ~callback () =
 202   ignore
 203     (wtool1#insert_button
 204       ~text: text
 205       ~tooltip: tooltip
 206       ~icon: (Gui_options.pixmap icon)#coerce
 207       ~callback: callback
 208       ());
 209   ignore
 210     (wtool2#insert_button
 211       ~text: text
 212       ~tooltip: tooltip
 213       ~icon: (Gui_options.pixmap (icon ^ "_mini"))#coerce
 214       ~callback: callback
 215       ())