X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fmatita%2FmatitaGui.ml;h=adb9bf753fc05fa9f05fa21be0451177383fc469;hb=9e8c5bce5abbfcee2f36c3e306f11c030c07d218;hp=b230adecc50f41ae68cb8c22c3facd47b25ac30d;hpb=3b7bfb05e6fc1a2ac6864d8f7d959fcda0597d21;p=helm.git diff --git a/helm/software/matita/matitaGui.ml b/helm/software/matita/matitaGui.ml index b230adecc..adb9bf753 100644 --- a/helm/software/matita/matitaGui.ml +++ b/helm/software/matita/matitaGui.ml @@ -415,17 +415,42 @@ class gui () = let lock_world _ = main#buttonsToolbar#misc#set_sensitive false; develList#buttonsHbox#misc#set_sensitive false; + main#scriptMenu#misc#set_sensitive false; source_view#set_editable false in let unlock_world _ = main#buttonsToolbar#misc#set_sensitive true; develList#buttonsHbox#misc#set_sensitive true; + main#scriptMenu#misc#set_sensitive true; source_view#set_editable true in - let locker f = + let worker_thread = ref None in + let locker f () = + let thread_main = fun () -> lock_world (); - try f ();unlock_world () with exc -> unlock_world (); raise exc in + try f ();unlock_world () with exc -> unlock_world (); raise exc + in + worker_thread := Some (Thread.create thread_main ()) in + let kill_worker = + (* the following lines are from Xavier Leroy: http://alan.petitepomme.net/cwn/2005.11.08.html *) + let interrupt = ref None in + let old_callback = ref (function _ -> ()) in + let force_interrupt n = + (* This function is called just before the thread's timeslice ends *) + !old_callback n; + if Some(Thread.id(Thread.self())) = !interrupt then + (interrupt := None; raise Sys.Break) in + let _ = + match Sys.signal Sys.sigvtalrm (Sys.Signal_handle force_interrupt) with + Sys.Signal_handle f -> old_callback := f + | Sys.Signal_ignore + | Sys.Signal_default -> assert false + in + fun () -> + match !worker_thread with + None -> assert false + | Some t -> interrupt := Some (Thread.id t) in let keep_focus f = fun () -> try @@ -486,10 +511,19 @@ class gui () = match get_devel_selected () with | None -> () | Some d -> - let clean = locker - (fun () -> MatitamakeLib.publish_development_in_bg refresh d) - in - ignore(clean ()))); + let publish = locker (fun () -> + MatitamakeLib.publish_development_in_bg refresh d) in + ignore(publish ()))); + connect_button develList#graphButton (fun () -> + match get_devel_selected () with + | None -> () + | Some d -> + (match MatitamakeLib.dot_for_development d with + | None -> () + | Some _ -> + let browser = MatitaMathView.cicBrowser () in + browser#load (`Development + (MatitamakeLib.name_for_development d)))); connect_button develList#closeButton (fun () -> develList#toplevel#misc#hide()); ignore(develList#toplevel#event#connect#delete @@ -789,6 +823,7 @@ class gui () = connect_button main#scriptTopButton top; connect_button main#scriptBottomButton bottom; connect_button main#scriptJumpButton jump; + connect_button main#scriptAbortButton kill_worker; connect_menu_item main#scriptAdvanceMenuItem advance; connect_menu_item main#scriptRetractMenuItem retract; connect_menu_item main#scriptTopMenuItem top; @@ -1007,16 +1042,34 @@ class gui () = method loadScript file = let script = MatitaScript.current () in script#reset (); - script#assignFileName file; - let content = - if Sys.file_exists file then file - else BuildTimeConf.script_template - in - source_view#source_buffer#begin_not_undoable_action (); - script#loadFromFile content; - source_view#source_buffer#end_not_undoable_action (); - console#message ("'"^file^"' loaded."); - self#_enableSaveTo file + if Pcre.pmatch ~pat:"\\.p$" file then + begin + let tptppath = + Helm_registry.get_opt_default Helm_registry.string ~default:"./" + "matita.tptppath" + in + let data = Matitaprover.p_to_ma ~filename:file ~tptppath () in + let filename = Pcre.replace ~pat:"\\.p$" ~templ:".ma" file in + script#assignFileName filename; + source_view#source_buffer#begin_not_undoable_action (); + script#loadFromString data; + source_view#source_buffer#end_not_undoable_action (); + console#message ("'"^filename^"' loaded."); + self#_enableSaveTo filename + end + else + begin + script#assignFileName file; + let content = + if Sys.file_exists file then file + else BuildTimeConf.script_template + in + source_view#source_buffer#begin_not_undoable_action (); + script#loadFromFile content; + source_view#source_buffer#end_not_undoable_action (); + console#message ("'"^file^"' loaded."); + self#_enableSaveTo file + end method setStar name b = let l = main#scriptLabel in