X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2FgTopLevel.ml;h=58e785dec3ef37c5ff6cf8dfc4dad4d2819b3ba5;hb=87b98314c08ec399096f87a8e06d30234d7cc498;hp=40e60b47e4f787361afba6164fa91a6a885b0b9e;hpb=85eee63b8b022bb73aaf4784b3d66262ed981e09;p=helm.git diff --git a/helm/gTopLevel/gTopLevel.ml b/helm/gTopLevel/gTopLevel.ml index 40e60b47e..58e785dec 100644 --- a/helm/gTopLevel/gTopLevel.ml +++ b/helm/gTopLevel/gTopLevel.ml @@ -128,6 +128,16 @@ let set_outputhtml,outputhtml = ) ;; +exception QedSetSensitiveNotInitialized;; +let qed_set_sensitive = + ref (function _ -> raise QedSetSensitiveNotInitialized) +;; + +exception SaveSetSensitiveNotInitialized;; +let save_set_sensitive = + ref (function _ -> raise SaveSetSensitiveNotInitialized) +;; + (* COMMAND LINE OPTIONS *) let usedb = ref true @@ -201,35 +211,46 @@ let output_html outputhtml msg = (* Check window *) -let check_window outputhtml uris_and_terms = +let check_window outputhtml uris = let window = GWindow.window ~width:800 ~modal:true ~title:"Check" ~border_width:2 () in let notebook = GPack.notebook ~scrollable:true ~packing:window#add () in - ignore ( + window#show () ; + let render_terms = List.map - (function (uri,expr) -> + (function uri -> let scrolled_window = GBin.scrolled_window ~border_width:10 ~packing: - (notebook#append_page - ~tab_label:((GMisc.label ~text:uri ())#coerce) - ) - () in - let mmlwidget = - GMathView.math_view - ~packing:(scrolled_window#add) ~width:400 ~height:280 () in - try - let mml = !mml_of_cic_term_ref 111 expr in + (notebook#append_page ~tab_label:((GMisc.label ~text:uri ())#coerce)) + () + in + lazy + (let mmlwidget = + GMathView.math_view + ~packing:scrolled_window#add ~width:400 ~height:280 () in + let expr = + let term = + term_of_cic_textual_parser_uri (cic_textual_parser_uri_of_string uri) + in + (Cic.Cast (term, CicTypeChecker.type_of_aux' [] [] term)) + in + try + let mml = !mml_of_cic_term_ref 111 expr in prerr_endline ("### " ^ CicPp.ppterm expr) ; - mmlwidget#load_tree ~dom:mml - with - e -> - output_html outputhtml - ("

" ^ Printexc.to_string e ^ "

") - ) uris_and_terms) ; - window#show () + mmlwidget#load_tree ~dom:mml + with + e -> + output_html outputhtml + ("

" ^ Printexc.to_string e ^ "

") + ) + ) uris + in + ignore + (notebook#connect#switch_page + (function i -> Lazy.force (List.nth render_terms i))) ;; exception NoChoice;; @@ -248,7 +269,7 @@ let GBin.scrolled_window ~border_width:10 ~packing:(window#vbox#pack ~expand:true ~fill:true ~padding:5) () in let clist = - let expected_height = 8 * List.length uris in + let expected_height = 18 * List.length uris in let height = if expected_height > 400 then 400 else expected_height in GList.clist ~columns:1 ~packing:scrolled_window#add ~height ~selection_mode () in @@ -278,16 +299,7 @@ let (* actions *) let check_callback () = assert (List.length !choices > 0) ; - check_window (outputhtml ()) - (List.map - (function uri -> - let term = - term_of_cic_textual_parser_uri - (cic_textual_parser_uri_of_string uri) - in - uri, - (Cic.Cast (term, CicTypeChecker.type_of_aux' [] [] term)) - ) !choices) + check_window (outputhtml ()) !choices in ignore (window#connect#destroy GMain.Main.quit) ; ignore (cancelb#connect#clicked window#destroy) ; @@ -326,12 +338,67 @@ let window#set_position `CENTER ; window#show () ; GMain.Main.main () ; - if !chosen or List.length !choices > 0 then + if !chosen && List.length !choices > 0 then !choices else raise NoChoice ;; +let interactive_interpretation_choice interpretations = + let chosen = ref None in + let window = + GWindow.window + ~modal:true ~title:"Ambiguous well-typed input." ~border_width:2 () in + let vbox = GPack.vbox ~packing:window#add () in + let lMessage = + GMisc.label + ~text: + ("Ambiguous input since there are many well-typed interpretations." ^ + " Please, choose one of them.") + ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in + let notebook = + GPack.notebook ~scrollable:true + ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in + let _ = + List.map + (function interpretation -> + let clist = + let expected_height = 18 * List.length interpretation in + let height = if expected_height > 400 then 400 else expected_height in + GList.clist ~columns:2 ~packing:notebook#append_page ~height + ~titles:["id" ; "URI"] () + in + ignore + (List.map + (function (id,uri) -> + let n = clist#append [id;uri] in + clist#set_row ~selectable:false n + ) interpretation + ) ; + clist#columns_autosize () + ) interpretations in + let hbox = + GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in + let okb = + GButton.button ~label:"Ok" + ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in + let cancelb = + GButton.button ~label:"Abort" + ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in + (* actions *) + ignore (window#connect#destroy GMain.Main.quit) ; + ignore (cancelb#connect#clicked window#destroy) ; + ignore + (okb#connect#clicked + (function () -> chosen := Some notebook#current_page ; window#destroy ())) ; + window#set_position `CENTER ; + window#show () ; + GMain.Main.main () ; + match !chosen with + None -> raise NoChoice + | Some n -> n +;; + (* MISC FUNCTIONS *) (* CSC: IMPERATIVE AND NOT VERY CLEAN, TO GET THE LAST ISSUED QUERY *) @@ -372,7 +439,7 @@ let locate_one_id id = | _ -> interactive_user_uri_choice ~selection_mode:`EXTENDED - ~ok:"Try all the sections." + ~ok:"Try every selection." ~title:"Ambiguous input." ~msg: ("Ambiguous input \"" ^ id ^ @@ -418,7 +485,11 @@ let disambiguate_input context metasenv dom mk_metasenv_and_expr = in aux dom' list_of_uris in -prerr_endline ("##### NE DISAMBIGUO: " ^ string_of_int (List.length resolve_ids)) ; + let tests_no = List.length resolve_ids in + if tests_no > 1 then + output_html (outputhtml ()) + ("

Disambiguation phase started: " ^ + string_of_int (List.length resolve_ids) ^ " cases will be tried.") ; (* now we select only the ones that generates well-typed terms *) let resolve_ids' = let rec filter = @@ -444,37 +515,27 @@ prerr_endline ("##### NE DISAMBIGUO: " ^ string_of_int (List.length resolve_ids) let choices = List.map (function resolve -> - String.concat " ; " - (List.map - (function id -> - id ^ " := " ^ - match resolve id with - None -> assert false - | Some uri -> - match uri with - CicTextualParser0.ConUri uri - | CicTextualParser0.VarUri uri -> - UriManager.string_of_uri uri - | CicTextualParser0.IndTyUri (uri,tyno) -> - UriManager.string_of_uri uri ^ "#xpointer(1/" ^ - string_of_int (tyno+1) ^ ")" - | CicTextualParser0.IndConUri (uri,tyno,consno) -> - UriManager.string_of_uri uri ^ "#xpointer(1/" ^ - string_of_int (tyno+1) ^ "/" ^ string_of_int consno ^ ")" - ) dom - ) + List.map + (function id -> + id, + match resolve id with + None -> assert false + | Some uri -> + match uri with + CicTextualParser0.ConUri uri + | CicTextualParser0.VarUri uri -> + UriManager.string_of_uri uri + | CicTextualParser0.IndTyUri (uri,tyno) -> + UriManager.string_of_uri uri ^ "#xpointer(1/" ^ + string_of_int (tyno+1) ^ ")" + | CicTextualParser0.IndConUri (uri,tyno,consno) -> + UriManager.string_of_uri uri ^ "#xpointer(1/" ^ + string_of_int (tyno+1) ^ "/" ^ string_of_int consno ^ ")" + ) dom ) resolve_ids' in - let choice = - GToolbox.question_box ~title:"Ambiguous input." - ~buttons:choices - ~default:1 "Ambiguous input. Please, choose one interpretation." - in - if choice > 0 then - List.nth resolve_ids' (choice - 1) - else - (* No choice from the user *) - raise NoChoice + let index = interactive_interpretation_choice choices in + List.nth resolve_ids' index in id_to_uris := known_ids @ dom', resolve_id' ; mk_metasenv_and_expr resolve_id' @@ -597,6 +658,7 @@ let refresh_proof (output : GMathView.math_view) = match !ProofEngine.proof with None -> assert false | Some (uri,metasenv,bo,ty) -> + !qed_set_sensitive (List.length metasenv = 0) ; (*CSC: Wrong: [] is just plainly wrong *) uri,(Cic.CurrentProof (UriManager.name_of_uri uri, metasenv, bo, ty, [])) in @@ -627,7 +689,7 @@ let refresh_sequent ?(empty_notebook=true) notebook = None -> if empty_notebook then begin - notebook#remove_all_pages ; + notebook#remove_all_pages ~skip_switch_page_event:false ; notebook#set_empty_page end else @@ -642,19 +704,29 @@ let refresh_sequent ?(empty_notebook=true) notebook = let sequent_gdome,ids_to_terms,ids_to_father_ids,ids_to_hypotheses = SequentPp.XmlPp.print_sequent metasenv currentsequent in - let sequent_doc = - Xml2Gdome.document_of_xml domImpl sequent_gdome - in - let sequent_mml = - applyStylesheets sequent_doc sequent_styles sequent_args + let regenerate_notebook () = + let skip_switch_page_event = + match metasenv with + (m,_,_)::_ when m = metano -> false + | _ -> true in + notebook#remove_all_pages ~skip_switch_page_event ; + List.iter (function (m,_,_) -> notebook#add_page m) metasenv ; + in if empty_notebook then begin - notebook#remove_all_pages ; - List.iter (function (m,_,_) -> notebook#add_page m) metasenv ; + regenerate_notebook () ; + notebook#set_current_page ~may_skip_switch_page_event:false metano + end + else + begin + let sequent_doc = Xml2Gdome.document_of_xml domImpl sequent_gdome in + let sequent_mml = + applyStylesheets sequent_doc sequent_styles sequent_args + in + notebook#set_current_page ~may_skip_switch_page_event:true metano; + notebook#proofw#load_tree ~dom:sequent_mml end ; - notebook#set_current_page metano ; - notebook#proofw#load_tree ~dom:sequent_mml ; current_goal_infos := Some (ids_to_terms,ids_to_father_ids,ids_to_hypotheses) with @@ -669,9 +741,11 @@ let metasenv = None -> assert false | Some (_,metasenv,_,_) -> metasenv in +try let currentsequent = List.find (function (m,_,_) -> m=metano) metasenv in prerr_endline ("Offending sequent: " ^ SequentPp.TextualPp.print_sequent currentsequent) ; flush stderr ; raise (RefreshSequentException e) +with Not_found -> prerr_endline ("Offending sequent " ^ string_of_int metano ^ " unkown."); raise (RefreshSequentException e) ;; (* @@ -1219,7 +1293,8 @@ let load () = prooffiletype ^ "

") ; output_html outputhtml ("

Current proof body loaded from " ^ - prooffile ^ "

") + prooffile ^ "") ; + !save_set_sensitive true | _ -> assert false with RefreshSequentException e -> @@ -1355,8 +1430,7 @@ let setgoal metano = | Some (_,metasenv,_,_) -> metasenv in try - ProofEngine.goal := Some metano ; - refresh_sequent ~empty_notebook:false notebook ; + refresh_sequent ~empty_notebook:false notebook with RefreshSequentException e -> output_html outputhtml @@ -1435,6 +1509,7 @@ let state () = ProofEngine.goal := Some 1 ; refresh_sequent notebook ; refresh_proof output ; + !save_set_sensitive true done with CicTextualParser0.Eof -> @@ -1829,143 +1904,185 @@ end;; class page () = let vbox1 = GPack.vbox () in +object(self) + val mutable proofw_ref = None + val mutable compute_ref = None + method proofw = + Lazy.force self#compute ; + match proofw_ref with + None -> assert false + | Some proofw -> proofw + method content = vbox1 + method compute = + match compute_ref with + None -> assert false + | Some compute -> compute + initializer + compute_ref <- + Some (lazy ( + let scrolled_window1 = + GBin.scrolled_window ~border_width:10 + ~packing:(vbox1#pack ~expand:true ~padding:5) () in + let proofw = + GMathView.math_view ~width:400 ~height:275 + ~packing:(scrolled_window1#add) () in + let _ = proofw_ref <- Some proofw in + let hbox3 = + GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in + let exactb = + GButton.button ~label:"Exact" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let introsb = + GButton.button ~label:"Intros" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let applyb = + GButton.button ~label:"Apply" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let elimsimplintrosb = + GButton.button ~label:"ElimSimplIntros" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let elimtypeb = + GButton.button ~label:"ElimType" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let whdb = + GButton.button ~label:"Whd" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let reduceb = + GButton.button ~label:"Reduce" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let simplb = + GButton.button ~label:"Simpl" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let foldb = + GButton.button ~label:"Fold" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let cutb = + GButton.button ~label:"Cut" + ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in + let hbox4 = + GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in + let changeb = + GButton.button ~label:"Change" + ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in + let letinb = + GButton.button ~label:"Let ... In" + ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in + let ringb = + GButton.button ~label:"Ring" + ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in + let clearbodyb = + GButton.button ~label:"ClearBody" + ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in + let clearb = + GButton.button ~label:"Clear" + ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in + let fourierb = + GButton.button ~label:"Fourier" + ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in + let rewritesimplb = + GButton.button ~label:"RewriteSimpl ->" + ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in + let reflexivityb = + GButton.button ~label:"Reflexivity" + ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in + let hbox5 = + GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in + let symmetryb = + GButton.button ~label:"Symmetry" + ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in + let transitivityb = + GButton.button ~label:"Transitivity" + ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in + let leftb = + GButton.button ~label:"Left" + ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in + let rightb = + GButton.button ~label:"Right" + ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in + let assumptionb = + GButton.button ~label:"Assumption" + ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in + ignore(exactb#connect#clicked exact) ; + ignore(applyb#connect#clicked apply) ; + ignore(elimsimplintrosb#connect#clicked elimsimplintros) ; + ignore(elimtypeb#connect#clicked elimtype) ; + ignore(whdb#connect#clicked whd) ; + ignore(reduceb#connect#clicked reduce) ; + ignore(simplb#connect#clicked simpl) ; + ignore(foldb#connect#clicked fold) ; + ignore(cutb#connect#clicked cut) ; + ignore(changeb#connect#clicked change) ; + ignore(letinb#connect#clicked letin) ; + ignore(ringb#connect#clicked ring) ; + ignore(clearbodyb#connect#clicked clearbody) ; + ignore(clearb#connect#clicked clear) ; + ignore(fourierb#connect#clicked fourier) ; + ignore(rewritesimplb#connect#clicked rewritesimpl) ; + ignore(reflexivityb#connect#clicked reflexivity) ; + ignore(symmetryb#connect#clicked symmetry) ; + ignore(transitivityb#connect#clicked transitivity) ; + ignore(leftb#connect#clicked left) ; + ignore(rightb#connect#clicked right) ; + ignore(assumptionb#connect#clicked assumption) ; + ignore(introsb#connect#clicked intros) ; + ignore(proofw#connect#selection_changed (choose_selection proofw)) ; + )) +end +;; + +class empty_page = + let vbox1 = GPack.vbox () in let scrolled_window1 = GBin.scrolled_window ~border_width:10 ~packing:(vbox1#pack ~expand:true ~padding:5) () in let proofw = GMathView.math_view ~width:400 ~height:275 ~packing:(scrolled_window1#add) () in - let hbox3 = - GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in - let exactb = - GButton.button ~label:"Exact" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let introsb = - GButton.button ~label:"Intros" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let applyb = - GButton.button ~label:"Apply" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let elimsimplintrosb = - GButton.button ~label:"ElimSimplIntros" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let elimtypeb = - GButton.button ~label:"ElimType" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let whdb = - GButton.button ~label:"Whd" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let reduceb = - GButton.button ~label:"Reduce" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let simplb = - GButton.button ~label:"Simpl" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let foldb = - GButton.button ~label:"Fold" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let cutb = - GButton.button ~label:"Cut" - ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in - let hbox4 = - GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in - let changeb = - GButton.button ~label:"Change" - ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in - let letinb = - GButton.button ~label:"Let ... In" - ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in - let ringb = - GButton.button ~label:"Ring" - ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in - let clearbodyb = - GButton.button ~label:"ClearBody" - ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in - let clearb = - GButton.button ~label:"Clear" - ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in - let fourierb = - GButton.button ~label:"Fourier" - ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in - let rewritesimplb = - GButton.button ~label:"RewriteSimpl ->" - ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in - let reflexivityb = - GButton.button ~label:"Reflexivity" - ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in - let hbox5 = - GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in - let symmetryb = - GButton.button ~label:"Symmetry" - ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in - let transitivityb = - GButton.button ~label:"Transitivity" - ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in - let leftb = - GButton.button ~label:"Left" - ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in - let rightb = - GButton.button ~label:"Right" - ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in - let assumptionb = - GButton.button ~label:"Assumption" - ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in -object - method proofw = proofw +object(self) + method proofw = (assert false : GMathView.math_view) method content = vbox1 - initializer - ignore(exactb#connect#clicked exact) ; - ignore(applyb#connect#clicked apply) ; - ignore(elimsimplintrosb#connect#clicked elimsimplintros) ; - ignore(elimtypeb#connect#clicked elimtype) ; - ignore(whdb#connect#clicked whd) ; - ignore(reduceb#connect#clicked reduce) ; - ignore(simplb#connect#clicked simpl) ; - ignore(foldb#connect#clicked fold) ; - ignore(cutb#connect#clicked cut) ; - ignore(changeb#connect#clicked change) ; - ignore(letinb#connect#clicked letin) ; - ignore(ringb#connect#clicked ring) ; - ignore(clearbodyb#connect#clicked clearbody) ; - ignore(clearb#connect#clicked clear) ; - ignore(fourierb#connect#clicked fourier) ; - ignore(rewritesimplb#connect#clicked rewritesimpl) ; - ignore(reflexivityb#connect#clicked reflexivity) ; - ignore(symmetryb#connect#clicked symmetry) ; - ignore(transitivityb#connect#clicked transitivity) ; - ignore(leftb#connect#clicked left) ; - ignore(rightb#connect#clicked right) ; - ignore(assumptionb#connect#clicked assumption) ; - ignore(introsb#connect#clicked intros) ; - initializer - ignore(proofw#connect#selection_changed (choose_selection proofw)) ; + method compute = (assert false : unit) end ;; +let empty_page = new empty_page;; + class notebook = object(self) val notebook = GPack.notebook () val pages = ref [] val mutable skip_switch_page_event = false + val mutable empty = true method notebook = notebook method add_page n = let new_page = new page () in - pages := !pages @ [n,new_page] ; + empty <- false ; + pages := !pages @ [n,lazy (setgoal n),new_page] ; notebook#append_page ~tab_label:((GMisc.label ~text:("?" ^ string_of_int n) ())#coerce) new_page#content#coerce - method remove_all_pages = - List.iter (function _ -> notebook#remove_page 0) !pages ; + method remove_all_pages ~skip_switch_page_event:skip = + if empty then + notebook#remove_page 0 (* let's remove the empty page *) + else + List.iter (function _ -> notebook#remove_page 0) !pages ; pages := [] ; - method set_current_page n = - let (_,page) = List.find (function (m,_) -> m=n) !pages in + skip_switch_page_event <- skip + method set_current_page ~may_skip_switch_page_event n = + let (_,_,page) = List.find (function (m,_,_) -> m=n) !pages in let new_page = notebook#page_num page#content#coerce in - if new_page <> notebook#current_page then + if may_skip_switch_page_event && new_page <> notebook#current_page then skip_switch_page_event <- true ; notebook#goto_page new_page - method set_empty_page = self#add_page (-1) + method set_empty_page = + empty <- true ; + pages := [] ; + notebook#append_page + ~tab_label:((GMisc.label ~text:"No proof in progress" ())#coerce) + empty_page#content#coerce method proofw = - (snd (List.nth !pages notebook#current_page))#proofw + let (_,_,page) = List.nth !pages notebook#current_page in + page#proofw initializer ignore (notebook#connect#switch_page @@ -1974,8 +2091,10 @@ object(self) skip_switch_page_event <- false ; if not skip then try - let metano = fst (List.nth !pages i) in - setgoal metano + let (metano,setgoal,page) = List.nth !pages i in + ProofEngine.goal := Some metano ; + Lazy.force (page#compute) ; + Lazy.force setgoal with _ -> () )) end @@ -1998,8 +2117,18 @@ class rendering_window output (notebook : notebook) = let export_to_postscript_menu_item = begin ignore - (factory1#add_item "Load" ~key:GdkKeysyms._L ~callback:load) ; - ignore (factory1#add_item "Save" ~key:GdkKeysyms._S ~callback:save) ; + (factory1#add_item "Load Unfinished Proof" ~key:GdkKeysyms._L + ~callback:load) ; + let save_menu_item = + factory1#add_item "Save Unfinished Proof" ~key:GdkKeysyms._S ~callback:save + in + let qed_menu_item = + factory1#add_item "Qed" ~key:GdkKeysyms._Q ~callback:qed in + ignore + (save_set_sensitive := function b -> save_menu_item#misc#set_sensitive b); + ignore (!save_set_sensitive false); + ignore (qed_set_sensitive:=function b -> qed_menu_item#misc#set_sensitive b); + ignore (!qed_set_sensitive false); ignore (factory1#add_separator ()) ; let export_to_postscript_menu_item = factory1#add_item "Export to PostScript..." ~key:GdkKeysyms._E @@ -2027,8 +2156,6 @@ class rendering_window output (notebook : notebook) = proveit_menu_item#misc#set_sensitive b ; focus_menu_item#misc#set_sensitive b in - let _ = factory2#add_separator () in - let _ = factory2#add_item "Qed" ~key:GdkKeysyms._Q ~callback:qed in let _ = !focus_and_proveit_set_sensitive false in (* settings menu *) let settings_menu = factory0#add_submenu "Settings" in @@ -2052,8 +2179,12 @@ class rendering_window output (notebook : notebook) = GBin.scrolled_window ~border_width:10 ~packing:(vbox#pack ~expand:true ~padding:5) () in let _ = scrolled_window0#add output#coerce in + let frame = + GBin.frame ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in + let vbox' = + GPack.vbox ~packing:frame#add () in let hbox4 = - GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in + GPack.hbox ~border_width:5 ~packing:(vbox'#pack ~expand:false ~fill:false ~padding:5) () in let stateb = GButton.button ~label:"State" ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in @@ -2070,15 +2201,17 @@ class rendering_window output (notebook : notebook) = GButton.button ~label:"SearchPattern" ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in let scrolled_window1 = - GBin.scrolled_window ~border_width:10 - ~packing:(vbox#pack ~expand:true ~padding:5) () in + GBin.scrolled_window ~border_width:5 + ~packing:(vbox'#pack ~expand:true ~padding:0) () in let inputt = GEdit.text ~editable:true ~width:400 ~height:100 ~packing:scrolled_window1#add () in let vboxl = GPack.vbox ~packing:(hbox0#pack ~expand:true ~fill:true ~padding:5) () in let _ = vboxl#pack ~expand:true ~fill:true ~padding:5 notebook#notebook#coerce in - let frame = GBin.frame ~packing:(vboxl#pack ~expand:true ~padding:5) () in + let frame = + GBin.frame ~shadow_type:`IN ~packing:(vboxl#pack ~expand:true ~padding:5) () + in let outputhtml = GHtml.xmhtml ~source:"" @@ -2101,7 +2234,6 @@ object (* signal handlers here *) ignore(output#connect#selection_changed (function elem -> - notebook#proofw#unload ; choose_selection output elem ; !focus_and_proveit_set_sensitive true )) ;