import labltklabltk

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/labltk@2531 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 39 insertions, 0 deletions

diff --git a/otherlibs/labltk/browser/jg_completion.ml b/otherlibs/labltk/browser/jg_completion.ml
new file mode 100644
index 0000000000..8836af09f8
--- /dev/null
+++ b/otherlibs/labltk/browser/jg_completion.ml
@@ -0,0 +1,39 @@
+(* $Id$ *)
+
+let lt_string ?:nocase{=false} s1 s2 =
+  if nocase then String.lowercase s1 < String.lowercase s2 else s1 < s2
+
+class completion ?:nocase texts = object
+  val mutable texts = texts
+  val nocase = nocase
+  val mutable prefix = ""
+  val mutable current = 0
+  method add c =
+    prefix <- prefix ^ c;
+    while current < List.length texts - 1 &
+      lt_string (List.nth texts pos:current) prefix ?:nocase
+    do
+      current <- current + 1
+    done;
+    current
+  method current = current
+  method get_current = List.nth texts pos:current
+  method reset =
+    prefix <- "";
+    current <- 0
+end
+
+class timed ?:nocase ?:wait texts = object (self)
+  inherit completion texts ?:nocase as super
+  val wait = match wait with None -> 500 | Some n -> n
+  val mutable timer = None
+  method add c =
+    begin match timer with
+      None -> self#reset
+    | Some t -> Timer.remove t
+    end;
+    timer <- Some (Timer.add ms:wait callback:(fun () -> self#reset));
+    super#add c
+  method reset =
+    timer <- None; super#reset
+end