(************************************************************
   listbox_with_filter.ml	Created      : Sat Nov 22 14:10:29 2003
  			Last modified: Sun Nov 23 01:59:56 2003
  Compile: ocamlc -dtypes -I +labltk str.cma labltk.cma listbox_with_filter.ml -o listbox_with_filter #
  FTP Directory: sources/ocaml #
************************************************************)
(**

  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>

*)
open Tk

let read_lines filename =
  let input = open_in filename in
  let rec iter lst =
    try
      let line = input_line input in
      iter (line::lst);
  with
    End_of_file ->
      close_in input;
      List.rev lst
  | e ->
    close_in input;
    raise e in
  iter []
;;

let show_all window elements =
  let frame = Frame.create window in
  let listbox = Listbox.create ~width:100 frame in
  let scroll = Scrollbar.create (Winfo.parent listbox) ~command:(Listbox.yview listbox) in
  let filter_entry = Entry.create window in
  let filter () =
    let str = Entry.get filter_entry in
    let lst = List.filter (fun x ->
      try 
	ignore (Str.search_forward (Str.regexp str) x 0);
	true
      with
	Not_found ->
	  false) elements in
    begin
      Listbox.delete ~first:(`Num 0) ~last:`End listbox;
      Listbox.insert ~index:(`Num 0) ~texts:lst listbox
    end in
  begin
    Listbox.configure ~yscrollcommand:(Scrollbar.set scroll) listbox;
    bind ~events:[`KeyPressDetail"Return"] ~breakable:true ~extend:false
      ~action:(fun _ -> filter ()) filter_entry;
    Listbox.insert ~index:(`Num 0) ~texts:elements listbox;
    pack ~side:`Top ~fill:`Both [frame];
    pack ~side:`Left ~expand:true [ listbox ];
    pack ~side:`Right ~fill:`Y [ scroll ];
    pack ~side:`Bottom ~expand:true ~fill:`X [ filter_entry ]
  end
;;

let _ =
  let window = openTk() in
  let lines = read_lines "listbox_with_filter.ml" in
  show_all window lines;
  mainLoop ()
;;

(*
  Local Variables:
  namazu-default-dir: "/home/tak/.ocaml_namazu/ /home/tak/.labltk_namazu/"
  End:
*)