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

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


(* $Id: cam_cvs_view.ml 334 2006-10-06 07:34:42Z zoggy $ *)

module Ocvs_types = Ocamlcvs.Types
module Ocvs_commands = Ocamlcvs.Commands
module Ocvs_behav = Ocamlcvs.Behav
module Ocvs_list = Ocamlcvs.List
module Ocvs_tree = Ocamlcvs.Tree

module M = Cam_messages

class cvs_file_data () =
  object
    val mutable elements = ([] : Ocvs_types.cvs_info list)

    method elements dir =
      List.filter
        (fun ci ->
          (Filename.dirname ci.Ocvs_types.cvs_file) = dir)
        elements

    method update_element ci =
      let rec iter = function
          [] ->
            [ci]
        | t :: q when t.Ocvs_types.cvs_file = ci.Ocvs_types.cvs_file ->
            ci :: q
        | t :: q ->
            t :: (iter q)
      in
      elements <- iter elements

    method remove_element file =
      elements <- List.filter
          (fun t -> t.Ocvs_types.cvs_file <> file)
          elements

    method cvs_info_of_t (ci : Ocvs_types.cvs_info) = ci
    method t_of_cvs_info (ci : Ocvs_types.cvs_info) = ci
  end

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

(* Tree view *)
(*************)


let handle_error f p def =
  try f p
  with Failure s ->
    GToolbox.message_box M.error s; def

class cvs_tree root =
  let data = ((new cvs_file_data ()) :> Ocvs_types.cvs_info Ocvs_behav.data) in
  let cvs = new Ocamlcvs.Behav.cvs data in
  object (self)
    inherit Cam_dir_view.dir_view root as base

    method subdirs s =
      List.filter (fun s ->  Filename.basename s <> "CVS") (base#subdirs s)

    method private update_dir dir () =
      let f () =
        ignore (cvs#cvs_update_dir dir);
        Cam_view.refresh_ressource_views dir
      in
      handle_error f () ()

    method private commit_dir dir () =
      let f () =
        let com_opt = GToolbox.input_text
              M.enter_comment
              (M.enter_comment_commit^" : ")
        in
        match com_opt with
          None -> ()
        | Some comment ->
            cvs#cvs_commit_dir ~comment dir;
            Cam_view.refresh_ressource_views dir
      in
      handle_error f () ()

    method private add_dir dir () =
      let f () =
        match Cam_misc.select_in_list ~value_in_list: false
            ~choices: (List.map Filename.basename (self#subdirs dir)) ~title: M.add_dir
            (Printf.sprintf "%s/" dir)
        with
        | None -> ()
        | Some new_d ->
            let new_d = Filename.concat dir new_d in
            if Sys.file_exists new_d then
              (
               cvs#cvs_add_dir new_d;
               self#update_selected_dir
              )
            else
              (* ask for confirmation to create the directory *)
              match GToolbox.question_box
                  ~title: M.add_dir
                  ~buttons: [ M.yes ; M.no ]
                  (M.should_create_dir new_d)
              with
                1 ->
                  cvs#cvs_create_and_add_dir new_d;
                  self#update_selected_dir
              | _ ->
                  ()
      in
      handle_error f () ()

    method private tag_dir dir () =
      let f () =
        let tag_opt = GToolbox.input_string
            M.tag_dir
            (M.enter_tag_for_dir dir)
        in
        match tag_opt with
          None -> ()
        | Some tag ->
            let confirm s =
            (GToolbox.question_box
               ~title: M.confirm
               ~buttons: [ M.yes ; M.no ]
               s
            ) = 1
            in
            cvs#cvs_tag_dir confirm tag dir
      in
      handle_error f () ()

    method menu_ctx (selection : string option) =
      let l =
        match selection with
          None -> []
        | Some dir ->
            [
              `I (M.add_dir, self#add_dir dir) ;
              `I (M.update_dir, self#update_dir dir) ;
              `I (M.commit_dir, self#commit_dir dir) ;
              `I (M.tag_dir, self#tag_dir dir) ;
            ]
     in
     match l with
       [] -> base#menu_ctx selection
     | _ -> l @ (`S :: base#menu_ctx selection)

    method init_col_display ~col_display ~complete ~renderer store =
      let f (store:GTree.model) (iter:Gtk.tree_iter) =
        let s = store#get ~row: iter ~column: complete in
        let props =
          if Sys.file_exists (Filename.concat s "CVS"then
            [`WEIGHT `BOLD]
          else
            [`WEIGHT `NORMAL]
        in
        renderer#set_properties ((`TEXT (Filename.basename s)) :: props)
      in
      ignore (col_display#set_cell_data_func renderer f)

  end

class cvs_tree_view
    (name : Cam_view.view_name)
    (root : Cam_view.ressource_name)
    (gdir : Gdir.gdir)
    (close_window_on_close : bool) =
  object (self)
    method changed = false
    method close = close_window_on_close
    method name = name
    method refresh = gdir#update
    method ressource = root
    method ressource_kind : Cam_view.ressource_kind = `Dir
  end

class cvs_tree_factory : Cam_view.view_factory =
  object (self)
    method create res_name args =
      let gdir = new cvs_tree res_name in
      let v = new cvs_tree_view (self#name) res_name gdir true in
      let w = Cam_view.create_view_window
          ~title: (Printf.sprintf "%s [%s]" res_name self#name)
          v
      in
      let _ = w#vbox#pack ~expand: true gdir#box#coerce in
      (v, w#window)


    method create_no_window window res_name args =
      let gdir = new cvs_tree res_name in
      let v = new cvs_tree_view (self#name) res_name gdir false in
      (v, gdir#box#coerce)

    method known_ressource_kinds = [`Dir]
    method name = "cvstree"
  end

let _ = Cam_view.register_factory (new cvs_tree_factory)

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

(* List view *)
(*************)


let color_string_of_status s =
  match s with
  | Ocvs_types.Up_to_date -> "DarkGreen"
  | Ocvs_types.Locally_modified
  | Ocvs_types.Locally_added
  | Ocvs_types.Locally_removed -> "SlateBlue"
  | Ocvs_types.Needs_checkout -> "Orange"
  | Ocvs_types.Needs_Patch -> "Orange"
  | Ocvs_types.Needs_Merge -> "Orange"
  | Ocvs_types.Conflicts_on_merge -> "Red"
  | Ocvs_types.Unknown -> "Black"


class cvs_files_behaviour f_update dir =
  let data = ((new cvs_file_data ()) :> Ocvs_types.cvs_info Ocvs_behav.data) in
  object(self)
   inherit [Ocvs_types.cvs_info] Ocamlcvs.Behav.cvs data as cvs
   val mutable last_clicked_column = 0

    method elements = data#elements
   method update_element = data#update_element
   method remove_element = data#remove_element
   method t_of_cvs_info = data#t_of_cvs_info
   method cvs_info_of_t = data#cvs_info_of_t


    method comparison_function col =
      match col with
      | 1 -> fun ci1 -> fun ci2 ->
          compare
            (Ocvs_types.string_of_status ci1.Ocvs_types.cvs_status)
            (Ocvs_types.string_of_status ci2.Ocvs_types.cvs_status)
      | 2 -> fun ci1 -> fun ci2 ->
          compare ci1.Ocvs_types.cvs_work_rev ci2.Ocvs_types.cvs_work_rev
      | 3 -> fun ci1 -> fun ci2 ->
          compare ci1.Ocvs_types.cvs_rep_rev ci2.Ocvs_types.cvs_rep_rev
      | 4 -> fun ci1 -> fun ci2 ->
          compare ci1.Ocvs_types.cvs_date_string ci2.Ocvs_types.cvs_date_string
      | _ -> fun ci1 -> fun ci2 ->
          compare ci1.Ocvs_types.cvs_file ci2.Ocvs_types.cvs_file

    method display_strings ci =
      (Some (color_string_of_status ci.Ocvs_types.cvs_status),
       [ Filename.basename ci.Ocvs_types.cvs_file ;
         Ocvs_types.string_of_status ci.Ocvs_types.cvs_status ;
         ci.Ocvs_types.cvs_work_rev ;
         ci.Ocvs_types.cvs_rep_rev ;
         ci.Ocvs_types.cvs_date_string ;
       ]
      )

    method autorize_file (f : Ocvs_types.cvs_info) =
(*
      print_string ("autorize file"^file.f_name); print_newline () ;
      if data#file_changed file
      then
        match GToolbox.question_box
            ~title: M.mQuestion
            ~buttons: [ M.continue ;
                        M.skip ;
                        M.stop ]
            (M.save_changed_file_before file.f_name)
        with
          1 ->
            data#save_file file ;
            Ocvs_behav.Continue
        | 2 -> Ocvs_behav.Skip
        | _ -> Ocvs_behav.Stop
      else
*)

        Ocvs_behav.Continue

    method after_action (_ : Ocvs_types.cvs_info) = ()

    method private real_cvs_add_files binary () =
      (* A VOIR : a changer quand on aura la sélection multiple
         dans select_files *)

      let add f =
        let (ok, ko) = cvs#cvs_add_files ~binary: binary [f] in
        match ko with
          _ :: _ ->
            GToolbox.message_box M.error (M.error_add_files ko)
        | [] ->
            ()
      in
      match GToolbox.select_file ~dir: (ref dir) ~title: M.add_files () with
         Some f -> add f; f_update ()
       | None -> ()

    method private add_files = self#real_cvs_add_files false
    method private add_binary_files = self#real_cvs_add_files true

   method private commit_selected_files selection () =
      (* appeler autorize_file pour chaque élément sélectionné. *)
      let files_ok =
        try
          let f acc file =
            match self#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
        [] -> ()
      | files ->
          let files = List.map (fun t -> t.Ocvs_types.cvs_file) files in
          let f () =
            let comment_opt = GToolbox.input_text
               M.enter_comment
               (M.enter_comment_commit^" : ")
            in
            match comment_opt with
              None -> ()
            | Some s ->
                cvs#cvs_commit_files ~comment: s files
          in
          handle_error f () () ;
          f_update ()

    method private tag_selected_files selection () =
      let files = List.map (fun t -> t.Ocvs_types.cvs_file) selection in
      (* ask for tag *)
      match GToolbox.input_string
          M.tag_files
          (M.enter_tag_for_files files)
      with
      |        None -> ()
      |        Some tag ->
          let f () =
            let confirm s =
              (GToolbox.question_box ~title: M.confirm
                 ~buttons: [ M.yes ; M.no ]
                 s
              ) = 1
            in
            cvs#cvs_tag_files confirm tag files
          in
          handle_error f () ()

    method private tags_of_selected_file selection () =
      match selection with
        [] -> ()
      | file :: _ ->
          let f () =
            let filename = file.Ocvs_types.cvs_file in
            let tags_revs = cvs#cvs_tags_file filename in
            Ocvs_list.display_string_list_list
              ~width: 300 ~height: 400
              (M.tags_of filename)
              [ M.tag ; M.revision ]
              (List.map (fun (t,r) -> [t ; r]) tags_revs)
          in
          handle_error f () ()


    method private remove_selected_files selection () =
      let files = List.map (fun t -> t.Ocvs_types.cvs_file) selection in
       let f () =
         (* ask for confirmation *)
         match GToolbox.question_box
             ~title: M.remove_files
             ~buttons: [ M.ok ; M.cancel ]
             (M.confirm_remove_files files)
         with
           1 ->
             (
              let (ok, ko) = cvs#cvs_remove_files files in
              match ko with
              | [] -> ()
              |        _ :: _ ->
                  GToolbox.message_box M.error
                    (M.error_remove_files ko)
             );
             f_update ()
         | _ ->
             ()
       in
       handle_error f () ()

    method private lastdiff_selected_file selection () =
      let f () =
        match selection with
          [] -> ()
        | cvsi :: _ ->
            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, _ ) = cvs#cvs_diff_file filename in
                Ocamlcvs.Diffs.display_diffs
                  ~title: (filename^" : "^Ocvs_messages.m_last_diff)
                  ~file: filename
                  diffs
      in
      handle_error f () ()

    method private revisions_file file =
      let f () =
        let filename = file.Ocvs_types.cvs_file in
        let revs = cvs#cvs_revisions_file filename in
        revs
      in
      handle_error f () []

    method private select_revision file =
      let f () =
        let revs = self#cvs_revisions_file file in
        match revs with
          [] -> None
        | _ ->
            match Ocamlcvs.Revisions.first_revision revs with
              None -> None
            | Some first_rev ->
                let rec build_tree rev =
                  match Ocamlcvs.Revisions.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 = Ocamlcvs.Revisions.string_of_revision_number rev.Ocvs_types.rev_number in
                let f_string rev = Glib.Convert.locale_to_utf8
                    (Ocamlcvs.Revisions.string_of_revision rev)
                in
                GToolbox.tree_selection_dialog ~title: file
                  ~tree: tree
                  ~label: f_label
                  ~info: f_string
                  ()
      in
      handle_error f () None

    method private log_selected_file selection () =
      match selection with
        [] -> ()
      | f :: _ ->
          let f () =
            let cvsi = self#cvs_info_of_t f in
            let log = cvs#cvs_log_file cvsi.Ocvs_types.cvs_file in
            Ocvs_list.display_log ~title: cvsi.Ocvs_types.cvs_file ~log ()
          in
          handle_error f () ()

    method private differences_with selection () =
      match selection with
        [] -> ()
      | file :: _ ->
          let filename = (self#cvs_info_of_t file).Ocvs_types.cvs_file in
          let f () =
            match self#select_revision filename with
              None -> ()
            | Some rev ->
                let (diffs, _) = cvs#cvs_diff_file
                    ~rev: rev filename
                in
                Ocamlcvs.Diffs.display_diffs
                  ~title: (filename^" : "^
                           (Ocvs_revision.string_of_revision_number rev.Ocvs_types.rev_number)^
                           " -> "^Ocvs_messages.working_rev)
                  ~file: filename
                  diffs
          in
          handle_error f () ()

   method private differences_between selection () =
      match selection with
        [] -> ()
      | file :: _ ->
          let filename = file.Ocvs_types.cvs_file in
          let f () =
            match self#select_revision filename with
              None -> ()
            | Some rev ->
                match self#select_revision filename with
                  None -> ()
                | Some rev2 ->
                    let (diffs, archive) = cvs#cvs_diff_file
                        ~rev: rev ~rev2: rev2 filename
                    in
                    let temp_file = cvs#rcs_revision rev2 archive in
                    Ocamlcvs.Diffs.display_diffs
                      ~on_close: (fun () -> Ocvs_commands.delete_file temp_file)
                      ~title:
                      (filename^" : "^
                       (Ocamlcvs.Revisions.string_of_revision_number rev.Ocvs_types.rev_number)^
                       " -> "^
                       (Ocamlcvs.Revisions.string_of_revision_number rev2.Ocvs_types.rev_number)
                      )
                      ~file: temp_file
                      diffs
          in
          handle_error f () ()

    method private resolve_conflicts selection () =
      match selection with
        [] -> ()
      | file :: _ ->
          let f () =
            match file.Ocvs_types.cvs_status with
              Ocvs_types.Conflicts_on_merge  ->
                Ocamlcvs.Diffs.manual_merge M.resolve_conflicts file.Ocvs_types.cvs_file
            | _ -> ()
          in
          handle_error f () ()

    method menu_ctx (selection : Ocvs_types.cvs_info list) : GToolbox.menu_entry list =
      match selection with
        [] ->
          [
            `I (M.add_files, self#add_files) ;
            `I (M.add_binary_files, self#add_binary_files) ;
          ]
        | f :: _ ->
            let cvs_choices =
              [
                `I (M.add_files, self#add_files) ;
                `I (M.add_binary_files, self#add_binary_files) ;
                `I (M.commit_files, self#commit_selected_files selection);
                `I (M.tag_files, self#tag_selected_files selection) ;
                `I (M.tags_of_file, self#tags_of_selected_file selection) ;
                `I (M.remove_files, self#remove_selected_files selection) ;
                `I (M.last_diff, self#lastdiff_selected_file selection) ;
                `I (M.diff_with, self#differences_with selection) ;
                `I (M.diff_between, self#differences_between selection) ;
                `I (M.resolve_conflicts, self#resolve_conflicts selection);
                `I (M.log, self#log_selected_file selection);
              ]
            in
            let l =
              match Cam_files.edition_commands_menu_entries f.Ocvs_types.cvs_file with
                [] -> []
              | l -> l @ [`S]
            in
            l @ cvs_choices

    method titles = [ "file" ; "status""working rev." ; "rep. rev." ; "date"]

    method select (_ : Ocvs_types.cvs_info) = ()
    method unselect (_ : Ocvs_types.cvs_info) = ()

    method double_click (_ : Ocvs_types.cvs_info) = ()
(*
      Cam_misc.execute_command Cam_config.file_double_click_command#get ()
*)


    method needs_cvs_status = true
  end

class cvs_files_view
    (name : Cam_view.view_name)
    (root : Cam_view.ressource_name)
    (lb : Ocvs_types.cvs_info Ocvs_behav.list_behaviour)
    (box : Ocvs_types.cvs_info Ocvs_list.box)
    close_window_on_close =
  object (self)
    method changed = false
    method close : bool = close_window_on_close
    method name = name
    method refresh = box#display_dir ~force: true (Some root)
    method ressource = root
    method ressource_kind : Cam_view.ressource_kind = `Dir

    initializer
      lb#cvs_status_dir root;
      self#refresh
  end

class cvs_files_factory : Cam_view.view_factory =
  object (self)
    method create res_name args =
      let ref_f_update = ref (fun () -> ()) in
      let f_update () = !ref_f_update () in
      let lb = new cvs_files_behaviour f_update res_name in
      let box = new Ocvs_list.box ~display_dir: false lb in
      ref_f_update := (fun () -> box#display_dir ~force: true (Some res_name));
      let v = new cvs_files_view (self#name) res_name lb box true in
      let w = Cam_view.create_view_window
          ~width: 500
          ~height: 500
          ~title: (Printf.sprintf "%s [%s]" res_name self#name)
          v
      in
      let _ = w#vbox#pack ~expand: true box#box#coerce in
      (v, w#window)

    method create_no_window window res_name args =
      let ref_f_update = ref (fun () -> ()) in
      let f_update () = !ref_f_update () in
      let lb = new cvs_files_behaviour f_update res_name in
      let box = new Ocvs_list.box ~display_dir: false lb in
      ref_f_update := (fun () -> box#display_dir ~force: true (Some res_name));
      let v = new cvs_files_view (self#name) res_name lb box false in
      (v, box#box#coerce)

    method known_ressource_kinds = [`Dir]
    method name = "cvsfiles"
  end

let _ = Cam_view.register_factory (new cvs_files_factory)

(*
let listbox = new Ocvs_list.box (lb)
let tb =
    new tree_behaviour f_roots
let treebox = new Gdir.gdir (tb :> Gdir.gdir_behaviour)
*)