(**************************************************************************)
(*                   Cameleon                                             *)
(*                                                                        *)
(*      Copyright (C) 2002 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 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 General Public License for more details.                      *)
(*                                                                        *)
(*      You should have received a copy of the GNU 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                                *)
(**************************************************************************)

(** This module defines the class used to define the behaviour
   of the ocamlcvs boxes, when the cvs repository is not available.*)

open Cam_data
open Ocamlcvs.Types
open Cam_types

let (!!) = Options.(!!)
let (=:=) = Options.(=:=)

let read_entries_file dir =
  try
    let entries_file = 
      Filename.concat (Filename.concat dir "CVS") "Entries"
    in    
    let date = Unix.time () in
    let inch = open_in entries_file in
    let re = Str.regexp "/" in
    let rec iter acc =
      let line_opt =
	try Some (input_line inch)
	with End_of_file -> None
      in
      match line_opt with
	None -> acc
      |	Some s -> 
	  let new_acc  =
	    prerr_endline s;
	    match Str.split_delim re s with
	      "" :: f :: v :: d :: _ ->
	      {
		cvs_file = Filename.concat dir f ;
		cvs_status = Unknown ;
		cvs_work_rev = v ;
		cvs_rep_rev = "" ;
		cvs_date_string = d ;
		cvs_date = date
	      } :: acc
	    | _ ->
		acc
	  in
	  iter new_acc
    in
    let l = iter [] in
    close_in inch;
    l
  with
    Sys_error s ->
      prerr_endline s;
      []

class norep_cvs (data : Cam_data.data) =
  object (self : 'a)
    constraint 'a = #Ocamlcvs.Behav.ct_cvs 

    method cvs_add_dir _ = ()
    method cvs_add_files ?(binary=false) _ = ([], [])
    method cvs_commit_files ?comment _ = ()
    method cvs_commit_dir ?comment _ = ()
    method cvs_create_and_add_dir _ = ()
    method cvs_remove_files _ = ([], [])
    method cvs_status_dir dir =
      let cvs_info_list = read_entries_file dir in
      List.iter (fun ci -> data#update_element (data#t_of_cvs_info ci)) cvs_info_list

    method cvs_status_files files = ()
    method cvs_update_dir _ = []
    method cvs_diff_file ?rev ?rev2 _ = raise (Failure "cvs_diff_file")
    method rcs_revision _ _ = ""
    method cvs_log_file _ = ""
    method cvs_revisions_file _ = []
    method cvs_tags_file _ = []
    method cvs_tag_files _ _ _ = ()
    method cvs_tag_dir ?(recursive=false) _ _ _ = ()
  end

class list_behaviour data (f_edit : unit -> unit) =
  object(self : 'a)
    inherit norep_cvs data
    constraint 'a = Cam_types.file #Ocamlcvs.Behav.list_behaviour

    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 =
      let f_value  =
	match col with
	| 1 -> fun f -> Ocamlcvs.Types.string_of_status f.f_status
	| 2 -> fun f -> f.f_work_rev
	| 3 -> fun f -> f.f_rep_rev
	| 4 -> fun f -> f.f_date_string
	| 5 -> fun f -> f.f_type.Cam_types.ft_name
	| _ -> fun f -> f.f_name
      in
      if last_clicked_column = col then
	(
	 last_clicked_column <- -1 ;
	 fun f1 -> fun f2 -> compare (f_value f2) (f_value f1)
	)
      else
	(
	 last_clicked_column <- col ;
	 fun f1 -> fun f2 -> compare (f_value f1) (f_value f2)
	)

    method display_strings f =
      (f.f_type.Cam_types.ft_color,
       [ Filename.basename f.f_name ; 
	 Ocamlcvs.Types.string_of_status f.f_status ; 
	 f.f_work_rev ;
	 f.f_rep_rev ;
	 f.f_date_string ;
	 f.f_type.Cam_types.ft_name
       ]
      )
    method titles = [ 
      Cam_messages.file ;
      Cam_messages.status ;
      Cam_messages.working_rev ;
      Cam_messages.rep_rev ;
      Cam_messages.date ;
      Cam_messages.file_type
    ] 
    method autorize_file (file : Cam_types.file) = Ocamlcvs.Behav.Stop

    method after_action (_ : Cam_types.file) = ()
    method menu_ctx (selection : Cam_types.file list) = 
      match selection with
	[] -> []
      | _ ->[ Cam_messages.m_edit, f_edit ]

    method select (_ : Cam_types.file) = ()
    method unselect (_ : Cam_types.file) = ()

    method double_click (_ : Cam_types.file) = 
      Cam_misc.execute_command !!Cam_config.file_double_click_command ()

    method needs_cvs_status = true
  end

class tree_behaviour (roots : string list) 
    current_box_index
    data =
  object (self : 'a)
    constraint 'a = Cam_types.file #Ocamlcvs.Behav.tree_behaviour
    inherit norep_cvs data

    (** expand the given directory or not *)
    method expand_dir complete_dir =
      List.mem complete_dir !!Cam_config.expanded_dirs;

    (** set the given directory as expanded *)
    method add_expanded_dir complete_dir =
      if self#expand_dir complete_dir then
	()
      else
	Cam_config.expanded_dirs =:= complete_dir :: !!Cam_config.expanded_dirs

    (** remove the given directory as expanded *)
    method remove_expanded_dir complete_dir =
      if self#expand_dir complete_dir then
	Cam_config.expanded_dirs =:= complete_dir :: !!Cam_config.expanded_dirs
      else
	()

    method update_element = data#update_element
    method t_of_cvs_info = data#t_of_cvs_info

    method roots = roots
    method menu_ctx (selection : string option) =[]

    method select (dir : string) = 
      try (List.nth !Cam_global.views (current_box_index ()))#display_dir (Some dir)
      with _ -> ()

    method unselect (dir : string) = 
      try (List.nth !Cam_global.views (current_box_index ()))#display_dir None
      with _ -> ()

  end


