matita/matita/contribs/lambdadelta/bin/recomm/recommOutput.ml

   1 module ET = RecommTypes
   2
   3 let width = ref 78
   4
   5 let replace = ref false
   6
   7 let string_length_utf8 s =
   8   let l = String.length s in
   9   let rec aux r i =
  10     if i >= l then r else
  11     if '\x80' <= s.[i] && s.[i] <= '\xBF'
  12     then aux (succ r) (succ i) else aux r (succ i)
  13   in
  14   l - aux 0 0
  15
  16 let complete s =
  17   let l = !width - string_length_utf8 s - 6 in
  18   if l < 0 then begin
  19     Printf.eprintf "overfull: %S\n" s;
  20     ""
  21   end else begin
  22     String.make l '*'
  23   end
  24
  25 let out_src och = function
  26   | ET.Line s             ->
  27     Printf.fprintf och "%s" s
  28   | ET.Text s             ->
  29     Printf.fprintf och "%s" s
  30   | ET.Mark s             ->
  31     Printf.fprintf och "(* *%s*)" s
  32   | ET.Key (s1, s2)       ->
  33     Printf.fprintf och "(* %s%s*)" s1 s2
  34   | ET.Title ss           ->
  35     let s = String.concat " " ss in
  36     Printf.fprintf och "(* %s %s*)" s (complete s)
  37   | ET.Slice ss           ->
  38     let s = String.capitalize_ascii (String.concat " " ss) in
  39     Printf.fprintf och "(* %s %s*)" s (complete s)
  40   | ET.Other (s1, s2, s3) ->
  41     Printf.fprintf och "%s%s%s" s1 s2 s3
  42
  43 let write_srcs file srcs =
  44   let target =
  45     if !replace then begin
  46       Sys.rename file (file ^ ".old");
  47       file
  48     end else begin
  49       file ^ ".new"
  50     end
  51   in
  52   let och = open_out target in
  53   List.iter (out_src och) srcs;
  54   close_out och