+++ /dev/null
-(* $Id$ *)
-
-(* A simple CSV data viewer *)
-
-type data =
- { fields : string list;
- titles : string list;
- data : string list list }
-
-let mem_string ~char s =
- try
- for i = 0 to String.length s - 1 do
- if s.[i] = char then raise Exit
- done;
- false
- with Exit -> true
-
-let rec until ~chars ?(escapes="") ?(buf = Buffer.create 80) s =
- match Stream.peek s with
- Some c ->
- if mem_string ~char:c escapes then begin
- Stream.junk s;
- Buffer.add_char buf (Stream.next s);
- until ~chars ~escapes ~buf s
- end else if mem_string ~char:c chars then
- Buffer.contents buf
- else begin
- Buffer.add_char buf c;
- Stream.junk s;
- until ~chars ~escapes ~buf s
- end
- | None ->
- if Buffer.length buf > 0 then raise (Stream.Error "until")
- else raise Stream.Failure
-
-let rec ignores ?(chars = " \t") s =
- match Stream.peek s with
- Some c when mem_string ~char:c chars ->
- Stream.junk s; ignores ~chars s
- | _ -> ()
-
-let parse_field = parser
- [< ''"'; f = until ~chars:"\"" ~escapes:"\\"; ''"'; _ = ignores >] ->
- for i = 0 to String.length f - 1 do
- if f.[i] = '\031' then f.[i] <- '\n'
- done;
- f
- | [< f = until ~chars:",\n\r" >] -> f
- | [< >] -> ""
-
-let comma = parser [< '','; _ = ignores >] -> ()
-
-let rec parse_list ~item ~sep = parser
- [< i = item; s >] ->
- begin match s with parser
- [< _ = sep; l = parse_list ~item ~sep >] -> i :: l
- | [< >] -> [i]
- end
- | [< >] -> []
-
-let parse_one = parse_list ~item:parse_field ~sep:comma
-
-let lf = parser [< ''\n'|'\r'; _ = ignores ~chars:"\n\r"; _ = ignores >] -> ()
-
-let parse_all = parse_list ~item:parse_one ~sep:lf
-
-let read_file file =
- let ic = open_in file in
- let s = Stream.of_channel ic in
- let data = parse_all s in
- close_in ic;
- match data with
- ("i"::fields) :: ("T"::titles) :: data ->
- {fields=fields; titles=titles; data=List.map ~f:List.tl data}
- | titles :: data ->
- {fields=titles; titles=titles; data=data}
- | _ -> failwith "Insufficient data"
-
-let print_string s =
- Format.print_char '"';
- for i = 0 to String.length s - 1 do
- match s.[i] with
- '\'' -> Format.print_char '\''
- | '"' -> Format.print_string "\\\""
- | '\160'..'\255' as c -> Format.print_char c
- | c -> Format.print_string (Char.escaped c)
- done;
- Format.print_char '"'
-
-(*
-#install_printer print_string;;
-*)
-
-open GMain
-
-let field_widths =
- [ "i", 0;
- "ATTR", 0;
- "NAME", 17;
- "NAPR", 8;
- "TEL1", 14;
- "ZIPC", 12;
- "ADR1", 40;
- "BRTH", 10;
- "RMRK", 20;
- "CHK1", 0;
- "CHK2", 0;
- "CHK3", 0;
- "CHK4", 0;
- "TIM1", 16;
- "TIM2", 16;
- "ALRM", 0;
- "ATTM", 0;
- ]
-
-let main argv =
- if Array.length argv <> 2 then begin
- prerr_endline "Usage: csview <csv file>";
- exit 2
- end;
- let data = read_file argv.(1) in
- let w = GWindow.window () in
- w#misc#realize ();
- let style = w#misc#style in
- let font = Gdk.Font.load_fontset "-schumacher-clean-medium-r-normal--13-*-*-*-c-60-*,-mnkaname-fixed-*--12-*" in
- let w0 = Gdk.Font.char_width font '0' in
- style#set_font font;
- w#connect#destroy ~callback:Main.quit;
- let sw = GBin.scrolled_window ~width:600 ~height:300 ~packing:w#add () in
- let cl = GList.clist ~titles:data.titles ~packing:sw#add () in
- List.fold_left data.fields ~init:0 ~f:
- begin fun acc f ->
- let width = try List.assoc f field_widths with Not_found -> -1 in
- if width = 0 then
- cl#set_column ~visibility:false acc
- else begin
- if width > 0 then cl#set_column ~width:(width * w0) acc
- else cl#set_column ~auto_resize:true acc;
- if f = "NAPR" || f = "TIM1" || f = "CLAS" then
- cl#set_sort ~auto:true ~column:acc ();
- try
- let ali = GBin.alignment_cast (cl#column_widget acc) in
- let lbl = GMisc.label_cast (List.hd ali#children) in
- lbl#set_alignment ~x:0. ()
- with _ ->
- prerr_endline ("No column widget for field " ^ f)
- end;
- succ acc
- end;
- List.iter data.data
- ~f:(fun l -> if List.length l > 1 then ignore (cl#append l));
- w#show ();
- Main.main ()
-
-let _ = main Sys.argv