l4/pkg/ocaml/contrib/otherlibs/labltk/frx/frx_entry.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                 MLTk, Tcl/Tk interface of Objective Caml            *)
   4 (*                                                                     *)
   5 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
   6 (*               projet Cristal, INRIA Rocquencourt                    *)
   7 (*            Jacques Garrigue, Kyoto University RIMS                  *)
   8 (*                                                                     *)
   9 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
  10 (*  en Automatique and Kyoto University.  All rights reserved.         *)
  11 (*  This file is distributed under the terms of the GNU Library        *)
  12 (*  General Public License, with the special exception on linking      *)
  13 (*  described in file LICENSE found in the Objective Caml source tree. *)
  14 (*                                                                     *)
  15 (***********************************************************************)
  16 open Camltk
  17
  18 let version = "$Id: frx_entry.ml 4745 2002-04-26 12:16:26Z furuse $"
  19
  20 (*
  21  * Tk 4.0 has emacs bindings for entry widgets
  22  *)
  23
  24 let new_label_entry parent txt action =
  25   let f = Frame.create parent [] in
  26   let m = Label.create f [Text txt]
  27   and e = Entry.create f [Relief Sunken; TextWidth 0] in
  28    Camltk.bind e [[], KeyPressDetail "Return"]
  29        (BindSet ([], fun _ -> action(Entry.get e)));
  30   pack [m][Side Side_Left];
  31   pack [e][Side Side_Right; Fill Fill_X; Expand true];
  32   f,e
  33
  34 let new_labelm_entry parent txt memo =
  35   let f = Frame.create parent [] in
  36   let m = Label.create f [Text txt]
  37   and e = Entry.create f [Relief Sunken; TextVariable memo; TextWidth 0] in
  38   pack [m][Side Side_Left];
  39   pack [e][Side Side_Right; Fill Fill_X; Expand true];
  40   f,e
  41
  42