summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/examples_camltk/fileinput.ml
diff options
context:
space:
mode:
authorJun FURUSE / 古瀬 淳 <jun.furuse@gmail.com>2002-04-26 12:16:26 +0000
committerJun FURUSE / 古瀬 淳 <jun.furuse@gmail.com>2002-04-26 12:16:26 +0000
commitc54baa5bd6c2a6d8addbea0613998e89d8cf4167 (patch)
treefe926e50c17b7d67fcde37d2ef713bcc896a05e1 /otherlibs/labltk/examples_camltk/fileinput.ml
parent82be04fd96c67653a27562c3f157674c99db84c2 (diff)
merge the branch mltk
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4745 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk/examples_camltk/fileinput.ml')
-rw-r--r--otherlibs/labltk/examples_camltk/fileinput.ml35
1 files changed, 35 insertions, 0 deletions
diff --git a/otherlibs/labltk/examples_camltk/fileinput.ml b/otherlibs/labltk/examples_camltk/fileinput.ml
new file mode 100644
index 000000000..35e7e8358
--- /dev/null
+++ b/otherlibs/labltk/examples_camltk/fileinput.ml
@@ -0,0 +1,35 @@
+(***********************************************************************)
+(* *)
+(* 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 Camltk ;;
+
+let top_w = opentk () ;;
+let buffer = String.create 256 ;;
+let (fd_in, fd_out) = Unix.pipe () ;;
+let text0_w = Text.create top_w [] ;;
+let entry0_w = Entry.create top_w [] ;;
+let button0_w = Button.create top_w [Text "Quit"; Command (fun _ -> exit 0)] ;;
+Fileevent.add_fileinput fd_in (fun _ ->
+ let n = Unix.read fd_in buffer 0 (String.length buffer) in
+ let txt = String.sub buffer 0 n in
+ Text.insert text0_w (TextIndex (End, [])) txt []) ;;
+let send _ =
+ let txt = Entry.get entry0_w ^ "\n" in
+ Entry.delete_range entry0_w (At 0) End ;
+ ignore (Unix.write fd_out txt 0 (String.length txt));;
+
+bind entry0_w [([], KeyPressDetail "Return")] (BindSet ([], send)) ;
+pack [text0_w; entry0_w; button0_w][Side Side_Top; Fill Fill_X; Expand true] ;;
+mainLoop () ;;