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 n =
  17   let l = !width - string_length_utf8 s - 5 - n 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     let s3 =
  34       if s1 = "NOTE" then complete (s1^s2) 0 else ""
  35     in
  36     Printf.fprintf och "(* %s%s%s*)" s1 s2 s3
  37   | ET.Title ss           ->
  38     let s = String.concat " " ss in
  39     Printf.fprintf och "(* %s %s*)" s (complete s 1)
  40   | ET.Slice ss           ->
  41     let s = String.capitalize_ascii (String.concat " " ss) in
  42     Printf.fprintf och "(* %s %s*)" s (complete s 1)
  43   | ET.Other (s1, s2, s3) ->
  44     Printf.fprintf och "%s%s%s" s1 s2 s3
  45
  46 let write_srcs file srcs =
  47   let target =
  48     if !replace then begin
  49       Sys.rename file (file ^ ".old");
  50       file
  51     end else begin
  52       file ^ ".new"
  53     end
  54   in
  55   let och = open_out target in
  56   List.iter (out_src och) srcs;
  57   close_out och