(*********************************************************************************)

(*                Cameleon                                                       *)
(*                                                                               *)
(*    Copyright (C) 2005,2006 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Library General Public License as            *)
(*    published by the Free Software Foundation; either version 2 of the         *)
(*    License, or  any later version.                                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Library General Public          *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)


(** Convenient functions. *)


let map_opt f = function
    None -> None
  | Some v -> Some (f v)


let rec my_int_of_string s =
  let len = String.length s in
  if len <= 0 then invalid_arg "my_int_of_string";
  match s.[0] with
    '+' -> my_int_of_string (String.sub s 1 (len - 1))
  | _ -> int_of_string s

(*c==v=[String.chop_n_char]=1.0====*)
let chop_n_char n s =
  let len = String.length s in
  if len <= n +1 or n < 0 then
    s
  else
    Printf.sprintf "%s..." (String.sub s 0 (n+1))
(*/c==v=[String.chop_n_char]=1.0====*)
(*c==v=[List.list_remove_doubles]=1.0====*)
let list_remove_doubles ?(pred=(=)) l =
  List.fold_left
    (fun acc e -> if List.exists (pred e) acc then acc else e :: acc)
    []
    (List.rev l)
(*/c==v=[List.list_remove_doubles]=1.0====*)

let add_shortcut w l ((mods, k), action) =
  try
    let (c_opt, f) = List.assoc action l in
    Okey.add ?cond: c_opt w ~mods k f
  with
    Not_found ->
      prerr_endline (Cam_messages.error_unknown_action action)
(*c==v=[File.file_of_string]=1.1====*)
let file_of_string ~file s =
  let oc = open_out file in
  output_string oc s;
  close_out oc
(*/c==v=[File.file_of_string]=1.1====*)

(* from GToolbox *)
let mOk = "Ok"
let mCancel = "Cancel"
let input_widget ~widget ~event ~get_text ~bind_ok ~expand
    ~title ?(ok=mOk) ?(cancel=mCancel) message =
  let retour = ref None in
  let window = GWindow.dialog ~title ~modal:true () in
  ignore (window#connect#destroy ~callback: GMain.Main.quit);
  let main_box = window#vbox in
  let hbox_boutons = window#action_area in

  let vbox_saisie = GPack.vbox ~packing: (main_box#pack ~expand: true) () in

  let _wl_invite = GMisc.label
      ~text: message
      ~packing: (vbox_saisie#pack ~padding: 3)
      ()
  in

  vbox_saisie#pack widget ~expand ~padding: 3;

  let wb_ok = GButton.button ~label: ok
      ~packing: (hbox_boutons#pack ~expand: true ~padding: 3) () in
  wb_ok#grab_default ();
  let wb_cancel = GButton.button ~label: cancel
      ~packing: (hbox_boutons#pack ~expand: true ~padding: 3) () in
  let f_ok () =
    retour := Some (get_text ()) ;
    window#destroy ()
  in
  let f_cancel () =
    retour := None;
    window#destroy ()
  in
  ignore(wb_ok#connect#clicked f_ok);
  ignore(wb_cancel#connect#clicked f_cancel);

  (* the enter key is linked to the ok action *)
  (* the escape key is linked to the cancel action *)
  event#connect#key_press ~callback:
    begin fun ev ->
      if GdkEvent.Key.keyval ev = GdkKeysyms._Return && bind_ok then f_ok ();
      if GdkEvent.Key.keyval ev = GdkKeysyms._Escape then f_cancel ();
      false
    end;

  widget#misc#grab_focus ();
  window#show ();
  GMain.Main.main ();

  !retour
(* /from GToolbox *)

let select_in_list ?ok ?cancel ?(allow_empty=false) ?(value_in_list=true) ~title ~choices message =
  let wc = GEdit.combo
      ~popdown_strings: choices
      ~allow_empty
      ~value_in_list
      ()
  in
  input_widget ~widget:wc#coerce ~event:wc#entry#event
    ~get_text:(fun () -> wc#entry#text) ~bind_ok:true
    ~expand: false
    ~title ?ok ?cancel message

let remove_char s c =
  if s <> "" then
    for i = 0 to (String.length s) - 1 do
      if s.[i] = c then s.[i] <- ' '
    done;
  s

let treat_gtk_events () =
  while Glib.Main.pending () do
    ignore (Glib.Main.iteration false)
  done

let get_wm_window_position_offset () =
  let win = GWindow.window ~width: 0 ~height: 0 () in
  win#show ();
  let (x,y) = Gdk.Window.get_position win#misc#window in
  win#move ~x ~y;
  treat_gtk_events ();
  let (x2,y2) = Gdk.Window.get_position win#misc#window in
  win#destroy ();
  Cam_dbg.print ~level: 3
    (Printf.sprintf "get_wm_window_position_offset: offset: x=%d-%d=%d y=%d-%d=%d"
       x2 x (x2-x) y2 y (y2-y));
  (x2 - x, y2 - y)

(*c==v=[File.subdirs]=0.2====*)
let subdirs path =
  let d = Unix.opendir path in
  let rec iter acc =
    let file =
      try Some (Unix.readdir d)
      with End_of_file -> Unix.closedir d; None
    in
    match file with
    | None -> List.rev acc
    | Some s when
        s = Filename.current_dir_name or
        s = Filename.parent_dir_name -> iter acc
    | Some file ->
        let complete_f = Filename.concat path file in
        match
          try Some (Unix.stat complete_f).Unix.st_kind
          with _ -> None
        with
          Some Unix.S_DIR -> iter (complete_f :: acc)
        | None | Some _ -> iter acc
  in
  iter []
(*/c==v=[File.subdirs]=0.2====*)

let line_of_char file n =
  try
    let chanin = open_in file in
    let rec iter l m =
      let s_opt =
        try Some (input_line chanin)
        with End_of_file -> None
      in
      match s_opt with
        None -> l
      | Some s ->
          let new_m = m + ((String.length s) + 1) in (* + 1 is for '\\' *)
          if new_m >= n then
            l
          else
            iter (l + 1) new_m
    in
    let l = iter 0 0 in
    close_in chanin ;
    l
  with
    Sys_error s ->
      prerr_endline s ;
      0
(*c==v=[String.replace_in_string]=1.0====*)
let replace_in_string ~pat ~subs ~s =
  let len_pat = String.length pat in
  let len = String.length s in
  let b = Buffer.create len in
  let rec iter pos =
    if pos >= len then
      ()
    else
      if pos + len_pat > len then
        Buffer.add_string b (String.sub s pos (len - pos))
      else
        if String.sub s pos len_pat = pat then
          (
           Buffer.add_string b subs;
           iter (pos+len_pat)
          )
        else
          (
           Buffer.add_char b s.[pos];
           iter (pos+1);
          )
  in
  iter 0;
  Buffer.contents b
(*/c==v=[String.replace_in_string]=1.0====*)

let escape_menu_label s = replace_in_string ~pat: "_" ~subs: "__" ~s

let utf8_nb_bytes_of_char c =
  let n = Char.code c in
  if n < 0b10000000 then
    1
  else if n < 0b11100000 then
      2
    else if n < 0b11110000 then
        3
      else
        4

let utf8_index_of_char s c =
  let cpt = ref 0 in
  let current = ref 0 in
  let len = String.length s in
  while !current < c && !cpt < len do
    cpt := !cpt + utf8_nb_bytes_of_char s.[!cpt];
    incr current;
  done;
  if !current = c then
    !cpt
  else
    raise Not_found

let utf8_char_of_index s i =
  let len = String.length s in
  if i >= len or i < 0 then
    invalid_arg "utf8_char_from_index"
  else
    begin
      let char_count = ref (-1) in
      let pos = ref 0 in
      while !pos <= i && !pos < len do
        incr char_count;
        pos := !pos + utf8_nb_bytes_of_char s.[!pos]
      done;
      !char_count
    end

let utf8_string_length s =
  let len = String.length s in
  let rec iter acc n =
    if n >= len then
      acc
    else
      iter (acc+1) (n + (utf8_nb_bytes_of_char s.[n]))
  in
  iter 0 0

(** conversions algorithm from http://en.wikipedia.org/wiki/UTF-8. *)

let utf8_char_of_code n =
  if n < 128 then
    String.make 1 (Char.chr n)
  else
    let z_mask = 0b00111111 in
    let z_part = (n land z_mask) in
    let z = 0b10000000 lor z_part in
    if n <= 0x0007FF then
      let y_mask = 0b0000011111000000 in
      let y_part = (n land y_mask) lsr 6 in
      let y = 0b11000000 lor y_part in
      Printf.sprintf "%c%c" (Char.chr y) (Char.chr z)
    else
      let y_mask = 0b111111000000 in
      let y_part = (n land y_mask) lsr 6 in
      let y = 0b10000000 lor y_part in
      if n <= 0x00FFFF then
        let x_mask = 0b1111 lsl 12 in
        let x_part = (n land x_mask) lsr 12 in
        let x = 0b11100000 lor x_part in
        Printf.sprintf "%c%c%c" (Char.chr x) (Char.chr y) (Char.chr z)
      else
        if n <= 0x10FFFF then
          let x_mask = 0b111111 lsl 12 in
          let x_part = (n land x_mask) lsr 12 in
          let x = 0b10000000 lor x_part in
          let w_mask = 0b111 lsl 18 in
          let w_part = (n land w_mask) lsr 18 in
          let w = 0b11110000 lor w_part in
          Printf.sprintf "%c%c%c%c" (Char.chr w) (Char.chr x) (Char.chr y) (Char.chr z)
        else
          failwith (Printf.sprintf "UTF-8 code out of range: %x" n)