1
(**************************************************************************)
3
(* This file is part of Frama-C. *)
5
(* Copyright (C) 2007-2008 *)
6
(* CEA (Commissariat � l'�nergie Atomique) *)
7
(* INRIA (Institut National de Recherche en Informatique et en *)
10
(* you can redistribute it and/or modify it under the terms of the GNU *)
11
(* Lesser General Public License as published by the Free Software *)
12
(* Foundation, version 2.1. *)
14
(* It is distributed in the hope that it will be useful, *)
15
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
16
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
17
(* GNU Lesser General Public License for more details. *)
19
(* See the GNU Lesser General Public License version v2.1 *)
20
(* for more details (enclosed in the file licenses/LGPLv2.1). *)
22
(**************************************************************************)
24
(*i $Id: register_gui.ml,v 1.29 2008/10/17 12:50:56 uid527 Exp $ i*)
30
(struct include Datatype.Bool let default () = true end)
31
(struct let name = "SlicingGui.Enabled" let dependencies = [] end)
39
(* for slicing callback *)
40
let mk_selection fselect = fselect (!Db.Slicing.Select.empty_selects ())
42
(* for slicing callback *)
43
let mk_selection_cad fselect =
44
mk_selection fselect (!Db.Slicing.Mark.make ~ctrl:true ~addr:true ~data:true)
46
(* for slicing callback *)
47
let mk_selection_all fselect =
48
mk_selection fselect ~spare:false
50
(* for slicing callback *)
51
let mk_slice selection =
52
let n = string_of_int (1 + List.length (!Db.Slicing.Project.get_all ())) in
53
let project = !Db.Slicing.Project.mk_project ("Slicing "^ n) in
54
!Db.Slicing.Request.add_persistent_selection project selection ;
55
!Db.Slicing.Request.apply_all_internal project;
56
if Cmdline.Slicing.Mode.Callers.get () then
57
!Db.Slicing.Slice.remove_uncalled project;
58
let new_project = !Db.Slicing.Project.extract ((!Db.Slicing.Project.get_name project)^ " export") project in
59
!Db.Slicing.Project.set_project (Some (project)) ;
62
(* To add a sensitive/unsensitive menu item to a [factory] *)
63
let add_item (factory:GMenu.menu GMenu.factory) ~callback name arg_opt =
65
| None -> (* add the menu item, but it isn't sensitive *)
66
let item = factory#add_item name ~callback:(fun () -> ())
67
in item#misc#set_sensitive false
68
| Some arg -> (* add the menu item with its callback *)
69
ignore (factory#add_item name ~callback:(fun () -> callback arg))
72
let gui_annot_info (main_ui:Design.main_window_extension_points) ~level txt =
73
if (Cmdline.Slicing.Mode.Verbose.get () >= level) then
75
main_ui#annot_window#buffer#insert ((txt ()) ^ ".\n")
78
let gui_annot_action (main_ui:Design.main_window_extension_points) txt =
79
if (Cmdline.Slicing.Mode.Verbose.get () >= 0) then
81
let tag_style_italic = Gtk_helper.make_tag main_ui#annot_window#buffer ~name:"slicing:style italic" [`STYLE `ITALIC] in
82
main_ui#annot_window#buffer#insert ~tags:[tag_style_italic] ((txt ()) ^ "\n")
85
let gui_annot_error (main_ui:Design.main_window_extension_points) txt =
86
let tag_style_italic = Gtk_helper.make_tag main_ui#annot_window#buffer ~name:"slicing:style italic" [`STYLE `OBLIQUE ; ] in
87
main_ui#annot_window#buffer#insert ~tags:[tag_style_italic] (txt ^ ".\n")
89
let gui_mk_slice main_ui selection ~info =
91
gui_annot_action main_ui info;
92
main_ui#lock () in (* lock the gui while ... *)
93
let new_project = mk_slice selection in (* ... slicing computation *)
94
main_ui#unlock already_locked ;
95
gui_annot_action main_ui (fun () -> "Slice exported to project: " ^ (Project.name new_project));
96
main_ui#rehighlight ()
98
let gui_compute_values (main_ui:Design.main_window_extension_points) =
99
if not (Db.Value.is_computed ()) then
101
gui_annot_action main_ui (fun () -> "Activating slicing plugin by running value analysis first");
102
let already_locked = main_ui#lock () in
103
(try !Db.Value.compute ();
104
with Globals.No_such_entry_point msg -> gui_annot_error main_ui msg);
105
main_ui#unlock already_locked
108
let gui_apply_action (main_ui:Design.main_window_extension_points) f x ~info =
110
gui_annot_action main_ui info
112
let get_setting_option_text txt = "Setting option " ^ txt ^ " for the current project"
114
let gui_toggle_slice_undef (main_ui:Design.main_window_extension_points) =
115
let slice_undef = not (Cmdline.Slicing.Mode.SliceUndef.get ()) in
116
gui_apply_action main_ui Cmdline.Slicing.Mode.SliceUndef.set slice_undef
119
if slice_undef then (get_setting_option_text "-slice-undef-functions" )^
120
". Allow the use of the slicing level for calls to undefined functions"
121
else (get_setting_option_text "-no-slice-undef-functions") ^
122
". Forbid the slicing of prototypes of undefined functions")
124
let gui_incr_verbose (main_ui:Design.main_window_extension_points) incr =
125
let v = (Cmdline.Slicing.Mode.Verbose.get ()) + incr in
126
gui_apply_action main_ui Cmdline.Slicing.Mode.Verbose.set v
127
~info:(fun () -> get_setting_option_text ("-slicing-debug \"-debug " ^ (string_of_int v) ^ "\""))
129
let gui_incr_level (main_ui:Design.main_window_extension_points) incr =
130
let v = (Cmdline.Slicing.Mode.Calls.get ()) + incr in
131
gui_apply_action main_ui Cmdline.Slicing.Mode.Calls.set v
132
~info:(fun () -> get_setting_option_text ("-slicing-level " ^ (string_of_int v)))
134
let gui_toggle_enabled (main_ui:Design.main_window_extension_points) =
135
let enabled = not (get_enabled ()) in
136
gui_compute_values main_ui ;
137
gui_apply_action main_ui set_enabled enabled
139
if enabled then "Enabling slicing requests"
140
else "Disabling slicing requests") ;
141
main_ui#rehighlight ()
143
let gui_set_project (main_ui:Design.main_window_extension_points) proj_opt =
144
gui_apply_action main_ui !Db.Slicing.Project.set_project proj_opt
146
Extlib.may_map ~dft:"Clear slicing highlighting"
147
(fun project -> ("Highlighting for " ^ (!Db.Slicing.Project.get_name project)))
149
main_ui#rehighlight ()
151
let slicing_selector (popup_factory:GMenu.menu GMenu.factory)
152
(main_ui:Design.main_window_extension_points) ~button localizable =
153
if not (Db.Value.is_computed ()) then
154
ignore (popup_factory#add_item "Activate _Slicing"
155
~callback:(fun () -> gui_compute_values main_ui ))
156
else if not (get_enabled ()) then
157
ignore (popup_factory#add_item "Enable _Slicing menu"
158
~callback:(fun () -> gui_toggle_enabled main_ui))
160
let slicing_project = !Db.Slicing.Project.get_project () in
162
begin let level = 0 in
163
let slicing_view project =
164
gui_annot_info main_ui ~level (fun () -> "Highlighting for " ^ (!Db.Slicing.Project.get_name project))
166
Extlib.may slicing_view slicing_project;
167
if Cmdline.Slicing.Mode.Verbose.get () > level then begin
168
let slicing_mark project =
169
let slicing_mark kf get_mark =
170
(* use -slicing-debug -verbose to get slicing mark information *)
171
let add_mark_info txt = gui_annot_info ~level main_ui (fun () -> "Tag: " ^ (txt ())) in
172
let slices = !Db.Slicing.Slice.get_all project kf in
174
| [] -> (* No slice for this kf *)
175
add_mark_info (fun () ->
176
if !Db.Slicing.Project.is_called project kf
177
then (* but the source function is called *)
178
(Cil.fprintf_to_string "<src>%a"
179
!Db.Slicing.Mark.pretty (!Db.Slicing.Mark.get_from_src_func project kf))
183
if !Db.Slicing.Project.is_called project kf
184
then begin (* The source function is also called *)
185
assert (not (kf == fst (Globals.entry_point ()))) ;
186
add_mark_info (fun () ->
187
Cil.fprintf_to_string "<src>%a"
188
!Db.Slicing.Mark.pretty (!Db.Slicing.Mark.get_from_src_func project kf))
190
let mark_slice slice =
191
add_mark_info (fun () -> Cil.fprintf_to_string "%a" !Db.Slicing.Mark.pretty (get_mark slice))
192
in List.iter mark_slice slices
193
in match localizable with
194
| Pretty_source.PTermLval(Some kf,(Kstmt ki),_) (* as for the statement *)
195
| Pretty_source.PLval (Some kf,(Kstmt ki),_) (* as for the statement *)
196
| Pretty_source.PStmt (kf,ki) -> slicing_mark kf (fun slice -> !Db.Slicing.Slice.get_mark_from_stmt slice ki)
197
| Pretty_source.PVDecl (Some kf,vi) -> slicing_mark kf (fun slice -> !Db.Slicing.Slice.get_mark_from_local_var slice vi)
199
in Extlib.may slicing_mark slicing_project
202
else if button = 3 then begin
203
let submenu = popup_factory#add_submenu "Slicing" in
204
let slicing_factory = new GMenu.factory submenu in
205
(* definitions for slicing plug-in *)
206
let add_slicing_item name = add_item slicing_factory name in
207
let mk_slice = gui_mk_slice main_ui in
208
let add_slice_menu kf_opt kf_ki_opt =
210
add_slicing_item "Slice calls to"
214
~info:(fun () -> Cil.fprintf_to_string "Request for slicing effects of function %a"
215
Kernel_function.pretty_name kf)
216
((mk_selection_all !Db.Slicing.Select.select_func_calls_to) kf));
217
add_slicing_item "Slice calls into"
221
~info:(fun () -> Cil.fprintf_to_string "Request for slicing entrance into function %a"
222
Kernel_function.pretty_name kf)
223
((mk_selection_all !Db.Slicing.Select.select_func_calls_into) kf));
224
add_slicing_item "Slice result"
225
(Extlib.opt_filter (fun kf ->
226
let is_not_void_kf x =
227
match x.Cil_types.vtype with
228
| Cil_types.TFun (Cil_types.TVoid (_),_,_,_) -> false
230
in is_not_void_kf (Kernel_function.get_vi kf))
234
~info:(fun () -> Cil.fprintf_to_string "Request for returned value of function %a"
235
Kernel_function.pretty_name kf)
236
((mk_selection_all !Db.Slicing.Select.select_func_return) kf));
237
add_slicing_item "Slice stmt"
239
~callback:(fun (kf, ki) ->
241
~info:(fun () -> Cil.fprintf_to_string "Request for slicing effects of statement %d"
243
((mk_selection_all !Db.Slicing.Select.select_stmt) ki kf));
244
add_slicing_item "Slice lval"
246
~callback:(fun (kf, ki) ->
247
let do_with_txt txt =
249
let lval_str = Cilutil.StringSet.add txt Cilutil.StringSet.empty in
251
~info:(fun () -> Cil.fprintf_to_string "Request for slicing Lvalue %s before statement %d"
254
((mk_selection_cad !Db.Slicing.Select.select_stmt_lval)
255
lval_str ~before:true ki ~scope:ki ~eval:ki kf)
256
with e -> main_ui#error "Invalid expression: %s" (Printexc.to_string e)
259
GToolbox.input_string
260
~title:"Input a pure Lvalue expression to slice before current statement"
262
in Extlib.may do_with_txt txt);
263
add_slicing_item "Slice rd"
265
~callback:(fun (kf, ki) ->
266
let do_with_txt txt =
268
let lval_str = Cilutil.StringSet.add txt Cilutil.StringSet.empty in
270
~info:(fun () -> Cil.fprintf_to_string "Request for slicing read accesses to Lvalue %s"
272
((mk_selection_cad !Db.Slicing.Select.select_func_lval_rw)
273
~rd:lval_str ~wr:Cilutil.StringSet.empty ~scope:ki ~eval:ki kf)
274
with e -> main_ui#error "Invalid expression: %s" (Printexc.to_string e)
277
GToolbox.input_string
278
~title:"Input a pure Lvalue expression to slice read accesses"
280
in Extlib.may do_with_txt txt);
281
add_slicing_item "Slice wr"
283
~callback:(fun (kf, ki) ->
284
let do_with_txt txt =
286
let lval_str = Cilutil.StringSet.add txt Cilutil.StringSet.empty in
288
~info:(fun () -> Cil.fprintf_to_string "Request for slicing writen accesses to Lvalue %s"
290
((mk_selection_cad !Db.Slicing.Select.select_func_lval_rw)
291
~rd:Cilutil.StringSet.empty ~wr:lval_str ~scope:ki ~eval:ki kf)
292
with e -> main_ui#error "Invalid expression: %s" (Printexc.to_string e)
295
GToolbox.input_string
296
~title:"Input a pure Lvalue expression to slice read accesses"
298
in Extlib.may do_with_txt txt);
299
add_slicing_item "Slice ctrl"
301
~callback:(fun (kf, ki) ->
303
~info:(fun () -> Cil.fprintf_to_string "Request for slicing accessibility to statement %d"
305
((mk_selection_all !Db.Slicing.Select.select_stmt_ctrl) ki kf))
307
let some_kf_from_vi vi =
308
try let kf = Globals.Functions.get vi in
310
&& (!Db.Value.is_called kf) then Some kf else None
311
with Not_found -> None in
312
let some_kf_from_lv lv =
314
| Var vi,_ -> some_kf_from_vi vi
316
let some_kf_ki kf ki =
318
&& (!Db.Value.is_called kf)
319
&& (Db.Value.is_accessible (Cil_types.Kstmt ki))
320
then Some (kf, ki) else None in
321
begin (* add menu for slicing and scope plug-in *)
322
match localizable with
323
| Pretty_source.PLval (Some kf,(Kstmt stmt),lv) ->
324
add_slice_menu (some_kf_from_lv lv) (some_kf_ki kf stmt)
325
| Pretty_source.PTermLval(Some kf,(Kstmt ki),_) (* as for the statement *)
326
| Pretty_source.PStmt (kf,ki) ->
327
add_slice_menu None (some_kf_ki kf ki)
328
| Pretty_source.PVDecl (_,vi) ->
329
add_slice_menu (some_kf_from_vi vi) None
331
add_slice_menu None None
333
let projects = !Db.Slicing.Project.get_all() in
334
ignore (slicing_factory#add_separator ());
335
add_slicing_item "_Disable"
337
~callback:(fun () -> gui_toggle_enabled main_ui);
338
add_slicing_item "_Clear"
339
(if slicing_project = None then None else Some ())
340
~callback:(fun () -> gui_set_project main_ui None) ;
343
let add_highlight_menu sensitive =
345
("Highlight " ^ (Pretty_utils.escape_underscores (!Db.Slicing.Project.get_name proj)))
347
~callback:(fun () -> gui_set_project main_ui (Some proj))
348
in match slicing_project with
349
| Some project -> add_highlight_menu (if (proj == project) then None else Some ())
350
| None -> add_highlight_menu (Some()))
354
let slicing_highlighter
355
(buffer:GSourceView.source_buffer) localizable ~start ~stop =
356
if (get_enabled ()) then begin
357
(* Definition for highlight 'Slicing' *)
358
let highlight project =
359
let ki = match localizable with
360
| Pretty_source.PStmt (_,stmt) -> Kstmt stmt
361
| Pretty_source.PLval (_,ki,_) | Pretty_source.PTermLval(_,ki,_) -> ki
362
| Pretty_source.PVDecl _ -> Kglobal
364
if Db.Value.is_accessible ki then
365
let unused_code_area =
366
Gtk_helper.make_tag buffer ~name:"slicing_unused" [`STRIKETHROUGH true ] in
367
let spare_code_area =
368
Gtk_helper.make_tag buffer ~name:"slicing_spare" [`UNDERLINE `LOW] in
369
let necessary_code_area =
370
Gtk_helper.make_tag buffer ~name:"slicing_necessary" [`BACKGROUND "green"] in
371
let apply_on_one_project_and_merge_slices kf pb pe mark_of_slice =
372
let apply_mark mark =
373
if Cmdline.Debug.get () > 0 then
374
Format.printf "Got mark: %a@." !Db.Slicing.Mark.pretty mark;
375
if !Db.Slicing.Mark.is_bottom mark then
376
Gtk_helper.apply_tag buffer unused_code_area pb pe;
377
if !Db.Slicing.Mark.is_spare mark then
378
Gtk_helper.apply_tag buffer spare_code_area pb pe;
379
if (!Db.Slicing.Mark.is_ctrl mark
380
|| !Db.Slicing.Mark.is_data mark
381
|| !Db.Slicing.Mark.is_addr mark)
383
Gtk_helper.apply_tag buffer necessary_code_area pb pe
385
let slices = !Db.Slicing.Slice.get_all project kf in
389
(* No slice for this kf *)
390
if !Db.Slicing.Project.is_called project kf
392
if Cmdline.Debug.get () > 0 then
393
Format.printf "Got source code@." ;
394
apply_mark (!Db.Slicing.Mark.get_from_src_func project kf)
397
Gtk_helper.apply_tag buffer unused_code_area pb pe
399
if !Db.Slicing.Project.is_called project kf
401
assert (not (kf == fst (Globals.entry_point ()))) ;
402
if Cmdline.Debug.get () > 0 then
403
Format.printf "Got source code@." ;
404
apply_mark (!Db.Slicing.Mark.get_from_src_func project kf)
406
if Cmdline.Debug.get () > 0 then begin
407
let l = List.length slices in
409
Format.printf "Got %d slices@."
412
let mark_slice slice =
413
let mark = mark_of_slice project slice in
415
in List.iter mark_slice slices
418
let tag_stmt kf stmt pb pe =
419
assert (Db.Value.is_accessible (Kstmt stmt)) ;
420
apply_on_one_project_and_merge_slices
424
(fun _ slice -> !Db.Slicing.Slice.get_mark_from_stmt slice stmt)
426
let tag_vdecl kf vi pb pe =
428
apply_on_one_project_and_merge_slices
432
(fun _ slice -> !Db.Slicing.Slice.get_mark_from_local_var slice vi)
434
match localizable with
435
| Pretty_source.PStmt (kf,stmt) -> tag_stmt kf stmt start stop
436
| Pretty_source.PVDecl (Some kf,vi) -> tag_vdecl kf vi start stop
437
| Pretty_source.PVDecl (None,_)
438
| Pretty_source.PLval _
439
| Pretty_source.PTermLval _ -> ()
441
let slicing_project = !Db.Slicing.Project.get_project () in
442
(* 2. Highlights the 'Slicing' *)
443
Extlib.may highlight slicing_project
446
let none_text = "<i>None</i>"
448
let refresh_combo_box ((combo_box, (model, _column)) as combo_box_text) slicing_project sensitive =
450
GEdit.text_combo_add combo_box_text none_text;
451
let offset_elts = 1 in (* offset for the entry "None" *)
452
let nb_combo_elts = model#iter_n_children None in
453
let projects = !Db.Slicing.Project.get_all() in
454
let i = ref offset_elts in
455
let nth_proj = ref 0 in
456
List.iter (fun proj ->
457
Extlib.may (fun slicing_proj ->
458
if (proj == slicing_proj) then nth_proj := !i;)
460
if (!i >= nb_combo_elts)
461
then (* add new entry into the [combo_box] *)
462
GEdit.text_combo_add combo_box_text (!Db.Slicing.Project.get_name proj) ;
466
(* activate the entry of the [combo_box] relative to the [slicing_project] *)
467
combo_box#set_active !nth_proj ;
468
combo_box#misc#set_sensitive sensitive
471
let slicing_panel main_ui =
472
let unsensitive_pressed_button (button:GButton.button) callback =
473
ignore (button#connect#pressed (fun () -> button #misc#set_sensitive false ; callback ())) in
474
let refreshing = ref false (* to forbide flashes while refresh actions *) in
475
let w = GPack.vbox () in
476
let hbox1 = GPack.hbox
477
~packing:w#pack () in
478
let activate_button = GButton.button ~label:"Activate"
479
~packing:hbox1#pack () in
480
let ((combo_box, (_model, column)) as combo_box_text) =
481
GEdit.combo_box_text ~strings:[ none_text ] ~wrap_width:3 ~use_markup:true
482
~packing:(hbox1#pack ~expand:true ~fill:true) () in
483
let hbox2 = GPack.hbox ~packing:w#pack () in
484
(* [enabled_button] to give slicing menu available *)
488
~active:(get_enabled ())
489
~packing:(hbox2#pack ~expand:true ~fill:true) () in
490
let _verbose_text = GMisc.label ~xalign:0.0 ~text:"Verbose: "
491
~packing:(hbox2#pack ~expand:false) () in
495
~packing:hbox2#pack () in
496
let verbose_box = GMisc.label ~xalign:0.0 ~text:(string_of_int (Cmdline.Slicing.Mode.Verbose.get ()))
497
~packing:hbox2#pack () in
501
~packing:hbox2#pack () in
502
let hbox3 = GPack.hbox ~packing:w#pack () in
503
(* [slice_undef_button] related to -slice-undef option *)
504
let slice_undef_button =
507
~active:(get_enabled ())
508
~packing:(hbox3#pack ~expand:true ~fill:true) () in
509
let _level_text = GMisc.label ~xalign:0.0 ~text:"Level: "
510
~packing:(hbox3#pack ~expand:false) () in
514
~packing:hbox3#pack () in
516
GMisc.label ~xalign:0.0 ~text:(string_of_int (Cmdline.Slicing.Mode.Calls.get ()))
517
~packing:hbox3#pack () in
521
~packing:hbox3#pack () in
522
combo_box#set_active 0 ;
523
ignore (combo_box#connect#changed
524
(fun () -> if not !refreshing then
525
match combo_box#active_iter with
528
let slicing_project_name =
529
(* get the text entry related to the current slicing project *)
530
Extlib.may_map !Db.Slicing.Project.get_name ~dft:none_text (!Db.Slicing.Project.get_project ())
531
and selected_name = combo_box#model#get ~row ~column in
532
if (selected_name != slicing_project_name) then
534
try Some (List.find (fun proj -> selected_name = !Db.Slicing.Project.get_name proj) (!Db.Slicing.Project.get_all ()))
535
with Not_found -> None
537
gui_set_project main_ui proj_opt));
538
ignore (activate_button#connect#pressed
539
(fun () -> gui_compute_values main_ui ));
540
ignore (enabled_button#connect#toggled
542
(fun () -> (* can be called by the refresh *)
543
if (not !refreshing) then
544
gui_toggle_enabled main_ui ;));
545
ignore (slice_undef_button#connect#toggled
547
(fun () -> (* can be called by the refresh *)
548
if (not !refreshing) then
549
gui_toggle_slice_undef main_ui ;));
550
(* Some buttons have to be instantatly unsensitive when pressed,
551
otherwise, when they are pressed twice quickly, global invariants can be broken.
552
Their sensitivity will be updated by the [refresh] function. *)
553
unsensitive_pressed_button verbose_incr (fun () -> gui_incr_verbose main_ui 1);
554
unsensitive_pressed_button verbose_decr (fun () -> gui_incr_verbose main_ui (-1));
555
unsensitive_pressed_button level_incr (fun () -> gui_incr_level main_ui 1);
556
unsensitive_pressed_button level_decr (fun () -> gui_incr_level main_ui (-1));
558
let verbose = Cmdline.Slicing.Mode.Verbose.get () in
559
let level = Cmdline.Slicing.Mode.Calls.get () in
560
let value_is_computed = Db.Value.is_computed () in
561
let slicing_project = !Db.Slicing.Project.get_project () in
562
let enabled = get_enabled () in
563
verbose_decr#misc#set_sensitive (verbose > 0) ;
564
verbose_incr#misc#set_sensitive (verbose < 2) ;
565
verbose_box#set_label (string_of_int verbose) ;
567
level_decr#misc#set_sensitive (level > 0) ;
568
level_incr#misc#set_sensitive (level < 3) ;
569
level_box#set_label (string_of_int level) ;
571
activate_button#misc#set_sensitive (not value_is_computed) ;
573
enabled_button#misc#set_sensitive value_is_computed ;
575
slice_undef_button#misc#set_sensitive enabled ;
577
(* to forbide flashes while refresh actions
578
execute the related callback using [!refreshing] *)
580
enabled_button#set_active enabled ;
581
slice_undef_button#set_active (Cmdline.Slicing.Mode.SliceUndef.get ()) ;
582
ignore (refresh_combo_box combo_box_text slicing_project (enabled && value_is_computed)) ;
583
refreshing := false ;
585
"Slicing",w#coerce,Some refresh
587
let file_tree_decorate (file_tree:Filetree.t) =
588
file_tree#append_pixbuf_column
594
(fun glob -> match glob with
595
| GFun ({svar = vi},_ ) ->
598
let kf = Globals.Functions.get vi
599
in (!Db.Slicing.Project.is_called project kf)
600
|| ( [] != (!Db.Slicing.Slice.get_all project kf))
601
with Not_found -> false
605
[`STOCK_ID "gtk-yes"]
609
(!Db.Slicing.Project.get_project ()))
611
let main (main_ui:Design.main_window_extension_points) =
612
main_ui#register_source_selector slicing_selector;
613
main_ui#register_source_highlighter slicing_highlighter;
614
main_ui#register_panel slicing_panel;
615
file_tree_decorate main_ui#file_tree
617
let () = Design.register_extension main
621
compile-command: "LC_ALL=C make -C ../.. -j"
added
removed
src/slicing/register_gui.R1.29.ml
