3 (* A simple CSV data viewer *)
6 { fields : string list;
8 data : string list list }
10 let mem_string ~char s =
12 for i = 0 to String.length s - 1 do
13 if s.[i] = char then raise Exit
18 let rec until ~chars ?(escapes="") ?(buf = Buffer.create 80) s =
19 match Stream.peek s with
21 if mem_string ~char:c escapes then begin
23 Buffer.add_char buf (Stream.next s);
24 until ~chars ~escapes ~buf s
25 end else if mem_string ~char:c chars then
28 Buffer.add_char buf c;
30 until ~chars ~escapes ~buf s
33 if Buffer.length buf > 0 then raise (Stream.Error "until")
34 else raise Stream.Failure
36 let rec ignores ?(chars = " \t") s =
37 match Stream.peek s with
38 Some c when mem_string ~char:c chars ->
39 Stream.junk s; ignores ~chars s
42 let parse_field = parser
43 [< ''"'; f = until ~chars:"\"" ~escapes:"\\"; ''"'; _ = ignores >] ->
44 for i = 0 to String.length f - 1 do
45 if f.[i] = '\031' then f.[i] <- '\n'
48 | [< f = until ~chars:",\n\r" >] -> f
51 let comma = parser [< '','; _ = ignores >] -> ()
53 let rec parse_list ~item ~sep = parser
55 begin match s with parser
56 [< _ = sep; l = parse_list ~item ~sep >] -> i :: l
61 let parse_one = parse_list ~item:parse_field ~sep:comma
63 let lf = parser [< ''\n'|'\r'; _ = ignores ~chars:"\n\r"; _ = ignores >] -> ()
65 let parse_all = parse_list ~item:parse_one ~sep:lf
68 let ic = open_in file in
69 let s = Stream.of_channel ic in
70 let data = parse_all s in
73 ("i"::fields) :: ("T"::titles) :: data ->
74 {fields=fields; titles=titles; data=List.map ~f:List.tl data}
76 {fields=titles; titles=titles; data=data}
77 | _ -> failwith "Insufficient data"
80 Format.print_char '"';
81 for i = 0 to String.length s - 1 do
83 '\'' -> Format.print_char '\''
84 | '"' -> Format.print_string "\\\""
85 | '\160'..'\255' as c -> Format.print_char c
86 | c -> Format.print_string (Char.escaped c)
91 #install_printer print_string;;
117 if Array.length argv <> 2 then begin
118 prerr_endline "Usage: csview <csv file>";
121 let data = read_file argv.(1) in
122 let w = GWindow.window () in
124 let style = w#misc#style in
125 let font = Gdk.Font.load_fontset "-schumacher-clean-medium-r-normal--13-*-*-*-c-60-*,-mnkaname-fixed-*--12-*" in
126 let w0 = Gdk.Font.char_width font '0' in
128 w#connect#destroy ~callback:Main.quit;
129 let sw = GBin.scrolled_window ~width:600 ~height:300 ~packing:w#add () in
130 let cl = GList.clist ~titles:data.titles ~packing:sw#add () in
131 List.fold_left data.fields ~init:0 ~f:
133 let width = try List.assoc f field_widths with Not_found -> -1 in
135 cl#set_column ~visibility:false acc
137 if width > 0 then cl#set_column ~width:(width * w0) acc
138 else cl#set_column ~auto_resize:true acc;
139 if f = "NAPR" || f = "TIM1" || f = "CLAS" then
140 cl#set_sort ~auto:true ~column:acc ();
142 let ali = GBin.alignment_cast (cl#column_widget acc) in
143 let lbl = GMisc.label_cast (List.hd ali#children) in
144 lbl#set_alignment ~x:0. ()
146 prerr_endline ("No column widget for field " ^ f)
151 ~f:(fun l -> if List.length l > 1 then ignore (cl#append l));
155 let _ = main Sys.argv