(**************************************************************************)
(*                                                                        *)
(*  Ocamlviz --- real-time profiling tools for Objective Caml             *)
(*  Copyright (C) by INRIA - CNRS - Universite Paris Sud                  *)
(*  Authors: Julien Robert                                                *)
(*           Guillaume Von Tokarski                                       *)
(*           Sylvain Conchon                                              *)
(*           Jean-Christophe Filliatre                                    *)
(*           Fabrice Le Fessant                                           *)
(*  GNU Library General Public License version 2                          *)
(*  See file LICENSE for details                                          *)
(*                                                                        *)
(**************************************************************************)

open Db
open Protocol
open Gui_misc


let row_stat = Hashtbl.create 17
let row_tag = Hashtbl.create 17
let row_int = (Hashtbl.create 17: (int,Gtk.tree_iter) Hashtbl.t)
let row_float = (Hashtbl.create 17: (int,Gtk.tree_iter) Hashtbl.t)
let row_string = (Hashtbl.create 17: (int,Gtk.tree_iter) Hashtbl.t)
let row_bool = (Hashtbl.create 17: (int,Gtk.tree_iter) Hashtbl.t)
let row_tree = (Hashtbl.create 17: (int,Gtk.tree_iter) Hashtbl.t)
let row_hash = (Hashtbl.create 17: (int,Gtk.tree_iter) Hashtbl.t)

let lists_table = (Hashtbl.create 17: 
	      (string, GTree.list_store * Protocol.tag GTree.column * string GTree.column * string GTree.column *
		 float GTree.column * string GTree.column * string GTree.column *
		 int GTree.column)  Hashtbl.t)
let trees = (Hashtbl.create 17: (int, Db.tag * Tree_panel.t) Hashtbl.t)


(* For the Stat notebook *)
let stat_cols = new GTree.column_list
let s_name_col = stat_cols#add Gobject.Data.string
let s_tag_count_col = stat_cols#add Gobject.Data.int
let s_count_col = stat_cols#add Gobject.Data.string
let s_count_lm_col = stat_cols#add Gobject.Data.float
let s_count_lm_s_col = stat_cols#add Gobject.Data.string
let s_count_color_col = stat_cols#add Gobject.Data.string
let s_check_count_col = stat_cols#add Gobject.Data.boolean
let s_tag_time_col = stat_cols#add Gobject.Data.int
let s_time_col = stat_cols#add Gobject.Data.string
let s_time_lm_col = stat_cols#add Gobject.Data.float
let s_time_lm_s_col = stat_cols#add Gobject.Data.string
let s_time_color_col = stat_cols#add Gobject.Data.string
let s_check_time_col = stat_cols#add Gobject.Data.boolean
let s_percent_col = stat_cols#add Gobject.Data.string
let s_check_percent_col = stat_cols#add Gobject.Data.boolean

let stat_model = GTree.list_store stat_cols


(* For the Tag notebook *)
let tag_cols = new GTree.column_list
let t_name_col = tag_cols#add Gobject.Data.string
let t_tag_count_col = tag_cols#add Gobject.Data.int
let t_count_col = tag_cols#add Gobject.Data.string
let t_count_lm_col = tag_cols#add Gobject.Data.float
let t_count_lm_s_col = tag_cols#add Gobject.Data.string
let t_count_color_col = tag_cols#add Gobject.Data.string
let t_check_count_col = tag_cols#add Gobject.Data.boolean
let t_max_count_col = tag_cols#add Gobject.Data.string
let t_max_count_lm_col = tag_cols#add Gobject.Data.float
let t_max_count_lm_s_col = tag_cols#add Gobject.Data.string
let t_check_max_count_col = tag_cols#add Gobject.Data.boolean
let t_tag_size_col = tag_cols#add Gobject.Data.int
let t_size_col = tag_cols#add Gobject.Data.string
let t_realsize_col = tag_cols#add Gobject.Data.string
let t_size_lm_col = tag_cols#add Gobject.Data.float
let t_size_lm_s_col = tag_cols#add Gobject.Data.string
let t_size_color_col = tag_cols#add Gobject.Data.string
let t_check_size_col = tag_cols#add Gobject.Data.boolean
let t_max_size_col = tag_cols#add Gobject.Data.string
let t_realmax_size_col = tag_cols#add Gobject.Data.string
let t_max_size_lm_col = tag_cols#add Gobject.Data.float
let t_max_size_lm_s_col = tag_cols#add Gobject.Data.string
let t_check_max_size_col = tag_cols#add Gobject.Data.boolean
let t_percent_col = tag_cols#add Gobject.Data.string
let t_check_percent_col = tag_cols#add Gobject.Data.boolean

let tag_model = GTree.list_store tag_cols


(* For the Value notebook *)
let value_int_cols = new GTree.column_list
let v_i_name_col = value_int_cols#add Gobject.Data.string
let v_i_tag_col = value_int_cols#add Gobject.Data.int
let v_i_value_col = value_int_cols#add Gobject.Data.string
let v_i_value_lm_col = value_int_cols#add Gobject.Data.float
let v_i_value_lm_s_col = value_int_cols#add Gobject.Data.string
let v_i_color_col = value_int_cols#add Gobject.Data.string
let v_i_check_value_col = value_int_cols#add Gobject.Data.boolean

let value_i_model = GTree.list_store value_int_cols

let value_float_cols = new GTree.column_list
let v_f_name_col = value_float_cols#add Gobject.Data.string
let v_f_tag_col = value_float_cols#add Gobject.Data.int
let v_f_value_col = value_float_cols#add Gobject.Data.string
let v_f_value_lm_col = value_float_cols#add Gobject.Data.float
let v_f_value_lm_s_col = value_float_cols#add Gobject.Data.string
let v_f_color_col = value_float_cols#add Gobject.Data.string
let v_f_check_value_col = value_float_cols#add Gobject.Data.boolean

let value_f_model = GTree.list_store value_float_cols

let value_bool_cols = new GTree.column_list
let v_b_name_col = value_bool_cols#add Gobject.Data.string
let v_b_tag_col = value_bool_cols#add Gobject.Data.int
let v_b_value_col = value_bool_cols#add Gobject.Data.string
let v_b_value_lm_col = value_bool_cols#add Gobject.Data.float
let v_b_value_lm_s_col = value_bool_cols#add Gobject.Data.string
let v_b_color_col = value_bool_cols#add Gobject.Data.string
let v_b_check_value_col = value_bool_cols#add Gobject.Data.boolean

let value_b_model = GTree.list_store value_bool_cols

let value_string_cols = new GTree.column_list
let v_s_name_col = value_string_cols#add Gobject.Data.string
let v_s_tag_col = value_string_cols#add Gobject.Data.int
let v_s_value_col = value_string_cols#add Gobject.Data.string
let v_s_value_lm_col = value_string_cols#add Gobject.Data.float
let v_s_value_lm_s_col = value_string_cols#add Gobject.Data.string
let v_s_color_col = value_string_cols#add Gobject.Data.string
let v_s_check_value_col = value_string_cols#add Gobject.Data.boolean

let value_s_model = GTree.list_store value_string_cols


(* For the Gc notebook *)
let gc_cols = new GTree.column_list
let gc_total = gc_cols#add Gobject.Data.string
let gc_check_total = gc_cols#add Gobject.Data.boolean
let gc_max = gc_cols#add Gobject.Data.string
let gc_check_max = gc_cols#add Gobject.Data.boolean
let gc_alive = gc_cols#add Gobject.Data.string
let gc_check_alive = gc_cols#add Gobject.Data.boolean

let gc_model = GTree.list_store gc_cols


let tree_cols = new GTree.column_list
let tree_name_col = tree_cols#add Gobject.Data.string
let tree_tag_col = tree_cols#add Gobject.Data.int
let tree_lm_s_col = tree_cols#add Gobject.Data.string
let tree_radio_col = tree_cols#add Gobject.Data.boolean

let tree_model = GTree.list_store tree_cols


let hash_cols = new GTree.column_list 
let h_name_col = hash_cols#add Gobject.Data.string
let h_tag_col = hash_cols#add Gobject.Data.int
let h_length_col = hash_cols#add Gobject.Data.string
let h_length_check_col = hash_cols#add Gobject.Data.boolean
let h_real_length_col = hash_cols#add Gobject.Data.string
let h_real_length_check_col = hash_cols#add Gobject.Data.boolean
let h_length_b_col = hash_cols#add Gobject.Data.string
let h_length_b_check_col = hash_cols#add Gobject.Data.boolean
let h_empty_b_col = hash_cols#add Gobject.Data.string
let h_empty_b_check_col = hash_cols#add Gobject.Data.boolean
let h_lm_col = hash_cols#add Gobject.Data.string
let h_lm_s_col = hash_cols#add Gobject.Data.string
let h_mean_col = hash_cols#add Gobject.Data.string
let h_mean_check_col = hash_cols#add Gobject.Data.boolean
let h_percent_col = hash_cols#add Gobject.Data.int
let h_percent_check_col = hash_cols#add Gobject.Data.boolean


let hash_model = GTree.list_store hash_cols

let log_cols = new GTree.column_list
let l_time_col = log_cols#add Gobject.Data.string
let l_log_col = log_cols#add Gobject.Data.string
let l_color_col = log_cols#add Gobject.Data.string

let log_model = GTree.list_store log_cols


(*************************************************
          FUNCTIONS TO FILL THE MODELS
**************************************************
**************************************************)



(* Fills the stat page with incomming values *)
       
let fill_stat point_list time_list =
  let model = stat_model in
  
  let fct_point {id=id; name=n; value=t,v; status=st} =
    
    let fct row =
      let _,st = st in
      begin
        match st with
	  | St_killed -> model#set ~row ~column:s_count_color_col "#EA2F24"
	  | St_active -> model#set ~row ~column:s_count_color_col "#000000"
	  | _ -> assert false
      end;
      match v with
	| No_value -> ()
	| Killed -> ()
	| Int i -> 
            model#set ~row ~column:s_count_col (string_of_int i);
            model#set ~row ~column:s_count_lm_col t;
            model#set ~row ~column:s_count_lm_s_col (time_of_float_parenthesis t)
	| Int64 i -> 
            model#set ~row ~column:s_count_col (Int64.to_string i);
            model#set ~row ~column:s_count_lm_col t;
            model#set ~row ~column:s_count_lm_s_col (time_of_float_parenthesis t)
	| _ -> assert false
    in
    
    if not(Hashtbl.mem row_stat n)
    then
      let row = model#append () in
      model#set ~row ~column:s_name_col n;
      model#set ~row ~column:s_tag_count_col id;
      model#set ~row ~column:s_count_lm_s_col "Never";
      fct row;
      Hashtbl.add row_stat n row
    else
      let row = Hashtbl.find row_stat n in
      fct row
  in
  
  let fct_time {id=id; name=n; value=t,v; status=st} =

    let fct row =
      let _,st = st in
      begin
	match st with
	  | St_killed -> model#set ~row ~column:s_time_color_col "#EA2F24"
	  | St_active -> model#set ~row ~column:s_time_color_col "#000000"
	  | _ -> assert false
      end;
      begin
	match v with
	  | No_value -> ()
	  | Killed -> ()
	  | Float f -> 
              model#set ~row ~column:s_time_col (string_of_float f);
              model#set ~row ~column:s_time_lm_col t;
              model#set ~row ~column:s_time_lm_s_col (time_of_float_parenthesis t)
	  | _ -> assert false
      end;
      
      let _,pv = Db.get_percent_time id in
      begin
	match pv with
	  | No_value -> ()
	  | Killed -> ()
		| Float f -> model#set ~row ~column:s_percent_col (to_percent (string_of_float(f)))
		| _ -> assert false
      end
    in
    
    if not(Hashtbl.mem row_stat n)
    then
      let row = model#append () in
      model#set ~row ~column:s_name_col n;
      model#set ~row ~column:s_tag_time_col id;
      model#set ~row ~column:s_time_lm_s_col "Never";
      fct row;
      Hashtbl.add row_stat n row
    else
      let row = Hashtbl.find row_stat n in
      fct row;
  in
  
  List.iter fct_point point_list;
  List.iter fct_time time_list
    

(* Fills the tag page with values *)
let fill_tag count_list size_list =
  let model = tag_model in

  let fct_count {id=id; name=n; value=t,v; status=st} =
    
    let fct row =
      let _,st = st in
      begin
	match st with
	  | St_killed -> model#set ~row ~column:t_count_color_col "#EA2F24"
	  | St_active -> model#set ~row ~column:t_count_color_col "#000000"
	  | _ -> assert false
      end;
      begin
	match v with
	  | No_value -> ()
	  | Int i -> 
              model#set ~row ~column:t_count_col (string_of_int i);
              model#set ~row ~column:t_count_lm_col t;
              model#set ~row ~column:t_count_lm_s_col (time_of_float_parenthesis t)
	  | Int64 i -> 
              model#set ~row ~column:t_count_col (Int64.to_string i);
              model#set ~row ~column:t_count_lm_col t;
              model#set ~row ~column:t_count_lm_s_col (time_of_float_parenthesis t)
	  | _ -> assert false
      end;
      
      let tmc,mc = Db.get_tag_max_count id in
      begin
	match mc with
	  | No_value -> ()
	  | Killed -> ()
	  | Int i -> 
              model#set ~row ~column:t_max_count_col (string_of_int i);
              model#set ~row ~column:t_max_count_lm_col tmc;
              model#set ~row ~column:t_max_count_lm_s_col (time_of_float_parenthesis tmc)
	  | Int64 i -> 
              model#set ~row ~column:t_max_count_col (Int64.to_string i);
              model#set ~row ~column:t_max_count_lm_col tmc;
              model#set ~row ~column:t_max_count_lm_s_col (time_of_float_parenthesis tmc)
	  | _ -> assert false
      end
    in
    
    if not(Hashtbl.mem row_tag id)
    then
      let l = Db.get_bindings id in
      if List.mem id l then
	let id' = List.find (fun id' -> id' <> id) l in
	if Hashtbl.mem row_tag id' then 
	  let row = Hashtbl.find row_tag id' in
          model#set ~row ~column:t_tag_count_col id;
	  Hashtbl.add row_tag id row;
	  fct row
	else 
	  let row = model#append () in
	  model#set ~row ~column:t_name_col n;
	  model#set ~row ~column:t_tag_count_col id;
          model#set ~row ~column:t_count_lm_s_col "Never";
          model#set ~row ~column:t_max_count_lm_s_col "Never";
	  fct row;
	  Hashtbl.add row_tag id row
      else 
	let row = model#append () in
	model#set ~row ~column:t_name_col n;
	model#set ~row ~column:t_tag_count_col id;
        model#set ~row ~column:t_count_lm_s_col "Never";
        model#set ~row ~column:t_max_count_lm_s_col "Never";
	fct row;
	Hashtbl.add row_tag id row
    else   
      let row = Hashtbl.find row_tag id in
      fct row
  in

  let fct_size {id=id; name=n; value=t,v; status=st} =
    
    let fct row =
      let _,st = st in
      begin
	match st with
	  | St_killed -> model#set ~row ~column:t_size_color_col "#EA2F24"
	  | St_active -> model#set ~row ~column:t_size_color_col "#000000"
	  | _ -> assert false
      end;
      begin
	match v with
	  | No_value -> ()
	  | Killed -> ()
	  | Int64 b -> 
	      model#set ~row ~column:t_realsize_col (Int64.to_string b);
	      model#set ~row ~column:t_size_col (string_of_byte b);
              model#set ~row ~column:t_size_lm_col t;
              model#set ~row ~column:t_size_lm_s_col (time_of_float_parenthesis t)
	  | _ -> assert false
      end;
      
      let tms,ms = Db.get_tag_max_size id in
      begin
	match ms with
	  | No_value -> ()
	  | Killed -> ()
	  | Int64 b -> 
	      model#set ~row ~column:t_realmax_size_col (Int64.to_string b);
	      model#set ~row ~column:t_max_size_col (string_of_byte b);
              model#set ~row ~column:t_max_size_lm_col tms;
              model#set ~row ~column:t_max_size_lm_s_col (time_of_float_parenthesis tms)
	  | _ -> assert false
      end;
      
      let tps,ps = Db.get_tag_percent_size id in
      begin
	match ps with
	  | No_value -> ()
	  | Killed -> ()
	  | Float f -> model#set ~row ~column:t_percent_col (to_percent (string_of_float f))
	  | _ -> assert false
      end
    in
    

    if not(Hashtbl.mem row_tag id)
    then
      let l = Db.get_bindings id in
      if List.mem id l then
	let id' = List.find (fun id' -> id' <> id) l in
	if Hashtbl.mem row_tag id' then 
	  let row = Hashtbl.find row_tag id' in
          model#set ~row ~column:t_tag_size_col id;
	  Hashtbl.add row_tag id row;
	  fct row
	else 
	  let row = model#append () in
	  model#set ~row ~column:t_name_col n;
	  model#set ~row ~column:t_tag_size_col id;
          model#set ~row ~column:t_size_lm_s_col "Never";
          model#set ~row ~column:t_max_size_lm_s_col "Never";
	  fct row;
	  Hashtbl.add row_tag id row
      else 
	let row = model#append () in
	model#set ~row ~column:t_name_col n;
	model#set ~row ~column:t_tag_size_col id;
        model#set ~row ~column:t_size_lm_s_col "Never";
        model#set ~row ~column:t_max_size_lm_s_col "Never";
	fct row;
	Hashtbl.add row_tag id row
    else   
      let row = Hashtbl.find row_tag id in
      fct row

  in
  
  List.iter fct_count count_list;
  List.iter fct_size size_list
    

let fill_value l (model: GTree.list_store) table name_col tag_col val_col val_lm_col val_lm_s_col color_col =
  let fct_value {id=id; name=n; value=t,v; status = st} = 
    
    let fct row = 
      let _,st = st in
      begin
	match st with
	  |St_collected -> model#set ~row ~column:color_col "#34D433"
	  |St_active -> model#set ~row ~column:color_col "#000000"
	  |_ -> assert false
      end;
      if v <> No_value then 
        begin
          model#set ~row ~column:val_lm_col t;          
          model#set ~row ~column:val_lm_s_col (time_of_float_parenthesis t);
        end;
      begin
	match v with
	  | No_value -> ()
	  | Float v -> model#set ~row ~column:val_col (string_of_float v)
	  | Int v -> model#set ~row ~column:val_col (string_of_int v)
	  | Int64 v -> model#set ~row ~column:val_col (Int64.to_string v)
	  | String v -> model#set ~row ~column:val_col v
	  | Bool v -> model#set ~row ~column:val_col (string_of_bool v)
	  | Collected -> 
	      let s = model#get ~row ~column:val_col in
	      if String.length s = 0 then
		model#set ~row ~column:val_col "Collected" 
	  | _ -> assert false
      end
    in
    
    if not(Hashtbl.mem table id) 
    then 
      begin
	let row = model#append () in
	model#set ~row ~column:name_col n;
	model#set ~row ~column:tag_col id;
        model#set ~row ~column:val_lm_s_col "Never";
	fct row;
	Hashtbl.add table id row
      end
    else
      begin
	let row = Hashtbl.find table id in
	fct row;
      end
  in 

  List.iter fct_value l


(* Fills the GC page *)

let init_gc () =
  gc_model#append ()

let fill_gc () = 
  let ts,size = Db.get_heap_total_size () in
  let ta,alive = Db.get_heap_alive_size () in
  let tm,max = Db.get_heap_max_size () in
  let opt = gc_model#get_iter_first in
  match opt with
    |Some row ->
       begin
	 match size with
	   | Int64 bsize -> 
	       gc_model#set ~row ~column:gc_total (string_of_byte bsize)
	   | _ -> ()
       end;
	begin
	  match max with
	    | Int64 bmax ->
		gc_model#set ~row ~column:gc_max (string_of_byte bmax)
	    | _ -> ()
	end;
	begin
	  match alive with
	    | Int64 balive -> gc_model#set ~row ~column:gc_alive (string_of_byte balive)
	    | _ -> ()
	end
    |None -> ()



let iter_lists n content = 
  let  (model: GTree.list_store),tag_col,name_col,value_col,value_lm_col,value_lm_s_col,color_col,type_col = content in
  model#foreach
    (fun _ row -> 
       let id = model#get ~row ~column:tag_col in
       let typ = model#get ~row ~column:type_col in
       let tag = get_tag id in
       let (t,v),k = 
	 match typ with
	   |8 -> Db.get_percent_time id,Protocol.Value_float
	   |3 -> Db.get_tag_max_count id, tag.kind
	   |4 -> Db.get_tag_max_size id, tag.kind
	   |5 -> Db.get_tag_percent_size id, Protocol.Value_float
	   |21 -> Db.get_hash_percent_filled id, Protocol.Value_float
	   |20 -> Db.get_hash_mean id, Protocol.Value_float
	   | _ -> tag.value, tag.kind
       in
       if v <> No_value then 
         begin
           model#set ~row ~column:value_lm_col t;
           model#set ~row ~column:value_lm_s_col (time_of_float_parenthesis t);
         end
       else model#set ~row ~column:value_lm_s_col "Never";
       let conv = 
	 match v with
	   |Int i -> string_of_int i
	   |Float f -> begin
	       match typ with 
		 |8 | 5 | 21 -> to_percent (string_of_float f)
		 |_ -> string_of_float f
	     end
	   |Int64 i -> begin 
	       match k with 
		 |Protocol.Tag_size -> string_of_byte i
		 |Protocol.Value_int -> Int64.to_string i
		 |Protocol.Special -> string_of_byte i
		 |_ -> assert false
	     end
	   |String s -> s
	   |Bool b -> string_of_bool b
	   |Hashtable (Int v1,Int v2,Int v3,Int v4) ->
	      begin
		match typ with
		  |16 -> string_of_int v2
		  |17 -> string_of_int v1
		  |18 -> string_of_int v4
		  |19 -> string_of_int v3
		  |_ -> assert false
	      end
	   |Hashtable (Int64 v1,Int64 v2,Int64 v3,Int64 v4) ->
	      begin
		match typ with
		  |16 -> Int64.to_string v2
		  |17 -> Int64.to_string v1
		  |18 -> Int64.to_string v4
		  |19 -> Int64.to_string v3
		  |_ -> assert false
	      end
	   |No_value -> ""
	   |_ -> assert false
       in
       begin
       match tag.status with
	 |_,St_killed -> model#set ~row ~column:color_col "#EA2F24"
	 |_,St_collected -> model#set ~row ~column:color_col "#34D433"
	 |_,St_active ->  model#set ~row ~column:color_col "#000000"
       end;
       model#set ~row ~column:value_col conv;false)



(* Fills the lists of exported values with the most recent values *)
let fill_lists () = 
  Hashtbl.iter (fun n content -> iter_lists n content) lists_table


let fill_tree tree_list = 
  let fct_tree {id=id ; name=n ; value=t,v} =
     
    if not(Hashtbl.mem row_tree id) 
    then 
      begin
	let row = tree_model#append () in
	tree_model#set ~row ~column:tree_name_col n;
	tree_model#set ~row ~column:tree_tag_col id;
	tree_model#set ~row ~column:tree_lm_s_col "Never";
	Hashtbl.add row_tree id row
      end
    else
      begin
	let row = Hashtbl.find row_tree id in
        if v <> No_value then tree_model#set ~row ~column:tree_lm_s_col (time_of_float_parenthesis t);
      end
  in 
  List.iter fct_tree tree_list;
  Hashtbl.iter (fun _ (t,t_p) ->
		  List.iter (fun tree ->
			       if tree.id = t.id then
				 let v = (match tree.value with
					    |_,Protocol.Tree t -> t
					    |_ -> assert false)
				 in
				 if t_p.Tree_panel.tree <> v then
				   t_p.Tree_panel.tree <- v;
			    ) tree_list
	       ) trees
    


let fill_hash hash_list = 
  let fct_hash {id=id ; name=n ; value=t,v} =
     
    let fct row = 
      let _,mean = Db.get_hash_mean id in
      let _,percent = Db.get_hash_percent_filled id in
      begin
	match mean,percent with
	  |Float m, Float p -> 
	     hash_model#set ~row ~column:h_mean_col (string_of_float (m));
	      hash_model#set ~row ~column:h_percent_col (int_of_float (p))
	  | _ -> ()
      end;
      match v with
	|No_value -> ()
	|Hashtable (Int v1,Int v2,Int v3,Int v4) -> 
	   hash_model#set ~row ~column:h_length_col (string_of_int v2);
	    hash_model#set ~row ~column:h_real_length_col (string_of_int v1);
	    hash_model#set ~row ~column:h_length_b_col (string_of_int v4);
	    hash_model#set ~row ~column:h_empty_b_col (string_of_int v3);
            hash_model#set ~row ~column:h_lm_s_col (time_of_float_parenthesis t);
            hash_model#set ~row ~column:h_lm_col (string_of_float t)
	|Hashtable (Int64 v1,Int64 v2,Int64 v3,Int64 v4) -> 
	   hash_model#set ~row ~column:h_length_col (Int64.to_string v2);
	    hash_model#set ~row ~column:h_real_length_col (Int64.to_string v1);
	    hash_model#set ~row ~column:h_length_b_col (Int64.to_string v4);
	    hash_model#set ~row ~column:h_empty_b_col (Int64.to_string v3);
            hash_model#set ~row ~column:h_lm_s_col (time_of_float_parenthesis t);
            hash_model#set ~row ~column:h_lm_col (string_of_float t)
	|_ -> assert false
    in
    
    if not(Hashtbl.mem row_hash id) 
    then 
      begin
	let row = hash_model#append () in
	hash_model#set ~row ~column:h_name_col n;
	hash_model#set ~row ~column:h_tag_col id;
        hash_model#set ~row ~column:h_lm_s_col "Never";
	fct row;
	Hashtbl.add row_hash id row
      end
    else
      begin
	let row = Hashtbl.find row_hash id in
	fct row;
      end
  in  
  List.iter fct_hash hash_list
  
    

let fill_log log =
  let _,v = log in
  match v with
    |No_value -> ()
    |Protocol.Log log_list ->
       log_model#clear ();
        List.iter (fun (t,elt) -> 
                     let row = log_model#append () in
                     log_model#set ~row ~column:l_time_col (time_of_float_parenthesis t);
                     log_model#set ~row ~column:l_log_col elt;
                     log_model#set ~row ~column:l_color_col "blue"
                  ) 
          log_list
    | _ -> assert false
  
    

(*******************************************************************
	            MODEL CREATION FUNCTIONS							    
********************************************************************
********************************************************************)


(* Sorts elements of a column *)

let sort_function column typ (model : #GTree.model) it_a it_b =
  let fct_int it =
     let a = model#get ~row:it ~column in
     if (compare a "" = 0)
     then -1
     else int_of_string a
  in
  let fct_float it =
    let a = model#get ~row:it ~column in
    if ( compare a "" = 0)
    then -1.
    else float_of_string a
  in
  let fct_percent it =
    let a = model#get ~row:it ~column in
    let f = String.sub a 0 ((String.length a) -1) in
    float_of_string f
  in
  match typ with
    |Stat_count|Tag_count|Tag_max_count|Value_i -> 
       compare (fct_int it_a) (fct_int it_b)
    |Stat_time|Value_f -> 
       compare (fct_float it_a) (fct_float it_b)
    |Name|Value_b|Value_s -> compare (model#get ~row:it_a ~column) (model#get ~row:it_b ~column) 
    |Stat_percent_time | Tag_percent_size -> compare (fct_percent it_a) (fct_percent it_b)
    |Tag_size | Tag_max_size -> compare (fct_float it_a) (fct_float it_b)
    |_ -> assert false
    

(* Makes the models depending on the notebook page *)   

let mk_model_aux s ong i col =
  s#set_sort_func i (sort_function col ong)


let mk_model_list (name: string) =
  let new_cols = new GTree.column_list in
  let name_col = new_cols#add Gobject.Data.string in
  let tag_col = new_cols#add Gobject.Data.int in
  let value_col = new_cols#add Gobject.Data.string in
  let value_lm_col = new_cols#add Gobject.Data.float in
  let value_lm_s_col = new_cols#add Gobject.Data.string in
  let color_col = new_cols#add Gobject.Data.string in
  let type_col = new_cols#add Gobject.Data.int in
  let s_m = GTree.list_store new_cols in
  Hashtbl.add lists_table name (s_m,tag_col,name_col,value_col,value_lm_col,value_lm_s_col,color_col,type_col);
  (s_m,name_col,value_col,value_lm_s_col,color_col)



let mk_model s_m noteb = 
  let s = GTree.model_sort s_m in  
  match noteb with 
    |Stat ->
       mk_model_aux s Name 0 s_name_col;
       mk_model_aux s Stat_count 2 s_count_col;
       mk_model_aux s Stat_time 8 s_time_col;
       mk_model_aux s Stat_percent_time 13 s_percent_col;
       s_m,s
    
    |Tag ->
       mk_model_aux s Name 0 t_name_col;
       mk_model_aux s Tag_count 2 t_count_col;
       mk_model_aux s Tag_max_count 7 t_max_count_col;
       mk_model_aux s Tag_size 12 t_realsize_col;
       mk_model_aux s Tag_max_size 18 t_realmax_size_col;
       mk_model_aux s Tag_percent_size 23 t_percent_col;
       s_m,s
    
    |Gc -> s_m,s
    
    |Value_int ->
       mk_model_aux s Name 0 v_i_name_col;
       mk_model_aux s Value_i 2 v_i_value_col;
	s_m,s
    
    |Value_float ->
       mk_model_aux s Name 0 v_f_name_col;
       mk_model_aux s Value_f 2 v_f_value_col;
       s_m,s
    
    |Value_bool ->
       mk_model_aux s Name 0 v_b_name_col;
       mk_model_aux s Value_b 2 v_b_value_col;
       s_m,s
    
    |Value_string ->
       mk_model_aux s Name 0 v_s_name_col;
       mk_model_aux s Value_s 2 v_s_value_col;
       s_m,s
    
    |Exported_graph _ -> s_m,s

    |Tree -> 
       mk_model_aux s Name 0 tree_name_col;
       s_m,s
    |Hash -> 
       mk_model_aux s Name 0 h_name_col;
	mk_model_aux s Value_i 2 h_length_col;
	mk_model_aux s Value_i 4 h_real_length_col;
	mk_model_aux s Value_i 6 h_length_b_col;
	mk_model_aux s Value_i 8 h_empty_b_col;
	mk_model_aux s Value_f 10 h_lm_col;
	mk_model_aux s Value_f 12 h_mean_col;
	s_m,s
    |_ -> assert false



 (*
Local Variables: 
compile-command: "unset LANG; make -C .."
End: 
*)
