open Ocvs_types
type autorization_response =
Continue
| Skip
| Stop
class type ['a] data =
object
method elements : string -> 'a list
method update_element : 'a -> unit
method remove_element : string -> unit
method t_of_cvs_info : cvs_info -> 'a
method cvs_info_of_t : 'a -> 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
method elements : string -> 'a list
method update_element : 'a -> unit
method remove_element : string -> unit
method t_of_cvs_info : cvs_info -> 'a
method cvs_info_of_t : 'a -> cvs_info
method comparison_function : int -> ('a -> 'a -> int)
method display_strings : 'a -> string option * string list
method titles : string list
method autorize_file : 'a -> autorization_response
method after_action : 'a -> unit
method menu_ctx : 'a list -> GToolbox.menu_entry list
method select : 'a -> unit
method unselect : 'a -> unit
method double_click : 'a -> unit
method needs_cvs_status : bool
end
class type ['a] tree_behaviour =
object
inherit ct_cvs
method expand_dir : string -> bool
method add_expanded_dir : string -> unit
method remove_expanded_dir : string -> unit
method update_element : 'a -> unit
method t_of_cvs_info : cvs_info -> 'a
method roots : string list
method menu_ctx : string option -> GToolbox.menu_entry list
method select : string -> unit
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;
try
let (exist, not_exist) = List.partition Sys.file_exists files in
List.iter data#remove_element not_exist ;
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;
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
let (exist, not_exist) = List.partition Sys.file_exists files in
List.iter data#remove_element not_exist ;
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
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
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
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