diff options
author | Jun FURUSE / 古瀬 淳 <jun.furuse@gmail.com> | 2002-04-26 12:16:26 +0000 |
---|---|---|
committer | Jun FURUSE / 古瀬 淳 <jun.furuse@gmail.com> | 2002-04-26 12:16:26 +0000 |
commit | c54baa5bd6c2a6d8addbea0613998e89d8cf4167 (patch) | |
tree | fe926e50c17b7d67fcde37d2ef713bcc896a05e1 /otherlibs/labltk/examples_camltk/fileinput.ml | |
parent | 82be04fd96c67653a27562c3f157674c99db84c2 (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.ml | 35 |
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 () ;; |