83 lines
3.0 KiB
OCaml
83 lines
3.0 KiB
OCaml
(*************************************************************************)
|
|
(* *)
|
|
(* Objective Caml LablTk library *)
|
|
(* *)
|
|
(* Jacques Garrigue, 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. *)
|
|
(* *)
|
|
(*************************************************************************)
|
|
|
|
(* $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 ?(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;
|
|
|
|
recenter lb ~index:(`Num 0) (* so that first item is active *)
|