From 161dc97ed2236aa451d23ecf18b198cad291c15c Mon Sep 17 00:00:00 2001
From: Virgile Prevosto <virgile.prevosto@m4x.org>
Date: Thu, 3 Jan 2019 17:02:51 +0100
Subject: [PATCH] [gui] full upgrade to lablgtk3 beta
---
src/plugins/gui/design.ml | 4 ++--
src/plugins/gui/filetree.ml | 6 ++---
src/plugins/gui/gtk_helper.ml | 18 +++++++++++----
src/plugins/gui/gtk_helper.mli | 10 ++++++++
src/plugins/gui/menu_manager.ml | 23 ++++++-------------
src/plugins/gui/project_manager.ml | 3 +--
src/plugins/gui/wfile.ml | 6 ++---
src/plugins/gui/widget.ml | 15 +++++-------
src/plugins/metrics/register_gui.ml | 15 ++++--------
src/plugins/scope/dpds_gui.ml | 6 ++---
src/plugins/slicing/register_gui.ml | 3 +--
src/plugins/studia/studia_gui.ml | 8 +++----
.../value/gui_files/gui_callstacks_manager.ml | 5 +---
13 files changed, 56 insertions(+), 66 deletions(-)
diff --git a/src/plugins/gui/design.ml b/src/plugins/gui/design.ml
index b7993e453b3..580fec0c99b 100644
--- a/src/plugins/gui/design.ml
+++ b/src/plugins/gui/design.ml
@@ -867,8 +867,8 @@ class main_window () : main_window_extension_points =
(* toplevel_vbox->bottom_hbox-> *statusbar *)
let statusbar =
GMisc.statusbar
- (* GTK3: argument does not exist *)
- (* ~has_resize_grip:false *)
+ (* GTK3: using this argument leads to a crash. *)
+ (*~has_resize_grip:false *)
~packing:bottom_hbox#add ()
in
let status_context = statusbar#new_context "messages" in
diff --git a/src/plugins/gui/filetree.ml b/src/plugins/gui/filetree.ml
index a60026927e6..7b83952df67 100644
--- a/src/plugins/gui/filetree.ml
+++ b/src/plugins/gui/filetree.ml
@@ -548,8 +548,7 @@ let make (tree_view:GTree.view) =
~label:"Hide built-ins" ~key:key_hide_builtins in
let mhide_annotations = MenusHide.menu_item menu
~label:"Hide global annotations" ~key:key_hide_annotations in
- (*GTK3: no GMenu.separator_item*)
- (*let () = menu#add (GMenu.separator_item () :> GMenu.menu_item) in*)
+ let () = menu#add (GMenu.separator_item () :> GMenu.menu_item) in
let mflat_mode =
MenusHide.menu_item menu ~label:"Flat mode" ~key:key_flat_mode in
@@ -1013,8 +1012,7 @@ let make (tree_view:GTree.view) =
mhide_annotations key_hide_annotations self#reset_internal);
ignore (MenusHide.mi_set_callback
mflat_mode key_flat_mode self#reset_internal);
- (*GTK3: no GMenu.separator_item*)
- (*menu#add (GMenu.separator_item () :> GMenu.menu_item);*)
+ menu#add (GMenu.separator_item () :> GMenu.menu_item);
tree_view#set_model (Some (init_model:>GTree.model));
self#enable_select_functions ();
diff --git a/src/plugins/gui/gtk_helper.ml b/src/plugins/gui/gtk_helper.ml
index 28a94e11632..19933af261f 100644
--- a/src/plugins/gui/gtk_helper.ml
+++ b/src/plugins/gui/gtk_helper.ml
@@ -357,12 +357,9 @@ type 'a chooser =
(* --- Bundle of fields --- *)
(* ------------------------------------------------------------------------ *)
-let do_tooltip ?tooltip _obj = match tooltip with
+let do_tooltip ?tooltip obj = match tooltip with
| None -> ()
- | Some _text -> ()
- (*GTK3: no GData.tooltips*)
- (* let tooltip = GData.tooltips () in
- tooltip#set_tip ~text obj#coerce *)
+ | Some text -> obj#coerce#misc#set_tooltip_text text
let on_bool ?tooltip ?use_markup (container:GPack.box) label get set =
let result = ref (get ()) in
@@ -1021,6 +1018,17 @@ let graph_window_through_dot ~parent ~title dot_formatter =
(Printexc.to_string exn)
;;
+let image_menu_item ~(image:GObj.widget) ~text ~packing =
+ let mi = GMenu.menu_item () in
+ let box =
+ GPack.hbox ~spacing:2 ~border_width:0 ~homogeneous:true ()
+ in
+ box#add image;
+ box#add (GMisc.label ~justify:`LEFT ~text ())#coerce;
+ mi#add box#coerce;
+ packing mi;
+ mi
+
(*
Local Variables:
compile-command: "make -C ../../.."
diff --git a/src/plugins/gui/gtk_helper.mli b/src/plugins/gui/gtk_helper.mli
index 679ebc2165c..1d99d79c245 100644
--- a/src/plugins/gui/gtk_helper.mli
+++ b/src/plugins/gui/gtk_helper.mli
@@ -432,6 +432,16 @@ val graph_window_through_dot:
(Format.formatter -> unit) ->
unit
+(** calls the packing function to append a new menu item
+ with an icon and a label.
+ replaces GMenu.image_menu_item that has been deprecated in GTK3
+*)
+val image_menu_item:
+ image:GObj.widget ->
+ text: string ->
+ packing: (GMenu.menu_item -> unit) ->
+ GMenu.menu_item
+
(*
Local Variables:
compile-command: "make -C ../../.."
diff --git a/src/plugins/gui/menu_manager.ml b/src/plugins/gui/menu_manager.ml
index 13df82394f8..2c500414c7d 100644
--- a/src/plugins/gui/menu_manager.ml
+++ b/src/plugins/gui/menu_manager.ml
@@ -213,10 +213,7 @@ class menu_manager ?packing ~host:(_:Gtk_helper.host) =
(fun () -> b#set_active (active ())) :: set_active_states;
BToggle b
in
- (*GTK3: set_tooltip does not exist anymore. *)
- (*(bt_type_as_skel b)#set_tooltip (GData.tooltips ()) tooltip "";*)
(bt_type_as_skel b)#misc#set_tooltip_text tooltip;
- (*/GTK3*)
toolbar_buttons <- (b, sensitive) :: toolbar_buttons;
b
in
@@ -241,10 +238,9 @@ class menu_manager ?packing ~host:(_:Gtk_helper.host) =
lazy (fst !!aux), lazy (snd !!aux)
in
let add_menu_separator =
- fun () -> ()
- (*GTK3: no GMenu.separator_item *)
- (*if !menu_pos > 0 || (!menu_pos = -1 && container#children <> []) then
- ignore (GMenu.separator_item ~packing:container_packing ()) *)
+ fun () ->
+ if !menu_pos > 0 || (!menu_pos = -1 && container#children <> []) then
+ ignore (GMenu.separator_item ~packing:container_packing ())
in
let add_item_menu stock_opt label callback sensitive =
let item = match stock_opt, callback with
@@ -253,15 +249,10 @@ class menu_manager ?packing ~host:(_:Gtk_helper.host) =
ignore (mi#connect#activate callback);
MStandard mi
| Some stock, Unit_callback callback ->
- let _image = GMisc.image ~stock () in
- let mi =
- (*GTK3: no image_menu_item *)
- (*(GMenu.image_menu_item
- ~image ~packing:!!menubar_packing ~label ()
- :> GMenu.menu_item) *)
- GMenu.menu_item ~label ()
- (*/GTK3*)
- in
+ let image = (GMisc.image ~stock () :> GObj.widget) in
+ let text = label in
+ let packing = !!menubar_packing in
+ let mi = Gtk_helper.image_menu_item ~image ~text ~packing in
ignore (mi#connect#activate callback);
MStandard mi
| _, Bool_callback (callback, active) ->
diff --git a/src/plugins/gui/project_manager.ml b/src/plugins/gui/project_manager.ml
index fcb2357a891..457cc3765bc 100644
--- a/src/plugins/gui/project_manager.ml
+++ b/src/plugins/gui/project_manager.ml
@@ -273,8 +273,7 @@ let () =
let new_item = constant_items.(0) in
new_item#add_accelerator `CONTROL 'n';
constant_items.(3)#add_accelerator `CONTROL 'd';
- (*GTK3: no GMenu.separator_item *)
- (* ignore (GMenu.separator_item ~packing:menu#append ());*)
+ ignore (GMenu.separator_item ~packing:menu#append ());
let callback () =
let is_reset = reset menu in
if is_reset then make_project_entries window menu
diff --git a/src/plugins/gui/wfile.ml b/src/plugins/gui/wfile.ml
index 9bcb0d74c44..3f6a539d468 100644
--- a/src/plugins/gui/wfile.ml
+++ b/src/plugins/gui/wfile.ml
@@ -76,9 +76,9 @@ class button ?kind ?title ?select ?tooltip ?parent () =
let box = GPack.hbox ~homogeneous:false ~spacing:0 ~border_width:0 () in
let fld = GMisc.label ~text:"(none)" ~xalign:0.0
~packing:(box#pack ~expand:true) () in
- (*GTK3: no GMisc.separator anymore. *)
- (*let _ = GMisc.separator `VERTICAL
- ~packing:(box#pack ~expand:false ~padding:2) ~show:true () in *)
+ let _ = GMisc.separator `VERTICAL
+ ~packing:(box#pack ~expand:false ~padding:2) ~show:true ()
+ in
let _ = GMisc.image ~packing:(box#pack ~expand:false) ~stock:`OPEN () in
let button = GButton.button () in
let dialog = new dialog ?kind ?title ?select ?parent () in
diff --git a/src/plugins/gui/widget.ml b/src/plugins/gui/widget.ml
index 0f63fd00ff6..94e6fd1daed 100644
--- a/src/plugins/gui/widget.ml
+++ b/src/plugins/gui/widget.ml
@@ -73,9 +73,8 @@ class label ?(style=`Label) ?(align=`Left) ?width ?text () =
| Some c0 , `NORMAL ->
w#misc#modify_fg [ `NORMAL , `COLOR c0 ]
| None , (#GDraw.color as c) ->
- (*GTK3: misc#style does not exist anymore *)
- (* fg <- Some (w#misc#style#fg `NORMAL) ; *)
- w#misc#modify_fg [ `NORMAL , c ]
+ fg <- Some (w#misc#style#fg `NORMAL) ;
+ w#misc#modify_fg [ `NORMAL , c ]
| Some _ , (#GDraw.color as c) ->
w#misc#modify_fg [ `NORMAL , c ]
@@ -85,9 +84,8 @@ class label ?(style=`Label) ?(align=`Left) ?width ?text () =
| Some c0 , `NORMAL ->
w#misc#modify_bg [ `NORMAL , `COLOR c0 ]
| None , (#GDraw.color as c) ->
- (*GTK3: misc#style does not exist anymore *)
- (* bg <- Some (w#misc#style#bg `NORMAL) ; *)
- w#misc#modify_bg [ `NORMAL , c ]
+ bg <- Some (w#misc#style#bg `NORMAL) ;
+ w#misc#modify_bg [ `NORMAL , c ]
| Some _ , (#GDraw.color as c) ->
w#misc#modify_bg [ `NORMAL , c ]
@@ -429,9 +427,8 @@ class popup () =
method add_separator = separator <- true
method add_item ~label ~callback =
- (*GTK3: no separator_item anymore. *)
- (* if not empty && separator then
- ignore (GMenu.separator_item ~packing:menu#append ()) ; *)
+ if not empty && separator then
+ ignore (GMenu.separator_item ~packing:menu#append ());
let item = GMenu.menu_item ~label ~packing:menu#append () in
ignore (item#connect#activate ~callback) ;
empty <- false ; separator <- false
diff --git a/src/plugins/metrics/register_gui.ml b/src/plugins/metrics/register_gui.ml
index ecc830a861e..409334f21a2 100644
--- a/src/plugins/metrics/register_gui.ml
+++ b/src/plugins/metrics/register_gui.ml
@@ -51,8 +51,7 @@ module HalsteadMetricsGUI = struct
padder#add (box:>GObj.widget);
ignore(GMisc.label ~markup:(Printf.sprintf "<b>%s</b>" name)
~justify:`LEFT ~packing:box#pack ());
- (*GTK3: no separator *)
- (* ignore(GMisc.separator `HORIZONTAL ~packing:box#pack ()); *)
+ ignore(GMisc.separator `HORIZONTAL ~packing:box#pack ());
let metrics = Metrics_cabs.Halstead.get_metrics () in
let table_contents = Metrics_cabs.Halstead.to_list metrics in
Metrics_gui.display_as_table table_contents box
@@ -110,8 +109,7 @@ module CyclomaticMetricsGUI = struct
true));
ignore(GMisc.label ~markup:(Printf.sprintf "<b>%s</b>" fname)
~justify:`LEFT ~packing:vbox#pack ());
- (*GTK3: no separator *)
- (* ignore(GMisc.separator `HORIZONTAL ~packing:vbox#pack ()); *)
+ ignore(GMisc.separator `HORIZONTAL ~packing:vbox#pack ());
let metrics_data = [["total stmts";(string_of_int total)];
["stmts analyzed";(string_of_int valeur)];
["percentage of stmts covered"; (string_of_float percent)]
@@ -145,8 +143,7 @@ module CyclomaticMetricsGUI = struct
true));
ignore(GMisc.label ~markup:(Printf.sprintf "<b>%s</b>" fname)
~justify:`LEFT ~packing:vbox#pack ());
- (*GTK3: no separator*)
- (* ignore(GMisc.separator `HORIZONTAL ~packing:vbox#pack ()); *)
+ ignore(GMisc.separator `HORIZONTAL ~packing:vbox#pack ());
let metrics_data = BasicMetrics.to_list self#get_data in
Metrics_gui.display_as_table metrics_data vbox;
let close_button = GButton.button ~stock:`OK ~packing:vbox#pack () in
@@ -204,8 +201,7 @@ module CyclomaticMetricsGUI = struct
padder#add (box:>GObj.widget);
ignore(GMisc.label ~markup:(Printf.sprintf "<b>%s</b>" name)
~justify:`LEFT ~packing:box#pack ());
- (* GTK3: no separator. *)
- (* ignore(GMisc.separator `HORIZONTAL ~packing:box#pack ()); *)
+ ignore(GMisc.separator `HORIZONTAL ~packing:box#pack ());
let metrics = Metrics_cilast.get_global_metrics ~libc in
let table_contents = BasicMetrics.to_list metrics in
Metrics_gui.display_as_table table_contents box
@@ -342,8 +338,7 @@ module ValueCoverageGUI = struct
padder#add (box:>GObj.widget);
ignore(GMisc.label ~markup:(Printf.sprintf "<b>%s</b>" name)
~justify:`LEFT ~packing:box#pack ());
- (* GTK3: no separator *)
- (* ignore(GMisc.separator `HORIZONTAL ~packing:box#pack ()); *)
+ ignore(GMisc.separator `HORIZONTAL ~packing:box#pack ());
let metrics = compute ~libc in
let pcent = Metrics_coverage.percent_coverage ~libc metrics in
let progress_bar = GRange.progress_bar ~packing:box#pack () in
diff --git a/src/plugins/scope/dpds_gui.ml b/src/plugins/scope/dpds_gui.ml
index 51b5d5e0a9f..410bb216d69 100644
--- a/src/plugins/scope/dpds_gui.ml
+++ b/src/plugins/scope/dpds_gui.ml
@@ -531,12 +531,10 @@ let selector (popup_factory:GMenu.menu GMenu.factory)
add_zones_item "DataScope" Scope;
add_zones_item "PropScope" Pscope;
- (*GTK3: no separator. *)
- (* ignore (submenu_factory#add_separator ()); *)
+ ignore (submenu_factory#add_separator ());
add_item main_ui ~use_values:false submenu_factory "Reset All" (Some())
(fun _ -> reset () ; main_ui#rehighlight ());
- (*GTK3: no separator. *)
- (* ignore (submenu_factory#add_separator ()); *)
+ ignore (submenu_factory#add_separator ());
add_item main_ui ~use_values:false submenu_factory
"Help" (Some()) (fun _ -> help main_ui) ;
end
diff --git a/src/plugins/slicing/register_gui.ml b/src/plugins/slicing/register_gui.ml
index e3f4129b36d..e8abaf50f85 100644
--- a/src/plugins/slicing/register_gui.ml
+++ b/src/plugins/slicing/register_gui.ml
@@ -377,8 +377,7 @@ let slicing_selector (popup_factory:GMenu.menu GMenu.factory)
| _ ->
add_slice_menu None None
end;
- (*GTK3: no add_separator*)
- (* ignore (slicing_factory#add_separator ()); *)
+ ignore (slicing_factory#add_separator ());
end
let slicing_highlighter(buffer:Design.reactive_buffer) localizable ~start ~stop=
diff --git a/src/plugins/studia/studia_gui.ml b/src/plugins/studia/studia_gui.ml
index d1c897d2a1b..552a1ee2e0c 100644
--- a/src/plugins/studia/studia_gui.ml
+++ b/src/plugins/studia/studia_gui.ml
@@ -280,7 +280,7 @@ let selector (popup_factory:GMenu.menu GMenu.factory)
~button localizable =
if button = 3 then begin
let submenu = popup_factory#add_submenu "Studia" in
- let _submenu_factory = new GMenu.factory submenu in
+ let submenu_factory = new GMenu.factory submenu in
let arg = match (Pretty_source.kf_of_localizable localizable,
Pretty_source.ki_of_localizable localizable)
with
@@ -294,12 +294,10 @@ let selector (popup_factory:GMenu.menu GMenu.factory)
in
add_menu_item "Writes" (callback `Writes);
add_menu_item "Reads" (callback `Reads);
- (*GTK3: no add_separator *)
- (* ignore (submenu_factory#add_separator ());*)
+ ignore (submenu_factory#add_separator ());
add_item main_ui ~uses_value:false submenu "Reset All" (Some())
(fun _ -> reset () ; main_ui#rehighlight ());
- (*GTK3: no add_separator *)
- (* ignore (submenu_factory#add_separator ()); *)
+ ignore (submenu_factory#add_separator ());
add_item main_ui ~uses_value:false submenu
"Help" (Some()) (fun _ -> help main_ui) ;
end
diff --git a/src/plugins/value/gui_files/gui_callstacks_manager.ml b/src/plugins/value/gui_files/gui_callstacks_manager.ml
index ed9ac1a087f..5aee78ab18b 100644
--- a/src/plugins/value/gui_files/gui_callstacks_manager.ml
+++ b/src/plugins/value/gui_files/gui_callstacks_manager.ml
@@ -326,8 +326,6 @@ module Make (Input: Input) = struct
list_mem equal_column_type col_type model.hidden_columns
then
let show = GMenu.check_menu_item ~label:txt () in
- (*GTK3: does not exist *)
- (* show#set_show_toggle true;*)
show#set_active column#visible;
(* Hide this column. Keep it alive for filters and co. *)
let callback_show_hide () =
@@ -691,8 +689,7 @@ module Make (Input: Input) = struct
let equal = GMenu.menu_item ~label:"Only equal" () in
let different = GMenu.menu_item ~label:"Only different" () in
menu#add copy;
- (* GTK3: no separator*)
- (* menu#add (GMenu.separator_item ()); *)
+ menu#add (GMenu.separator_item ());
menu#add equal;
menu#add different;
ignore (copy#connect#activate callback_copy);
--
GitLab