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

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


(** Types and objects to specify the behaviour of the list and tree displaying cvs-handled files. *)


open Ocvs_types

type autorization_response =
    Continue 
     (** ok *)

  | Skip 
    (** Skip this file *)

  | Stop 
    (** Stop the command *)


class type ['a] data =
  object
    
    (** get elements from a key *)

    method elements : string -> 'a list
    
    (** add or update element *)

    method update_element : '-> unit
    method remove_element : string -> unit

    method t_of_cvs_info : cvs_info -> 'a
    method cvs_info_of_t : '-> cvs_info

  end

class type ct_cvs =
  object
    method cvs_status_dir : string -> unit
    method cvs_status_files : string list -> unit
    method cvs_commit_files : ?comment: string -> string list -> unit
    method cvs_commit_dir : ?comment: string -> string -> unit
    method cvs_update_dir : string -> (string * update_action) list
    method cvs_add_dir : string -> unit
    method cvs_create_and_add_dir : string -> unit
    method cvs_add_files : ?binary: bool -> string list -> string list * string list
    method cvs_remove_files : string list -> string list * string list
    method cvs_diff_file :
        ?rev: cvs_revision ->
          ?rev2: cvs_revision ->
            string -> Odiff.diffs * string
    method cvs_revisions_file : string -> Ocvs_types.cvs_revision list
    method rcs_revision : cvs_revision -> string -> string

    method cvs_tags_file : string -> (string * string) list
    method cvs_tag_files : (string -> bool) -> string -> string list -> unit
    method cvs_tag_dir : ?recursive: bool -> (string -> bool) -> string -> string -> unit

    method cvs_log_file : string -> string
  end

class type ['a] list_behaviour =
  object
    inherit ct_cvs

    
    (** get the elements from a directory *)

    method elements : string -> 'a list

    
    (** add or update element *)

    method update_element : '-> unit
    method remove_element : string -> unit
    method t_of_cvs_info : cvs_info -> 'a
    method cvs_info_of_t : '-> cvs_info

    
    (** return a comparison function in function of a number (0-based) of column. The comparison function is used to sort a list of elements. *)

    method comparison_function : int -> ('-> '-> int)

    
    (** the function giving the optional color and the strings to display for a file in a list *)

    method display_strings : '-> string option * string list

    
    (** the titles of columns *)

    method titles : string list

    
    (** to call for each file before performing an operation on it, for example to save a file before a commit. *)

    method autorize_file : '-> autorization_response

    
    (** to call after an operation on a file, for example, to reload a file after an update.*)

    method after_action : '-> unit

    
    (** to get the contextual menu, depending on the selected elements *)

    method menu_ctx : 'a list -> GToolbox.menu_entry list

    
    (** to call when an element is selected *)

    method select : '-> unit

    
    (** to call when an element is unselected *)

    method unselect : '-> unit

    
    (** to call when an element is double clicked *)

    method double_click : '-> unit

    
    (** indicate whether the update of the list needs a 'cvs status'.*)

    method needs_cvs_status : bool
  end

class type ['a] tree_behaviour =
  object
    inherit ct_cvs

    
    (** expand the given directory or not *)

    method expand_dir : string -> bool

    
    (** set the given directory as expanded *)

    method add_expanded_dir : string -> unit

    
    (** remove the given directory as expanded *)

    method remove_expanded_dir : string -> unit

    
    (** add or update element *)

    method update_element : '-> unit

    method t_of_cvs_info : cvs_info -> 'a

    
    (** root directories *)

    method roots : string list

    
    (** to get the contextual menu, depending on the selected directory *)

    method menu_ctx : string option -> GToolbox.menu_entry list

    
    (** to call when a directory is selected *)

    method select : string -> unit

    
    (** to call when a directory is unselected *)

    method unselect : string -> unit

  end


class ['a] cvs (data : 'a data) =
  object(self)
    method cvs_status_dir dir =
      try
        let cvs_info_list = Ocvs_commands.status_dir dir in
        List.iter (fun ci -> data#update_element (data#t_of_cvs_info ci)) cvs_info_list
      with
        CvsFailure s
      |        CvsPartFailure s ->
          raise (Failure s)

    method cvs_status_files files =
      try
        let cvs_info_list = Ocvs_commands.status_files files in
        List.iter (fun ci -> data#update_element (data#t_of_cvs_info ci)) cvs_info_list
      with
        CvsFailure s
      |        CvsPartFailure s ->
          raise (Failure s)

    method cvs_commit_files ?(comment="") files =
      try
        Ocvs_commands.commit_files ~comment: comment files;
        (* Update the elements in data. *)
        try
          (* we remove the files which don't appear any more *)
          let (exist, not_exist) = List.partition Sys.file_exists files in
          List.iter data#remove_element not_exist ;
          (* and update the others *)
          self#cvs_status_files exist
        with _ -> ()
      with
        CvsFailure s
      |        CvsPartFailure s ->
          raise (Failure s)

    method cvs_commit_dir ?(comment="") dir =
      try
        Ocvs_commands.commit_dir ~comment: comment dir;
        (* Update the elements in data. *)
        try
          let check_dirs = dir :: (Ocvs_misc.get_cvs_directories dir) in
          let f d =
            let files = List.map
                (fun e -> (data#cvs_info_of_t e).Ocvs_types.cvs_file)
                (data#elements d)
            in
            (* we remove the files which don't appear any more *)
            let (exist, not_exist) = List.partition Sys.file_exists files in
            List.iter data#remove_element not_exist ;
            (* and update the others *)
            self#cvs_status_files exist
          in
          List.iter f check_dirs
        with _ -> ()
      with
        CvsFailure s
      |        CvsPartFailure s ->
          raise (Failure s)

    method cvs_update_dir (dir : string) =
      try
        let l = Ocvs_commands.update_dir dir in
        (* we must remove from data the removed files *)
        let elements = data#elements dir in
        let files = List.map (fun e -> (data#cvs_info_of_t e).cvs_file) elements in
        let removed_files = List.filter (fun f -> not (Sys.file_exists f)) files in
        List.iter data#remove_element removed_files ;
        self#cvs_status_dir dir ;
        l
      with CvsFailure s -> raise (Failure s)

    method cvs_add_dir dir =
      try Ocvs_commands.add_dir dir
      with CvsFailure s -> raise (Failure s)

    method cvs_create_and_add_dir dir =
      try Ocvs_commands.create_and_add_dir dir
      with CvsFailure s -> raise (Failure s)

    method cvs_add_files ?(binary=false) files =
      let ok, ko = Ocvs_commands.add_files ~binary: binary files in
      (* Update the elements in data. *)
      let _ =
        try self#cvs_status_files ok
        with _ -> ()
      in
      (ok, ko)

    method cvs_remove_files files =
      let ok, ko = Ocvs_commands.remove_files files in
      (* update the removed elements in data. *)
      let _ =
        try
          let date = Unix.time () in
          let l_cvs_info =
            List.map
              (fun f ->
                {
                  cvs_file = f ;
                  cvs_status = Locally_removed ;
                  cvs_rep_rev = "" ;
                  cvs_work_rev = "" ;
                  cvs_date_string = "" ;
                  cvs_date = date
                }
              )
              ok
          in
          List.iter (fun ci -> data#update_element (data#t_of_cvs_info ci)) l_cvs_info
        with _ -> ()
      in
      (ok, ko)

    method cvs_diff_file ?rev ?rev2 file =
      try Ocvs_commands.diff_file ?rev ?rev2 file
      with CvsFailure s -> raise (Failure s)

    method cvs_revisions_file file =
      try Ocvs_commands.revisions_file file
      with CvsFailure s -> raise (Failure s)

    method rcs_revision rev archive =
      Ocvs_commands.rcs_revision rev archive

    method cvs_log_file file =
      try Ocvs_commands.log file
      with CvsFailure s -> raise (Failure s)

    method cvs_tag_files f_confirm tag files =
      try Ocvs_commands.tag_files f_confirm tag files
      with
        CvsFailure s -> raise (Failure s)
      |        Tag_error n -> raise (Failure (Ocvs_messages.error_tag_char tag n))

    method cvs_tag_dir ?recursive f_confirm tag dir =
      try Ocvs_commands.tag_dir ?recursive f_confirm tag dir
      with
        CvsFailure s -> raise (Failure s)
      |        Tag_error n -> raise (Failure (Ocvs_messages.error_tag_char tag n))

    method cvs_tags_file file =
      try Ocvs_commands.tags_file file
      with CvsFailure s -> raise (Failure s)
  end