Source file `metrics_gui_panels.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
(**************************************************************************)
(*                                                                        *)
(*  SPDX-License-Identifier LGPL-2.1                                      *)
(*  Copyright (C)                                                         *)
(*  CEA (Commissariat à l'énergie atomique et aux énergies alternatives)  *)
(*                                                                        *)
(**************************************************************************)

type ('a, 'b, 'c) metrics_panel = {
  top : 'a option;
  bottom : 'b option;
  actions : 'c list;
}
;;

(* The option type for top and bottom GTK objects is compulsory in order not to
   have warnings at runtime.
   Creation of GTK objects cannot be made before the general window is
   initialized.
   The option type with a None value marks the fact that this value is not
   initialized either (it will only be at register time).
*)
let get_panel, set_panel, add_panel_action =
  let panel = ref {
      top = None;
      bottom = None;
      actions = [];
    } in
  (fun () -> !panel),
  (fun top_widget bottom_widget ->
     panel := { top = top_widget; bottom = bottom_widget; actions = []; }
  ),
  (fun action -> panel := { !panel with actions = action :: !panel.actions; })
;;

(** Display the [table_contents] matrix as a GTK table *)
let display_as_table table_contents (parent:GPack.box) =
  let table = GPack.table
      ~columns:(List.length (List.hd table_contents))
      ~rows:(List.length table_contents)
      ~homogeneous:true
      ~packing:parent#pack () in
  List.iteri (fun i row ->
      List.iteri (fun j text ->
          table#attach ~left:j ~top:i
            ((GMisc.label ~justify:`LEFT ~text:text ()):>GObj.widget)) row)
    table_contents ;
;;


(** Remove all sub-elements of a GUI object *)
let clear_container w = List.iter (fun c -> c#destroy ()) w#children ;;

(** The panel of Metrics has two parts:
    - The upper part contains the various choices of the user;
    - The bottom part displays the result.
*)
let init_panel (main_ui: Design.main_window_extension_points) =
  let v = GPack.vbox () in
  (* Titles, buttons, and headers *)
  let up = GPack.hbox ~width:120 ~packing:(v#pack ~expand:true) () in
  (* Results *)
  let bottom = GPack.vbox ~width:120 ~packing:(v#pack ~expand:true) () in

  let choices = GEdit.combo_box_text ~active:0 ~strings:[] ~packing:(up#pack) ()
  in
  let launch_button = GButton.button ~label:"Launch"
      ~packing:(up#pack) ()
  in
  ignore(launch_button#connect#clicked ~callback:(fun () ->
      let actions = (get_panel ()).actions in
      let sopt = GEdit.text_combo_get_active choices in
      match sopt with
      | None -> ()
      | Some s ->
        if List.mem_assoc s actions then
          let action = List.assoc s actions in
          clear_container bottom;
          ignore (main_ui#full_protect ~cancelable:true
                    (fun () -> action bottom))
        else ()
    ) );
  set_panel (Some choices) (Some bottom);
  v
;;

let reset_panel _ =
  let metrics_panel = get_panel () in
  match metrics_panel.bottom with
  | None -> ()
  | Some b -> clear_container b;
;;


(** Returning a value to register in Frama-C's GUI *)
let coerce_panel_to_ui panel_box _main_ui = "Metrics", panel_box#coerce, None ;;

(** Add a new metrics to its dedicated panel.
    The text is added to the combo box while the action is added to the
    association lists of possible actions.
*)
let register_metrics ?(apply=false) name display_function =
  add_panel_action (name, display_function);
  let metrics_panel = get_panel () in
  GEdit.text_combo_add (Option.get metrics_panel.top) name;
  if apply
  then display_function (Option.get metrics_panel.bottom);
;;