]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/gTopLevel/gTopLevel.ml
Interface change: the get_as_string and set_term methods of the term-editors
[helm.git] / helm / gTopLevel / gTopLevel.ml
index 1c81ddbbfbc72f6882d67fa5f569c480a87eb9fd..3dd4573844b426b79ab0467c1c68d00eaa6d75cb 100644 (file)
@@ -37,13 +37,14 @@ open Printf;;
 
 (* DEBUGGING *)
 
-let debug_print = 
-  let debug = true in
-  fun s -> prerr_endline (sprintf "DEBUG: %s" s)
-;;
+module MQI = MQueryInterpreter
+module MQIC = MQIConn
 
 (* GLOBAL CONSTANTS *)
 
+let mqi_flags = [] (* default MathQL interpreter options *)
+let mqi_handle = MQIC.init mqi_flags prerr_string
+
 let xlinkns = Gdome.domString "http://www.w3.org/1999/xlink";;
 
 let htmlheader =
@@ -70,13 +71,6 @@ let prooffiletype =
   Not_found -> "/public/currentprooftype"
 ;;
 
-let postgresqlconnectionstring =
- try
-  Sys.getenv "POSTGRESQL_CONNECTION_STRING"
- with
-  Not_found -> "host=mowgli.cs.unibo.it dbname=helm_mowgli_new_schema user=helm"
-;;
-
 (* GLOBAL REFERENCES (USED BY CALLBACKS) *)
 
 let htmlheader_and_content = ref htmlheader;;
@@ -574,7 +568,17 @@ let refresh_proof (output : TermViewer.proof_viewer) =
    match !ProofEngine.proof with
       None -> assert false
     | Some (uri,metasenv,bo,ty) ->
-       !qed_set_sensitive (List.length metasenv = 0) ;
+       if List.length metasenv = 0 then
+        begin
+         !qed_set_sensitive true ;
+prerr_endline "CSC: ###### REFRESH_PROOF, Hbugs.clear ()" ;
+         Hbugs.clear ()
+        end
+       else
+begin
+prerr_endline "CSC: ###### REFRESH_PROOF, Hbugs.notify ()" ;
+        Hbugs.notify () ;
+end ;
        (*CSC: Wrong: [] is just plainly wrong *)
        uri,
         (Cic.CurrentProof (UriManager.name_of_uri uri, metasenv, bo, ty, []))
@@ -647,7 +651,6 @@ let currentsequent = List.find (function (m,_,_) -> m=metano) metasenv in
       raise (InvokeTactics.RefreshSequentException e)
 with Not_found -> prerr_endline ("Offending sequent " ^ string_of_int metano ^ " unknown."); raise (InvokeTactics.RefreshSequentException e)
 
-let __notify_hbugs = ref None;;
 module InvokeTacticsCallbacks =
  struct
   let sequent_viewer () = (rendering_window ())#notebook#proofw
@@ -665,15 +668,11 @@ module InvokeTacticsCallbacks =
   let decompose_uris_choice_callback = decompose_uris_choice_callback
   let mk_fresh_name_callback = mk_fresh_name_callback
   let output_html msg = output_html (outputhtml ()) msg
-  let notify_hbugs () =
-    match !__notify_hbugs with
-    | Some f -> f ()
-    | None -> assert false
  end
 ;;
 module InvokeTactics' = InvokeTactics.Make (InvokeTacticsCallbacks);;
-module Hbugs' = Hbugs.Make (InvokeTactics');;
-__notify_hbugs := Some Hbugs'.notify;;
+(* Just to initialize the Hbugs module *)
+module Ignore = Hbugs.Initialize (InvokeTactics');;
 
   (** load an unfinished proof from filesystem *)
 let load_unfinished_proof () =
@@ -707,7 +706,6 @@ let load_unfinished_proof () =
               ("<h1 color=\"Green\">Current proof body loaded from " ^
                 prooffile ^ "</h1>") ;
             !save_set_sensitive true;
-            Hbugs'.notify ()
          | _ -> assert false
   with
      InvokeTactics.RefreshSequentException e ->
@@ -959,7 +957,7 @@ let user_uri_choice ~title ~msg uris =
 
 let locate_callback id =
  let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
- let result = MQueryGenerator.locate id in
+ let result = MQueryGenerator.locate mqi_handle id in
  let uris =
   List.map
    (function uri,_ ->
@@ -1254,6 +1252,7 @@ let new_inductive () =
         ~packing:(vbox#pack ~expand:true ~padding:0) () in
       let newinputt =
        TexTermEditor'.term_editor
+        mqi_handle
         ~width:400 ~height:20 ~packing:scrolled_window#add 
         ~share_id_to_uris_with:inputt ()
         ~isnotempty_callback:
@@ -1365,6 +1364,7 @@ let new_inductive () =
         ~packing:(vbox#pack ~expand:true ~padding:0) () in
       let newinputt =
        TexTermEditor'.term_editor
+        mqi_handle
         ~width:400 ~height:20 ~packing:scrolled_window#add
         ~share_id_to_uris_with:inputt ()
         ~isnotempty_callback:
@@ -1508,7 +1508,9 @@ let new_proof () =
    ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
  (* moved here to have visibility of the ok button *)
  let newinputt =
-  TexTermEditor'.term_editor ~width:400 ~height:100 ~packing:scrolled_window#add
+  TexTermEditor'.term_editor
+   mqi_handle
+   ~width:400 ~height:100 ~packing:scrolled_window#add
    ~share_id_to_uris_with:inputt ()
    ~isnotempty_callback:
     (function b ->
@@ -1516,7 +1518,12 @@ let new_proof () =
       okb#misc#set_sensitive (b && uri_entry#text <> ""))
  in
  let _ =
+let xxx = inputt#get_as_string in
+prerr_endline ("######################## " ^ xxx) ;
+  newinputt#set_term xxx ;
+(*
   newinputt#set_term inputt#get_as_string ;
+*)
   inputt#reset in
  let _ =
   uri_entry#connect#changed
@@ -1565,7 +1572,6 @@ let new_proof () =
      !save_set_sensitive true ;
      inputt#reset ;
      ProofEngine.intros ~mk_fresh_name_callback () ;
-     Hbugs'.notify ();
      refresh_goals notebook ;
      refresh_proof output
   with
@@ -1924,7 +1930,7 @@ let completeSearchPattern () =
    let metasenv,expr = inputt#get_metasenv_and_term ~context:[] ~metasenv:[] in
    let must = MQueryLevels2.get_constraints expr in
    let must',only = refine_constraints must in
-   let results = MQueryGenerator.searchPattern must' only in 
+   let results = MQueryGenerator.searchPattern mqi_handle must' only in 
     show_query_results results
   with
    e ->
@@ -1991,7 +1997,7 @@ let insertQuery () =
       None -> ()
     | Some q ->
        let results =
-        Mqint.execute (MQueryUtil.query_of_text (Lexing.from_string q))
+        MQI.execute mqi_handle (MQueryUtil.query_of_text (Lexing.from_string q))
        in
         show_query_results results
   with
@@ -2139,6 +2145,7 @@ let searchPattern () =
       | Some metano ->
          let uris' =
            TacticChaser.searchPattern
+           mqi_handle
             ~output_html:(output_html outputhtml) ~choose_must ()
             ~status:(proof, metano)
          in
@@ -2748,7 +2755,7 @@ class rendering_window output (notebook : notebook) =
  let factory6 = new GMenu.factory hbugs_menu ~accel_group in
  let toggle_hbugs_menu_item =
   factory6#add_check_item
-    ~active:false ~key:GdkKeysyms._F5 ~callback:Hbugs'.toggle "HBugs enabled"
+    ~active:false ~key:GdkKeysyms._F5 ~callback:Hbugs.toggle "HBugs enabled"
  in
  (* settings menu *)
  let settings_menu = factory0#add_submenu "Settings" in
@@ -2780,6 +2787,7 @@ class rendering_window output (notebook : notebook) =
    ~packing:frame#add () in
  let inputt =
   TexTermEditor'.term_editor
+   mqi_handle
    ~width:400 ~height:100 ~packing:scrolled_window1#add ()
    ~isnotempty_callback:
     (function b ->
@@ -2843,21 +2851,15 @@ let initialize_everything () =
      Gdome_xslt.setDebugCallback
       (Some (print_error_as_html "XSLT Debug Message: "));
      rendering_window'#show () ;
-(*      Hbugs'.toggle true; *)
+(*      Hbugs.toggle true; *)
      GtkThread.main ()
 ;;
 
 let main () =
- if !usedb then
-  begin
-   Mqint.set_database Mqint.postgres_db ;
-   Mqint.init postgresqlconnectionstring ;
-  end ;
  ignore (GtkMain.Main.init ()) ;
  initialize_everything () ;
- if !usedb then Mqint.close ();
- prerr_endline "FOO";
- Hbugs'.quit ()
+ MQIC.close mqi_handle;
+ Hbugs.quit ()
 ;;
 
 try