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

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


(** Main module for ocamlcvs standalone program. *)


open Ocvs_types


let roots = ref []

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

let usage ="Usage : "^Sys.argv.(0)^" [dir1 dir2 ...]"
(** The list of options.*)

let options_list = []

(* Parse the args. *)
let _ = Arg.parse options_list
    (fun s ->
      (* remove ending slash before, or else
         it causes trouble in class data to say
         that two elements are the same. *)

      let len = String.length s in
      match len with
        0 -> ()
      | _ ->
          let dir =
            if s.[len - 1] = '/' then
              String.sub s 0 (len -1)
            else
              s
          in
          try
            let st = Unix.stat dir in
            if st.Unix.st_kind = Unix.S_DIR then
              roots := !roots @ [dir]
            else
              prerr_endline (dir^" is not a directory")
          with
            Unix.Unix_error (e, s1, s2) ->
              prerr_endline ((Unix.error_message e)^": "^s2)
    )
    usage

let _ = if !roots = [] then roots := [Filename.current_dir_name]

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


let _ = GMain.Main.init ()

let window = GWindow.window
    ~width: 600
    ~height: 600
    ~title: "ocamlcvs" ()

let _ = window#connect#destroy GMain.Main.quit

let vbox = GPack.vbox ~packing: window#add ()

let menubar = GMenu.menu_bar
    ~packing: (vbox#pack ~expand: false)
    ()
let menuFile = GMenu.menu ()
let itemFile = GMenu.menu_item
    ~label: Ocvs_messages.m_file
    ~packing: menubar#add
    ()
let _ = itemFile#set_submenu menuFile
let itemQuit = GMenu.menu_item
    ~label: Ocvs_messages.m_quit
    ~packing: menuFile#add
    ()

let menuCvs = GMenu.menu ()
let itemCvs = GMenu.menu_item
    ~label: Ocvs_messages.m_cvs
    ~packing: menubar#add
    ()
let _ = itemCvs#set_submenu menuCvs
let itemAdd_dir = GMenu.menu_item
    ~label: Ocvs_messages.m_add_dir
    ~packing: menuCvs#add
    ()
let itemUpdate_dir = GMenu.menu_item
    ~label:  Ocvs_messages.m_update_dir
    ~packing: menuCvs#add
    ()
let itemCommit_dir = GMenu.menu_item
    ~label:  Ocvs_messages.m_commit_dir
    ~packing: menuCvs#add
    ()
let itemTag_dir = GMenu.menu_item
    ~label:  Ocvs_messages.m_tag_dir
    ~packing: menuCvs#add
    ()

let _ = GMenu.menu_item ~packing: menuCvs#add ()

let itemAdd_files = GMenu.menu_item
    ~label:  Ocvs_messages.m_add_files
    ~packing: menuCvs#add
    ()
let itemAdd_binary_files = GMenu.menu_item
    ~label:  Ocvs_messages.m_add_binary_files
    ~packing: menuCvs#add
    ()
let itemCommit_files = GMenu.menu_item
    ~label:  Ocvs_messages.m_commit_files
    ~packing: menuCvs#add
    ()
let itemTag_files = GMenu.menu_item
    ~label:  Ocvs_messages.m_tag_files
    ~packing: menuCvs#add
    ()
let itemTags_of_file = GMenu.menu_item
    ~label:  Ocvs_messages.m_tags_of_file
    ~packing: menuCvs#add
    ()
let itemRemove_files = GMenu.menu_item
    ~label:  Ocvs_messages.m_remove_files
    ~packing: menuCvs#add
    ()
let _ = GMenu.menu_item ~packing: menuCvs#add ()
let itemLast_diff = GMenu.menu_item
    ~label:  Ocvs_messages.m_last_diff
    ~packing: menuCvs#add
    ()
let itemDiff_with = GMenu.menu_item
    ~label:  Ocvs_messages.m_diff_with
    ~packing: menuCvs#add
    ()
let itemDiff_between = GMenu.menu_item
    ~label:  Ocvs_messages.m_diff_between
    ~packing: menuCvs#add
    ()
let itemResolve_conflicts = GMenu.menu_item
    ~label:  Ocvs_messages.m_resolve_conflicts
    ~packing: menuCvs#add
    ()
let itemLog_file = GMenu.menu_item
    ~label:  Ocvs_messages.m_log
    ~packing: menuCvs#add
    ()


class data () =
  object
    val mutable elements = ([] : cvs_info list)

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

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

    method remove_element file =
(*
      print_string ("removing "^file);
      print_newline ();
*)

      elements <- List.filter
          (fun t -> t.cvs_file <> file)
          elements

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

let data = new data ()

(*let cvs = new Ocvs_behav.cvs data*)


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


class list_behaviour data : [cvs_info] Ocvs_behav.list_behaviour =
  object
    inherit [cvs_info] Ocvs_behav.cvs data

    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 (string_of_status ci1.cvs_status) (string_of_status ci2.cvs_status)
      |        2 -> fun ci1 -> fun ci2 ->
          compare ci1.cvs_work_rev ci2.cvs_work_rev
      |        3 -> fun ci1 -> fun ci2 ->
          compare ci1.cvs_rep_rev ci2.cvs_rep_rev
      |        4 -> fun ci1 -> fun ci2 ->
          compare ci1.cvs_date_string ci2.cvs_date_string
      |        _ -> fun ci1 -> fun ci2 ->
          compare ci1.cvs_file ci2.cvs_file

    method display_strings ci =
      (Some (color_string_of_status ci.cvs_status),
       [ Filename.basename ci.cvs_file ;
         string_of_status ci.cvs_status ;
         ci.cvs_work_rev ;
         ci.cvs_rep_rev ;
         ci.cvs_date_string ]
      )
    method titles = [ "file" ; "status""working rev." ; "rep. rev." ; "date"]
    method autorize_file (_ : cvs_info) = Ocvs_behav.Continue
    method after_action (_ : cvs_info) = ()
    method menu_ctx (selection : cvs_info list) =
      match selection with
        [] ->
          [ `I (Ocvs_messages.m_add_files, itemAdd_files#activate) ;
            `I (Ocvs_messages.m_add_binary_files, itemAdd_binary_files#activate) ;
          ]
      | _ ->
          [ `I (Ocvs_messages.m_add_files, itemAdd_files#activate) ;
            `I (Ocvs_messages.m_add_binary_files, itemAdd_binary_files#activate) ;
            `I (Ocvs_messages.m_commit_files, itemCommit_files#activate) ;
            `I (Ocvs_messages.m_tag_files, itemTag_files#activate) ;
            `I (Ocvs_messages.m_tags_of_file, itemTags_of_file#activate) ;
            `I (Ocvs_messages.m_remove_files, itemRemove_files#activate) ;
            `I (Ocvs_messages.m_last_diff, itemLast_diff#activate) ;
            `I (Ocvs_messages.m_diff_with, itemDiff_with#activate) ;
            `I (Ocvs_messages.m_diff_between, itemDiff_between#activate) ;
            `I (Ocvs_messages.m_resolve_conflicts, itemResolve_conflicts#activate);
            `I (Ocvs_messages.m_log, itemLog_file#activate);
          ]

    method select (_ : cvs_info) = ()
    method unselect (_ : cvs_info) = ()
    method double_click (_ : cvs_info) = ()

    method needs_cvs_status = true
  end

class tree_behaviour (roots : string list)
    (box : cvs_info Ocvs_list.box)
    data : [cvs_info] Ocvs_behav.tree_behaviour =
  object
    inherit [cvs_info] Ocvs_behav.cvs data

    
    (** expand the given directory or not *)

    method expand_dir (_:string) = true

    
    (** set the given directory as expanded *)

    method add_expanded_dir (_:string) = ()

    
    (** remove the given directory as expanded *)

    method remove_expanded_dir (_:string) = ()

    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) =
      match selection with
        None ->
          [ `I (Ocvs_messages.m_add_dir, itemAdd_dir#activate) ]
      |        Some s ->
          [ `I (Ocvs_messages.m_add_dir, itemAdd_dir#activate) ;
            `I (Ocvs_messages.m_update_dir, itemUpdate_dir#activate) ;
            `I (Ocvs_messages.m_commit_dir, itemCommit_dir#activate) ;
            `I (Ocvs_messages.m_tag_dir, itemTag_dir#activate) ;
          ]

    method select (dir : string) = (box#display_dir (Some dir) : unit)
    method unselect (dir : string) = (box#display_dir None : unit)

  end


let lb = new list_behaviour data

let wpane = GPack.paned `HORIZONTAL
    ~packing: (vbox#pack ~expand: true) ()

let vbox_list = GPack.vbox ~packing: wpane#add2 ()
let listbox = new Ocvs_list.box (lb :> Ocvs_types.cvs_info Ocvs_behav.list_behaviour)
let _ = vbox_list#pack ~expand: true listbox#box#coerce


let vbox_tree = GPack.vbox ~width: 200 ~packing: wpane#add1 ()
let tb = new tree_behaviour !roots listbox data
let treebox = new Ocvs_tree.box (tb :> Ocvs_types.cvs_info Ocvs_behav.tree_behaviour)
let _ = vbox_tree#pack ~expand: true treebox#box#coerce

let _ = itemQuit#connect#activate window#destroy
let _ = itemAdd_files#connect#activate (fun () -> treebox#cvs_add_files)
let _ = itemAdd_binary_files#connect#activate (fun () -> treebox#cvs_add_binary_files)
let _ = itemCommit_files#connect#activate (fun () -> listbox#cvs_commit_selected_files)
let _ = itemTag_files#connect#activate (fun () -> listbox#cvs_tag_selected_files)
let _ = itemTags_of_file#connect#activate (fun () -> listbox#cvs_tags_of_file)
let _ = itemRemove_files#connect#activate (fun () -> listbox#cvs_remove_selected_files)
let _ = itemLast_diff#connect#activate (fun () -> listbox#cvs_lastdiff_file)
let _ = itemDiff_with#connect#activate (fun () -> listbox#cvs_differences_with)
let _ = itemDiff_between#connect#activate (fun () -> listbox#cvs_differences_between)
let _ = itemResolve_conflicts#connect#activate (fun () -> listbox#cvs_resolve_conflicts)
let _ = itemLog_file#connect#activate (fun () -> listbox#cvs_log_file)

let _ = itemCommit_dir#connect#activate (fun () -> treebox#cvs_commit_dir)
let _ = itemTag_dir#connect#activate (fun () -> treebox#cvs_tag_dir)
let _ = itemUpdate_dir#connect#activate (fun () -> treebox#cvs_update_dir)
let _ = itemAdd_dir#connect#activate (fun () -> treebox#cvs_add_dir)

let _ = window#show ()

let _ = GMain.Main.main ()