(***********************************************************************) (* *) (* MLTk, Tcl/Tk interface of OCaml *) (* *) (* 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 OCaml source tree. *) (* *) (***********************************************************************) open Camltk;; let win = opentk();; let cvs = Canvas.create win [];; let t = Label.create cvs [Text "File name"];; let b = Button.create cvs [Text "Save"; Command (function _ -> let s = getSaveFile [Title "SAVE FILE TEST"; DefaultExtension ".foo"; FileTypes [ { typename= "just test"; extensions= [".foo"; ".test"]; mactypes= ["FOOO"; "BARR"] } ]; InitialDir Filename.temp_dir_name; InitialFile "hogehoge" ] in Label.configure t [Text s])];; let bb = Button.create cvs [Text "Open"; Command (function _ -> let s = getOpenFile [] in Label.configure t [Text s])];; let q = Button.create cvs [Text "Quit"; Command (function _ -> closeTk (); exit 0)];; pack [cvs; q; bb; b; t] [];; mainLoop ();;