6 let file_dialog ~title ~callback ?filename () =
7 let sel = GWindow.file_selection ~title ~modal:true ?filename () in
8 sel#cancel_button#connect#clicked ~callback:sel#destroy;
9 sel#ok_button#connect#clicked ~callback:
11 let name = sel#get_filename in
17 let w = GWindow.window ~title:"Okaimono" ()
18 let vb = GPack.vbox ~packing:w#add ()
20 let menubar = GMenu.menu_bar ~packing:vb#pack ()
21 let factory = new GMenu.factory menubar
22 let file_menu = factory#add_submenu "File"
23 let edit_menu = factory#add_submenu "Edit"
25 let sw = GBin.scrolled_window ~height:200 ~packing:vb#add
26 ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
27 let vp = GBin.viewport ~width:340 ~shadow_type:`NONE ~packing:sw#add ()
28 let table = GPack.table ~columns:4 ~rows:256 ~packing:vp#add ()
30 table#focus#set_vadjustment (Some vp#vadjustment)
35 table#attach ~left:!left ~top:!top ~expand:`X w;
37 if !left >= 4 then (incr top; left := 0)
39 let entry_list = ref []
43 List.map [40;200;40;60]
44 ~f:(fun width -> GEdit.entry ~packing:add_to_table ~width ())
45 in entry_list := entry :: !entry_list
48 List.iter2 ["Number";"Name";"Count";"Price"] [40;200;40;60] ~f:
49 begin fun text width ->
50 ignore (GButton.button ~label:text ~width ~packing:add_to_table ())
52 for i = 1 to 9 do add_entry () done
55 let len = String.length s in
58 try String.index_from s pos sep with Not_found -> len
60 let sub = String.sub s ~pos ~len:(next-pos) in
61 if next = len then [sub] else sub::loop (next+1)
66 let ic = open_in name in
68 ~f:(fun l -> List.iter l ~f:(fun e -> e#set_text ""));
69 let entries = Stack.create () in
70 List.iter !entry_list ~f:(fun x -> Stack.push x entries);
72 let line = input_line ic in
73 let fields = split ~sep:'\t' line in
77 add_entry (); List.hd !entry_list
79 List.fold_left fields ~init:entry ~f:
80 begin fun acc field ->
81 (List.hd acc)#set_text field;
85 with End_of_file -> close_in ic
86 with Sys_error _ -> ()
91 let oc = open_out name in
92 List.iter (List.rev !entry_list) ~f:
94 let l = List.map entry ~f:(fun e -> e#text) in
95 if List.exists l ~f:((<>) "") then
96 let rec loop = function
98 | [x] -> fprintf oc "%s\n" x
99 | x::l -> fprintf oc "%s\t" x; loop l
103 with Sys_error _ -> ()
108 w#connect#destroy ~callback:Main.quit;
109 w#event#connect#key_press ~callback:
111 let key = GdkEvent.Key.keyval ev and adj = vp#vadjustment in
112 if key = _Page_Up then
113 adj#set_value (adj#value -. adj#page_increment)
114 else if key = _Page_Down then
115 adj#set_value (min (adj#value +. adj#page_increment)
116 (adj#upper -. adj#page_size));
119 w#add_accel_group factory#accel_group;
120 let ff = new GMenu.factory file_menu ~accel_group:factory#accel_group in
121 ff#add_item ~key:_O "Open..."
122 ~callback:(file_dialog ~title:"Open data file" ~callback:load);
123 ff#add_item ~key:_S "Save..."
124 ~callback:(file_dialog ~title:"Save data" ~callback:save);
126 ff#add_item ~key:_Q "Quit" ~callback:w#destroy;
127 let ef = new GMenu.factory edit_menu ~accel_group:factory#accel_group in
128 ef#add_item ~key:_A "Add line" ~callback:add_entry;