This commit was manufactured by cvs2svn to create branch

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

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/csview.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/csview.ml
deleted file mode 100644 (file)
index eaf8de1..0000000
--- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/csview.ml
+++ /dev/null
@@ -1,155 +0,0 @@
-(* $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