utils.ml

   1 module StringSet = Set.Make (struct type t = string let compare = compare end)
   2
   3 let decrlf line =
   4   if line.[String.length line - 1] = '\r'
   5   then
   6     String.sub line 0 (String.length line - 1)
   7   else
   8     line
   9
  10 let safe_input_line ic =
  11   try
  12     Some (input_line ic)
  13   with
  14     | End_of_file ->
  15         None
  16
  17 let iter_crlf_chan ic f =
  18   let rec loop () =
  19     let opt_line = safe_input_line ic in
  20       match opt_line with
  21         | Some line ->
  22             f (decrlf line);
  23             loop ()
  24         | None ->
  25             ()
  26   in
  27     loop ()
  28
  29 let fold_crlf_chan ic f init =
  30   let rec loop accu =
  31     let opt_line = safe_input_line ic in
  32       match opt_line with
  33         | Some line ->
  34             let accu = f (decrlf line) accu in
  35               loop accu
  36         | None ->
  37             accu
  38   in
  39     loop init
  40
  41 let process_status = function
  42   | Unix.WEXITED code ->
  43       code
  44   | Unix.WSIGNALED signum ->
  45       prerr_string "signalled ";
  46       prerr_int signum;
  47       prerr_newline ();
  48       101
  49   | Unix.WSTOPPED signum ->
  50       prerr_string "stopped ";
  51       prerr_int signum;
  52       prerr_newline ();
  53       102
  54
  55 let close_process_in ic =
  56   let status = Unix.close_process_in ic in
  57     process_status status
  58
  59 let close_process_full channels =
  60   let status = Unix.close_process_full channels in
  61     process_status status
  62
  63 let make_arg_string f argv pos =
  64   let rec loop accu i =
  65     if i >= Array.length argv
  66     then
  67       List.rev accu
  68     else
  69       let s = f argv.(i) in
  70       let accu = s :: accu in
  71         loop accu (succ i)
  72   in
  73   let arg_list = loop [] pos in
  74     String.concat " " arg_list
  75
  76 let safe_group_extents group_nr =
  77   try
  78     Str.group_beginning group_nr, Str.group_end group_nr
  79   with Not_found ->
  80     failwith "Internal error (cannot get group extents)"
  81
  82 let safe_group group_nr s =
  83   try
  84     Str.matched_group group_nr s
  85   with Not_found ->
  86     failwith "Internal error (cannot find matched group)"
  87
  88 let safe_group_end group_nr =
  89   try
  90     Str.group_end group_nr
  91   with Not_found ->
  92     failwith "Internal error (cannot find group end)"
  93
  94 let some_action f d = function
  95   | None ->
  96       d
  97   | Some v ->
  98       f v
  99
 100 let array_find_from p a pos =
 101   let rec loop i =
 102     if i >= Array.length a
 103     then
 104       false
 105     else
 106       p a.(i) || loop (succ i)
 107   in
 108     loop pos
 109
 110 let question_pred s = s = "/?" || s = "-?"
 111 let contains_question argv arg_start =
 112   array_find_from question_pred argv arg_start
 113
 114 let tool_name s =
 115   try
 116     Unix.getenv ("IMT_" ^ (String.uppercase s))
 117   with Not_found ->
 118     s
 119
 120 let build_reject_list () =
 121   let rejs =
 122     try
 123       Some (Unix.getenv "IMT_REJ")
 124     with Not_found ->
 125       None
 126   in
 127     match rejs with
 128       | None ->
 129           []
 130
 131       | Some rejs ->
 132           let l = String.length rejs in
 133           let rec collect accu old_pos =
 134             if old_pos >= l
 135             then
 136               accu
 137             else
 138               let pos =
 139                 try
 140                   String.index_from rejs old_pos ':'
 141                 with Not_found->
 142                   l
 143               in
 144               let s = String.sub rejs old_pos (pos - old_pos) in
 145               let accu =
 146                 let re =
 147                   if Sys.os_type = "Win32"
 148                   then
 149                     Str.regexp_string_case_fold s
 150                   else
 151                     Str.regexp_string s
 152                 in
 153                   re :: accu
 154               in
 155                 collect accu (pos + 1)
 156           in
 157             collect [] 0
 158
 159 let quotere = Str.regexp "\""
 160
 161 let quote s =
 162   if String.contains s ' '
 163   then
 164     let ss = Str.global_substitute quotere (fun _ -> "\\\"") s in
 165       "\"" ^ ss ^ "\""
 166   else
 167     s
 168
 169 let output_quoted_path oc s =
 170   if String.contains s ' '
 171   then
 172     let ss = Str.global_substitute quotere (fun _ -> "\\\"") s in
 173       output_char oc '"';
 174       output_string oc ss;
 175       output_char oc '"'
 176   else
 177     output_string oc s
 178
 179 let reject_path s = function
 180   | [] -> false
 181   | rejrel ->
 182       let rec find = function
 183         | [] -> false
 184         | rejre :: tl ->
 185             if Str.string_partial_match rejre s 0
 186             then
 187               true
 188             else
 189               find tl
 190       in
 191         find rejrel
 192
 193 let construct_args tool args extra =
 194   let cmdline =
 195     try
 196       let via = Sys.getenv "IMT_VIA" in
 197       let s1 =
 198         try
 199           let s = Sys.getenv "IMT_VIA_PASS_NAME" in
 200             s ^ " " ^ quote tool
 201         with Not_found ->
 202           tool
 203       and s2 =
 204         try
 205           let s = Sys.getenv "IMT_VIA_PASS_ARGS" in
 206             args ^ " " ^ s ^ " " ^ quote extra
 207         with Not_found ->
 208           args ^ " " ^ extra
 209       in
 210         via ^ " " ^ s1 ^ " " ^ s2
 211     with Not_found ->
 212       tool ^ " " ^ args ^ " " ^ extra
 213   in
 214     Wine.command cmdline
 215
 216 (* let construct_args tool args extra = *)
 217 (*   let s = construct_args tool args extra in *)
 218 (*     prerr_endline tool; *)
 219 (*     prerr_endline args; *)
 220 (*     prerr_endline extra; *)
 221 (*     prerr_endline s; *)
 222 (*     s *)