(* $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 ()