summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/browser/jg_box.ml
blob: e7add1139a8c5d48adc0150b519497dedde77108 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
(* $Id$ *)

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 *)
   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 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] 
    action:(`Set([`Char], 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))));

  begin match action with 
    Some action ->
      bind lb events:[[], `KeyPressDetail "Return"]
        action:(`Set ([], fun _ -> action `Active));
      bind lb events:[[`Double], `ButtonPressDetail 1]
        action:(`Setbreakable ([`MouseY], fun ev ->
          action (Listbox.nearest lb y:ev.ev_MouseY); break ()))
  | None -> ()
  end;

  recenter lb index:(`Num 0)   (* so that first item is active *)