This commit was manufactured by cvs2svn to create branch

[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / examples / kaimono.ml

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/kaimono.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/kaimono.ml
deleted file mode 100644 (file)
index e524156..0000000
--- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/kaimono.ml
+++ /dev/null
@@ -1,130 +0,0 @@
-(* $Id$ *)
-
-open GMain
-open Printf
-
-let file_dialog ~title ~callback ?filename () =
-  let sel = GWindow.file_selection ~title ~modal:true ?filename () in
-  sel#cancel_button#connect#clicked ~callback:sel#destroy;
-  sel#ok_button#connect#clicked ~callback:
-    begin fun () ->
-      let name = sel#get_filename in
-      sel#destroy ();
-      callback name
-    end;
-  sel#show ()
-
-let w = GWindow.window ~title:"Okaimono" ()
-let vb = GPack.vbox ~packing:w#add ()
-
-let menubar = GMenu.menu_bar ~packing:vb#pack ()
-let factory = new GMenu.factory menubar
-let file_menu = factory#add_submenu "File"
-let edit_menu = factory#add_submenu "Edit"
-
-let sw = GBin.scrolled_window ~height:200 ~packing:vb#add
-    ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
-let vp = GBin.viewport ~width:340 ~shadow_type:`NONE ~packing:sw#add ()
-let table = GPack.table ~columns:4 ~rows:256 ~packing:vp#add ()
-let _ =
-  table#focus#set_vadjustment (Some vp#vadjustment)
-
-let top = ref 0
-and left = ref 0
-let add_to_table  w =
-  table#attach ~left:!left ~top:!top ~expand:`X w;
-  incr left;
-  if !left >= 4 then (incr top; left := 0)
-
-let entry_list = ref []
-
-let add_entry () =
-  let entry =
-    List.map [40;200;40;60]
-      ~f:(fun width -> GEdit.entry ~packing:add_to_table ~width ())
-  in entry_list := entry :: !entry_list
-
-let _ =
-  List.iter2 ["Number";"Name";"Count";"Price"] [40;200;40;60] ~f:
-    begin fun text width ->
-      ignore (GButton.button ~label:text ~width ~packing:add_to_table ())
-    end;
-  for i = 1 to 9 do add_entry () done
-
-let split ~sep s =
-  let len = String.length s in
-  let rec loop pos =
-    let next =
-      try String.index_from s pos sep with Not_found -> len
-    in
-    let sub = String.sub s ~pos ~len:(next-pos) in
-    if next = len then [sub] else sub::loop (next+1)
-  in loop 0
-
-let load name =
-  try
-    let ic = open_in name in
-    List.iter !entry_list
-      ~f:(fun l -> List.iter l ~f:(fun e -> e#set_text ""));
-    let entries = Stack.create () in
-    List.iter !entry_list ~f:(fun x -> Stack.push x entries);
-    try while true do
-      let line = input_line ic in
-      let fields = split ~sep:'\t' line in
-      let entry =
-       try Stack.pop entries
-       with Stack.Empty ->
-         add_entry (); List.hd !entry_list
-      in
-      List.fold_left fields ~init:entry ~f:
-       begin fun acc field ->
-         (List.hd acc)#set_text field;
-         List.tl acc
-       end
-    done
-    with End_of_file -> close_in ic
-  with Sys_error _ -> ()
-    
-
-let save name =
-  try
-    let oc = open_out name in
-    List.iter (List.rev !entry_list) ~f:
-      begin fun entry ->
-       let l = List.map entry ~f:(fun e -> e#text) in
-       if List.exists l ~f:((<>) "") then
-         let rec loop = function
-             [] -> ()
-           | [x] -> fprintf oc "%s\n" x
-           | x::l -> fprintf oc "%s\t" x; loop l
-         in loop l
-      end;
-    close_out oc
-  with Sys_error _ -> ()
-
-open GdkKeysyms
-
-let _ =
-  w#connect#destroy ~callback:Main.quit;
-  w#event#connect#key_press ~callback:
-    begin fun ev ->
-      let key = GdkEvent.Key.keyval ev and adj = vp#vadjustment in
-      if key = _Page_Up then
-       adj#set_value (adj#value -. adj#page_increment)
-      else if key = _Page_Down then
-       adj#set_value (min (adj#value +. adj#page_increment)
-                        (adj#upper -. adj#page_size));
-      false
-    end;
-  w#add_accel_group factory#accel_group;
-  let ff = new GMenu.factory file_menu ~accel_group:factory#accel_group in
-  ff#add_item ~key:_O "Open..."
-    ~callback:(file_dialog ~title:"Open data file" ~callback:load);
-  ff#add_item ~key:_S "Save..."
-    ~callback:(file_dialog ~title:"Save data" ~callback:save);
-  ff#add_separator ();
-  ff#add_item ~key:_Q "Quit" ~callback:w#destroy;
-  let ef = new GMenu.factory edit_menu ~accel_group:factory#accel_group in
-  ef#add_item ~key:_A "Add line" ~callback:add_entry;
-  w#show ();
-  Main.main ()