summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorUlrich Müller <ulm@gentoo.org>2015-04-06 16:23:03 +0000
committerUlrich Müller <ulm@gentoo.org>2015-04-06 16:24:17 +0000
commit6611d008e9d18e9da243b0ee8076ab3ae22d5355 (patch)
treed505709d62a0520ff3e7fa9055a46539386bf8b4 /test-plans/text.ml
downloademacs-6611d008e9d18e9da243b0ee8076ab3ae22d5355.tar.gz
emacs-6611d008e9d18e9da243b0ee8076ab3ae22d5355.tar.bz2
emacs-6611d008e9d18e9da243b0ee8076ab3ae22d5355.zip
Import test plans.
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 ()
+;;
+