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

(** Creation of new files according to file types and templates. *)

open Cam_types

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

(** Create a file from a file type. Add it to the repository. 
   @raise Failure if the file already exists or an error occurs.*)
let create_file_from_file_type f ft =
  if Sys.file_exists f then
    raise (Failure (Cam_messages.error_file_exists f))
  else
    (
     let com_pre = 
       match ft.ft_templates with
	 [] -> "touch "
       | l -> "cat "^(String.concat " " (List.map Filename.quote l))^" > "
	 in
     let com = com_pre^" "^(Filename.quote f) in
     let n = Sys.command com in
     if n <> 0 then
       raise (Failure (Cam_messages.error_exec com))
     else
       (
	let cvs = new Ocamlcvs.Behav.cvs (Cam_data.data :> Cam_types.file Ocamlcvs.Behav.data) in
	let (ok, ko) = cvs#cvs_add_files ~binary: ft.ft_binary [f] in
	    (* data has been updated by the cvs object *)
	match ok with
	  [] -> GToolbox.message_box Cam_messages.error (Cam_messages.error_cvs_add f)
	| _ -> 
	    let file_opt = Cam_data.data#file_of_string f in
	    (
	     match file_opt with
	       None -> GToolbox.message_box Cam_messages.error (Cam_messages.error_file_info f)
	     | Some file -> 
		 Cam_edit.edit Cam_data.data file
	    );
       )
    )

(** Create a file from a file type.
   @param f_dir_opt is a function used to get the selected directory, if any.
   @param f_update is a function to be called when the file has successfully been added.
   It updates the listbox where files are displayed.
*)
let create_file f_dir_opt f_update ft =
  let title = Cam_messages.m_new^" "^ft.ft_name in
  let f_opt =
    match f_dir_opt () with
      None -> GToolbox.select_file ~title: title ()
    | Some d -> GToolbox.select_file ~dir: (ref d) ~title: title ()
  in
  match f_opt with
  | Some f ->
      (
       try create_file_from_file_type f ft ; f_update ()
       with Failure s -> GToolbox.message_box Cam_messages.error s
      )
  | None ->
      ()
    
(** Create a popup menu with menu items to create new files, according to file types.
   @param f_dir_opt is a function used to get the selected directory, if any. 
   (see {!Cam_new_file.create_file})
   @param f_update is a function to be called when the file has successfully been added. 
   (see {!Cam_new_file.create_file})
*)
let popup x y f_dir_opt f_update =
  let f ft =
    let label = ft.ft_name in
    let f () = create_file f_dir_opt f_update ft in
    (label, f)
  in
  
  let l = List.map f !!Cam_config.file_types in
  GToolbox.popup_menu ~button: 3 ~time: 0 ~entries: (List.map (fun c -> `I c) l)

(** Create the given files in the given directory. 
   The filenames must be relative to the given directory.
   @param f_update is a function to be called when the files have been added. 
*)
let create_file_list dir files f_update =
  let errors = ref [] in
  let f file =
    if Filename.is_relative file then
      (
       let complete = Filename.concat dir file in
       try
	 let ft = Cam_data.file_type_of_name complete in
	 create_file_from_file_type complete ft
       with
	 Failure s -> errors := s :: !errors
       | e -> errors := (Printexc.to_string e) :: !errors
      )
    else
      !Cam_global.display_message (file^" is not a relative file name.")
  in
  List.iter f files;
  (
   match List.rev !errors with
     [] -> ()
   | l -> GToolbox.message_box Cam_messages.error 
	 (String.concat "\n" l)
  );
  f_update ()
