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

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


open Rep_desc

(** *)


let map_opt f = function
    None -> None
  | Some v -> Some (f v)

(**

Edition boxes

*)



module C = Configwin

type attribute = {
    mutable att_name : string ;
    mutable att_code : string ;
  }

let params_for_att a =
  let param_name = C.string
      ~f: (fun s -> a.att_name <- s)
      Rep_messages.name a.att_name
  in
  let param_code = C.string
      ~f: (fun s -> a.att_code <- s)
      Rep_messages.code a.att_code
  in
  [param_name ; param_code]

let tag_attributes_param tag =
  let f_string a = [ a.att_name ; a.att_code ] in
  let f_edit a =
    ignore (C.simple_get Rep_messages.edit (params_for_att a));
    a
  in
  let f_add () =
    let a = { att_name = "" ; att_code = "" } in
    match C.simple_get Rep_messages.edit (params_for_att a) with
      C.Return_cancel -> []
    | C.Return_apply
    | C.Return_ok -> [a]
  in
  let f_eq a1 a2 = a1.att_name = a2.att_name in
  let p = C.list
      ~f: (fun atts ->
            tag.atts <- List.map (fun a -> (a.att_name, a.att_code)) atts
          )
      ~eq: f_eq
      ~edit: f_edit
      ~add: f_add
      ~titles: [ Rep_messages.name ; Rep_messages.code ]
      Rep_messages.attributes
      f_string
      (List.map (fun (n,c) -> { att_name = n ; att_code = c}) tag.atts)
  in
  p

(**

Main gui boxes

*)


let dir = ref (Sys.getcwd ())

let find_first_child store it =
  let p = store#get_path it in
  let res = ref None in
  store#foreach
    (fun _ it ->
      let parent = store#iter_parent it in
      match parent with
        None -> false
      |        Some itp ->
          if store#get_path itp = p then (res := Some it; trueelse false
    );
  !res

let find_iter_above store it =
  let p = store#get_path it in
  let res = ref None in
  store#foreach
    (fun path it ->
      let rr = store#get_row_reference path in
      store#iter_next it;
      if store#get_path it = p then (res := Some rr; trueelse false
    );
  !res

let find_iter_below store it =
  if store#iter_next it then
    Some (store#get_row_reference (store#get_path it))
  else
    None

let clipboard = ref (None : Rep_desc.report_ele option)

class file wlabel filename_opt =
  let cols = new GTree.column_list in
  let col_display = cols#add Gobject.Data.string in
  let (col_data: Rep_desc.report_ele GTree.column) = cols#add Gobject.Data.caml in
  let store = GTree.tree_store cols in
  object(self)
    inherit Rep_gui_base.file ~file: Rep_installation.glade_file ()

    val mutable filename = filename_opt

    val mutable report_params = []
    val mutable report_header = ""

    method save () =
      match filename with
        None -> self#save_as ()
      |        Some f ->
          let report = self#build_report () in
          Rep_io.store_report f report

    method save_as () =
      match GToolbox.select_file ~title: Rep_messages.open_file ~dir () with
        None -> ()
      |        Some f ->
          filename <- Some f;
          wlabel#set_text (Filename.basename f);
          self#save ()

    method close () = true

    method delete ?(cut=false) () =
      match self#selected_rr with
        None -> ()
      |        Some rr ->
          let row = rr#iter in
          match store#get ~row ~column: col_data with
            Then _ | Else _ -> ()
          | _ ->
              match self#build_report_desc ~row () with
              | [] -> ()
              | rep_desc :: _ ->
                  if cut then clipboard := Some rep_desc;
                  ignore (store#remove rr#iter) ;
                  tv#selection#unselect_all ()

    method copy () =
      match self#selected_rr with
        None -> ()
      |        Some rr ->
          let row = rr#iter in
          match self#build_report_desc ~row () with
            rep_desc :: _ ->
              clipboard := Some rep_desc
          | [] -> ()

    method paste () =
      match !clipboard with
        None -> ()
      |        Some ele ->
          let rr = self#selected_rr in
          match rr with
            None ->
              self#insert_rep_desc ele ;
              tv#selection#unselect_all ()
          | Some rr ->
              match store#get ~row: rr#iter ~column: col_data with
                Cond _ -> ()
              | _ ->
                  self#insert_rep_desc ~parent: rr ele ;
                  tv#selection#unselect_all ()

    method move_up () =
      match self#selected_rr with
        None -> ()
      |        Some rr ->
          let row = rr#iter in
          match store#get ~row ~column: col_data with
            Then _ | Else _ -> ()
          | _ ->
              match find_iter_above store row with
                None -> ()
              | Some rr2 ->
                  let it1 = store#get_iter rr#path in
                  let it2 = rr2#iter in
                  ignore (store#swap it1 it2)

    method move_down () =
      match self#selected_rr with
        None -> ()
      |        Some rr ->
          let row = rr#iter in
          match store#get ~row ~column: col_data with
            Then _ | Else _ -> ()
          | _ ->
              match find_iter_below store row with
                None -> ()
              | Some rr2 ->
                  let it1 = store#get_iter rr#path in
                  let it2 = rr2#iter in
                  ignore (store#swap it1 it2)

    method selected_rr =
       match tv#selection#get_selected_rows with
      |        [] -> None
      |        path :: _ -> Some (store#get_row_reference path)

    method private params_for_leaf leaf =
      let param = C.string
          ~f: (fun s -> leaf.leaf <- s)
          Rep_messages.fun_unit leaf.leaf
      in
      [param]

    method private params_for_sub sub =
      let param = C.string
          ~f: (fun s -> sub.sub_code <- s)
          Rep_messages.code sub.sub_code
      in
      [param]

    method private params_for_tag tag =
      let param_tag = C.string
          ~f: (fun s -> tag.tag <- s)
          Rep_messages.tag tag.tag
      in
      let param_atts = tag_attributes_param tag in
      [param_tag ; param_atts]

    method private params_for_mark mark =
      let param_id = C.string
          ~f: (fun s -> mark.mark_id <- s)
          Rep_messages.ocaml_id mark.mark_id
      in
      let param_name = C.string
          ~f: (fun s -> mark.mark_name <- s)
          Rep_messages.name mark.mark_name
      in
      [param_id ; param_name]

    method private params_for_list list =
      let param_f = C.string
          ~f: (fun s -> list.f <- s)
          Rep_messages.fun_unit list.f
      in
      let param_var = C.string
          ~f: (fun s -> list.var <- s)
          Rep_messages.ocaml_id list.var
      in
      [param_var ; param_f]

    method private params_for_cond cond =
      let param = C.string
          ~f: (fun s -> cond.cond <- s)
          Rep_messages.fun_unit cond.cond
      in
      [param]

    method insert_in_selected ele =
      match self#selected_rr with
        None -> self#insert_rep_desc ele
      |        Some rr -> self#insert_rep_desc ~parent: rr ele

    method insert_leaf () =
      let leaf = { leaf = "" } in
      match C.simple_get ~width: 500 Rep_messages.insert_leaf
          (self#params_for_leaf leaf)
      with
        C.Return_ok -> self#insert_in_selected (Leaf leaf)
      | _ -> ()

    method insert_sub () =
      let sub = { sub_code = "" } in
      match C.simple_get ~width: 500 Rep_messages.insert_sub
          (self#params_for_sub sub)
      with
        C.Return_ok -> self#insert_in_selected (Sub sub)
      | _ -> ()

    method insert_tag () =
      let tag = { tag = "" ; atts = [] ; tag_subs = []} in
      match C.simple_get ~width: 400 ~height: 300 Rep_messages.insert_tag
          (self#params_for_tag tag)
      with
        C.Return_ok -> self#insert_in_selected (Tag tag)
      | _ -> ()

    method insert_mark () =
      let mark = { mark_id = "" ; mark_name = ""in
      match C.simple_get ~width: 500 Rep_messages.insert_mark
          (self#params_for_mark mark)
      with
        C.Return_ok -> self#insert_in_selected (Mark mark)
      | _ -> ()

    method insert_list () =
      let list = { f = "" ; var = "" ; list_subs = []} in
      match C.simple_get ~width: 500 Rep_messages.insert_list
          (self#params_for_list list)
      with
        C.Return_ok -> self#insert_in_selected (List list)
      | _ -> ()

    method insert_cond () =
      let cond = { cond = "" ; subs_then = [] ; subs_else = []} in
      match C.simple_get ~width: 500 Rep_messages.insert_cond
          (self#params_for_cond cond)
      with
        C.Return_ok -> self#insert_in_selected (Cond cond)
      | _ -> ()

    method edit_selected () =
      match self#selected_rr with
        None -> ()
      | Some rr ->
          let row = rr#iter in
          match store#get ~row ~column: col_data with
            Then _ | Else _ -> ()
          | ele ->
              let params =
                match ele with
                  Leaf l -> self#params_for_leaf l
                | Mark m -> self#params_for_mark m
                | Tag t -> self#params_for_tag t
                | List l -> self#params_for_list l
                | Cond c -> self#params_for_cond c
                | Sub s -> self#params_for_sub s
                | Else _ | Then _ -> assert false
              in
              match params with
                [] -> ()
              | _ ->
                  match C.simple_get Rep_messages.edit_selected params
                  with
                    C.Return_ok ->
                      store#set ~row ~column: col_display (self#string_of_desc_ele ele);
                  | _ ->
                      ()

    method edit_params () =
      let param = C.strings
          ~f: (fun l -> report_params <- l)
          ~add: (fun () ->
            match GToolbox.input_string
                Rep_messages.add_parameter
                Rep_messages.name
            with
              None -> []
            | Some s -> [s]
                )
          Rep_messages.parameters
          report_params
      in
      ignore (C.simple_get Rep_messages.edit_params [param])

    method edit_header () =
      let param = C.text
          ~f: (fun s -> report_header <- s)
          Rep_messages.header
          report_header
      in
      ignore (C.simple_get Rep_messages.edit_header [param])

    method string_of_desc_ele = function
        Leaf l -> l.leaf
      |        Tag t ->
          Printf.sprintf
            "<%s %s>"
            t.tag
            (String.concat " "
               (List.map
                  (fun (n,v) -> Printf.sprintf "%s=%s" n v)
                  t.atts
               )
            )
      | List l -> Printf.sprintf "for %s in %s ()" l.var l.f
      |        Cond c -> Printf.sprintf "if %s ()" c.cond
      |        Sub s -> Printf.sprintf "sub: %s ()" s.sub_code
      |        Mark m -> Printf.sprintf "mark: id=%s name=%s" m.mark_id m.mark_name
      |        Then _ -> "then"
      |        Else _ -> "else"

    method insert_rep_desc ?parent ?pos ele =
      let row =
        match pos with
          None -> store#append ?parent: (map_opt (fun rr -> rr#iter) parent) ()
        | Some pos -> store#insert ?parent: (map_opt (fun rr -> rr#iter) parent) pos
      in
      let iter_rr rr = store#get_row_reference (store#get_path rr) in
      (
       match parent with
         None -> ()
       | Some rr -> tv#expand_row rr#path
      );
      match ele with
        Leaf l ->
          store#set row col_display (self#string_of_desc_ele ele);
          store#set row col_data (Leaf { leaf = l.leaf })
      | Tag t ->
          store#set row col_display (self#string_of_desc_ele ele);
          store#set row col_data (Tag { t with tag_subs = [] });
          List.iter (self#insert_rep_desc ~parent: (iter_rr row)) t.tag_subs
      | List l ->
          store#set row col_display (self#string_of_desc_ele ele);
          store#set row col_data (List { l with list_subs = []});
          List.iter (self#insert_rep_desc ~parent: (iter_rr row)) l.list_subs
      | Cond c ->
          store#set row col_display (self#string_of_desc_ele ele);
          store#set row col_data (Cond {c with subs_then = [] ; subs_else = []});
          self#insert_rep_desc ~parent: (iter_rr row) (Then c);
          self#insert_rep_desc ~parent: (iter_rr row) (Else c)
      | Sub s ->
          store#set row col_display (self#string_of_desc_ele ele);
          store#set row col_data (Sub { sub_code = s.sub_code })
      | Mark m ->
          store#set row col_display (self#string_of_desc_ele ele);
          store#set row col_data (Mark { m with mark_id = m.mark_id })
      | Then c ->
          store#set row col_display (self#string_of_desc_ele ele);
          store#set row col_data (Then {c with subs_then = [] ; subs_else = []});
          List.iter (self#insert_rep_desc ~parent: (iter_rr row)) c.subs_then
      | Else c ->
          store#set row col_display (self#string_of_desc_ele ele);
          store#set row col_data (Else {c with subs_then = [] ; subs_else = []});
          List.iter (self#insert_rep_desc ~parent: (iter_rr row)) c.subs_else

    method show_report report =
      store#clear ();
      report_header <- report.rep_header ;
      report_params <- report.rep_params ;
      List.iter self#insert_rep_desc report.rep_eles

    method build_report () =
      { rep_header = report_header ;
        rep_params = report_params ;
        rep_eles = self#build_report_desc () ;
      }

    method get_children (it_opt : Gtk.tree_iter option) =
      let first =
        match it_opt with
          None -> store#get_iter_first
        | Some it ->
            if store#iter_has_child it then
              find_first_child store it
            else
              None
      in
      match first with
        None -> []
      |        Some it ->
          let rr it = store#get_row_reference (store#get_path it) in
          let rec f acc it =
            if store#iter_next it then
              f (rr it :: acc) it
            else
              List.rev acc
          in
          f [rr it] it

    method build_report_desc ?row () =
      let rec build rr =
        let it = rr#iter in
        match store#get ~row: it ~column: col_data with
          Leaf l -> Leaf { leaf = l.leaf }
        | Tag t ->
            let subs = List.map build (self#get_children (Some it)) in
            Tag { t with tag_subs = subs }
        | List l ->
            let subs = List.map build (self#get_children (Some it)) in
            List { l with list_subs = subs }
        | Cond c ->
            let (subs_then, subs_else) =
              match self#get_children (Some it) with
                rr_then :: rr_else :: _ ->
                  (List.map build (self#get_children (Some rr_then#iter)),
                   List.map build (self#get_children (Some rr_else#iter))
                  )
              | _ -> ([], [])
            in
            Cond { c with subs_then = subs_then ; subs_else = subs_else ; }
        | Sub s ->
            Sub { sub_code = s.sub_code }
        | Mark m ->
            Mark { m with mark_id = m.mark_id }
        | Then c ->
            Cond { c with subs_else = [] ;
                   subs_then = List.map build (self#get_children (Some it)) }
        | Else c ->
            Cond { c with subs_then = [] ;
                   subs_else = List.map build (self#get_children (Some it)) }
      in
      match row with
        None -> List.map build (self#get_children None)
      |        Some it -> [build (store#get_row_reference (store#get_path it))]

    method load file =
      try
        let report = Rep_io.load_report file in
        self#show_report report
      with
        Failure s ->
          GToolbox.message_box ~title: Rep_messages.error
            s

    initializer
      tv#set_model (Some (store :> GTree.model));
      let col = GTree.view_column ()
          ~renderer:(GTree.cell_renderer_text [], ["text", col_display]) in
      ignore (tv#append_column col);

      match filename_opt with
        None -> ()
      |        Some filename -> self#load filename
  end

class gui files =
  object(self)
    inherit Rep_gui_base.gui ~file: Rep_installation.glade_file ()

    val mutable file_boxes = []

    method add_file_box f_opt =
      let title =
        match f_opt with
          None -> "<no name>"
        | Some s -> Filename.basename s
      in
      let label = GMisc.label ~text: title () in
      let fb = new file label f_opt in
      let eb = GBin.event_box () in
      fb#reparent eb#coerce;
      ignore(notebook#append_page ~tab_label: label#coerce eb#coerce);
      file_boxes <- file_boxes @ [fb];
      notebook#goto_page ((List.length file_boxes) - 1)

    method active_file =
      try
        let n = notebook#current_page in
        Some (List.nth file_boxes n)
      with
        _ -> None

    method quit = toplevel#destroy
    method about () =
      GToolbox.message_box
        Rep_messages.about
        Rep_messages.software_about

    method new_report () = self#add_file_box None

    method close_current () =
      match self#active_file with
        None -> ()
      |        Some fb ->
          if fb#close () then
            ignore (notebook#remove_page notebook#current_page)

    method open_report () =
      match GToolbox.select_file ~title: Rep_messages.open_file ~dir () with
        None -> ()
      |        Some f -> self#add_file_box (Some f)

    method on_current f () =
      match self#active_file with
        None -> ()
      |        Some fb -> f fb

    initializer
      (
       match files with
         [] -> self#add_file_box None
       | _ -> List.iter (fun s -> self#add_file_box (Some s)) files
      );
      let handlers =
        [ "on_quit_activate"`Simple self#quit;
          "on_about_activate",`Simple self#about;
          "on_new_activate"`Simple self#new_report;
          "on_open_activate"`Simple self#open_report;
          "on_save_activate"`Simple (self#on_current (fun fb -> fb#save ())) ;
          "on_save_as_activate"`Simple (self#on_current (fun fb -> fb#save_as ())) ;
          "on_close_activate"`Simple self#close_current ;
          "on_edit_report_params_activate"`Simple (self#on_current (fun fb -> fb#edit_params ())) ;
          "on_edit_report_header_activate"`Simple (self#on_current (fun fb -> fb#edit_header ())) ;
          "on_edit_selected_node_activate"`Simple (self#on_current (fun fb -> fb#edit_selected ())) ;
          "on_cut_activate"`Simple (self#on_current (fun fb -> fb#delete ~cut: true ())) ;
          "on_copy_activate"`Simple (self#on_current (fun fb -> fb#copy ())) ;
          "on_paste_activate"`Simple (self#on_current (fun fb -> fb#paste ())) ;
          "on_delete_activate"`Simple (self#on_current (fun fb -> fb#delete ~cut: false ())) ;
          "on_move_up_activate"`Simple (self#on_current (fun fb -> fb#move_up ())) ;
          "on_move_down_activate"`Simple (self#on_current (fun fb -> fb#move_down ())) ;
          "on_mark_activate"`Simple (self#on_current (fun fb -> fb#insert_mark ())) ;
          "on_leaf_activate"`Simple (self#on_current (fun fb -> fb#insert_leaf ())) ;
          "on_list_activate"`Simple (self#on_current (fun fb -> fb#insert_list ())) ;
          "on_cond_activate"`Simple (self#on_current (fun fb -> fb#insert_cond ())) ;
          "on_tag_activate"`Simple (self#on_current (fun fb -> fb#insert_tag ())) ;
          "on_sub_activate"`Simple (self#on_current (fun fb -> fb#insert_sub ())) ;
        ]
      in
      (* Finalize GUI *)
      Glade.bind_handlers ~extra:handlers ~warn:true self#xml;
      ignore(gui#connect#destroy GMain.Main.quit)

  end