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

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


(* $Id: cam_files_view.ml 334 2006-10-06 07:34:42Z zoggy $ *)

type row_content = [
    `File_type of string
  | `File of string
]

class box dir =
  let vbox = GPack.vbox () in
  let wscroll = GBin.scrolled_window
      ~vpolicy: `AUTOMATIC
      ~hpolicy: `AUTOMATIC
      ~packing: (vbox#pack ~expand: true)
      ()
  in
  let cols = new GTree.column_list in
  let col_display = cols#add Gobject.Data.string in
  let (col_data: row_content GTree.column) = cols#add Gobject.Data.caml in

  let store = GTree.tree_store cols in
  let view = GTree.view
      ~headers_visible: false
      ~model: store ~packing: wscroll#add_with_viewport () in
  let renderer = GTree.cell_renderer_text [] in
  let col = GTree.view_column ()
      ~renderer:(renderer, ["text", col_display]) in
  let () = ignore (view#append_column col) in

  object(self)
    val mutable selection = (None : string option)

    val mutable collapsed = [Cam_files.ft_unknown]

    method on_select _ = ()
    method on_unselect _ = ()
    method expand ft = not (List.mem ft collapsed)
    method menu_ctx _ =
      match selection with
        None ->
          let view_names = Cam_view.available_views ~kind: `Dir () in
          List.map
            (fun s -> `I (Printf.sprintf "%s view" s, fun () -> ignore (Cam_view.open_ressource dir s [| |])))
            view_names
      | Some f -> Cam_files.edition_commands_menu_entries f

    method init_col_display ~col_display ~complete ~renderer _ = ()
    method on_collapse ft = collapsed <- ft :: collapsed
    method on_expand ft = collapsed <- List.filter ((<>) ft) collapsed
    method selection = selection

    method box = vbox

    method select f =
      selection <- Some f ;
      self#on_select f

    method unselect f =
      selection <- None ;
      self#on_unselect f
    method col_display = col_display
    method col_data = col_data
    method view = view

    method get_file_types =
      let t = Hashtbl.create 13 in
      let f file =
        let ft = Cam_files.file_type_of_file file in
        try
          let l = Hashtbl.find t ft in
          Hashtbl.replace t ft (file::l)
        with Not_found ->
          Hashtbl.add t ft [file]
      in
      Ffind.find Ffind.Ignore [dir] [Ffind.Maxdepth 1] f;
      let gather ft acc =
        try
          let l = Hashtbl.find t ft in
          (ft, (List.sort compare l)) :: acc
        with
          Not_found -> acc
      in
      List.fold_right gather (Cam_files.file_types ()) []

    method insert_ft ft files =
      match files with
        [] -> ()
      |        _ ->
          let row_ft = store#append () in
          store#set row_ft col_data (`File_type ft);
          store#set row_ft col_display (Glib.Convert.locale_to_utf8 ft);
          let f file =
            let row = store#append ~parent: row_ft () in
            store#set row col_data (`File file);
            store#set row col_display
              (Glib.Convert.locale_to_utf8 (Filename.basename file));
          in
          List.iter f files;
          let rr = store#get_row_reference (store#get_path row_ft) in
          if self#expand ft then
            view#expand_row rr#path

    method update =
      (
       match selection with
         None -> ()
       | Some f ->
           selection <- None ;
           self#unselect f
      );
      store#clear ();
      List.iter (fun (ft, files) -> self#insert_ft ft files) self#get_file_types

    initializer

      view#selection#set_mode `SINGLE;

      ignore
        (view#connect#row_expanded
           (fun it _ ->
             match store#get ~row: it ~column: col_data with
               `File_type ft -> self#on_expand ft
             | _ -> ()
           )
        );
      ignore
        (view#connect#row_collapsed
           (fun it _ ->
             match store#get ~row: it ~column: col_data with
               `File_type ft -> self#on_collapse ft
             | _ -> ()
           )
        );

      ignore
        (view#selection#connect#changed
           (fun () ->
             (
              match selection with
                None -> ()
              | Some file -> self#unselect file
             );
             let sel = view#selection in
             match sel#get_selected_rows with
               [] -> ()
             | row :: _ ->
                 let it = store#get_iter row in
                 match store#get ~row: it ~column: col_data with
                   `File_type _ -> ()
                 | `File file ->  self#select file
           )
        );

      (* connect the press on button 3 for contextual menu *)
      let _ = view#event#connect#button_press ~callback:
        (
         fun ev ->
           GdkEvent.Button.button ev = 3 &&
           GdkEvent.get_type ev = `BUTTON_PRESS &&
           (
            match self#menu_ctx self#selection with
              [] -> true
            | l ->
                GToolbox.popup_menu
                  ~button: 3
                  ~time: (Int32.of_int 0)
                  ~entries: l;
                true
           )
        )
      in
      self#init_col_display
        ~col_display: col ~complete: col_data ~renderer store;
      self#update
  end

class view
    (name : Cam_view.view_name)
    (dir : Cam_view.ressource_name)
    (box : box)
    (close_window_on_close : bool) =
  object (self)
    method changed = false
    method close = close_window_on_close
    method name = name
    method refresh = box#update
    method ressource = dir
    method ressource_kind : Cam_view.ressource_kind = `Dir
  end

class factory : Cam_view.view_factory =
  object (self)
    method create res_name args =
      let box = new box res_name in
      let v = new view (self#name) res_name box true in
      let w = Cam_view.create_view_window
          ~title: (Printf.sprintf "%s [%s]" res_name self#name)
          v
      in
      let _ = w#vbox#pack ~expand: true box#box#coerce in
      (v, w#window)

    method create_no_window window res_name args =
      let box = new box res_name in
      let v = new view (self#name) res_name box false in
      (v, box#box#coerce)

    method known_ressource_kinds = [`Dir]
    method name = "filetypes"
  end

let _ = Cam_view.register_factory (new factory)