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

(*                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 tree widget to display directories. *)


let file_exists f =
  try let _ = Unix.stat f in true
  with _ -> false


let is_prefix f1 f2 =
  let len1 = String.length f1 in
  let len2 = String.length f2 in
  (len1 < len2) &&
  (String.sub f2 0 len1) = f1


class ['a] box (behav : 'Ocvs_behav.tree_behaviour) =
  let vbox = GPack.vbox () in
  let wscroll = GBin.scrolled_window
      ~vpolicy: `AUTOMATIC
      ~hpolicy: `AUTOMATIC
      ~packing: (vbox#pack ~expand: true)
      ()
  in
  let cols = new GTree.column_list in
  let col_dir = cols#add Gobject.Data.string in
  let col_complete = cols#add Gobject.Data.string in

  let store = GTree.tree_store cols in
  let view = GTree.view ~model: store ~packing: wscroll#add_with_viewport () in
  let col = GTree.view_column ()
      ~renderer:(GTree.cell_renderer_text [], ["text", col_dir]) in
  let () = ignore (view#append_column col) in

  object(self)
    val mutable selection = (None : string option)

    method selection = selection

    method box = vbox

    method select_dir dir =
      selection <- Some dir ;
      behav#select dir

    method unselect_dir dir =
      selection <- None ;
      behav#unselect dir

    method insert_node ?parent dirname basename =
      let complete_name = Filename.concat dirname basename in
      let row = store#append ?parent () in
      store#set row col_dir basename;
      store#set row col_complete complete_name;

      let subdirs = Ocvs_misc.get_cvs_directories complete_name in
      match subdirs with
        [] ->
          ()
      | l ->
          let rr = store#get_row_reference (store#get_path row) in
          List.iter
            (self#insert_node ~parent: row complete_name)
            (List.sort compare l);
          if behav#expand_dir complete_name then
            view#expand_row rr#path

    method update =
      (
       match selection with
         None -> ()
       | Some dir ->
           selection <- None ;
           self#unselect_dir dir
      );
      store#clear ();
      List.iter (self#insert_node "") behav#roots

    method update_selected_dir =
      let sel = view#selection in
      match sel#get_selected_rows with
        [] -> ()
      |        row :: _ ->
          let it = store#get_iter row in
          while store#iter_has_child it do
            match Gstuff.find_first_child store it with
              None -> ()
            | Some iter -> ignore (store#remove iter)
          done;
          let dir = store#get ~row: it ~column: col_complete in
          let subdirs = Ocvs_misc.get_cvs_directories dir in
          (
           match subdirs with
             [] ->
               ()
           | l ->
               List.iter
                 (self#insert_node ~parent: it dir)
                 (List.sort compare l)
          );
          self#select_dir dir

    method cvs_update_dir =
      let sel = view#selection in
      match sel#get_selected_rows with
        [] -> ()
      |        row :: _ ->
          let it = store#get_iter row in
          let dir = store#get ~row: it ~column: col_complete in
          (
           (* A VOIR : demander les autorisations pour les fichiers ? *)
           try let _ = behav#cvs_update_dir dir in ()
           with Failure s -> GToolbox.message_box Ocvs_messages.error s
          );
          self#update_selected_dir
            (* A VOIR : mettre à jour les éléments dans data ?
               Non, car behav est au courant des fichiers modifiés
               et se mettra à jour tout seul.*)


    method cvs_commit_dir =
      let sel = view#selection in
      match sel#get_selected_rows with
        [] -> ()
      |        row :: _ ->
          let it = store#get_iter row in
          let dir = store#get ~row: it ~column: col_complete in
          (
           (* A VOIR : demander les autorisations pour les fichiers ? *)
           let com_opt = GToolbox.input_text
              Ocvs_messages.enter_comment
              (Ocvs_messages.enter_comment_commit^" : ")
           in
           match com_opt with
             None -> ()
           | Some comment ->
               (
                try let _ = behav#cvs_commit_dir ~comment: comment dir in ()
                with Failure s ->
                  GToolbox.message_box Ocvs_messages.error s
               );
               self#update_selected_dir
               (* A VOIR : mettre à jour les éléments dans data ?
                  Non, car behav est au courant des fichiers modifiés
                  et se mettra à jour tout seul.*)

          )

    method cvs_tag_dir =
      let sel = view#selection in
      match sel#get_selected_rows with
        [] -> ()
      |        row :: _ ->
          let it = store#get_iter row in
          let dir = store#get ~row: it ~column: col_complete in
           (* A VOIR : demander les autorisations pour les fichiers ? *)
           let tag_opt = GToolbox.input_string
               Ocvs_messages.m_tag_dir
               (Ocvs_messages.enter_tag_for_dir dir)
           in
           match tag_opt with
             None -> ()
           | 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_dir confirm tag dir
               with Failure s -> GToolbox.message_box Ocvs_messages.error s

    method cvs_add_dir =
      let sel = view#selection in
      match sel#get_selected_rows with
        [] -> ()
      |        row :: _ ->
          let it = store#get_iter row in
          let dir = store#get ~row: it ~column: col_complete in
          (
           match GToolbox.select_file ~dir: (ref dir) ~title: Ocvs_messages.add_dir () with
             Some new_d ->
               (
                try
                  if file_exists new_d then
                    (
                     behav#cvs_add_dir new_d;
                     if is_prefix dir new_d then
                       self#update_selected_dir
                     else
                       self#update
                    )
                  else
                    (* ask for confirmation to create the directory *)
                    match GToolbox.question_box
                        ~title: Ocvs_messages.add_dir
                        ~buttons: [ Ocvs_messages.mYes ; Ocvs_messages.mNo ]
                        (Ocvs_messages.should_create_dir new_d)
                    with
                      1 ->
                        behav#cvs_create_and_add_dir new_d;
                        if is_prefix dir new_d then
                          self#update_selected_dir
                        else
                          self#update
                    | _ ->
                        ()
                with
                  Failure s ->
                    GToolbox.message_box Ocvs_messages.error s
               )
           | None ->
               ()
          )

    method private real_cvs_add_files binary =
      let start_dir =
        match selection with
          None ->
            (
             match behav#roots with
               [] -> Unix.getcwd ()
             | s :: _ -> s
            )
        | Some d -> d
      in
      (* A VOIR : a changer quand on aura la sélection multiple
         dans select_files *)

      let add f =
        let (ok, ko) = behav#cvs_add_files ~binary: binary [f] in
        match ok with
          [] ->
            GToolbox.message_box Ocvs_messages.error
              (Ocvs_messages.error_add_files ko)
        | _ ->
            ()
      in
      (
       match GToolbox.select_file
           ~dir: (ref start_dir)
           ~title: Ocvs_messages.add_files
           ()
       with
         Some f -> add f
       | None -> ()
      );
      let sel = view#selection in
      match sel#get_selected_rows with
        [] -> ()
      |        row :: _ ->
          let it = store#get_iter row in
          let dir = store#get ~row: it ~column: col_complete in
          self#unselect_dir dir;
          self#select_dir dir

    method cvs_add_files = self#real_cvs_add_files false
    method cvs_add_binary_files = self#real_cvs_add_files true

    initializer

      view#selection#set_mode `SINGLE;

      ignore
        (view#connect#row_expanded
           (fun it _ ->
             let dir = store#get ~row: it ~column: col_complete in
             behav#add_expanded_dir dir
           )
        );
      ignore
        (view#connect#row_collapsed
           (fun it _ ->
             let dir = store#get ~row: it ~column: col_complete in
             behav#remove_expanded_dir dir
           )
        );
      ignore
        (view#selection#connect#changed
           (fun () ->
             (
              match selection with
                None -> ()
              | Some d -> self#unselect_dir d
             );
             let sel = view#selection in
             match sel#get_selected_rows with
               [] -> ()
             | row :: _ ->
                 let it = store#get_iter row in
                 let dir = store#get ~row: it ~column: col_complete in
                 self#select_dir dir
           )
        );

      (* connect the press on button 3 for contextual menu *)
      let _ = view#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
           )
        )
      in

      self#update
  end