src/gtk/gui/gui_queries.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 Gettext
  23 open CommonTypes
  24 open GuiProto
  25 open Gui_columns
  26
  27
  28
  29 module M = Gui_messages
  30 module P = Gpattern
  31 module O = Gui_options
  32
  33 let (!!) = Options.(!!)
  34
  35
  36 type ent = GEdit.entry
  37
  38 type query_form =
  39   QF_AND of query_form list
  40 | QF_OR of query_form list
  41 | QF_ANDNOT of query_form * query_form
  42 | QF_MODULE of query_form
  43
  44 | QF_KEYWORDS of ent
  45 | QF_MINSIZE of ent * ent (** number and unit *)
  46 | QF_MAXSIZE of ent * ent (** number and unit *)
  47 | QF_FORMAT of ent
  48 | QF_MEDIA of ent
  49
  50 | QF_MP3_ARTIST of ent
  51 | QF_MP3_TITLE of ent
  52 | QF_MP3_ALBUM of ent
  53 | QF_MP3_BITRATE of ent
  54
  55 | QF_COMBO of ent
  56
  57 | QF_HIDDEN of GPack.box * query_form list
  58
  59 let form_leaf qe we =
  60   match qe with
  61   | Q_KEYWORDS _ -> QF_KEYWORDS we
  62   | Q_MP3_ARTIST _ -> QF_MP3_ARTIST we
  63   | Q_MP3_TITLE  _ -> QF_MP3_TITLE we
  64   | Q_MP3_ALBUM  _ -> QF_MP3_ALBUM we
  65   | _ -> assert false
  66
  67 let rec form_of_entry f_submit qe =
  68   match qe with
  69     Q_AND le ->
  70       let wf = GBin.frame ~label: "&" () in
  71       let vbox = GPack.vbox ~packing: wf#add () in
  72
  73       let rec iter l =
  74         match l with
  75           [] -> []
  76         | (Q_MODULE (s1, qe1) ) :: (Q_MODULE (s2, qe2) ) :: tail ->
  77             let hbox = GPack.hbox ~packing: vbox#add () in
  78
  79             let wf1 = GBin.frame ~label: s1 () in
  80             let (w1,e1,f1) = form_of_entry f_submit qe1 in
  81             wf1#add w1;
  82
  83             let wf2 = GBin.frame ~label: s2 () in
  84             let (w2,e2,f2) = form_of_entry f_submit qe2 in
  85             wf2#add w2;
  86
  87             hbox#pack ~padding: 2 ~expand: e1 wf1#coerce;
  88             hbox#pack ~padding: 2 ~expand: e2 wf2#coerce;
  89
  90             (QF_MODULE f1) :: (QF_MODULE f2) :: (iter tail)
  91
  92         | qe :: tail ->
  93             let (w, expand, form) = form_of_entry f_submit qe in
  94             vbox#pack ~padding: 2 ~expand w;
  95             form :: (iter tail)
  96       in
  97       let le = QF_AND (iter le) in
  98
  99 (*
 100       let l = List.map (form_of_entry f_submit) le in
 101       List.iter (fun (w,expand,form) -> vbox#pack ~padding: 2 ~expand w) l;
 102 *)
 103
 104       (wf#coerce, false, le)
 105 (*       QF_AND (List.map (fun (_,_,f) -> f) l)) *)
 106
 107   | Q_OR le ->
 108       let wf = GBin.frame ~label: "||" () in
 109       let vbox = GPack.vbox ~packing: wf#add () in
 110       let l = List.map (form_of_entry f_submit) le in
 111       List.iter (fun (w,expand,form) -> vbox#pack ~padding: 2 ~expand w) l;
 112       (wf#coerce, false,
 113        QF_OR (List.map (fun (_,_,f) -> f) l))
 114
 115   | Q_ANDNOT (qe1, qe2) ->
 116       let wf = GBin.frame () in
 117       let vbox = GPack.vbox ~packing: wf#add () in
 118       let (w1,e1,f1) = form_of_entry f_submit qe1 in
 119       let (w2,e2,f2) = form_of_entry f_submit qe2 in
 120       vbox#pack ~padding: 2 ~expand: e1 w1;
 121       vbox#pack ~padding: 2 ~expand: false (GMisc.label ~text: "AND NOT" ())#coerce;
 122       vbox#pack ~padding: 2 ~expand: e2 w2;
 123       (wf#coerce, false, QF_ANDNOT (f1, f2))
 124
 125   | Q_MODULE (s, qe) ->
 126       let wf = GBin.frame ~label: s () in
 127       let (w,_,f) = form_of_entry f_submit qe in
 128       wf#add w;
 129       (wf#coerce, true, QF_MODULE f)
 130
 131
 132   | Q_FORMAT (label, v) ->
 133       let hbox = GPack.hbox () in
 134       let wl = GMisc.label ~text: (label^":")
 135           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 136       in
 137       let wcombo = GEdit.combo
 138           ~popdown_strings: [""; "avi"; "mp3"]
 139           ~value_in_list: false
 140           ~ok_if_empty: true
 141           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 142       in
 143       wcombo#entry#set_text v;
 144       (hbox#coerce, false, QF_FORMAT wcombo#entry)
 145
 146   | Q_MEDIA (label, v) ->
 147       let hbox = GPack.hbox () in
 148       let wl = GMisc.label ~text: (label^":")
 149           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 150       in
 151       let wcombo = GEdit.combo
 152           ~popdown_strings: [""; "Audio"; "Video"; "Program";
 153                               "Image"; "Documentation"; "Collection"]
 154           ~value_in_list: false
 155           ~ok_if_empty: true
 156           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 157       in
 158       wcombo#entry#set_text v;
 159       (hbox#coerce, false, QF_MEDIA wcombo#entry)
 160
 161   | Q_COMBO (label, default, args) ->
 162       let hbox = GPack.hbox () in
 163       let wl = GMisc.label ~text: (label^":")
 164           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 165       in
 166       let wcombo = GEdit.combo
 167           ~popdown_strings: args
 168           ~value_in_list: true
 169           ~ok_if_empty: true
 170           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 171       in
 172       wcombo#entry#set_text default;
 173       (hbox#coerce, false, QF_COMBO wcombo#entry)
 174
 175   | Q_MP3_BITRATE (label, v) ->
 176       let hbox = GPack.hbox () in
 177       let wl = GMisc.label ~text: (label^":")
 178           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 179       in
 180       let wcombo = GEdit.combo
 181           ~popdown_strings: [""; "64"; "96"; "128"; "160"; "192"]
 182           ~value_in_list: false
 183           ~ok_if_empty: true
 184         ~width: 60
 185           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 186       in
 187       wcombo#entry#set_text v;
 188       (hbox#coerce, false, QF_MP3_BITRATE wcombo#entry)
 189
 190   | Q_MINSIZE (label, v) ->
 191       let hbox = GPack.hbox () in
 192       let wl = GMisc.label ~text: (label^":")
 193           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 194       in
 195       let we = GEdit.entry ~width: 100 ~packing: (hbox#pack ~padding: 2 ~expand: false) () in
 196       let wcombo = GEdit.combo
 197           ~popdown_strings: ["" ; "Mo"; "ko"]
 198           ~value_in_list: false
 199           ~ok_if_empty: true
 200           ~width: 60
 201           ~packing: (hbox#pack ~padding: 2 ~expand: false ~fill: false) ()
 202       in
 203       we#set_text v;
 204       (hbox#coerce, false, QF_MINSIZE (we, wcombo#entry))
 205
 206   | Q_MAXSIZE (label, v) ->
 207       let hbox = GPack.hbox () in
 208       let wl = GMisc.label ~text: (label^":")
 209           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 210       in
 211       let we = GEdit.entry ~width: 100 ~packing: (hbox#pack ~padding: 2 ~expand: false) () in
 212       let wcombo = GEdit.combo
 213           ~popdown_strings: ["" ; "Mo"; "ko"]
 214           ~value_in_list: false
 215           ~ok_if_empty: true
 216           ~width: 60
 217           ~packing: (hbox#pack ~padding: 2 ~expand: false ~fill: false) ()
 218       in
 219       we#set_text v;
 220       (hbox#coerce, false, QF_MAXSIZE (we, wcombo#entry))
 221
 222   | Q_KEYWORDS (label, v)
 223   | Q_MP3_ARTIST (label, v)
 224   | Q_MP3_TITLE (label, v)
 225   | Q_MP3_ALBUM (label, v) ->
 226       let hbox = GPack.hbox () in
 227       let wl = GMisc.label ~text: (label^":")
 228           ~packing: (hbox#pack ~padding: 2 ~expand: false) ()
 229       in
 230       let we = GEdit.entry ~packing: (hbox#pack ~padding: 2 ~expand: false) () in
 231       Okey.add we ~mods: [] GdkKeysyms._Return f_submit;
 232       we#set_text v;
 233       (hbox#coerce, false, (form_leaf qe we))
 234
 235   | Q_HIDDEN le ->
 236       let vbox = GPack.vbox () in
 237       vbox#misc#hide ();
 238       let l = List.map (form_of_entry f_submit) le in
 239       List.iter
 240         (fun (w, expand, form) -> vbox#pack ~padding: 2 ~expand w)
 241         l;
 242       (vbox#coerce, false,
 243        QF_HIDDEN (vbox, List.map (fun (_,_,f) -> f) l))
 244
 245 let rec hide_or_show show qf =
 246   match qf with
 247     QF_AND l
 248   | QF_OR l ->
 249       List.iter (hide_or_show show) l
 250   | QF_ANDNOT (qf1, qf2) ->
 251       hide_or_show show qf1;
 252       hide_or_show show qf2
 253   | QF_MODULE qf ->
 254       hide_or_show show qf
 255
 256   | QF_KEYWORDS _
 257   | QF_MINSIZE _
 258   | QF_MAXSIZE _
 259   | QF_FORMAT _
 260   | QF_MEDIA _
 261   | QF_MP3_ARTIST _
 262   | QF_MP3_TITLE _
 263   | QF_MP3_ALBUM _
 264   | QF_COMBO _
 265   | QF_MP3_BITRATE  _ -> ()
 266
 267   | QF_HIDDEN (b, l) ->
 268       if show then b#misc#show () else b#misc#hide () ;
 269       List.iter (hide_or_show show) l
 270
 271 let rec entry_of_form qf =
 272   match qf with
 273     QF_AND l ->
 274       Q_AND (List.map entry_of_form l)
 275   | QF_OR l ->
 276       Q_OR (List.map entry_of_form l)
 277   | QF_ANDNOT (qf1, qf2) ->
 278       Q_ANDNOT (entry_of_form qf1, entry_of_form qf2)
 279   | QF_MODULE qf ->
 280       Q_MODULE ("", entry_of_form qf)
 281   | QF_KEYWORDS we -> Q_KEYWORDS ("", we#text)
 282   | QF_MINSIZE (we,we2) ->
 283       let size =
 284         try
 285           Int64.to_string
 286             (Int64.mul (Int64.of_string we#text) (Gui_misc.unit_of_string we2#text))
 287         with _ -> ""
 288       in
 289       Q_MINSIZE ("", size)
 290   | QF_MAXSIZE (we,we2) ->
 291       let size =
 292         try Int64.to_string
 293             (Int64.mul (Int64.of_string we#text) (Gui_misc.unit_of_string we2#text))
 294         with _ -> ""
 295       in
 296       Q_MAXSIZE ("", size)
 297
 298   | QF_COMBO we -> Q_COMBO ("", we#text, [])
 299
 300   | QF_FORMAT we -> Q_FORMAT ("", we#text)
 301   | QF_MEDIA we -> Q_MEDIA ("", we#text)
 302   | QF_MP3_ARTIST we -> Q_MP3_ARTIST ("", we#text)
 303   | QF_MP3_TITLE we -> Q_MP3_TITLE ("", we#text)
 304   | QF_MP3_ALBUM we -> Q_MP3_ALBUM ("", we#text)
 305   | QF_MP3_BITRATE  we -> Q_MP3_BITRATE ("", we#text)
 306
 307   | QF_HIDDEN (b, l) ->
 308       Q_HIDDEN (List.map entry_of_form l)
 309
 310
 311
 312 class box submit_search query_entry =
 313   let f_submit = ref (fun () -> ()) in
 314   let (w,expand,form) = form_of_entry
 315       (fun () -> !f_submit ())
 316     query_entry
 317   in
 318   object(self)
 319     inherit Gui_queries_base.box ()
 320
 321     method submit ?(local=RemoteSearch) () =
 322       let qe = entry_of_form form in
 323       let max_hits =
 324         try int_of_string we_max_hits#text
 325         with _ -> 200
 326       in
 327       let net = List.assoc nets_wcombo#entry#text nets in
 328       let search = Gui_misc.create_search qe max_hits net local in
 329       submit_search search
 330
 331     method local () = self#submit ~local: LocalSearch ()
 332     method subscribe () = self#submit ~local: SubscribeSearch ()
 333
 334     method set_tb_style st =
 335         if Options.(!!) Gui_options.mini_toolbars then
 336           (wtool1#misc#hide (); wtool2#misc#show ()) else
 337           (wtool2#misc#hide (); wtool1#misc#show ());
 338       wtool1#set_style st;
 339       wtool2#set_style st;
 340
 341     initializer
 342       f_submit := (fun () -> self#submit ());
 343       box_fields#pack w;
 344       ignore (wchk_show#connect#clicked
 345           (fun () -> hide_or_show wchk_show#active form));
 346
 347       Gui_misc.insert_buttons wtool1 wtool2
 348         ~text: (gettext M.submit)
 349       ~tooltip: (gettext M.submit)
 350       ~icon: (M.o_xpm_submit_search)
 351       ~callback: self#submit
 352         ();
 353       Gui_misc.insert_buttons wtool1 wtool2
 354         ~text: (gettext M.local_search)
 355       ~tooltip: (gettext M.local_search)
 356       ~icon: (M.o_xpm_local_search)
 357           ~callback: self#local
 358         ();
 359       Gui_misc.insert_buttons wtool1 wtool2
 360           ~text: (gettext M.subscribe)
 361         ~tooltip: (gettext M.subscribe)
 362         ~icon: (M.o_xpm_download)
 363           ~callback: self#subscribe
 364         ();
 365
 366 end
 367
 368 (*   let query_entry = Q_KEYWORDS ("Title", "") in *)
 369
 370 class url_box query_entry submit_search =
 371   let f_submit = ref (fun () -> ()) in
 372   let (w,expand,form) = form_of_entry
 373       (fun () -> !f_submit ())
 374     query_entry
 375   in
 376   object(self)
 377     inherit Gui_queries_base.box ()
 378
 379     method submit () =
 380       let qe = entry_of_form form in
 381       submit_search qe
 382
 383     method set_tb_style st =
 384       wtool1#set_style st;
 385       wtool2#set_style st;
 386         if Options.(!!) Gui_options.mini_toolbars then
 387         (wtool1#misc#hide (); wtool2#misc#show ()) else
 388         (wtool2#misc#hide (); wtool1#misc#show ())
 389
 390     initializer
 391       f_submit := (fun () -> self#submit ());
 392       box_fields#pack w;
 393       ignore (wchk_show#connect#clicked
 394           (fun () -> hide_or_show wchk_show#active form));
 395       Gui_misc.insert_buttons wtool1 wtool2
 396           ~text: (gettext M.submit)
 397         ~tooltip: (gettext M.submit)
 398       ~icon: (M.o_xpm_submit_search)
 399           ~callback: self#submit
 400           ()
 401
 402
 403 end
 404
 405
 406 class paned () =
 407   object(self)
 408     inherit Gui_queries_base.paned ()
 409
 410 (** Associations (numéro de query de gui, boite affichant les résultats) *)
 411     val mutable results = ([] : (int *
 412           (Gui_results.search_result_box * GPack.box)) list)
 413
 414     val mutable queries_box = ([] : box list)
 415     val mutable static_queries_box = ([] : url_box list)
 416     val mutable static_results = ([] : Gui_cdget.url_results list)
 417
 418     val mutable wnote_main = GPack.notebook ()
 419     val mutable wnote_results = GPack.notebook ()
 420     method set_wnote_results w = wnote_results <- w
 421     method set_wnote_main w = wnote_main <- w
 422
 423     method clear =
 424       List.iter (fun box -> box#coerce#destroy ()) queries_box;
 425       queries_box <- [];
 426       results <- [] ;
 427
 428
 429     method close_query num forget () =
 430       try
 431         if forget then  begin
 432             let (box_res, vb) = List.assoc num results in
 433             vb#destroy ();
 434             results <- List.filter (fun (n,_) -> n <> num) results;
 435           end;
 436         Gui_com.send (GuiProto.CloseSearch (num, forget))
 437       with
 438         Not_found ->
 439           ()
 440
 441     method submit_search s =
 442       Gui_com.send (GuiProto.Search_query (s));
 443       let desc = Gui_misc.description_of_query s.GuiTypes.search_query in
 444       let wl = GMisc.label ~text: desc () in
 445       let vbox = GPack.vbox () in
 446       let box_res = new Gui_results.search_result_box s.GuiTypes.search_num () in
 447       vbox#pack ~expand: true box_res#coerce;
 448       let wb_close = GButton.button ~label: (gettext M.close_search)
 449         ~packing: (vbox#pack ~expand: false)
 450         ()
 451       in
 452       let wb_stop = GButton.button ~label: (gettext M.stop_search)
 453         ~packing: (vbox#pack ~expand: false)
 454         ()
 455       in
 456       ignore (wb_close#connect#clicked (self#close_query s.GuiTypes.search_num true));
 457       ignore (wb_stop#connect#clicked (self#close_query s.GuiTypes.search_num false));
 458       wnote_results#insert_page ~tab_label: wl#coerce ~pos: 0 vbox#coerce;
 459       wnote_results#goto_page 0;
 460       wnote_main#goto_page 3;
 461       box_res#set_tb_style !!Gui_options.toolbars_style;
 462
 463 (* only the last result box must have an "extended search" button *)
 464 (*      List.iter (fun (_,(b,_)) -> b#remove_extend_search_button) results; *)
 465
 466       results <- (s.GuiTypes.search_num, (box_res, vbox)) :: results
 467
 468     method submit_url_search result_box qe =
 469       let desc = Gui_misc.description_of_query qe in
 470       let wl = GMisc.label ~text: desc () in
 471       let vbox = GPack.vbox () in
 472       let box_res = result_box qe in
 473       static_results <- box_res :: static_results;
 474       vbox#pack ~expand: true box_res#coerce;
 475       let wb_close = GButton.button ~label: (gettext M.close_search)
 476         ~packing: (vbox#pack ~expand: false)
 477         ()
 478         in
 479       ignore (wb_close#connect#clicked (fun _ ->
 480             static_results <- List2.removeq box_res static_results;
 481             vbox#destroy ()
 482         ));
 483       wnote_results#insert_page ~tab_label: wl#coerce ~pos: 0 vbox#coerce;
 484       wnote_results#goto_page 0;
 485       wnote_main#goto_page 3;
 486
 487 (* only the last result box must have an "extended search" button *)
 488 (*      List.iter (fun (_,(b,_)) -> b#remove_extend_search_button) results; *)
 489
 490     method set_tb_style st =
 491       List.iter (fun b -> b#set_tb_style st) queries_box;
 492       List.iter (fun b -> b#set_tb_style st) static_queries_box;
 493       List.iter (fun (_,(b,_)) -> b#set_tb_style st) results;
 494       List.iter (fun b -> b#set_tb_style st) static_results
 495
 496 (** {2 Handling of core messages} *)
 497
 498     method h_search_filter_networks =
 499       List.iter (fun (_, (srbox, _)) -> srbox#filter_networks) results
 500
 501     method h_search_result num res =
 502       try
 503         let (box_res, vb) = List.assoc num results in
 504         box_res#add_result res
 505       with
 506         Not_found ->
 507           ()
 508
 509     method h_search_waiting num waiting =
 510       try
 511         let (box_res, vb) = List.assoc num results in
 512         box_res#set_waiting waiting
 513       with
 514         Not_found ->
 515           ()
 516
 517     method h_define_searches l =
 518       let f (label, qe) =
 519         let b = new box self#submit_search qe in
 520         let wl = GMisc.label ~text: label () in
 521         wnote_queries#insert_page ~pos: 0 ~tab_label: wl#coerce b#coerce;
 522         wnote_queries#goto_page 0;
 523         b#set_tb_style !!Gui_options.toolbars_style;
 524         queries_box <- b :: queries_box
 525       in
 526       List.iter f l
 527
 528     initializer
 529
 530     let b = new url_box Gui_cdget.ShareReactor.query
 531         (self#submit_url_search (new Gui_cdget.ShareReactor.results)) in
 532     static_queries_box <- b :: static_queries_box;
 533     let wl = GMisc.label ~text: "ShareReactor Search" () in
 534     wnote_queries#append_page ~tab_label: wl#coerce b#coerce;
 535
 536     let b = new url_box Gui_cdget.Jigle.query
 537         (self#submit_url_search (new Gui_cdget.Jigle.results)) in
 538     static_queries_box <- b :: static_queries_box;
 539     let wl = GMisc.label ~text: "Jigle Search" () in
 540     wnote_queries#append_page ~tab_label: wl#coerce b#coerce;
 541
 542     let b = new url_box Gui_cdget.FreeDB.query
 543         (self#submit_url_search (new Gui_cdget.FreeDB.results)) in
 544     static_queries_box <- b :: static_queries_box;
 545     let wl = GMisc.label ~text: "FreeDB Search" () in
 546     wnote_queries#append_page ~tab_label: wl#coerce b#coerce;
 547
 548     let b = new url_box (Q_KEYWORDS ("Title", ""))
 549         (self#submit_url_search (new Gui_cdget.IMDB.results)) in
 550     static_queries_box <- b :: static_queries_box;
 551     let wl = GMisc.label ~text: "IMDB Search" () in
 552     wnote_queries#append_page ~tab_label: wl#coerce b#coerce;
 553
 554   end