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

(*                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                                          *)
(*                                                                               *)
(*********************************************************************************)


(** The list widget to display files. *)


(** To display a list of list of strings. *)

let display_string_list_list ?(modal=false)
    ?(width=500) ?(height=500) title titles lists =
  let window = GWindow.window
      ~title: title
      ~width: width
      ~height: height
      ~modal: modal
      ()
  in
  let _ =
    if modal then
      let _ = window #connect#destroy ~callback: (GMain.Main.quit) in ()
  in
  let vbox = GPack.vbox ~packing: window#add () in

  (* the wlist *)
  let wscroll = GBin.scrolled_window
      ~vpolicy: `AUTOMATIC
      ~hpolicy: `AUTOMATIC
      ~packing: (vbox#pack ~expand: true)
      ()
  in
  let wlist = GList.clist
      ~titles: titles
      ~titles_show: true
      ~packing: wscroll#add
      ()
  in

  let hbox_boutons = GPack.hbox ~packing: (vbox#pack ~expand: false) () in
  let wb_ok = GButton.button
      ~label: Ocvs_messages.mOk
      ~packing: (hbox_boutons#pack ~expand: true ~padding: 3) ()
  in
  let _ = wb_ok#connect#clicked window#destroy in

  let _ = window#event#connect#key_press
      ~callback:(fun ev -> if (GdkEvent.Key.keyval ev = GdkKeysyms._Return) then window#destroy (); true)
  in

  List.iter
    (fun l -> let _ = wlist#append l in ())
    lists;
  GToolbox.autosize_clist wlist ;

  window#show ();

  if modal then GMain.Main.main () else ()


let display_log ?(modal=false) ?(width=400) ?(height=600) ~title ~log () =
  let window = GWindow.window
      ~title
      ~allow_shrink: true
      ~width: width
      ~height: height
      ~modal: modal
      ()
  in
  let vbox = GPack.vbox ~packing: window#add () in
  let wscroll = GBin.scrolled_window
      ~vpolicy: `AUTOMATIC
      ~hpolicy: `AUTOMATIC
      ~packing: (vbox#pack ~expand: true ~padding: 2) ()
  in
  let wview = GText.view
(*      ~height: 100*)
      ~editable: false
      ~packing: wscroll#add
      ()
  in
  let wb = GButton.button ~label: Ocvs_messages.close
      ~packing: (vbox#pack ~expand: false)
      ()
  in
  let sep = "----------------------------\n" in
  let l = Str.split (Str.regexp_string sep) log in
  let tag = wview#buffer#create_tag [`FONT "fixed"in
  let rec iter = function
      [] -> ()
    | [h] ->wview#buffer#insert ~tags: [tag] h
    | h :: q ->
        wview#buffer#insert ~tags: [tag] h;
        let tag2 = wview#buffer#create_tag [`FOREGROUND "Blue"in
        wview#buffer#insert ~tags: [tag ; tag2] sep;
        iter q
  in
  iter l;
  ignore (wb#connect#clicked window#destroy);
  window#show ();
  if modal then
    (
     ignore (window#connect#destroy GMain.Main.quit);
     GMain.Main.main ()
    )
  else
    ()



class ['a] box ?(display_dir=true)
    (behav : 'Ocvs_behav.list_behaviour) =
  let vbox = GPack.vbox () in

  (* for the directory name *)
  let hbox_dir = GPack.hbox () in
  let _ =
    if display_dir then
      ignore (vbox#pack ~expand: false hbox_dir#coerce)
    else
      ()
  in
  let _wl_dir = GMisc.label
      ~text: (Ocvs_messages.directory^" : ")
      ~packing: (hbox_dir#pack ~expand: false ~padding: 3)
      ()
  in
  let we_dir = GEdit.entry
      ~editable: false
      ~packing: (hbox_dir#pack ~expand: true ~padding: 3)
      ()
  in

  (* the wlist *)
  let wscroll = GBin.scrolled_window
      ~vpolicy: `AUTOMATIC
      ~hpolicy: `AUTOMATIC
      ~packing: (vbox#pack ~expand: true)
      ()
  in
  let wlist = GList.clist
      ~titles: behav#titles
      ~titles_show: true
      ~selection_mode: `MULTIPLE
      ~packing: wscroll#add
      ()
  in

  object (self)
    val mutable selection = ([] : 'a list)
    val mutable elements = ([] : 'a list)
    val mutable dir = (None : string option)
    val mutable compare_function = (None : ('-> '-> int) option)

    method box = vbox

    method selection = selection

    method display_dir ?(force=behav#needs_cvs_status) dir_opt =
      dir <- dir_opt ;
      self#update force

    method private sort_elements l =
      match compare_function with
        None -> l
      |        Some f -> List.sort f l

    method private click_column col =
      compare_function <- Some (behav#comparison_function col) ;
      self#update behav#needs_cvs_status

    method update update_status =
      wlist#freeze ();
      selection <- [] ;
      wlist#clear () ;
      we_dir#set_text "";
      let _ =
        match dir with
          None ->
            elements <- []
        | Some d ->
            let _ =
              if update_status then
                try behav#cvs_status_dir d
                with Failure s -> prerr_endline s
              else
                ()
            in
            we_dir#set_text d;
            elements <- self#sort_elements (behav#elements d) ;
(*
            List.iter
              (fun e ->
                match snd (behav#display_strings e) with
                  file :: _ -> prerr_endline file
                | [] -> prerr_endline "no file"
              )
              elements;
*)

            List.iter
              (fun t ->
                let (color_opt, strings) = behav#display_strings t in
                let _ = wlist#append strings in
                match color_opt with
                  None -> ()
                | Some c ->
                    let _ = wlist#set_row ~foreground: (`NAME c)
                        (wlist#rows -1)
                    in
                    ()
              )
              elements;
            GToolbox.autosize_clist wlist
      in
      wlist#thaw ()

    method cvs_commit_selected_files =
      (* appeler autorize_file pour chaque élément sélectionné. *)
      let files_ok =
        try
          let f acc file =
            match behav#autorize_file file with
              Ocvs_behav.Skip -> acc
            | Ocvs_behav.Continue -> acc @ [file]
            | Ocvs_behav.Stop -> raise Not_found
          in
          List.fold_left f [] selection
        with
          Not_found -> []
      in
      match files_ok with
        [] -> ()
      |        l ->
          let files = List.map (fun t -> (behav#cvs_info_of_t t).Ocvs_types.cvs_file) l in
          let comment_opt = GToolbox.input_text
              Ocvs_messages.enter_comment
              (Ocvs_messages.enter_comment_commit^" : ")
          in
          match comment_opt with
            None ->
              ()
          | Some s ->
              (
               try behav#cvs_commit_files ~comment: s files
               with Failure s -> GToolbox.message_box Ocvs_messages.error s
              );
              self#update behav#needs_cvs_status

    method cvs_tag_selected_files =
      match selection with
        [] ->
          ()
      |        l ->
          let files = List.map (fun t -> (behav#cvs_info_of_t t).Ocvs_types.cvs_file) l in
         (* ask for confirmation *)
          match GToolbox.input_string
              Ocvs_messages.m_tag_files
              (Ocvs_messages.enter_tag_for_files files)
          with
            Some tag ->
              (
               let confirm s =
                 (GToolbox.question_box ~title: Ocvs_messages.mConfirm
                    ~buttons: [ Ocvs_messages.mYes ; Ocvs_messages.mNo ]
                   s) = 1
               in
               try behav#cvs_tag_files confirm tag files
               with Failure s -> GToolbox.message_box Ocvs_messages.error s
              )
          | None ->
              ()

    method cvs_tags_of_file =
      match self#selection with
        [] -> ()
      |        file :: _ ->
          try
            let filename = (behav#cvs_info_of_t file).Ocvs_types.cvs_file in
            let tags_revs = behav#cvs_tags_file filename in
            display_string_list_list
              ~width: 300 ~height: 400
              (Ocvs_messages.tags_of filename)
              [ Ocvs_messages.tag ; Ocvs_messages.revision ]
              (List.map (fun (t,r) -> [t ; r]) tags_revs)
          with
            Failure s ->
              GToolbox.message_box Ocvs_messages.error s


    method cvs_remove_selected_files =
      match selection with
        [] ->
          ()
      |        l ->
          let files = List.map (fun t -> (behav#cvs_info_of_t t).Ocvs_types.cvs_file) l in
         (* ask for confirmation *)
          match GToolbox.question_box
              ~title: Ocvs_messages.remove_files
              ~buttons: [ Ocvs_messages.mOk ; Ocvs_messages.mCancel ]
              (Ocvs_messages.confirm_remove_files files)
          with
            1 ->
              (
               let (ok, ko) = behav#cvs_remove_files files in
               match ok with
                 [] ->
                   GToolbox.message_box Ocvs_messages.error
                     (Ocvs_messages.error_remove_files ko)
               | _ ->
                   self#update behav#needs_cvs_status
              )
          | _ ->
              ()

    method cvs_log_file =
      match selection with
        [] ->
          ()
      |        f :: _ ->
          try
            let cvsi = behav#cvs_info_of_t f in
            let log = behav#cvs_log_file cvsi.Ocvs_types.cvs_file in
            display_log ~title: cvsi.Ocvs_types.cvs_file ~log ()
          with
            Failure s ->
              GToolbox.message_box Ocvs_messages.error s

    method cvs_lastdiff_file =
      match selection with
        [] ->
          ()
      |        f :: _ ->
          try
            let cvsi = behav#cvs_info_of_t f in
            match cvsi.Ocvs_types.cvs_status with
              Ocvs_types.Up_to_date
            | Ocvs_types.Locally_added
            | Ocvs_types.Locally_removed
            | Ocvs_types.Needs_checkout
            | Ocvs_types.Needs_Patch
            | Ocvs_types.Unknown ->
                raise (Failure Ocvs_messages.no_diff_to_display)

            | Ocvs_types.Conflicts_on_merge ->
                raise (Failure Ocvs_messages.resolve_conflicts_first)

            | Ocvs_types.Locally_modified
            | Ocvs_types.Needs_Merge ->
                let filename = cvsi.Ocvs_types.cvs_file in
                let (diffs, _ ) = behav#cvs_diff_file filename in
                let w = Odiff_gui.diffs_window
                    ~title: (filename^" : "^Ocvs_messages.m_last_diff)
                    ~file: filename
                    diffs
                in
                w#window#show ()
          with
            Failure s ->
              GToolbox.message_box Ocvs_messages.error s

    method cvs_revisions_file file =
      try
        let filename = (behav#cvs_info_of_t file).Ocvs_types.cvs_file in
        let revs = behav#cvs_revisions_file filename in
        revs
      with
        Failure s ->
          GToolbox.message_box Ocvs_messages.error s ;
          []

    method cvs_select_revision file =
      try
        let revs = self#cvs_revisions_file file in
        match revs with
          [] -> None
        | _ ->
            let filename = (behav#cvs_info_of_t file).Ocvs_types.cvs_file in
            match Ocvs_revision.first_revision revs with
              None -> None
            | Some first_rev ->
                let rec build_tree rev =
                  match Ocvs_revision.children_revisions revs rev with
                    [] -> `L rev
                  | subs -> `N (rev, List.map build_tree subs)
                in
                let tree = build_tree first_rev in
                let f_label rev = Ocvs_revision.string_of_revision_number rev.Ocvs_types.rev_number in
                let f_string rev = Glib.Convert.locale_to_utf8 (Ocvs_revision.string_of_revision rev) in
                GToolbox.tree_selection_dialog ~title: filename
                  ~tree: tree
                  ~label: f_label
                  ~info: f_string
                  ()
      with
        Failure s ->
          GToolbox.message_box Ocvs_messages.error s ;
          None

    method cvs_differences_with =
      match self#selection with
        [] -> ()
      |        file :: _ ->
          match self#cvs_select_revision file with
            None -> ()
          | Some rev ->
              try
                let filename = (behav#cvs_info_of_t file).Ocvs_types.cvs_file in
                let (diffs, _) = behav#cvs_diff_file
                    ~rev: rev filename
                in
                let title = Printf.sprintf "%s : %s -> %s"
                    filename
                    (Ocvs_revision.string_of_revision_number rev.Ocvs_types.rev_number)
                    Ocvs_messages.working_rev
                in
                let w = Odiff_gui.diffs_window ~title ~file: filename diffs in
                w#window#show ()
              with
                Failure s ->
                  GToolbox.message_box Ocvs_messages.error s

    method cvs_differences_between =
      match self#selection with
        [] -> ()
      |        file :: _ ->
          match self#cvs_select_revision file with
            None -> ()
          | Some rev ->
              match self#cvs_select_revision file with
                None -> ()
              | Some rev2 ->
                  try
                    let filename = (behav#cvs_info_of_t file).Ocvs_types.cvs_file in
                    let (diffs, archive) = behav#cvs_diff_file
                        ~rev: rev ~rev2: rev2 filename
                    in
                    let temp_file = behav#rcs_revision rev2 archive in
                    let title = Printf.sprintf "%s : %s -> %s"
                        filename
                        (Ocvs_revision.string_of_revision_number rev.Ocvs_types.rev_number)
                        (Ocvs_revision.string_of_revision_number rev2.Ocvs_types.rev_number)
                    in
                    let w = Odiff_gui.diffs_window ~title ~file: temp_file diffs in
                    let _ = w#window#connect#destroy (fun () -> Ocvs_commands.delete_file temp_file) in
                    w#window#show ()
                  with
                    Failure s ->
                      GToolbox.message_box Ocvs_messages.error s

    method cvs_resolve_conflicts =
      match self#selection with
        [] -> ()
      |        t :: _ ->
          let file = behav#cvs_info_of_t t in
          match file.Ocvs_types.cvs_status with
            Ocvs_types.Conflicts_on_merge  ->
              (
               try
                 let info = Odiff_merge.build_info file.Ocvs_types.cvs_file in
                 ignore (new Odiff_merge.window "test" file.Ocvs_types.cvs_file info)
               with Failure s ->
                 GToolbox.message_box Ocvs_messages.error s
              )
          | _ -> ()


    initializer
      (* testing teh double click *)
      let check_double_click event d =
        (
         match event with
           None -> ()
         | Some ev ->
             let t = GdkEvent.get_type ev in
             match t with
               `TWO_BUTTON_PRESS -> behav#double_click d
             | _ -> ()
        )
      in

      (* selection and deselection *)
      let f_select ~row ~column ~event =
        try
          let ele = List.nth elements row in
          selection <- ele :: selection ;
          behav#select ele;
          check_double_click event ele;
        with Failure _ -> ()
      in
      let f_unselect ~row ~column ~event =
        try
          let ele_unselected = List.nth elements row in
          let new_selection = List.filter (fun ele -> ele <> ele_unselected) selection in
          selection <- new_selection ;
          behav#unselect ele_unselected;
          check_double_click event ele_unselected;
        with
          Failure _ -> ()
      in
      (* connect the select and deselect events *)
      ignore (wlist#connect#select_row f_select) ;
      ignore (wlist#connect#unselect_row f_unselect) ;

      (* connect the click on a column header *)
      ignore (wlist#connect#click_column self#click_column) ;

      (* connect the press on button 3 for contextual menu *)
      ignore (wlist#event#connect#button_press ~callback:
                (
                 fun ev ->
                   GdkEvent.Button.button ev = 3 &&
                   GdkEvent.get_type ev = `BUTTON_PRESS &&
                   (
                    match behav#menu_ctx self#selection with
                      [] -> true
                    | l ->
                        GToolbox.popup_menu
                          ~button: 3
                          ~time: (Int32.of_int 0)
                          ~entries: l;
                        true
                   )
                )
             )

  end