(*************************************************************************)
(*                                                                       *)
(*                Objective Caml LablTk library                          *)
(*                                                                       *)
               , Kyoto University RIMS                    
(*                                                                       *)
    Copyright 1999 Institut National de Recherche en Informatique et    
    en Automatique and Kyoto University .   All rights reserved .          
    This file is distributed under the terms of the GNU Library         
(*   General Public License, with the special exception on linking       *)
(*   described in file ../../../LICENSE.                                 *)
(*                                                                       *)
(*************************************************************************)

  $ I d : jg_box.ml 10250 2010 - 04 - 08 03:58:41Z garrigue $

open Tk

let add_scrollbar lb  =
  let sb =
    Scrollbar.create (Winfo.parent lb) ~command:(Listbox.yview lb) in
  Listbox.configure lb ~yscrollcommand:(Scrollbar.set sb); sb

let create_with_scrollbar ?selectmode parent =
  let frame = Frame.create parent in
  let lb = Listbox.create frame ?selectmode in
  frame, lb, add_scrollbar lb

(* from frx_listbox,adapted *)

let recenter lb ~index =
   Listbox.selection_clear lb ~first:(`Num 0) ~last:`End;
  Activate it , to keep consistent with Up / Down . 
         You have to be in Extended or Browse mode
        You have to be in Extended or Browse mode *)
   Listbox.activate lb ~index;
   Listbox.selection_anchor lb ~index;
   Listbox.yview_index lb ~index

class timed ?wait ?nocase get_texts = object
  val get_texts = get_texts
  inherit Jg_completion.timed [] ?wait ?nocase as super
  method! reset =
    texts <- get_texts ();
    super#reset
end

let add_completion ?action ?wait ?nocase ?(double=true) lb =
  let comp =
    new timed ?wait ?nocase
      (fun () -> Listbox.get_range lb ~first:(`Num 0) ~last:`End) in

  Jg_bind.enter_focus lb;

  bind lb ~events:[`KeyPress] ~fields:[`Char] ~action:
    begin fun ev ->
      (* consider only keys producing characters. The callback is called
         even if you press Shift. *)
      if ev.ev_Char <> "" then
        recenter lb ~index:(`Num (comp#add ev.ev_Char))
    end;

  begin match action with
    Some action ->
      bind lb ~events:[`KeyPressDetail "Return"]
        ~action:(fun _ -> action `Active);
      let bmod = if double then [`Double] else [] in
      bind lb ~events:[`Modified(bmod, `ButtonPressDetail 1)]
        ~breakable:true ~fields:[`MouseY]
        ~action:
        begin fun ev ->
          let index = Listbox.nearest lb ~y:ev.ev_MouseY in
          if not double then begin
            Listbox.selection_clear lb ~first:(`Num 0) ~last:`End;
            Listbox.selection_set lb ~first:index ~last:index;
          end;
          action index;
          break ()
        end
  | None -> ()
  end;

  so that first item is active

***********************************************************************
                                                                       
                Objective Caml LablTk library                          
                                                                       
                                                                       
   General Public License, with the special exception on linking       
   described in file ../../../LICENSE.                                 
                                                                       
***********************************************************************
 from frx_listbox,adapted 
 consider only keys producing characters. The callback is called
         even if you press Shift. 
               , Kyoto University RIMS                    
    Copyright 1999 Institut National de Recherche en Informatique et    
    en Automatique and Kyoto University .   All rights reserved .          
    This file is distributed under the terms of the GNU Library         

  $ I d : jg_box.ml 10250 2010 - 04 - 08 03:58:41Z garrigue $

open Tk

let add_scrollbar lb  =
  let sb =
    Scrollbar.create (Winfo.parent lb) ~command:(Listbox.yview lb) in
  Listbox.configure lb ~yscrollcommand:(Scrollbar.set sb); sb

let create_with_scrollbar ?selectmode parent =
  let frame = Frame.create parent in
  let lb = Listbox.create frame ?selectmode in
  frame, lb, add_scrollbar lb


let recenter lb ~index =
   Listbox.selection_clear lb ~first:(`Num 0) ~last:`End;
  Activate it , to keep consistent with Up / Down . 
         You have to be in Extended or Browse mode
        You have to be in Extended or Browse mode *)
   Listbox.activate lb ~index;
   Listbox.selection_anchor lb ~index;
   Listbox.yview_index lb ~index

class timed ?wait ?nocase get_texts = object
  val get_texts = get_texts
  inherit Jg_completion.timed [] ?wait ?nocase as super
  method! reset =
    texts <- get_texts ();
    super#reset
end

let add_completion ?action ?wait ?nocase ?(double=true) lb =
  let comp =
    new timed ?wait ?nocase
      (fun () -> Listbox.get_range lb ~first:(`Num 0) ~last:`End) in

  Jg_bind.enter_focus lb;

  bind lb ~events:[`KeyPress] ~fields:[`Char] ~action:
    begin fun ev ->
      if ev.ev_Char <> "" then
        recenter lb ~index:(`Num (comp#add ev.ev_Char))
    end;

  begin match action with
    Some action ->
      bind lb ~events:[`KeyPressDetail "Return"]
        ~action:(fun _ -> action `Active);
      let bmod = if double then [`Double] else [] in
      bind lb ~events:[`Modified(bmod, `ButtonPressDetail 1)]
        ~breakable:true ~fields:[`MouseY]
        ~action:
        begin fun ev ->
          let index = Listbox.nearest lb ~y:ev.ev_MouseY in
          if not double then begin
            Listbox.selection_clear lb ~first:(`Num 0) ~last:`End;
            Listbox.selection_set lb ~first:index ~last:index;
          end;
          action index;
          break ()
        end
  | None -> ()
  end;

  so that first item is active
