summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to 'test-plans/text.ml')
-rw-r--r--test-plans/text.ml55
1 files changed, 55 insertions, 0 deletions
diff --git a/test-plans/text.ml b/test-plans/text.ml
new file mode 100644
index 0000000..0001ae7
--- /dev/null
+++ b/test-plans/text.ml
@@ -0,0 +1,55 @@
+(***********************************************************************)
+(* *)
+(* MLTk, Tcl/Tk interface of Objective Caml *)
+(* *)
+(* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis *)
+(* projet Cristal, INRIA Rocquencourt *)
+(* Jacques Garrigue, Kyoto University RIMS *)
+(* *)
+(* Copyright 2002 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 found in the Objective Caml source tree. *)
+(* *)
+(***********************************************************************)
+open Tk
+
+let top = opentk ()
+
+let scroll_link sb tx =
+ Text.configure tx [YScrollCommand (Scrollbar.set sb)];
+ Scrollbar.configure sb [ScrollCommand (Text.yview tx)]
+
+let f = Frame.create top []
+let text = Text.create f []
+let scrollbar = Scrollbar.create f []
+
+let buffer = ref ""
+
+let kill () =
+ buffer :=
+ Text.get text (TextIndex (Insert, []))
+ (TextIndex (Insert, [LineEnd]));
+ Text.delete text (TextIndex (Insert, []))
+ (TextIndex (Insert, [LineEnd]))
+;;
+
+let yank () =
+ Text.insert text (TextIndex (Insert, [])) !buffer []
+
+let _ = bind text [[Control], KeyPressDetail "y"] (BindSet ([], fun _ ->
+ yank () ))
+;;
+let _ = bind text [[Control], KeyPressDetail "k"] (BindSet ([], fun _ ->
+ kill () ))
+;;
+
+let _ =
+ scroll_link scrollbar text;
+
+ pack [text;f][];
+ pack [f][];
+ mainLoop ()
+;;
+