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

(*                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: tdl_gui.ml,v 1.5 2004/04/08 15:12:05 zoggy Exp $ *)

(** Classes to add edition of todo list in lablgtk2 applications, using the Tdl library. *)


open Tdl

open Gobject.Data
open GTree

let _ = Tdl_gui_rc.read ()
let _ = Tdl_gui_rc.write ()

let software = "TDL"
let software_author = "Maxence Guesdon"
let software_author_mail = "Maxence.Guesdon@inria.fr"
let software_copyright =
  "Copyright 2004,2005,2006 Institut National de Recherche en \n"^
  "Informatique et en Automatique. All rights reserved.\n"^
  "This software is distributed under the terms of the\n"^
  "GNU Library General Public License version 2.\n"^
  "(see file LICENSE in the distribution)"

let software_about =
  software^" version "^Cam_installation.software_version^"\n\n"^
  software_author^"\n"^
  software_author_mail^"\n\n"^
  software_copyright

type data = [
    `Item of Tdl.item
  | `Group of Tdl.group
]

let to_utf8 ?coding s =
  match coding with
    Some charset ->
      Glib.Convert.convert
        ~to_codeset: "UTF-8" ~from_codeset: charset s
  | None ->
      try Glib.Convert.locale_to_utf8 s
      with _ ->
        try
          Glib.Convert.convert
            ~to_codeset: "UTF-8" ~from_codeset: Tdl_gui_rc.encoding#get s
        with
          _ -> s

let from_utf8 ?coding s =
  match coding with
    Some charset ->
      Glib.Convert.convert
        ~from_codeset: "UTF-8" ~to_codeset: charset s
  | None ->
      try Glib.Convert.locale_from_utf8 s
      with _ ->
        Glib.Convert.convert
          ~from_codeset: "UTF-8" ~to_codeset: Tdl_gui_rc.encoding#get s

let string_of_state = function
    Done -> "Done"
  | Suspended -> "Suspended"
  | Priority_low -> "Low priority"
  | Priority_normal -> "Normal priority"
  | Priority_high -> "High priority"

let string_of_date ?(hour=false) d =
  Printf.sprintf
    "%04d-%02d-%02d%s"
    d.year
    d.month
    d.day
    (
     if hour then
       Printf.sprintf " %02d:%02d"
         d.hour
         d.minute
     else
       ""
    )


let print_data = function
    `Item item ->
      prerr_endline "item";
      prerr_endline item.item_title
  | `Group g ->
      prerr_endline "group";
      prerr_endline g.group_title

let pix_size = 16
let create_pix =
  let f file =
    GdkPixbuf.from_file_at_size file ~width: pix_size ~height: pix_size
  in
  fun cp ->
    try f cp#get
    with e -> prerr_endline (Printexc.to_string e); f cp#get_default

let safe_load to_utf8 file =
  try Tdl.group_of_file file
  with e ->
      let err =
        match e with
          Xml.File_not_found s -> Printf.sprintf "File not found: %s" s
        | Xml.Error e ->
            Printf.sprintf "File %s: %s" file (Xml.error e)
        | Failure s | Sys_error s -> s
        | e -> raise e
      in
      GToolbox.message_box "Error" (to_utf8 err);
      Tdl.group ()

let string_of_opt = function
    None -> ""
  | Some s -> s
let opt_of_string = function
    "" -> None
  | s -> Some s

let params_for_item ~from_utf8 ~to_utf8 item =
  let title = Configwin.string
      ~f: (fun s -> item.item_title <- from_utf8 s)
      "Title: " (to_utf8 item.item_title)
  in
  let desc = Configwin.text
      ~f:(fun s -> item.item_desc <- opt_of_string (from_utf8 s))
      "Details: " (to_utf8 (string_of_opt item.item_desc))
  in
  [title;desc]

let buffer = ref (None : data option)

class file_view
    ?(from_utf8=from_utf8)
    ?(to_utf8=to_utf8) filename =
  let shown_states =
    ref [Suspended;Priority_high;Priority_normal;Priority_low]
  in
  let hide_state s =
    shown_states := List.filter ((<>) s) !shown_states
  in
  let show_state s =
    if not (List.mem s !shown_states) then
      shown_states := s :: !shown_states
  in
  let pix_group = create_pix Tdl_gui_rc.pix_group in
  let pix_item = create_pix Tdl_gui_rc.pix_item in
  let pix_low = create_pix Tdl_gui_rc.pix_low in
  let pix_high = create_pix Tdl_gui_rc.pix_high in
  let pix_done = create_pix Tdl_gui_rc.pix_done in
  let pix_susp = create_pix Tdl_gui_rc.pix_susp in
  let pix_of_state = function
      Done -> pix_done
    | Suspended -> pix_susp
    | Priority_low -> pix_low
    | Priority_normal -> pix_item
    | Priority_high -> pix_high
  in
  let main_group = ref (safe_load to_utf8 filename) in
  let f_children = function
      `Item _ -> []
    | `Group g ->
        (List.fold_left
           (fun acc i ->
             if List.mem i.item_state !shown_states then
               (`Item i) :: acc
             else
               acc
           )
           []
           (List.rev (Tdl.sort_items_by_state g.group_items))
        ) @
        (List.map (fun g -> `Group g) g.group_groups)
  in
  let f_expand _ = true in
  let f_roots () = f_children (`Group !main_group) in
  let f_contents data =
    let (pix,strings) =
      match data with
        `Group g -> (pix_group, [g.group_title;""])
      | `Item i ->
          (pix_of_state i.item_state,
           [ i.item_title ;
             (match i.item_enddate with
               None -> ""
             | Some d -> string_of_date d
             )
           ]
          )
    in
    `Pixmap (Some pix) ::
    (List.map (fun s -> `String (to_utf8 s)) strings)
  in
  let tree =
    object(self)
      inherit [data] Gmytree.tree_edit
          ~f_expand ~f_roots ~f_children ~f_contents
          [ `Pixmap None ;
            `String "Title";
            `String "End date"
          ]

      val mutable modified = false
      method modified = modified
      val mutable on_modified_changed = fun () -> ()
      method set_on_modified_changed f = on_modified_changed <- f
      method set_modified b =
        if modified <> b then
          (
           modified <- b;
           on_modified_changed ()
          )

      method on_double_click data =
        match selection, self#selected_row with
          None, _
        | _, None -> ()
        | Some (`Group g), Some row ->
            self#group_edit_title row g ()
        | Some (`Item i), Some row ->
            self#item_edit row i ()

      method tree_add_item parent item =
        self#insert ~append: true ?parent (`Item item)

      method tree_add_group parent g =
        self#insert ~append: true ?parent (`Group g)

      (* Editing items *)

      method item_edit iter item () =
        match Configwin.simple_get "Edit item"
            (params_for_item ~from_utf8 ~to_utf8 item)
        with
          Configwin.Return_cancel -> ()
        | Configwin.Return_apply
        | Configwin.Return_ok ->
            self#set_modified true;
            self#set_row iter (`Item item)

      method item_set_state iter item new_state () =
        item.item_state <- new_state;
        (
         match new_state with
           Done ->
             let date = Tdl.float_to_date (Unix.time ()) in
             item.item_enddate <- Some date;
         | _ -> ()
        );
        self#set_modified true;
        self#set_row iter (`Item item)

      method item_menu iter item =
        let set_state_entries =
          List.map
            (fun st ->
              `I (string_of_state st, self#item_set_state iter item st))
            [ Done ; SuspendedPriority_lowPriority_normalPriority_high]
        in
        [
          `I ("Edit", self#item_edit iter item) ;
          `M ("Set state", set_state_entries) ;
          `S ;
          `I ("Remove", self#group_remove_item iter item) ;
        ]

      method on_selected f =
        match selection, self#selected_row with
          None, _
        | _, None -> ()
        | Some data, Some row -> f row data

      method copy =
        let f _ = function
            `Group g -> buffer := Some (`Group (Tdl.copy_group g))
          | `Item i -> buffer := Some (`Item (Tdl.copy_item i))
        in
        self#on_selected f

      method delete confirm =
        let f row = function
            `Group g -> self#group_remove_group ~confirm row g ()
          | `Item i -> self#group_remove_item row i ()
        in
        self#on_selected f

      method cut = self#copy; self#delete false

      method paste =
        match selection, self#selected_row with
          None, _
        | _, None ->
            begin
              match !buffer with
                None -> ()
              | Some (`Group g) ->
                  (!main_group).group_groups <- (!main_group).group_groups @ [g];
                  self#set_modified true;
                  self#tree_add_group None g;
              | Some (`Item i) ->
                  (!main_group).group_items <- (!main_group).group_items @ [i];
                  self#set_modified true;
                  self#tree_add_item None i
            end
        | Some (`Group g), Some row ->
            begin
              match !buffer with
                None -> ()
              | Some (`Group g2) ->
                  g.group_groups <- g.group_groups @ [g2];
                  self#set_modified true;
                  self#tree_add_group (Some row) g2;
              | Some (`Item i) ->
                  g.group_items <- g.group_items @ [i];
                  self#set_modified true;
                  self#tree_add_item (Some row) i
            end
        | Some (`Item _), _ -> ()

      (* Editing groups *)

      method group_edit_title iter g () =
        match GToolbox.input_string ~title: "Edit group title"
            ~text: (to_utf8 g.group_title) "Title"
        with
          None -> ()
        | Some s ->
            g.group_title <- from_utf8 s;
            self#set_modified true;
            self#set_row iter (`Group g)

      method group_add_item parent g () =
        let item = Tdl.item ~title: "" ~state: Priority_normal () in
        match Configwin.simple_get "Add item"
            (params_for_item ~from_utf8 ~to_utf8 item)
        with
          Configwin.Return_cancel -> ()
        | Configwin.Return_apply
        | Configwin.Return_ok ->
            g.group_items <- g.group_items @ [item];
            self#set_modified true;
            self#tree_add_item parent item

      method group_add_group parent g () =
        match GToolbox.input_string ~title: "Add group"
            ~text: "" "Title"
        with
          None -> ()
        | Some title ->
            let title = from_utf8 title in
            let group = Tdl.group ~title () in
            g.group_groups <- g.group_groups @ [group];
            self#set_modified true;
            self#tree_add_group parent group

      method group_remove_group ?(confirm=true) it g () =
        if
          (g.group_items = [] && g.group_groups = []) or
          (not confirm) or
          (GToolbox.question_box
             ~title: "Question"
             ~buttons: ["Ok" ; "Cancel"]
             ~default: 1
             (to_utf8
                (Printf.sprintf "Destroy group \"%s\" (not empty) ?"
                   g.group_title)
             )
          ) = 1
        then
          (
           Tdl.remove_group (self#father_group it) g;
           self#set_modified true;
           ignore(self#remove_row it);
          )

      method group_remove_item it i () =
        Tdl.remove_item (self#father_group it) i;
        self#set_modified true;
        ignore(self#remove_row it)

      method group_menu iter g =
        [
          `I ("Edit title", self#group_edit_title iter g) ;
          `I ("Add item", self#group_add_item (Some iter) g) ;
          `I ("Add group", self#group_add_group (Some iter) g) ;
          `S ;
          `I ("Remove", self#group_remove_group iter g) ;
        ]

      method top_group_menu =
        [
          `I ("Add item", self#group_add_item None !main_group) ;
          `I ("Add group", self#group_add_group None !main_group) ;
        ]

      method father_group it =
        match self#father_data it with
          None ->
            !main_group
        | Some (`Group g) ->
            g
        | Some (`Item i) ->
            !main_group

      method common_menu =
        let (to_hide,to_show) = List.partition
            (fun s -> List.mem s !shown_states)
            Tdl.states
        in
        let mk label f l =
           match List.map
               (fun s -> `I (string_of_state s, (fun () -> f s; self#update)))
               l
           with
             [] -> []
           | l -> [`M (label, l)]
        in
        (mk "Hide items with state..." hide_state to_hide) @
        (mk "Show items with state..." show_state to_show)

      method menu =
        (
         match selection with
           None -> self#top_group_menu
         | Some (`Group g) ->
             begin
               match self#selected_row with
                 None -> []
               | Some it -> self#group_menu it g
             end
         | Some (`Item i) ->
             begin
               match self#selected_row with
                None -> []
               | Some it -> self#item_menu it i
             end
        ) @ (`S :: self#common_menu)


      method add_item =
        match selection, self#selected_row with
          None, _
        | _, None -> self#group_add_item None !main_group ()
        | Some (`Group g), Some iter ->
            self#group_add_item (Some iter) g ()
        | Some (`Item _), _ -> ()

      method add_group =
        match selection, self#selected_row with
          None, _
        | _, None -> self#group_add_group None !main_group ()
        | Some (`Group g), Some iter ->
            self#group_add_group (Some iter) g ()
        | Some (`Item _), _ -> ()

      method edit_selected =
        match selection, self#selected_row with
          None, _ | _, None -> ()
        | Some (`Group g), Some iter -> self#group_edit_title iter g ()
        | Some (`Item i), Some iter -> self#item_edit iter i ()

    end
  in
  let vbox = GPack.vbox () in
  object(self)
    method box = vbox#coerce
    method tree_view = tree#view

    val mutable filename = filename
    method filename = filename

    method save =
      try
        Tdl.print_file ~encoding: Tdl_gui_rc.encoding#get
          filename !main_group;
        tree#set_modified false
      with Failure s | Sys_error s ->
        GToolbox.message_box "Error" s

    method reload =
      main_group := safe_load to_utf8 filename;
      tree#set_modified false;
      tree#update

    method modified = tree#modified
    method set_on_modified_changed = tree#set_on_modified_changed

    method copy = tree#copy
    method cut = tree#cut
    method paste = tree#paste
    method delete = tree#delete true

    method add_item = tree#add_item
    method add_group = tree#add_group
    method edit_selected = tree#edit_selected

    initializer
      vbox#pack ~expand: true ~fill: true tree#box#coerce ;
  end

let glade_file = Filename.concat Cam_installation.glade_dir "tdl.glade"

class file_window file =
  let v = new file_view file in
  object (self)
    inherit Tdl_gui_base.main ~file: glade_file ()

    method on_about () =
      GToolbox.message_box ("About "^software^" ...") software_about
    method on_quit () =
      if (not v#modified) or
        (GToolbox.question_box ~title:"Quit"
           "Changes not saved. Quit anyway ?"
           ~buttons:["Yes";"No"] = 1)
      then
        main#destroy ()

    initializer
      vbox#pack ~expand: true ~fill: true v#box;
      vbox#reorder_child  v#box ~pos: 1;
      main#set_title (Printf.sprintf "%s: %s" software (Glib.Convert.filename_to_utf8 file));

      let handlers =
        [
          ("on_quit_activate",         `Simple self#on_quit);
          ("on_save_activate",         `Simple (fun () -> v#save));
(*          ("on_reload_activate",       `Simple (fun () -> v#reload));*)
          ("on_about_activate",        `Simple self#on_about);
          ("on_copy_activate",         `Simple (fun () -> v#copy)) ;
          ("on_cut_activate",          `Simple (fun () -> v#cut)) ;
          ("on_paste_activate",        `Simple (fun () -> v#paste)) ;
          ("on_delete_activate",       `Simple (fun () -> v#delete)) ;
          ("on_add_item_activate",     `Simple (fun () -> v#add_item)) ;
          ("on_add_group_activate",    `Simple (fun () -> v#add_group)) ;
        ]
      in
      (* Finalize GUI *)
      Glade.bind_handlers ~extra:handlers ~warn:true self#xml;
  end

(*
class editor_view () =
  let cols = new GTree.column_list in
  let ctitle = cols#add string in
  let cstate = cols#add string in
  let cenddate = cols#add string in
  let (cdata: item_or_group GTree.column) = cols#add caml in
  let (store : GTree.tree_store)  = GTree.tree_store cols in
  let view = GTree.view ~model: store () in
  object (self)
    val mutable group = Tdl.group ()
    method group = group
    method set_group g =
      group <- g;
      store#clear ();
      self#fill_store_with_group group

    method view = view

    (* Filling the tree *)

    method add_item parent item =
      let row = store#append ?parent () in
      store#set ~row ~column: cdata (Item item);
      store#set ~row ~column: ctitle item.item_title;
      store#set ~row ~column: cstate
        (string_of_state item.item_state);
      store#set ~row ~column: cenddate
        (match item.item_enddate with
          None -> ""
        | Some d -> string_of_date d
        )

    method add_group parent g =
      let row = store#append ?parent () in
      store#set ~row ~column: cdata (Group g);
      store#set ~row ~column: ctitle g.group_title;
      store#set ~row ~column: cstate "";
      store#set ~row ~column: cenddate "";
      List.iter (self#add_item (Some row)) g.group_items;
      List.iter (self#add_group (Some row)) g.group_groups

    method fill_store_with_group g =
      List.iter (self#add_item None) g.group_items;
      List.iter (self#add_group None) g.group_groups ;
      view#expand_all ()

    (* Editing items *)

    method item_edit_title iter item () =
      match GToolbox.input_string ~title: "Edit item title"
          ~text: item.item_title "Title"
      with
        None -> ()
      | Some s ->
          item.item_title <- s;
          store#set ~row: iter ~column: ctitle item.item_title

    method item_set_state iter item new_state () =
      item.item_state <- new_state;
      (
       match new_state with
         Done ->
           let date = Tdl.float_to_date (Unix.time ()) in
           item.item_enddate <- Some date;
           store#set ~row: iter ~column: cenddate (string_of_date date)
       | _ -> ()
      );
      store#set ~row: iter ~column: cstate (string_of_state new_state)

    method popup_item_menu iter item =
      let set_state_entries =
        List.map
          (fun st ->
            `I (string_of_state st, self#item_set_state iter item st))
          [ Done ; Suspended; Priority_low; Priority_normal; Priority_high]
      in
      let entries =
        [
          `I ("Edit title", self#item_edit_title iter item) ;
          `M ("Set state", set_state_entries) ;
          `S ;
          `I ("Remove", self#group_remove_item iter item) ;
        ]
      in
      GToolbox.popup_menu ~entries ~button: 3 ~time: (Int32.of_int 0)

     (* Editing groups *)

    method group_edit_title iter g () =
      match GToolbox.input_string ~title: "Edit group title"
          ~text: g.group_title "Title"
      with
        None -> ()
      | Some s ->
          g.group_title <- s;
          store#set ~row: iter ~column: ctitle g.group_title

    method group_add_item parent g () =
      match GToolbox.input_string ~title: "Add item"
          ~text: "" "Title"
      with
        None -> ()
      | Some title ->
          let item = Tdl.item ~title ~state: Priority_normal () in
          g.group_items <- g.group_items @ [item];
          self#add_item parent item

    method group_add_group parent g () =
      match GToolbox.input_string ~title: "Add group"
          ~text: "" "Title"
      with
        None -> ()
      | Some title ->
          let group = Tdl.group ~title () in
          g.group_groups <- g.group_groups @ [group];
          self#add_group parent group

    method group_remove_group it g () =
      if
        (g.group_items = [] && g.group_groups = []) or
        (GToolbox.question_box
           ~title: "Question"
           ~buttons: ["Ok" ; "Cancel"]
           ~default: 1
           (Printf.sprintf "Destroy group \"%s\" (not empty) ?" g.group_title)
        ) = 1
      then
        (
         Tdl.remove_group (self#father_group it) g;
         ignore (store#remove it);
        )

    method group_remove_item it i () =
      Tdl.remove_item (self#father_group it) i;
      ignore (store#remove it)

    method popup_group_menu iter g =
      let entries =
        [
          `I ("Edit title", self#group_edit_title iter g) ;
          `I ("Add item", self#group_add_item (Some iter) g) ;
          `I ("Add group", self#group_add_group (Some iter) g) ;
          `S ;
          `I ("Remove", self#group_remove_group iter g) ;
        ]
      in
      GToolbox.popup_menu ~entries ~button: 3 ~time: (Int32.of_int 0)

    method popup_top_group_menu =
      let entries =
        [
          `I ("Add item", self#group_add_item None group) ;
          `I ("Add group", self#group_add_group None group) ;
        ]
      in
      GToolbox.popup_menu ~entries ~button: 3 ~time: (Int32.of_int 0)

    method father_group it =
      match store#iter_parent it with
        None -> group
      |        Some it ->
          match store#get ~row: it ~column: cdata with
            Item _ -> group
          | Group g -> g

    initializer
      let col_title = GTree.view_column ~title:"Title" ()
          ~renderer:(GTree.cell_renderer_text[], ["text",ctitle]) in
      ignore (view#append_column col_title);
      let col_state = GTree.view_column ~title:"State" ()
          ~renderer:(GTree.cell_renderer_text[], ["text",cstate]) in
      ignore (view#append_column col_state);
      let col_enddate = GTree.view_column ~title:"End date" ()
          ~renderer:(GTree.cell_renderer_text[], ["text",cenddate]) in
      ignore (view#append_column col_enddate);

      self#fill_store_with_group group;

      ignore
        (view#event#connect#button_press
           (fun button ->
             match GdkEvent.Button.button button with
               3 ->
                 (
                  match view#selection#get_selected_rows with
                    [] ->
                      self#popup_top_group_menu
                  | path :: _ ->
                      let it = store#get_iter path in
                      match store#get ~row: it ~column: cdata with
                        Item item ->
                          self#popup_item_menu it item
                      | Group g ->
                          self#popup_group_menu it g
                 );
                 true
             | _ ->
                 false
           )
        );


  end

class editor () =
  let window = GWindow.window () in
  let vbox = GPack.vbox ~packing: window#add () in
  let menubar = GMenu.menu_bar ~packing: (vbox#pack ~expand: false) () in
  let menu_item_file = GMenu.menu_item
      ~label: "File"
      ()
  in
  let _ = menubar#insert menu_item_file 0 in
  let menu_file = GMenu.menu () in
  let _ = menu_item_file#set_submenu menu_file in

  let view = new editor_view () in
  object (self)
    val mutable file = (None : string option)

    method set_file f =
      file <- Some f;
      window#set_title ("OCamlTDL : "^f)

    method load_file f =
      self#set_file f;
      try
        let group = Tdl.group_of_file f  in
        view#set_group group
      with
      |        Sys_error s ->
          prerr_endline s
      |        e ->
        file <- None;
        Printf.eprintf "Error on load: %s\n" (Printexc.to_string e);
        flush stderr;

    method save_as () =
      match  GToolbox.select_file ~title: "Save as ..." () with
        None -> ()
      |        Some f ->
          self#set_file f ;
          self#save ()

    method save () =
      match file with
        None -> self#save_as ()
      |        Some f -> Tdl.print_file f view#group

    method window = window

    initializer
      let f_save_and_quit () =
        self#save ();
        window#destroy ()
      in
      let _ = GToolbox.build_menu menu_file
          [ `I ("Save", self#save) ;
            `I ("Save and quit", f_save_and_quit) ;
          ]
      in
(*
      let f_add_top_group () =
        let g = Tdl.group () in
        view#group.group_groups <- view#group.group_groups @ [g];
        add_group model None g;
      in
      let _ = GToolbox.build_menu menu_edit
          [ `I ("Add top group", f_add_top_group) ;
            `I ("Add top item", group_add_item model None group) ;
          ]
      in
*)
      vbox#pack ~expand: true view#view#coerce;
      view#view#misc#show ();
      window#show ();
  end
*)