Commit b6699186 authored by Quentin Garchery's avatar Quentin Garchery

Merge branch 'master' of gitlab.inria.fr:why3/why3 into improve_elim_let

parents 42f3e637 e2c5d555
...@@ -3,7 +3,9 @@ ...@@ -3,7 +3,9 @@
"http://why3.lri.fr/why3session.dtd"> "http://why3.lri.fr/why3session.dtd">
<why3session shape_version="5"> <why3session shape_version="5">
<prover id="0" name="CVC4" version="1.5" timelimit="5" steplimit="0" memlimit="1000"/> <prover id="0" name="CVC4" version="1.5" timelimit="5" steplimit="0" memlimit="1000"/>
<file name="../231_destruct.mlw"> <file>
<path name=".."/>
<path name="231_destruct.mlw"/>
<theory name="T"> <theory name="T">
<goal name="G"> <goal name="G">
<transf name="destruct" arg1="H"> <transf name="destruct" arg1="H">
......
...@@ -5,14 +5,15 @@ ...@@ -5,14 +5,15 @@
<prover id="0" name="Z3" version="4.6.0" timelimit="11" steplimit="0" memlimit="1000"/> <prover id="0" name="Z3" version="4.6.0" timelimit="11" steplimit="0" memlimit="1000"/>
<prover id="1" name="Alt-Ergo" version="2.0.0" timelimit="11" steplimit="0" memlimit="1000"/> <prover id="1" name="Alt-Ergo" version="2.0.0" timelimit="11" steplimit="0" memlimit="1000"/>
<prover id="2" name="CVC4" version="1.6" timelimit="1" steplimit="0" memlimit="1000"/> <prover id="2" name="CVC4" version="1.6" timelimit="1" steplimit="0" memlimit="1000"/>
<prover id="3" name="Alt-Ergo" version="2.2.0" timelimit="5" steplimit="0" memlimit="1000"/>
<prover id="4" name="CVC4" version="1.5" timelimit="11" steplimit="0" memlimit="1000"/> <prover id="4" name="CVC4" version="1.5" timelimit="11" steplimit="0" memlimit="1000"/>
<file proved="true"> <file proved="true">
<path name=".."/> <path name=".."/>
<path name="isqrt.mlw"/> <path name="isqrt.mlw"/>
<theory name="Square" proved="true"> <theory name="Square" proved="true">
<goal name="sqr_non_neg" proved="true"> <goal name="sqr_non_neg" proved="true">
<proof prover="1" obsolete="true"><result status="valid" time="0.00" steps="2"/></proof>
<proof prover="2"><result status="valid" time="0.02"/></proof> <proof prover="2"><result status="valid" time="0.02"/></proof>
<proof prover="3"><result status="valid" time="0.00" steps="2"/></proof>
</goal> </goal>
<goal name="sqr_increasing" proved="true"> <goal name="sqr_increasing" proved="true">
<proof prover="0"><result status="valid" time="0.01"/></proof> <proof prover="0"><result status="valid" time="0.01"/></proof>
......
...@@ -171,6 +171,9 @@ val t_open_branch : term_branch -> pattern * term ...@@ -171,6 +171,9 @@ val t_open_branch : term_branch -> pattern * term
val t_open_quant : term_quant -> vsymbol list * trigger * term val t_open_quant : term_quant -> vsymbol list * trigger * term
val t_open_bound_with : term -> term_bound -> term val t_open_bound_with : term -> term_bound -> term
(** [t_open_bound_with t tb] opens the binding [tb] and immediately
replaces the corresponding bound variable with [t] *)
val t_clone_bound_id : term_bound -> preid val t_clone_bound_id : term_bound -> preid
(** open bindings with optimized closing callbacks *) (** open bindings with optimized closing callbacks *)
......
...@@ -58,25 +58,43 @@ val fold_map : (task_hd -> 'a * 'b -> ('a * 'b) ) -> 'a -> 'b -> 'b trans ...@@ -58,25 +58,43 @@ val fold_map : (task_hd -> 'a * 'b -> ('a * 'b) ) -> 'a -> 'b -> 'b trans
val fold_map_l : (task_hd -> 'a * 'b -> ('a * 'b) list) -> 'a -> 'b -> 'b tlist val fold_map_l : (task_hd -> 'a * 'b -> ('a * 'b) list) -> 'a -> 'b -> 'b tlist
val decl : (decl -> decl list ) -> task -> task trans val decl : (decl -> decl list ) -> task -> task trans
(** [decl f t1 t2] adds to task [t1] the declarations [f d] for each (** [decl f t1 t2] appends to task [t1] the set of declarations [f d]
declaration [d] of task [t2]. (similar to a "flat_map" for each declaration [d] of task [t2], similarly to a "flat_map"
operation) *) operation on lists.
For example, if [t2] is made of the two declarations [d1] and [d2]
in that order, if [f d1 = [d11;d12]] and [f d2 = [d21;d22]], then
the resulting task contains the declarations of [t1] followed by
[d11;d12;d21;d22] *)
val decl_l : (decl -> decl list list) -> task -> task tlist val decl_l : (decl -> decl list list) -> task -> task tlist
(** [decl_l f t1 t2]: on each declaration d of task [t2] (** [decl_f f t1 t2] produces a set of tasks obtained by appending new
(with [f d] = [ld_1; ld_2; ... ld_n]), create n duplicates (newt_i) declarations to task [t1]. It iterates on each declaration [d]
of t1 with the declaration d_i replaced by ld_i. appearing in [t2]: if [f d = [ld_1; ld_2; ... ld_n]] then it
produces [n] tasks [t'1;..;t'n], where [ld_i] is appended to [t'i].
The operation on remaining tasks of [t2] are then applied to each task [t'i].
For example, if [t2] is made of the two declarations [d1] and [d2]
in that order, if [f d1 = [[d111;d112];[d12]]] and [f d2 =
[[d21];[d221;d222]]], then the result is made of the 4 tasks
[t1;d111;d112;d21], [t1;d111;d112;d221;d222], [t1;d12;d21] and
[t1;d12;d221;d222] *)
Note for example that this 'decl_l (fun d -> [[d]; [d]])' will
duplicate the task on each declaration and probably run forever.
*)
type diff_decl = type diff_decl =
| Goal_decl of Decl.decl | Goal_decl of Decl.decl
| Normal_decl of Decl.decl | Normal_decl of Decl.decl
(* FIXME: the differenciation of goal versus normal decl should be made using
[is_goal d = match d.decl_node with
| Prop(Goal,_) -> true | _ -> false] *)
val decl_goal_l: (decl -> diff_decl list list) -> task -> task tlist val decl_goal_l: (decl -> diff_decl list list) -> task -> task tlist
(** [decl_goal_l f t1 t2] does the same as decl_l except that it can (** FIXME:
* make this comment more comprehensible
* there should be no "disallowed cases": as soon as a goal is produced, no new decls should be added anymore in the resulting tasks
[decl_goal_l f t1 t2] does the same as decl_l except that it can
differentiate a new axiom added to a task from a new goal added to a task. differentiate a new axiom added to a task from a new goal added to a task.
In case of a new axiom, everything works as in decl_l. When a new goal [ng] In case of a new axiom, everything works as in decl_l. When a new goal [ng]
is generated, it is remembered so that it can replace the old_goal when the is generated, it is remembered so that it can replace the old_goal when the
......
...@@ -529,9 +529,10 @@ let init () = ...@@ -529,9 +529,10 @@ let init () =
resize_images 20; resize_images 20;
Debug.dprintf debug " done.@." Debug.dprintf debug " done.@."
let show_legend_window () = let show_legend_window ~parent () =
let dialog = let dialog =
GWindow.dialog GWindow.dialog
~modal:true ~parent
~title:"Why3: legend of icons" ~icon:!why_icon ~title:"Why3: legend of icons" ~icon:!why_icon
() ()
in in
...@@ -597,9 +598,10 @@ let show_legend_window () = ...@@ -597,9 +598,10 @@ let show_legend_window () =
dialog#destroy () dialog#destroy ()
let show_about_window () = let show_about_window ~parent () =
let about_dialog = let about_dialog =
GWindow.about_dialog GWindow.about_dialog
~parent
~name:"The Why3 Verification Platform" ~name:"The Why3 Verification Platform"
~authors:["François Bobot"; ~authors:["François Bobot";
"Jean-Christophe Filliâtre"; "Jean-Christophe Filliâtre";
...@@ -1130,9 +1132,9 @@ let editors_page c (notebook:GPack.notebook) = ...@@ -1130,9 +1132,9 @@ let editors_page c (notebook:GPack.notebook) =
Mprover.iter add_prover (Whyconf.get_provers c.config) Mprover.iter add_prover (Whyconf.get_provers c.config)
let preferences (c : t) = let preferences ~parent (c : t) =
let dialog = GWindow.dialog let dialog = GWindow.dialog
~modal:true ~icon:(!why_icon) ~modal:true ~parent ~icon:(!why_icon)
~title:"Why3: preferences" () ~title:"Why3: preferences" ()
in in
let vbox = dialog#vbox in let vbox = dialog#vbox in
...@@ -1190,19 +1192,20 @@ let run_auto_detection gconfig = ...@@ -1190,19 +1192,20 @@ let run_auto_detection gconfig =
(*let () = Debug.dprintf debug "[config] end of configuration initialization@."*) (*let () = Debug.dprintf debug "[config] end of configuration initialization@."*)
let uninstalled_prover_dialog ~height ~callback c unknown = let uninstalled_prover_dialog ~parent ~callback c unknown =
let others,names,versions = let others,names,versions =
Whyconf.unknown_to_known_provers Whyconf.unknown_to_known_provers
(Whyconf.get_provers c.config) unknown (Whyconf.get_provers c.config) unknown
in in
let dialog = GWindow.dialog let dialog = GWindow.dialog
~icon:(!why_icon) ~modal:true ~icon:(!why_icon) ~modal:true ~parent
~title:"Why3: Uninstalled prover" () ~title:"Why3: Uninstalled prover" ()
in in
let vbox = dialog#vbox in let vbox = dialog#vbox in
let vbox_pack = vbox#pack ~fill:true ~expand:true ?from:None ?padding:None in let vbox_pack = vbox#pack ~fill:true ~expand:true ?from:None ?padding:None in
let hbox = GPack.hbox ~packing:vbox_pack () in let hbox = GPack.hbox ~packing:vbox_pack () in
let hbox_pack = hbox#pack ~fill:true ~expand:true ?from:None ?padding:None in let hbox_pack = hbox#pack ~fill:true ~expand:true ?from:None ?padding:None in
let height = parent#misc#allocation.Gtk.height * 3 / 4 in
let scrollview = let scrollview =
GBin.scrolled_window ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC ~height GBin.scrolled_window ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC ~height
~packing:hbox_pack () ~packing:hbox_pack ()
......
...@@ -112,12 +112,12 @@ val image_failure_obs : GdkPixbuf.pixbuf ref ...@@ -112,12 +112,12 @@ val image_failure_obs : GdkPixbuf.pixbuf ref
(* miscellaneous dialogs *) (* miscellaneous dialogs *)
(*************************) (*************************)
val show_legend_window : unit -> unit val show_legend_window : parent:#GWindow.window_skel -> unit -> unit
val show_about_window : unit -> unit val show_about_window : parent:#GWindow.window_skel -> unit -> unit
val preferences : t -> unit val preferences : parent:#GWindow.window_skel -> t -> unit
val uninstalled_prover_dialog : val uninstalled_prover_dialog :
height:int -> parent:#GWindow.window_skel ->
callback: (Whyconf.prover -> Whyconf.prover_upgrade_policy -> unit) -> callback: (Whyconf.prover -> Whyconf.prover_upgrade_policy -> unit) ->
t -> Whyconf.prover -> unit t -> Whyconf.prover -> unit
......
...@@ -17,6 +17,8 @@ open Ide_utils ...@@ -17,6 +17,8 @@ open Ide_utils
open History open History
open Itp_communication open Itp_communication
module GSourceView = GSourceView2
external reset_gc : unit -> unit = "ml_reset_gc" external reset_gc : unit -> unit = "ml_reset_gc"
let debug = Debug.lookup_flag "ide_info" let debug = Debug.lookup_flag "ide_info"
...@@ -200,7 +202,7 @@ let (why_lang, any_lang) = ...@@ -200,7 +202,7 @@ let (why_lang, any_lang) =
let main = Whyconf.get_main gconfig.config in let main = Whyconf.get_main gconfig.config in
let load_path = Filename.concat (Whyconf.datadir main) "lang" in let load_path = Filename.concat (Whyconf.datadir main) "lang" in
let languages_manager = let languages_manager =
GSourceView2.source_language_manager ~default:true GSourceView.source_language_manager ~default:true
in in
languages_manager#set_search_path languages_manager#set_search_path
(load_path :: languages_manager#search_path); (load_path :: languages_manager#search_path);
...@@ -238,15 +240,15 @@ let try_convert s = ...@@ -238,15 +240,15 @@ let try_convert s =
(* For each view, we have to recreate the tags *) (* For each view, we have to recreate the tags *)
let create_colors v = let create_colors v =
let premise_tag (v: GSourceView2.source_view) = v#buffer#create_tag let premise_tag (v: GSourceView.source_view) = v#buffer#create_tag
~name:"premise_tag" [`BACKGROUND gconfig.premise_color] in ~name:"premise_tag" [`BACKGROUND gconfig.premise_color] in
let neg_premise_tag (v: GSourceView2.source_view) = v#buffer#create_tag let neg_premise_tag (v: GSourceView.source_view) = v#buffer#create_tag
~name:"neg_premise_tag" [`BACKGROUND gconfig.neg_premise_color] in ~name:"neg_premise_tag" [`BACKGROUND gconfig.neg_premise_color] in
let goal_tag (v: GSourceView2.source_view) = v#buffer#create_tag let goal_tag (v: GSourceView.source_view) = v#buffer#create_tag
~name:"goal_tag" [`BACKGROUND gconfig.goal_color] in ~name:"goal_tag" [`BACKGROUND gconfig.goal_color] in
let error_line_tag (v: GSourceView2.source_view) = v#buffer#create_tag let error_line_tag (v: GSourceView.source_view) = v#buffer#create_tag
~name:"error_line_tag" [`BACKGROUND gconfig.error_line_color] in ~name:"error_line_tag" [`BACKGROUND gconfig.error_line_color] in
let error_tag (v: GSourceView2.source_view) = v#buffer#create_tag let error_tag (v: GSourceView.source_view) = v#buffer#create_tag
~name:"error_tag" [`BACKGROUND gconfig.error_color_bg] in ~name:"error_tag" [`BACKGROUND gconfig.error_color_bg] in
let _ : GText.tag = premise_tag v in let _ : GText.tag = premise_tag v in
let _ : GText.tag = neg_premise_tag v in let _ : GText.tag = neg_premise_tag v in
...@@ -256,7 +258,7 @@ let create_colors v = ...@@ -256,7 +258,7 @@ let create_colors v =
() ()
(* Erase all the source location tags in a source file *) (* Erase all the source location tags in a source file *)
let erase_color_loc (v:GSourceView2.source_view) = let erase_color_loc (v:GSourceView.source_view) =
let buf = v#buffer in let buf = v#buffer in
buf#remove_tag_by_name "premise_tag" ~start:buf#start_iter ~stop:buf#end_iter; buf#remove_tag_by_name "premise_tag" ~start:buf#start_iter ~stop:buf#end_iter;
buf#remove_tag_by_name "neg_premise_tag" ~start:buf#start_iter ~stop:buf#end_iter; buf#remove_tag_by_name "neg_premise_tag" ~start:buf#start_iter ~stop:buf#end_iter;
...@@ -288,7 +290,7 @@ let exit_function_unsafe () = ...@@ -288,7 +290,7 @@ let exit_function_unsafe () =
source has been modified source has been modified
- label_of_tab is the mutable title of the tab - label_of_tab is the mutable title of the tab
*) *)
let source_view_table : (int * GSourceView2.source_view * bool ref * GMisc.label) Hstr.t = let source_view_table : (int * GSourceView.source_view * bool ref * GMisc.label) Hstr.t =
Hstr.create 14 Hstr.create 14
(* The corresponding file does not have a source view *) (* The corresponding file does not have a source view *)
...@@ -300,7 +302,7 @@ let get_source_view_table (file:string) = ...@@ -300,7 +302,7 @@ let get_source_view_table (file:string) =
| exception Not_found -> raise (Nosourceview file) | exception Not_found -> raise (Nosourceview file)
(* This returns the source_view of a file *) (* This returns the source_view of a file *)
let get_source_view (file: string) : GSourceView2.source_view = let get_source_view (file: string) : GSourceView.source_view =
match Hstr.find source_view_table file with match Hstr.find source_view_table file with
| (_, v, _, _) -> v | (_, v, _, _) -> v
| exception Not_found -> raise (Nosourceview file) | exception Not_found -> raise (Nosourceview file)
...@@ -308,7 +310,7 @@ let get_source_view (file: string) : GSourceView2.source_view = ...@@ -308,7 +310,7 @@ let get_source_view (file: string) : GSourceView2.source_view =
(* Saving function for sources *) (* Saving function for sources *)
let save_sources () = let save_sources () =
Hstr.iter Hstr.iter
(fun k (_n, (s: GSourceView2.source_view), b, _l) -> (fun k (_n, (s: GSourceView.source_view), b, _l) ->
if !b then if !b then
let text_to_save = s#source_buffer#get_text () in let text_to_save = s#source_buffer#get_text () in
send_request (Save_file_req (k, text_to_save)) send_request (Save_file_req (k, text_to_save))
...@@ -395,12 +397,8 @@ let window_title = ...@@ -395,12 +397,8 @@ let window_title =
| None -> "Why3 Interactive Proof Session" | None -> "Why3 Interactive Proof Session"
let main_window : GWindow.window = let main_window : GWindow.window =
let w = GWindow.window let w = GWindow.window ~title:window_title () in
~allow_grow:true ~allow_shrink:true w#resize ~width:gconfig.window_width ~height:gconfig.window_height;
~width:gconfig.window_width
~height:gconfig.window_height
~title:window_title ()
in
(* callback to record the new size of the main window when changed, so (* callback to record the new size of the main window when changed, so
that on restart the window size is the same as the last session *) that on restart the window size is the same as the last session *)
let (_ : GtkSignal.id) = let (_ : GtkSignal.id) =
...@@ -467,13 +465,15 @@ let (_ : GtkSignal.id) = ...@@ -467,13 +465,15 @@ let (_ : GtkSignal.id) =
let hp = GPack.paned `HORIZONTAL ~packing:hb#add () let hp = GPack.paned `HORIZONTAL ~packing:hb#add ()
let scrollview = (** {2 view for the session tree} *)
let scrolled_session_view =
let sv = let sv =
GBin.scrolled_window GBin.scrolled_window
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
~width:gconfig.tree_width ~shadow_type:`ETCHED_OUT ~shadow_type:`ETCHED_OUT
~packing:hp#add () ~packing:hp#add ()
in in
hp#set_position gconfig.tree_width;
let (_ : GtkSignal.id) = let (_ : GtkSignal.id) =
sv#misc#connect#size_allocate sv#misc#connect#size_allocate
~callback: ~callback:
...@@ -481,14 +481,6 @@ let scrollview = ...@@ -481,14 +481,6 @@ let scrollview =
gconfig.tree_width <- w) gconfig.tree_width <- w)
in sv in sv
(** {2 view for the session tree} *)
let scrolled_session_view =
GBin.scrolled_window
~hpolicy: `AUTOMATIC ~vpolicy: `AUTOMATIC
~shadow_type:`ETCHED_OUT
~packing:scrollview#add_with_viewport
()
(* Vertical pan *) (* Vertical pan *)
let vpan222 = GPack.paned `VERTICAL ~packing:hp#add () let vpan222 = GPack.paned `VERTICAL ~packing:hp#add ()
...@@ -661,7 +653,7 @@ let (_ : GtkSignal.id) = ...@@ -661,7 +653,7 @@ let (_ : GtkSignal.id) =
let task_view = let task_view =
GSourceView2.source_view GSourceView.source_view
~editable:false ~editable:false
~cursor_visible:false ~cursor_visible:false
~show_line_numbers:true ~show_line_numbers:true
...@@ -690,7 +682,7 @@ let create_source_view = ...@@ -690,7 +682,7 @@ let create_source_view =
~shadow_type:`ETCHED_OUT ~shadow_type:`ETCHED_OUT
~packing:scrolled_source_view#add () in ~packing:scrolled_source_view#add () in
let source_view = let source_view =
GSourceView2.source_view GSourceView.source_view
~auto_indent:gconfig.allow_source_editing ~auto_indent:gconfig.allow_source_editing
~insert_spaces_instead_of_tabs:true ~tab_width:2 ~insert_spaces_instead_of_tabs:true ~tab_width:2
~show_line_numbers:true ~show_line_numbers:true
...@@ -781,7 +773,7 @@ let scrolled_edited_view = ...@@ -781,7 +773,7 @@ let scrolled_edited_view =
~shadow_type:`ETCHED_OUT ~packing:edited_tab#add () ~shadow_type:`ETCHED_OUT ~packing:edited_tab#add ()
let edited_view = let edited_view =
GSourceView2.source_view GSourceView.source_view
~editable:false ~editable:false
~show_line_numbers:true ~show_line_numbers:true
~packing:scrolled_edited_view#add ~packing:scrolled_edited_view#add
...@@ -799,7 +791,7 @@ let scrolled_output_view = ...@@ -799,7 +791,7 @@ let scrolled_output_view =
~shadow_type:`ETCHED_OUT ~packing:output_tab#add () ~shadow_type:`ETCHED_OUT ~packing:output_tab#add ()
let output_view = let output_view =
GSourceView2.source_view GSourceView.source_view
~editable:false ~editable:false
~show_line_numbers:true ~show_line_numbers:true
~packing:scrolled_output_view#add ~packing:scrolled_output_view#add
...@@ -818,7 +810,7 @@ let scrolled_counterexample_view = ...@@ -818,7 +810,7 @@ let scrolled_counterexample_view =
~shadow_type:`ETCHED_OUT ~packing:counterexample_tab#add () ~shadow_type:`ETCHED_OUT ~packing:counterexample_tab#add ()
let counterexample_view = let counterexample_view =
GSourceView2.source_view GSourceView.source_view
~editable:false ~editable:false
~show_line_numbers:true ~show_line_numbers:true
~packing:scrolled_counterexample_view#add ~packing:scrolled_counterexample_view#add
...@@ -958,7 +950,7 @@ let update_monitor = ...@@ -958,7 +950,7 @@ let update_monitor =
(* Current position in the source files *) (* Current position in the source files *)
let current_cursor_loc = ref None let current_cursor_loc = ref None
let move_to_line ~yalign (v : GSourceView2.source_view) line = let move_to_line ~yalign (v : GSourceView.source_view) line =
let line = max 0 (line - 1) in let line = max 0 (line - 1) in
let line = min line v#buffer#line_count in let line = min line v#buffer#line_count in
let it = v#buffer#get_iter (`LINE line) in let it = v#buffer#get_iter (`LINE line) in
...@@ -1077,7 +1069,7 @@ let convert_color (color: color): string = ...@@ -1077,7 +1069,7 @@ let convert_color (color: color): string =
| Error_line_color -> "error_line_tag" | Error_line_color -> "error_line_tag"
let color_line ~color loc = let color_line ~color loc =
let color_line (v:GSourceView2.source_view) ~color l = let color_line (v:GSourceView.source_view) ~color l =
let buf = v#buffer in let buf = v#buffer in
let top = buf#start_iter in let top = buf#start_iter in
let start = top#forward_lines (l-1) in let start = top#forward_lines (l-1) in
...@@ -1102,7 +1094,7 @@ let color_loc ?(ce=false) ~color loc = ...@@ -1102,7 +1094,7 @@ let color_loc ?(ce=false) ~color loc =
(* This apply a background [color] on a location given by its file view [v] line (* This apply a background [color] on a location given by its file view [v] line
[l] beginning char [b] and end char [e]. *) [l] beginning char [b] and end char [e]. *)
let color_loc (v:GSourceView2.source_view) ~color l b e = let color_loc (v:GSourceView.source_view) ~color l b e =
let buf = v#buffer in let buf = v#buffer in
let top = buf#start_iter in let top = buf#start_iter in
let start = top#forward_lines (l-1) in let start = top#forward_lines (l-1) in
...@@ -1795,7 +1787,7 @@ let (_: GMenu.menu_item) = ...@@ -1795,7 +1787,7 @@ let (_: GMenu.menu_item) =
let (_: GMenu.menu_item) = let (_: GMenu.menu_item) =
let callback () = let callback () =
Gconfig.preferences gconfig; Gconfig.preferences ~parent:main_window gconfig;
make_sources_editable gconfig.allow_source_editing; make_sources_editable gconfig.allow_source_editing;
send_session_config_to_server () send_session_config_to_server ()
in in
...@@ -1908,12 +1900,12 @@ let help_factory = new menu_factory help_menu ~accel_path:"<Why3-Main>/Help/" ~a ...@@ -1908,12 +1900,12 @@ let help_factory = new menu_factory help_menu ~accel_path:"<Why3-Main>/Help/" ~a
let (_ : GMenu.menu_item) = let (_ : GMenu.menu_item) =
help_factory#add_item help_factory#add_item
"Legend" "Legend"
~callback:show_legend_window ~callback:(show_legend_window ~parent:main_window)
let (_ : GMenu.menu_item) = let (_ : GMenu.menu_item) =
help_factory#add_item help_factory#add_item
"About" "About"
~callback:show_about_window ~callback:(show_about_window ~parent:main_window)
(*****************************************************************) (*****************************************************************)
(* "Tools" submenus for strategies, provers, and transformations *) (* "Tools" submenus for strategies, provers, and transformations *)
...@@ -2248,11 +2240,7 @@ let check_uninstalled_prover = ...@@ -2248,11 +2240,7 @@ let check_uninstalled_prover =
let callback p u = let callback p u =
send_request (Set_prover_policy(p,u)) send_request (Set_prover_policy(p,u))
in in
(* The gconfig.window_height is always the height of the window thanks to uninstalled_prover_dialog ~parent:main_window ~callback gconfig p
the callback to size_allocate. By default, this dialog has 3/4 the
height of the main window. *)
let height = 3 * gconfig.window_height / 4 in
uninstalled_prover_dialog ~height ~callback gconfig p
end end
let treat_notification n = let treat_notification n =
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment