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

(** Gui for editing a column. *)

open Dbf_types.Current

module M = Dbf_messages
module C = Configwin
module Mi = Dbf_misc


class box_type_sql_dbms dbms cdbms =
  let vbox = GPack.vbox () in
  let len = List.length dbms#types in
  let table = GPack.table
      ~rows: ((len / 2) + len mod 2)
      ~columns: 2
      ~packing: (vbox#pack ~expand: true) () 
  in
  let (current_t,v_opt,args_opt) = cdbms.col_type_sql in 
  let e_args = GEdit.entry ~editable: true () in
  object (self)
    val mutable l = []
    val mutable n_select = 0

    method box = vbox
    method apply () =
      try
	let (t,s_opt) = List.nth dbms#types n_select in
	let e_opt = List.assoc n_select l in
	let v = (t,
		 (match s_opt with
		   None -> None
		 | Some _ ->
		     try
		       match e_opt with
			 None -> None
		       | Some e -> Some e#text
		     with Not_found -> None
		 ),
		 (match Mi.remove_blanks e_args#text with
		   "" -> None
		 | _ -> Some e_args#text
		 )
		)
	in
	cdbms.col_type_sql <- v
      with
	Not_found ->
	  ()

    initializer
      let group = ref None in
      let cur_col = ref 0 in
      let n = ref 0 in
      let f (t, s_opt) =
	let hbox = GPack.hbox
	    ~packing: (table#attach ~left: !cur_col ~top: (!n / 2) ~expand: `NONE) () in
	let radio = GButton.radio_button
	    ~label: t
	    ~packing: (hbox#pack ~expand: false) () in
	(match !group with
	  None -> group := Some radio#group
	| Some g -> radio#set_group g);
	let is_current = current_t = t in
	radio#set_active is_current;
	if is_current then n_select <- !n;
	let entry_opt =
	  match s_opt with
	    None -> None
	  | Some s ->
	      let l = GMisc.label ~text: (s^"= ")
		  ~packing: (hbox#pack ~expand: false) () in
	      let e = GEdit.entry ~editable: true
		  ~packing: (hbox#pack ~expand: true) () in
	      if is_current then
		e#set_text 
		  (match v_opt with 
		    None -> "" | Some s -> s);
	      Some e
	in
	let cpt = !n in
	ignore (radio#connect#clicked
		  (fun () -> n_select <- cpt));
	l <- l @ [(cpt, entry_opt)];
	incr n ;
	cur_col := (!cur_col + 1) mod 2
      in
      List.iter f dbms#types;

      let hbox_args = GPack.hbox ~packing: (vbox#pack ~expand: false) () in
      let l_args = GMisc.label ~text: (M.optional_args^": ")
	  ~packing: (hbox_args#pack ~expand: false) () in
      hbox_args#pack ~expand: true e_args#coerce ;
      e_args#set_text (match args_opt with None -> "" | Some s -> s);

  end

let string_of_key k =
  match k with
    Primary_key -> "primary key"
  | Key -> "key"

let string_of_key_opt k_opt =
  match k_opt with
    None -> ""
  | Some k -> string_of_key k

let key_opt_of_string s =
  match Dbf_misc.remove_blanks s with
    "primarykey" -> Some Primary_key
  | "key" -> Some Key
  | _ -> None

let col_dbms_params dbms cdbms =
  let b_sql = new box_type_sql_dbms dbms cdbms in
  let p_sql_type = C.custom ~label: M.sql_type b_sql#box b_sql#apply false in
  let p_key = C.combo
      ~f: (fun s -> cdbms.col_key <- key_opt_of_string s)
      ~blank_allowed: true
      ~new_allowed: false
      M.optional_key
      (""::(List.map string_of_key dbms#col_keys))
      (string_of_key_opt cdbms.col_key)
  in
  let p_2ml = C.combo
      ~f: (fun s -> cdbms.col_2ml <- s)
      ~blank_allowed: true
      ~new_allowed: true
      M.fun_2ml 
      dbms#funs_2ml
      cdbms.col_2ml
  in
  let p_ml2 = C.combo
      ~f: (fun s -> cdbms.col_ml2 <- s)
      ~blank_allowed: true
      ~new_allowed: true
      M.fun_ml2 
      dbms#funs_ml2
      cdbms.col_ml2
  in
  let p_default = C.string
      ~f: (fun s ->
   	      let s_opt = 
		match Mi.remove_blanks s with
		  "" -> None
		| _ -> Some s
	      in
	      cdbms.col_default <- s_opt
	  )
      M.sql_default
      (match cdbms.col_default with None -> "" | Some s -> s)
  in
  [ p_sql_type ; p_key ; p_2ml ; p_ml2 ; p_default ]

(** Return [true] if the column was modified (button ok pressed).*)
let edit_column data c =
  let p_name = C.string
      ~f: (fun s -> c.col_name <- s) 
      M.name c.col_name 
  in
  let p_comment = C.text
      ~expand: false
      ~f: (fun s -> c.col_comment <- s) 
      M.comment c.col_comment
  in
  let p_ml_type = C.string
      ~f: (fun s -> c.col_type_ml <- s) 
      M.ml_type c.col_type_ml
  in
  let p_null = C.bool
      ~f: (fun b -> c.col_nullable <- b)
      M.nullable c.col_nullable
  in
  let p_index = C.bool
      ~f: (fun b -> c.col_index <- b)
      M.index c.col_index
  in
  let dbms_props = List.map
      (fun dbms ->
	let cdbms =
	  try List.assoc dbms#dbms c.col_dbms
	  with Not_found ->
	    let cdbms = { col_type_sql = ("", None, None) ;
			  col_2ml = "";
			  col_ml2 = "";
			  col_key = None ;
			  col_default = None ;
			  col_atts = []
			} 
	    in
	    c.col_dbms <- (dbms#dbms, cdbms) :: c.col_dbms;
	    cdbms
	in
	C.Section (dbms#name, col_dbms_params dbms cdbms)
      )
      data#dbms
  in
  let common_props = C.Section
      (M.common_props,
       [ p_name ; p_comment ; p_ml_type ; p_null ; p_index])
  in
  (C.get c.col_name ~width: 700 ~height: 560  (common_props :: dbms_props)) = C.Return_ok


