]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/gTopLevel/gTopLevel.ml
1. helmns and domImpl moved to the misc module ;-(
[helm.git] / helm / gTopLevel / gTopLevel.ml
index 06f72d5502746765b8abcacbf5f57f74f5898e1b..4bef88816c302adba3a353cdaf3f1274f0f30e15 100644 (file)
@@ -36,7 +36,6 @@
 
 (* GLOBAL CONSTANTS *)
 
-let helmns = Gdome.domString "http://www.cs.unibo.it/helm";;
 let xlinkns = Gdome.domString "http://www.w3.org/1999/xlink";;
 
 let htmlheader =
@@ -86,9 +85,6 @@ let postgresqlconnectionstring =
   Not_found -> "host=mowgli.cs.unibo.it dbname=helm_mowgli_new_schema user=helm"
 ;;
 
-let empty_id_to_uris = ([],function _ -> None);;
-
-
 (* GLOBAL REFERENCES (USED BY CALLBACKS) *)
 
 let htmlheader_and_content = ref htmlheader;;
@@ -97,8 +93,6 @@ let current_cic_infos = ref None;;
 let current_goal_infos = ref None;;
 let current_scratch_infos = ref None;;
 
-let id_to_uris = ref empty_id_to_uris;;
-
 let check_term = ref (fun _ _ _ -> assert false);;
 let mml_of_cic_term_ref = ref (fun _ _ -> assert false);;
 
@@ -221,7 +215,7 @@ let check_window outputhtml uris =
         let expr =
          let term =
           term_of_cic_textual_parser_uri
-           (Disambiguate.cic_textual_parser_uri_of_string uri)
+           (Misc.cic_textual_parser_uri_of_string uri)
          in
           (Cic.Cast (term, CicTypeChecker.type_of_aux' [] [] term))
         in
@@ -418,89 +412,6 @@ let get_last_query =
   function result -> !query ^ " <h1>Result:</h1> " ^ MQueryUtil.text_of_result result "<br>"
 ;;
 
-let domImpl = Gdome.domImplementation ();;
-
-let parseStyle name =
- let style =
-  domImpl#createDocumentFromURI
-(*
-   ~uri:("http://phd.cs.unibo.it:8081/getxslt?uri=" ^ name) ?mode:None
-*)
-   ~uri:("styles/" ^ name) ()
- in
-  Gdome_xslt.processStylesheet style
-;;
-
-let d_c = parseStyle "drop_coercions.xsl";;
-let tc1 = parseStyle "objtheorycontent.xsl";;
-let hc2 = parseStyle "content_to_html.xsl";;
-let l   = parseStyle "link.xsl";;
-
-let c1 = parseStyle "rootcontent.xsl";;
-let g  = parseStyle "genmmlid.xsl";;
-let c2 = parseStyle "annotatedpres.xsl";;
-
-
-let getterURL = Configuration.getter_url;;
-let processorURL = Configuration.processor_url;;
-
-let mml_styles = [d_c ; c1 ; g ; c2 ; l];;
-let mml_args ~explode_all =
- ("explodeall",(if explode_all then "true()" else "false()"))::
-  ["processorURL", "'" ^ processorURL ^ "'" ;
-   "getterURL", "'" ^ getterURL ^ "'" ;
-   "draw_graphURL", "'http%3A//phd.cs.unibo.it%3A8083/'" ;
-   "uri_set_queueURL", "'http%3A//phd.cs.unibo.it%3A8084/'" ;
-   "UNICODEvsSYMBOL", "'symbol'" ;
-   "doctype-public", "'-//W3C//DTD%20XHTML%201.0%20Transitional//EN'" ;
-   "encoding", "'iso-8859-1'" ;
-   "media-type", "'text/html'" ;
-   "keys", "'d_c%2CC1%2CG%2CC2%2CL'" ;
-   "interfaceURL", "'http%3A//phd.cs.unibo.it/helm/html/cic/index.html'" ;
-   "naturalLanguage", "'yes'" ;
-   "annotations", "'no'" ;
-   "URLs_or_URIs", "'URIs'" ;
-   "topurl", "'http://phd.cs.unibo.it/helm'" ;
-   "CICURI", "'cic:/Coq/Init/Datatypes/bool_ind.con'" ]
-;;
-
-let sequent_styles = [d_c ; c1 ; g ; c2 ; l];;
-let sequent_args =
- ["processorURL", "'" ^ processorURL ^ "'" ;
-  "getterURL", "'" ^ getterURL ^ "'" ;
-  "draw_graphURL", "'http%3A//phd.cs.unibo.it%3A8083/'" ;
-  "uri_set_queueURL", "'http%3A//phd.cs.unibo.it%3A8084/'" ;
-  "UNICODEvsSYMBOL", "'symbol'" ;
-  "doctype-public", "'-//W3C//DTD%20XHTML%201.0%20Transitional//EN'" ;
-  "encoding", "'iso-8859-1'" ;
-  "media-type", "'text/html'" ;
-  "keys", "'d_c%2CC1%2CG%2CC2%2CL'" ;
-  "interfaceURL", "'http%3A//phd.cs.unibo.it/helm/html/cic/index.html'" ;
-  "naturalLanguage", "'no'" ;
-  "annotations", "'no'" ;
-  "explodeall", "true()" ;
-  "URLs_or_URIs", "'URIs'" ;
-  "topurl", "'http://phd.cs.unibo.it/helm'" ;
-  "CICURI", "'cic:/Coq/Init/Datatypes/bool_ind.con'" ]
-;;
-
-let parse_file filename =
- let inch = open_in filename in
-  let rec read_lines () =
-   try
-    let line = input_line inch in
-     line ^ read_lines ()
-   with
-    End_of_file -> ""
-  in
-   read_lines ()
-;;
-
-let applyStylesheets input styles args =
- List.fold_left (fun i style -> Gdome_xslt.applyStylesheet i style args)
-  input styles
-;;
-
 let
  mml_of_cic_object ~explode_all uri annobj ids_to_inner_sorts ids_to_inner_types
 =
@@ -515,16 +426,16 @@ let
  in
   let input =
    match bodyxml with
-      None -> Xml2Gdome.document_of_xml domImpl xml
+      None -> Xml2Gdome.document_of_xml Misc.domImpl xml
     | Some bodyxml' ->
        Xml.pp xml (Some constanttypefile) ;
-       Xml2Gdome.document_of_xml domImpl bodyxml'
+       Xml2Gdome.document_of_xml Misc.domImpl bodyxml'
   in
 (*CSC: We save the innertypes to disk so that we can retrieve them in the  *)
 (*CSC: stylesheet. This DOES NOT work when UWOBO and/or the getter are not *)
 (*CSC: local.                                                              *)
    Xml.pp xmlinnertypes (Some innertypesfile) ;
-   let output = applyStylesheets input mml_styles (mml_args ~explode_all) in
+   let output = ApplyStylesheets.apply_proof_stylesheets input ~explode_all in
     output
 ;;
 
@@ -652,9 +563,10 @@ let refresh_sequent ?(empty_notebook=true) notebook =
            end
           else
            begin
-            let sequent_doc = Xml2Gdome.document_of_xml domImpl sequent_gdome in
+            let sequent_doc =
+             Xml2Gdome.document_of_xml Misc.domImpl sequent_gdome in
             let sequent_mml =
-             applyStylesheets sequent_doc sequent_styles sequent_args
+             ApplyStylesheets.apply_sequent_stylesheets sequent_doc
             in
              notebook#set_current_page ~may_skip_switch_page_event:true metano;
              notebook#proofw#load_doc ~dom:sequent_mml
@@ -704,11 +616,9 @@ let mml_of_cic_term metano term =
     SequentPp.XmlPp.print_sequent metasenv (metano,context,term)
    in
     let sequent_doc =
-     Xml2Gdome.document_of_xml domImpl sequent_gdome
+     Xml2Gdome.document_of_xml Misc.domImpl sequent_gdome
     in
-     let res =
-      applyStylesheets sequent_doc sequent_styles sequent_args ;
-     in
+     let res = ApplyStylesheets.apply_sequent_stylesheets sequent_doc in
       current_scratch_infos :=
        Some (term,ids_to_terms,ids_to_father_ids,ids_to_hypotheses) ;
       res
@@ -868,6 +778,8 @@ let load () =
 ;;
 
 let edit_aliases () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
+ let id_to_uris = inputt#id_to_uris in
  let chosen = ref false in
  let window =
   GWindow.window
@@ -926,7 +838,7 @@ let edit_aliases () =
        let n' = Str.search_forward regexpr inputtext n in
         let id = Str.matched_group 2 inputtext in
         let uri =
-         Disambiguate.cic_textual_parser_uri_of_string
+         Misc.cic_textual_parser_uri_of_string
           ("cic:" ^ (Str.matched_group 5 inputtext))
         in
          let dom,resolve_id = aux (n' + 1) in
@@ -936,11 +848,11 @@ let edit_aliases () =
            id::dom,
             (function id' -> if id = id' then Some uri else resolve_id id')
       with
-       Not_found -> empty_id_to_uris
+       Not_found -> TermEditor.empty_id_to_uris
      in
       aux 0
    in
-    id_to_uris := dom,resolve_id
+    id_to_uris := (dom,resolve_id)
 ;;
 
 let proveit () =
@@ -956,7 +868,7 @@ let proveit () =
       (*CSC: OCAML DIVERGE
       ((element : G.element)#getAttributeNS
       *)
-        ~namespaceURI:helmns
+        ~namespaceURI:Misc.helmns
         ~localName:(G.domString "xref"))#to_string
      in
       if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
@@ -998,7 +910,7 @@ let focus () =
       (*CSC: OCAML DIVERGE
       ((element : G.element)#getAttributeNS
       *)
-        ~namespaceURI:helmns
+        ~namespaceURI:Misc.helmns
         ~localName:(G.domString "xref"))#to_string
      in
       if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
@@ -1127,7 +1039,7 @@ let locate_callback id =
  let uris =
   List.map
    (function uri,_ ->
-     Disambiguate.wrong_xpointer_format_from_wrong_xpointer_format' uri)
+     Misc.wrong_xpointer_format_from_wrong_xpointer_format' uri)
    result in
  let html =
   (" <h1>Locate Query: </h1><pre>" ^ get_last_query result ^ "</pre>")
@@ -1261,53 +1173,12 @@ module Callbacks =
  end
 ;;
 
-module Disambiguate' = Disambiguate.Make(Callbacks);;
-
-class term_editor ?packing ?width ?height ?isnotempty_callback () =
- let input = GEdit.text ~editable:true ?width ?height ?packing () in
- let _ =
-  match isnotempty_callback with
-     None -> ()
-   | Some callback ->
-      ignore(input#connect#changed (function () -> callback (input#length > 0)))
- in
-object(self)
- method coerce = input#coerce
- method reset =
-  input#delete_text 0 input#length
- (* CSC: txt is now a string, but should be of type Cic.term *)
- method set_term txt =
-  self#reset ;
-  ignore ((input#insert_text txt) ~pos:0)
- (* CSC: this method should disappear *)
- method get_as_string =
-  input#get_chars 0 input#length
- method get_metasenv_and_term ~context ~metasenv =
-  let name_context =
-   List.map
-    (function
-        Some (n,_) -> Some n
-      | None -> None
-    ) context
-  in
-   let lexbuf = Lexing.from_string (input#get_chars 0 input#length) in
-    let dom,mk_metasenv_and_expr =
-     CicTextualParserContext.main
-      ~context:name_context ~metasenv CicTextualLexer.token lexbuf
-    in
-     let id_to_uris',metasenv,expr =
-      Disambiguate'.disambiguate_input context metasenv dom mk_metasenv_and_expr
-       ~id_to_uris:!id_to_uris
-     in
-      id_to_uris := id_to_uris' ;
-      metasenv,expr
-end
-;;
+module TermEditor' = TermEditor.Make(Callbacks);;
 
 (* OTHER FUNCTIONS *)
 
 let locate () =
- let inputt = ((rendering_window ())#inputt : term_editor) in
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
  let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
    try
     match
@@ -1328,6 +1199,7 @@ exception UriAlreadyInUse;;
 exception NotAUriToAConstant;;
 
 let new_inductive () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
  let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
  let output = ((rendering_window ())#output : GMathViewAux.single_selection_math_view) in
  let notebook = (rendering_window ())#notebook in
@@ -1447,7 +1319,9 @@ let new_inductive () =
        GBin.scrolled_window ~border_width:5
         ~packing:(vbox#pack ~expand:true ~padding:0) () in
       let newinputt =
-       new term_editor ~width:400 ~height:20 ~packing:scrolled_window#add ()
+       TermEditor'.term_editor
+        ~width:400 ~height:20 ~packing:scrolled_window#add 
+        ~share_id_to_uris_with:inputt ()
         ~isnotempty_callback:
          (function b ->
            (*non_empty_type := b ;*)
@@ -1556,7 +1430,9 @@ let new_inductive () =
        GBin.scrolled_window ~border_width:5
         ~packing:(vbox#pack ~expand:true ~padding:0) () in
       let newinputt =
-       new term_editor ~width:400 ~height:20 ~packing:scrolled_window#add ()
+       TermEditor'.term_editor
+        ~width:400 ~height:20 ~packing:scrolled_window#add
+        ~share_id_to_uris_with:inputt ()
         ~isnotempty_callback:
          (function b ->
            (* (*non_empty_type := b ;*)
@@ -1669,7 +1545,7 @@ let mk_fresh_name_callback context name ~typ =
 ;;
 
 let new_proof () =
- let inputt = ((rendering_window ())#inputt : term_editor) in
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
  let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
  let output = ((rendering_window ())#output : GMathViewAux.single_selection_math_view) in
  let notebook = (rendering_window ())#notebook in
@@ -1714,7 +1590,8 @@ let new_proof () =
    ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
  (* moved here to have visibility of the ok button *)
  let newinputt =
-  new term_editor ~width:400 ~height:100 ~packing:scrolled_window#add ()
+  TermEditor'.term_editor ~width:400 ~height:100 ~packing:scrolled_window#add
+   ~share_id_to_uris_with:inputt ()
    ~isnotempty_callback:
     (function b ->
       non_empty_type := b ;
@@ -1799,7 +1676,7 @@ let check_term_in_scratch scratch_window metasenv context expr =
 ;;
 
 let check scratch_window () =
- let inputt = ((rendering_window ())#inputt : term_editor) in
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
  let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
   let metasenv =
    match !ProofEngine.proof with
@@ -1829,7 +1706,7 @@ let decompose_uris_choice_callback uris =
   let module U = UriManager in 
    List.map 
     (function uri ->
-      match Disambiguate.cic_textual_parser_uri_of_string uri with
+      match Misc.cic_textual_parser_uri_of_string uri with
          CicTextualParser0.IndTyUri (uri,typeno) -> (uri,typeno,[])
        | _ -> assert false)
     (interactive_user_uri_choice 
@@ -1885,7 +1762,7 @@ let call_tactic_with_input tactic () =
  let notebook = (rendering_window ())#notebook in
  let output = ((rendering_window ())#output : GMathViewAux.single_selection_math_view) in
  let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
- let inputt = ((rendering_window ())#inputt : term_editor) in
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
  let savedproof = !ProofEngine.proof in
  let savedgoal  = !ProofEngine.goal in
   let uri,metasenv,bo,ty =
@@ -1946,7 +1823,7 @@ let call_tactic_with_goal_input tactic () =
      [node] ->
       let xpath =
        ((node : Gdome.element)#getAttributeNS
-         ~namespaceURI:helmns
+         ~namespaceURI:Misc.helmns
          ~localName:(G.domString "xref"))#to_string
       in
        if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
@@ -2003,7 +1880,7 @@ let call_tactic_with_goal_inputs tactic () =
     let term_of_node node =
      let xpath =
       ((node : Gdome.element)#getAttributeNS
-        ~namespaceURI:helmns
+        ~namespaceURI:Misc.helmns
         ~localName:(G.domString "xref"))#to_string
      in
       if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
@@ -2055,14 +1932,14 @@ let call_tactic_with_input_and_goal_input tactic () =
   let notebook = (rendering_window ())#notebook in
   let output = ((rendering_window ())#output : GMathViewAux.single_selection_math_view) in
   let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
-  let inputt = ((rendering_window ())#inputt : term_editor) in
+  let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
   let savedproof = !ProofEngine.proof in
   let savedgoal  = !ProofEngine.goal in
    match notebook#proofw#get_selections with
      [node] ->
       let xpath =
        ((node : Gdome.element)#getAttributeNS
-         ~namespaceURI:helmns
+         ~namespaceURI:Misc.helmns
          ~localName:(G.domString "xref"))#to_string
       in
        if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
@@ -2137,7 +2014,7 @@ let call_tactic_with_goal_input_in_scratch tactic scratch_window () =
      [node] ->
       let xpath =
        ((node : Gdome.element)#getAttributeNS
-         ~namespaceURI:helmns
+         ~namespaceURI:Misc.helmns
          ~localName:(G.domString "xref"))#to_string
       in
        if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
@@ -2186,7 +2063,7 @@ let call_tactic_with_goal_inputs_in_scratch tactic scratch_window () =
             let term_of_node node =
              let xpath =
               ((node : Gdome.element)#getAttributeNS
-                ~namespaceURI:helmns
+                ~namespaceURI:Misc.helmns
                 ~localName:(G.domString "xref"))#to_string
              in
               if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
@@ -2218,7 +2095,7 @@ let call_tactic_with_hypothesis_input tactic () =
      [node] ->
       let xpath =
        ((node : Gdome.element)#getAttributeNS
-         ~namespaceURI:helmns
+         ~namespaceURI:Misc.helmns
          ~localName:(G.domString "xref"))#to_string
       in
        if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
@@ -2396,8 +2273,8 @@ let show_query_results results =
      (fun ~row ~column ~event ->
        let (uristr,_) = List.nth results row in
         match
-         Disambiguate.cic_textual_parser_uri_of_string
-          (Disambiguate.wrong_xpointer_format_from_wrong_xpointer_format'
+         Misc.cic_textual_parser_uri_of_string
+          (Misc.wrong_xpointer_format_from_wrong_xpointer_format'
             uristr)
         with
            CicTextualParser0.ConUri uri
@@ -2615,7 +2492,7 @@ let refine_constraints (must_obj,must_rel,must_sort) =
 ;;
 
 let completeSearchPattern () =
- let inputt = ((rendering_window ())#inputt : term_editor) in
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
  let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
   try
    let metasenv,expr = inputt#get_metasenv_and_term ~context:[] ~metasenv:[] in
@@ -2823,7 +2700,7 @@ let choose_must list_of_must only =
 ;;
 
 let searchPattern () =
- let inputt = ((rendering_window ())#inputt : term_editor) in
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
  let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
   try
     let metasenv =
@@ -2854,7 +2731,7 @@ let searchPattern () =
           let uris =
            List.map
             (function uri,_ ->
-              Disambiguate.wrong_xpointer_format_from_wrong_xpointer_format' uri
+              Misc.wrong_xpointer_format_from_wrong_xpointer_format' uri
             ) result in
           let html =
            " <h1>Backward Query: </h1>" ^
@@ -2871,7 +2748,7 @@ let searchPattern () =
                    if
                     ProofEngine.can_apply
                      (term_of_cic_textual_parser_uri
-                      (Disambiguate.cic_textual_parser_uri_of_string uri))
+                      (Misc.cic_textual_parser_uri_of_string uri))
                    then
                     uri::tl',exc
                    else
@@ -2913,7 +2790,7 @@ let choose_selection mmlwidget (element : Gdome.element option) =
  let module G = Gdome in
   let rec aux element =
    if element#hasAttributeNS
-       ~namespaceURI:helmns
+       ~namespaceURI:Misc.helmns
        ~localName:(G.domString "xref")
    then
      mmlwidget#set_selection (Some element)
@@ -3501,7 +3378,8 @@ class rendering_window output (notebook : notebook) =
   GBin.scrolled_window ~border_width:5
    ~packing:frame#add () in
  let inputt =
-  new term_editor ~width:400 ~height:100 ~packing:scrolled_window1#add ()
+  TermEditor'.term_editor
+   ~width:400 ~height:100 ~packing:scrolled_window1#add ()
    ~isnotempty_callback:
     (function b ->
       check_menu_item#misc#set_sensitive b ;