Commits

Sébastien Ferré committed 70d33f9

[gui] simplifications (removing dead code)

Comments (0)

Files changed (1)

 
 let _ =
   prerr_endline "Gui: parsing command line arguments...";
-(*
-  Gc.set { (Gc.get())
-	 with
-	   Gc.major_heap_increment = 512*1024;
-	   Gc.space_overhead = 50;
-	   Gc.max_overhead = 50;
-           Gc.stack_limit = 8 * 1024 * 1024 };
-*)
   Arg.parse
     [ ("-user", Arg.String (fun uri -> current_src := uri), "user URI");
       ("-logui", Arg.Unit (fun () -> logui := true), "logs the GUI session");
 
 let cb_copy : cb_copy ref = ref Nothing (* clipboard of object ids for copy, paste, ... *)
 
-type id_view = Lisql.Feature.spec
-
 let all_ext_colors, last_ext_color =
 (*      let splits = [| 0; 16; 8; 24; 4; 12; 20; 28; 2; 6; 10; 14; 18; 22; 26; 30;
    1; 3; 5; 7; 9; 11; 13; 15; 17; 19; 21; 23; 25; 27; 29; 31 |] in *)
   done;
   t, nbcolors-1
 
-type ext_data = { mutable count : int; mutable color : string option}
 
-class state_ext_colors =
-  object (self)
-    val mutable ext_colors : (Ext.t,ext_data) Hashtbl.t = Hashtbl.create 13
-    val mutable next_color : int = 0
-
-    method get_ext_color (e : Ext.t) =
-      try
-	let d = Hashtbl.find ext_colors e in
-	if d.count <= 1 then str_white else match d.color with Some c -> c | None -> str_white
-      with _ -> str_white
-
-    method incr_ext_count (e : Ext.t) =
-      try
-	let d = Hashtbl.find ext_colors e in
-	d.count <- d.count + 1;
-	if d.count >= 2 && d.color = None
-	then begin
-	  d.color <- Some all_ext_colors.(next_color);
-	  next_color <- min (next_color + 1) last_ext_color
-	end
-      with _ ->
-	Hashtbl.replace ext_colors e {count = 1; color = None}
-
-    method decr_ext_count (e : Ext.t) =
-      try
-	let d = Hashtbl.find ext_colors e in
-	d.count <- d.count - 1
-      with _ -> ()
-
-    method copy = new state_ext_colors (* all colors can be reused in new state *)
-  end
+type id_view = Lisql.Feature.spec
 
 let default_links_page_size = 100
 
-class state_view ext_colors0 (v : id_view) =
+class state_view (v : id_view) =
   object (self)
     val view = v
-    val mutable ext_colors : state_ext_colors = ext_colors0
     val mutable expanded : bool = false
-    val mutable links_opt : incr list option = None
-    val mutable suppmin_opt : int option = None
     val mutable links_sort_fun : links_sort_fun = sort_by_feature
     val mutable links_page_start : int = 1 (* first page *)
     val mutable links_page_size : int = default_links_page_size (*  use max_int for no limit *)
 
     method view = view
     method expanded = expanded
-    method links_opt = links_opt
-    method suppmin_opt = suppmin_opt
     method links_sort_fun = links_sort_fun
     method links_page_start = links_page_start
     method links_page_size = links_page_size
 
-    method set_expanded b =
-      if not expanded && b
-      then begin
-	match links_opt with
-	| None -> assert false
-	| Some l ->
-	    List.iter (fun i -> ext_colors#incr_ext_count i#ext) l end
-      else if expanded && not b
-      then begin
-	match links_opt with
-	| None -> assert false
-	| Some l ->
-	    List.iter (fun i -> ext_colors#decr_ext_count i#ext) l
-      end;
-      expanded <- b
-
-    method set_suppmin_opt x = suppmin_opt <- x
+    method set_expanded b = expanded <- b
     method set_links_sort_fun f = links_sort_fun <- f
     method set_links_page_start s = links_page_start <- s
     method set_links_page_size s = links_page_size <- s
 
-    method set_links_opt l =
-      if expanded then begin
-	( match links_opt with
-	| None -> ()
-	| Some l_old ->
-	    List.iter (fun i -> ext_colors # decr_ext_count i#ext) l_old);
-	(match l with
-	| None -> ()
-	| Some l_new ->
-	    List.iter (fun i -> ext_colors # incr_ext_count i#ext) l_new)
-      end;
-      links_opt <- l
-
-    method copy ext_colors0 (v : id_view) =
+    method copy (v : id_view) =
       {< view = v;
-	 ext_colors = ext_colors0;
-	 links_opt = None;
 	 links_page_start = 1>}
   end
 
     method unregister_to_all = place_view#unregister_to_all
 
     val mutable views : (id_view,state_view) Hashtbl.t = Hashtbl.create 13
-    val mutable ext_colors : state_ext_colors = new state_ext_colors
     val mutable int_preselect : Ext.t option = None (* set of selected objects *)
 
     method views = views
     method int_preselect = int_preselect
 
-    method new_view (v : id_view) = new state_view ext_colors v
+    method new_view (v : id_view) = new state_view v
 
-    method copy_view (sv : state_view) (v : id_view) = sv#copy ext_colors v
+    method copy_view (sv : state_view) (v : id_view) = sv#copy v
 
     method get_view v =
       try Hashtbl.find views v
       with Not_found ->
-	let sv = new state_view ext_colors v in
+	let sv = new state_view v in
 	Hashtbl.add views v sv;
 	sv
 
-    method ext_colors = ext_colors
-
     method replace_view : id_view -> id_view -> unit =
       fun v v' ->
 	try
     method set_int_preselect oids = int_preselect <- oids
 
     method copy foc =
-      let ext_colors_copy = ext_colors # copy in
       {< place_view =
 	 begin
 	   let view = new Tarpit.incremental_view (Some self#place) in
 	     | Some place -> Some (place#copy ~obs foc));
 	   view
 	 end;
-	 ext_colors = ext_colors_copy;
 	 int_preselect = None;
 	 views =
          let ht = Hashtbl.create (Hashtbl.length views) in
-	 Hashtbl.iter (fun v sv -> Hashtbl.add ht v (sv # copy ext_colors_copy v)) views;
+	 Hashtbl.iter (fun v sv -> Hashtbl.add ht v (sv # copy v)) views;
 	 ht;>}
 
     initializer
       List.iter
 	(fun v ->
-	  Hashtbl.add views v (new state_view ext_colors v))
+	  Hashtbl.add views v (new state_view v))
 	[Lisql.Feature.Spec_Thing; Lisql.Feature.Spec_Something]
   end
 
 class tree_features_callbacks =
   object
     method row_activated : Gtk.tree_path -> unit = fun path -> ()
-    method row_expanded : Gtk.tree_path -> unit = fun path -> ()
-    method row_collapsed : Gtk.tree_path -> unit = fun path -> ()
     method refresh_preselect : bool -> unit = fun _ -> ()
     method ctx_menu : incr list -> GMenu.menu -> unit = fun lx menu -> ()
     method data_received : unit -> unit = fun () -> ()
   let row_weight = cols#add int in
   let bg_color = cols#add string in
   let thumb_file = cols#add string in
-(*  let model = GTree.tree_store cols in *)
-(*  let h_incr = Hashtbl.create 101 in *)
   let view = GTree.view (*~model:model*) ~headers_visible:false ~packing:sw#add () in
   let cell_count =  GTree.cell_renderer_text [`XALIGN 1.; `YALIGN 0.] in
   let col_count =
 	end
       end
 
-    method row_activated path vcol =
-      match model#custom_get_iter path with
-	| None -> ()
-	| Some iter ->
-	  let count = model#get_count iter (*model#get ~row:iter ~column:count*) in
-	  if count <> ""
-	  then callbacks # row_activated path
-	  (*else begin (* a function has been activated *)
-	    let sf = self # feature_from_path path in
-	    if sf = function_top then self # page_top (model#iter_parent iter)
-	    else if sf = function_up then self # page_up (model#iter_parent iter)
-	    else if sf = function_down then self # page_down (model#iter_parent iter)
-	    else if sf = function_bottom then self # page_bottom (model#iter_parent iter)
-	    else ()
-	  end*)
+    method row_activated path vcol = callbacks#row_activated path
 
     method button_press ev =
       let path_opt =
 	callbacks # ctx_menu lx menu;
 	menu#popup ~button:(GdkEvent.Button.button ev) ~time:(GdkEvent.Button.time ev);
 	true
-      else if button = 2 then
-	match path_opt with
-	| None -> false
-	| Some path -> self#expand_row path; true
       else
 	false
 
     method ext_from_path path : Ext.t =
       (self#incr_from_path path)#ext
 
-    method feature_from_path path : string =
-      match model#custom_get_iter path with
-	| None -> failwith "Gui.tree_features#feature_from_path"
-	| Some iter -> model#get_feature iter
-
     method spec_from_path path : Lisql.Feature.spec =
       (self#incr_from_path path)#spec
 
 	Hashtbl.add views v sv;
 	sv
 
-(*
-    method private row_color_from_incr i =
-      if not check_feat_color#active
-      then str_black
-      else
-	let open Lisql.Feature in
-	match i#kind with
-	| Kind_Variable -> str_color_variable
-	| Kind_Entity -> str_color_entity
-	| Kind_Literal -> str_color_literal
-	| Kind_Class -> str_color_class
-	| Kind_Property -> str_color_property
-	| Kind_InverseProperty -> str_color_property
-	| Kind_Structure -> str_color_functor
-	| Kind_Argument -> str_color_functor
-	| _ -> str_black
-
-    method private row_scale_from_incr i =
-      if not check_scale#active
-      then 1.
-      else i#scale
-
-    method private row_weight_from_incr i =
-      if i#anew
-      then 400
-      else 200
-
-    method private lift_label_from_incr i =
-      (* Printf.sprintf "%d%%" (int_of_float (i#lift *. 100.)) *)
-      if not check_lift#active
-      then " "
-      else string_of_int i#lift#supp
-
-    method private lift_scale_from_incr i =
-      if not check_scale#active
-      then 1.
-      else i#lift#scale
-
-    method private lift_color_from_incr i =
-      if not check_lift_color#active
-      then str_white
-      else i#lift#color
-
-    method private lift_fg_color_from_incr i =
-      if true || not check_lift_color#active || i#scale >= i#lift#scale
-      then str_black
-      else str_white
-
-(*
-   method private row_bg_color_from_incr (s,n,e) =
-   if check_int_preselect#active
-   then Common.fold_option (fun oids -> if not (Ext.is_empty (Ext.inter oids e)) then str_white else str_lightgrey) str_white history#current#int_preselect
-   else str_white
- *)
-	  
-    method private bg_color_from_ext int_preselect e =
-      if not check_int_preselect#active
-      then str_white
-      else
-	match int_preselect with
-	| None -> str_white
-	| Some oids ->
-	    let inter = Ext.inter oids e in
-	    color_of_ratio (Ext.cardinal inter) (Ext.cardinal oids)
-*)
-
     method selected_paths = view # selection # get_selected_rows
 
     method selected_increments =
       let fs = List.map (fun path -> self # incr_from_path path) paths in
       cb_copy := Features fs
 
-(*
-    method private refresh_function_iter iter (s : string) : unit = Common.prof "Gui.tree_features#refresh_function_iter" (fun () ->
-      model#set ~row:iter ~column:feature s;
-      model#set ~row:iter ~column:markup s;
-      model#set ~row:iter ~column:count "";
-      model#set ~row:iter ~column:lift_label "";
-      model#set ~row:iter ~column:lift_color str_white;
-      model#set ~row:iter ~column:row_color str_darkred;
-      model#set ~row:iter ~column:row_scale 1.;
-      model#set ~row:iter ~column:row_weight 400;
-      model#set ~row:iter ~column:bg_color str_white;
-      model#set ~row:iter ~column:thumb_file "")
-(*
-   for i = model#iter_n_children (Some iter) - 1 downto 0 do
-   ignore (model#remove (model#iter_children ~nth:i (Some iter)))
-   done
- *)
-
-    method private refresh_tree_iter iter i : unit = Common.prof "Gui.tree_features#refresh_tree_iter" (fun () ->
-      let s = i#string in
-      Hashtbl.replace h_incr s i;
-      model#set ~row:iter ~column:feature s;
-      model#set ~row:iter ~column:markup (make_markup (i#display ~obs:Tarpit.blind_observer));
-(*	  model#set ~row:iter ~column:incr i; *)
-      model#set ~row:iter ~column:count (string_of_int i#supp);
-      model#set ~row:iter ~column:lift_label (self # lift_label_from_incr i);
-      model#set ~row:iter ~column:lift_color (self # lift_color_from_incr i);
-(*      model#set ~row:iter ~column:row_color (self # row_color_from_incr i); *)
-      model#set ~row:iter ~column:row_scale (self # row_scale_from_incr i);
-      model#set ~row:iter ~column:row_weight (self # row_weight_from_incr i);
-      model#set ~row:iter ~column:bg_color (self # bg_color_from_ext history#current#int_preselect i#ext);
-      model#set ~row:iter ~column:thumb_file
-	( match i#uri_opt with
-	| None -> ""
-	| Some uri ->
-	    match picture_of_name ~obs:Tarpit.blind_observer (Rdf.URI uri) with
-	    | None -> ""
-	    | Some f -> f))
-
-
-    method refresh_view force parent_opt i sv = Common.prof "Gui.tree_features#refresh_view" (fun () ->
-      let page_start, page_size = sv#links_page_start, sv#links_page_size in
-      let incrs = ls_opt ~obs:Tarpit.blind_observer force sv i in
-      let nb_incrs = List.length incrs in
-      let visible_incrs = Common.sub_list incrs (page_start - 1) page_size in
-      sv # set_expanded true;
-      let expd = false (* (List.length visible_incrs) = 1 *) in
-      let n_children = model#iter_n_children parent_opt in
-      let pos = ref (-1) in
-      let get_iter () = Common.prof "Gui.get_iter" (fun () ->
-	Pervasives.incr pos;
-	if !pos < n_children
-	then model#iter_children ~nth:!pos parent_opt
-	else model#append ?parent:parent_opt ()) in
-      if nb_incrs > page_size then
-	self # refresh_function_iter (get_iter ())
-	  (if page_start = 1
-	  then function_bottom
-	  else function_up);
-      List.iter
-	(fun i' ->
-	  let iter' = get_iter () in (* TODO: try to set iter' as a reference out of the loop *)
-	  self # refresh_tree_iter iter' i';
-	  if i#spec <> Lisql.Feature.Spec_Something then
-	    self # expand_view expd force iter' (model#get_path iter') i')
-	visible_incrs;
-      if nb_incrs > page_size then
-	self # refresh_function_iter (get_iter ())
-	  (if nb_incrs > page_start - 1 + page_size
-	  then function_down
-	  else function_top);
-      for i = n_children - 1 downto !pos + 1 do
-	ignore (model#remove (model#iter_children ~nth:i parent_opt))
-      done)
-
-    method private expand_view expd force tree_iter path i = Common.prof "Gui.tree_features#expand_view" (fun () ->
-      let v = i#spec in
-      model#set ~row:(model#append ~parent:tree_iter ()) ~column:markup "";
-      let st = history # current in
-      let views = st # views in
-      let sv_opt =
-	try
-	  let sv = Hashtbl.find views v in
-	  if sv # expanded
-	  then Some sv
-	  else None
-	with _ ->
-	  if expd  (* if we must expand tree_iter *)
-	  then begin (* then we create a stateview for tree_iter in expanded_views *)
-	    let sv =
-	      try
-		match model#iter_parent tree_iter with
-		| None -> st # copy_view (self # state_view) v
-		| Some iter ->
-		    let parent_v = self#spec_from_iter iter in
-		    st # copy_view (Hashtbl.find views v) v
-	      with _ -> (* should not happen *)
-		st # new_view v in
-	    Hashtbl.add views v sv;
-	    Some sv end
-	  else None in
-      match sv_opt with
-      | None -> ()
-	  (*view # collapse_row path*)
-      | Some sv ->
-	  ignore (self # refresh_view force (Some tree_iter) i sv);
-	  view # expand_row path)
-
-    method refresh force =  (* when force is true, links are re-computed *)
-      Common.prof "Gui.tree_features#refresh" (fun () ->
-	view#selection#unselect_all ();
-	let i = get_incr () in
-(*	view#misc#freeze_notify (); *)
-	view#set_model None;
-	self#refresh_view force None i (history#current#get_view i#spec);
-	view#set_model (Some (model :> GTree.model)))
-(*	view#misc#thaw_notify ()) *)
-*)
-
     method refresh (force : bool) =
       Common.prof "Gui.tree_features#refresh" (fun () ->
 	view#selection#unselect_all ();
 	    false)
 *)
 
-    method expand_row path =
-(*
-      let i = self # incr_from_path path in
-      let sv = self # state_view_from_path path in
-      self # refresh_view false (Some (model#get_iter path)) i sv;
-*)
-      view # expand_row path
-
-    method collapse_row path =
-(*
-      let v = self # spec_from_path path in
-      let views = history # current # views in
-      (try (Hashtbl.find views v) # set_expanded false with Not_found -> ());
-*)
-      view # collapse_row path
-
-(*
-    method page_top parent_opt =
-      let v = Common.fold_option self#spec_from_iter v parent_opt in
-      let sv = Hashtbl.find history#current#views v in
-      let new_offset = 1 in
-      sv # set_links_page_start new_offset;
-      match parent_opt with
-      | None -> self # refresh false
-      | Some iter -> self # refresh_view false (Some iter) (self#incr_from_iter iter) sv
-
-    method page_up parent_opt =
-      let v = Common.fold_option self#spec_from_iter v parent_opt in
-      let sv = Hashtbl.find history#current#views v in
-      let offset = sv # links_page_start in
-      let maxobj = sv # links_page_size in
-      let new_offset =
-	let no = offset - maxobj in
-	if no < 1 then 1 else no in
-      sv # set_links_page_start new_offset;
-      match parent_opt with
-      | None -> self # refresh false
-      | Some iter -> self # refresh_view false (Some iter) (self#incr_from_iter iter) sv
-
-    method page_down parent_opt =
-      let v = Common.fold_option self#spec_from_iter v parent_opt in
-      let sv = Hashtbl.find history#current#views v in
-      let offset = sv # links_page_start in
-      let maxobj = sv # links_page_size in
-      let nbobj = Common.fold_option (fun l -> List.length l) 0 sv#links_opt in
-      let new_offset =
-	let no = offset + maxobj in
-	if no > nbobj then offset else no in
-      sv # set_links_page_start new_offset;
-      match parent_opt with
-      | None -> self # refresh false
-      | Some iter -> self # refresh_view false (Some iter) (self#incr_from_iter iter) sv
-
-    method page_bottom parent_opt =
-      let v = Common.fold_option self#spec_from_iter v parent_opt in
-      let sv = Hashtbl.find history#current#views v in
-      let maxobj = sv # links_page_size in
-      let nbobj = Common.fold_option (fun l -> List.length l) 0 sv#links_opt in
-      let new_offset = ((nbobj - 1) / maxobj) * maxobj + 1 in
-      sv # set_links_page_start new_offset;
-      match parent_opt with
-      | None -> self # refresh false
-      | Some iter -> self#refresh_view false (Some iter) (self#incr_from_iter iter) sv
-*)
+    method expand_row path = view#expand_row path
+    method collapse_row path = view#collapse_row path
 
     initializer
-(*      model#set_sort_column_id GTree.unsorted_sort_column_id `DESCENDING; *)
       view#selection#set_mode `MULTIPLE;
       col_lift#set_sizing `AUTOSIZE;
-(*
-   col_lift#set_cell_data_func
-   cell_lift
-   (fun model iter ->
-   let lift_color = model # get ~row:iter ~column:lift_color in
-   cell_lift#set_properties [`CELL_BACKGROUND_GDK lift_color]);
- *)
       col_count#set_sizing `AUTOSIZE;
       col_count#set_cell_data_func
 	cell_count
 	(fun model iter ->
-(*	      let row_color = model # get ~row:iter ~column:row_color in *)
 	  let bg_color =
 	    if check_ext_color#active (* && row_color = str_black *)
 	    then
 		if incr#supp = place#nb_answers
 		then
 		  if place#rank = 0 then str_color_query else str_color_update
-		else
-		  try current#ext_colors#get_ext_color incr#ext
-		  with _ -> str_white
+		else str_white
 	      with _ -> str_white
 	    else str_white in
 	  cell_count#set_properties [`CELL_BACKGROUND bg_color]);
 
       view#selection#connect#after#changed ~callback:self#selection_changed;
       view#connect#after#row_activated ~callback:self#row_activated;
-      view#connect#row_expanded ~callback:(fun _ path -> self # expand_row path; callbacks # row_expanded path);
-      view#connect#row_collapsed ~callback:(fun _ path -> self # collapse_row path; callbacks # row_collapsed path);
       view#event#connect#button_press ~callback:self#button_press;
       view#drag#source_set ~modi:[`BUTTON1] ~actions:[`MOVE]
 	[ { Gtk.target = "STRING"; Gtk.flags = []; Gtk.info = 0} ];
 
     method selection_changed = self # current # selection_changed
 
-    method feature_from_path = self # current # feature_from_path
-
     method spec_from_path = self # current # spec_from_path
 
     method incr_from_path = self # current # incr_from_path
       self#tree_p12#refresh_preselect unselect;
       self#tree_s12#refresh_preselect unselect
 
-    method expand_row = self # current # expand_row
-
-    method collapse_row = self # current # collapse_row
+    method expand_row path = self#current#expand_row path
+    method collapse_row path = self#current#collapse_row path
 
     method set_ratio n d = paned_set_ratio paned n d
   end
   let vbox = w#vbox in
   let check_lexicalorder = GButton.check_button ~label:"logical (vs. decreasing count) sorting of increments"
       ~active:(sv # links_sort_fun==sort_by_feature) ~packing:vbox#add () in
-  let suppmin = Option.map string_of_int sv#suppmin_opt in
-  let check_suppmin = GButton.check_button ~label:"minimum support of increments" ~active:(suppmin<>None)  ~packing:vbox#add () in
-  let entry_suppmin = GEdit.entry ?text:suppmin ~editable:(suppmin<>None) ~width_chars:10 ~packing:vbox#add () in
   let page_size = let ps = sv # links_page_size in if ps = max_int then None else Some (string_of_int ps) in
   let check_page_size = GButton.check_button ~label:"maximum number of increments displayed" ~active:(page_size<>None) ~packing:vbox#add () in
   let entry_page_size = GEdit.entry ?text:page_size ~editable:(page_size<>None) ~width_chars:10 ~packing:vbox#add () in
-  check_suppmin#connect#toggled ~callback:(fun () -> entry_suppmin#set_editable check_suppmin#active);
   check_page_size#connect#toggled ~callback:(fun () -> entry_page_size#set_editable check_page_size#active);
 
   let action_area = w#action_area in
   button_cancel#connect#clicked ~callback:w#destroy;
   button_ok#connect#clicked ~callback:(fun () ->
     try
-      let suppmin_opt =
-	if check_suppmin#active then Some (int_of_string entry_suppmin#text)
-	else None in
       let sort_fun =
 	if check_lexicalorder#active
 	then sort_by_feature
 	if check_page_size#active
 	then int_of_string entry_page_size#text
 	else max_int in
-      let chsv sv =
-	sv # set_suppmin_opt suppmin_opt;
-	sv # set_links_sort_fun sort_fun;
-	sv # set_links_page_size page_size in
-      ( match paths with
-      | [] ->
-	  chsv sv;
-	  navig # refresh true
-      | _ ->
-	  List.iter 
-	    (fun path ->
-	      sv # set_links_opt None;
-	      chsv sv;
-	      navig # expand_row path)
-	    paths
-       );
+      sv # set_links_sort_fun sort_fun;
+      sv # set_links_page_size page_size;
+      List.iter navig#expand_row paths;
+      navig # refresh true;
       w#destroy ()
     with _ -> ());
   w#show ()
     match paths with
     | [] -> navig # state_view
     | path::_ -> navig # state_view_from_path path in
-  try
-    match paths with
-    | [] ->
-	f sv;
-	navig # refresh true
-    | _ ->
-	List.iter 
-	  (fun path ->
-	    sv # set_links_opt None;
-	    f sv;
-	    navig # expand_row path)
-	  paths
-  with _ -> ()
+  f sv;
+  List.iter navig#expand_row paths;
+  navig#refresh true
 
 let menu_collapse () =
   let paths = navig # selected_paths in
 	let x = (navig#incr_from_path path)#feature in
 	menu_insert Logui.uri_SingleFeatureSelection x
 
-      method row_expanded path = ()
-
-      method row_collapsed path = ()
-
       method refresh_preselect _ = ()
 
       method ctx_menu = ctx_menu_clicked