]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/matita/matitaMathView.ml
New version.
[helm.git] / helm / software / matita / matitaMathView.ml
index d8c02af44df108cbc2afc2cc1cdf7a23177f85cf..f57dc4d320824cd2e67fb213a5368c5dd596c16a 100644 (file)
@@ -65,9 +65,11 @@ let near (x1, y1) (x2, y2) =
   let distance = sqrt (((x2 -. x1) ** 2.) +. ((y2 -. y1) ** 2.)) in
   (distance < 4.)
 
+let mathml_ns = Gdome.domString "http://www.w3.org/1998/Math/MathML"
 let xlink_ns = Gdome.domString "http://www.w3.org/1999/xlink"
 let helm_ns = Gdome.domString "http://www.cs.unibo.it/helm"
 let href_ds = Gdome.domString "href"
+let maction_ds = Gdome.domString "maction"
 let xref_ds = Gdome.domString "xref"
 
 let domImpl = Gdome.domImplementation ()
@@ -163,6 +165,18 @@ let hrefs_of_elt elt =
   else
     None
 
+let rec has_maction (elt :Gdome.element) = 
+  (* fix this comparison *)
+  if elt#get_tagName#to_string = "m:maction" ||
+   elt#get_tagName#to_string = "b:action" then
+    true
+  else 
+    match elt#get_parentNode with
+    | Some node when node#get_nodeType = GdomeNodeTypeT.ELEMENT_NODE -> 
+        has_maction (new Gdome.element_of_node node)
+    | _ -> false
+;;
+
 class clickableMathView obj =
 let text_width = 80 in
 object (self)
@@ -176,7 +190,8 @@ object (self)
   method private cic_info = _cic_info
 
   val normal_cursor = Gdk.Cursor.create `LEFT_PTR
-  val href_cursor = Gdk.Cursor.create `HAND1
+  val href_cursor = Gdk.Cursor.create `HAND2
+  val maction_cursor = Gdk.Cursor.create `QUESTION_ARROW
 
   initializer
     self#set_font_size !current_font_size;
@@ -221,7 +236,11 @@ object (self)
       button_press_y <- GdkEvent.Button.y gdk_button;
       selection_changed <- false
     end else if button = right_button then
-      self#popup_contextual_menu (GdkEvent.Button.time gdk_button);
+      self#popup_contextual_menu 
+        (self#get_element_at 
+          (int_of_float (GdkEvent.Button.x gdk_button)) 
+          (int_of_float (GdkEvent.Button.y gdk_button)))  
+        (GdkEvent.Button.time gdk_button);
     false
 
   method private element_over_cb (elt_opt, _, _, _) =
@@ -233,6 +252,9 @@ object (self)
     in
     match elt_opt with
     | Some elt ->
+        if has_maction elt then
+          Gdk.Window.set_cursor (win ()) maction_cursor
+        else
         (match hrefs_of_elt elt with
         | Some ((_ :: _) as hrefs) ->
             Gdk.Window.set_cursor (win ()) href_cursor;
@@ -274,22 +296,36 @@ object (self)
     | [] -> assert false (* this method is invoked only if there's a sel. *)
     | node :: _ -> self#tactic_text_pattern_of_node node
 
-  method private popup_contextual_menu time =
+  method private popup_contextual_menu element time =
     let menu = GMenu.menu () in
     let add_menu_item ?(menu = menu) ?stock ?label () =
       GMenu.image_menu_item ?stock ?label ~packing:menu#append () in
     let check = add_menu_item ~label:"Check" () in
     let reductions_menu_item = GMenu.menu_item ~label:"βδιζ-reduce" () in
     let tactics_menu_item = GMenu.menu_item ~label:"Apply tactic" () in
+    let hyperlinks_menu_item = GMenu.menu_item ~label:"Hyperlinks" () in
     menu#append reductions_menu_item;
     menu#append tactics_menu_item;
+    menu#append hyperlinks_menu_item;
     let reductions = GMenu.menu () in
     let tactics = GMenu.menu () in
+    let hyperlinks = GMenu.menu () in
     reductions_menu_item#set_submenu reductions;
     tactics_menu_item#set_submenu tactics;
+    hyperlinks_menu_item#set_submenu hyperlinks;
     let normalize = add_menu_item ~menu:reductions ~label:"Normalize" () in
     let simplify = add_menu_item ~menu:reductions ~label:"Simplify" () in
     let whd = add_menu_item ~menu:reductions ~label:"Weak head" () in
+    (match element with 
+    | None -> hyperlinks_menu_item#misc#set_sensitive false
+    | Some elt -> 
+        match hrefs_of_elt elt, href_callback with
+        | Some l, Some f ->
+            List.iter 
+              (fun h ->
+                let item = add_menu_item ~menu:hyperlinks ~label:h () in
+                connect_menu_item item (fun () -> f h)) l
+        | _ -> hyperlinks_menu_item#misc#set_sensitive false);
     menu#append (GMenu.separator_item ());
     let copy = add_menu_item ~stock:`COPY () in
     let gui = get_gui () in
@@ -329,9 +365,10 @@ object (self)
           (match self#get_element_at x y with
           | None -> ()
           | Some elt ->
+              if has_maction elt then ignore(self#action_toggle elt) else
               (match hrefs_of_elt elt with
               | Some hrefs -> self#invoke_href_callback hrefs gdk_button
-              | None -> ignore (self#action_toggle elt)))
+              | None -> ()))
     end;
     false
 
@@ -814,6 +851,29 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
     win#queryInputText#set_text input;
     combo#set_active (aux 0 queries);
   in
+  let searchText = 
+    GSourceView.source_view ~auto_indent:false ~editable:false ()
+  in
+  let _ =
+     win#scrolledwinContent#add (searchText :> GObj.widget);
+     let callback () = 
+       let text = win#entrySearch#text in
+       let highlight start end_ =
+         searchText#source_buffer#move_mark `INSERT ~where:start;
+         searchText#source_buffer#move_mark `SEL_BOUND ~where:end_;
+         searchText#scroll_mark_onscreen `INSERT
+       in
+       let iter = searchText#source_buffer#get_iter `SEL_BOUND in
+       match iter#forward_search text with
+       | None -> 
+           (match searchText#source_buffer#start_iter#forward_search text with
+           | None -> ()
+           | Some (start,end_) -> highlight start end_)
+       | Some (start,end_) -> highlight start end_
+     in
+     ignore(win#entrySearch#connect#activate ~callback);
+     ignore(win#buttonSearch#connect#clicked ~callback);
+  in
   let set_whelp_query txt =
     let query, arg = 
       try
@@ -890,8 +950,8 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       win#mathOrListNotebook#set_show_tabs false;
       win#browserForwardButton#misc#set_sensitive false;
       win#browserBackButton#misc#set_sensitive false;
-      ignore (win#browserUri#entry#connect#activate (handle_error' (fun () ->
-        self#loadInput win#browserUri#entry#text)));
+      ignore (win#browserUri#connect#activate (handle_error' (fun () ->
+        self#loadInput win#browserUri#text)));
       ignore (win#browserHomeButton#connect#clicked (handle_error' (fun () ->
         self#load (`About `Current_proof))));
       ignore (win#browserRefreshButton#connect#clicked
@@ -926,6 +986,10 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
         match self#currentCicUri with
         | Some uri -> self#load (`Metadata (`Deps (`Back, uri)))
         | None -> ());
+      connect_menu_item win#browserCloseMenuItem (fun () ->
+        let my_id = Oo.id self in
+        cicBrowsers := List.filter (fun b -> Oo.id b <> my_id) !cicBrowsers;
+        win#toplevel#misc#hide(); win#toplevel#destroy ());
       (* remove hbugs *)
       (*
       connect_menu_item win#hBugsTutorsMenuItem (fun () ->
@@ -933,7 +997,7 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       *)
       win#hBugsTutorsMenuItem#misc#hide ();
       connect_menu_item win#browserUrlMenuItem (fun () ->
-        win#browserUri#entry#misc#grab_focus ());
+        win#browserUri#misc#grab_focus ());
       connect_menu_item win#univMenuItem (fun () ->
         match self#currentCicUri with
         | Some uri -> self#load (`Univs uri)
@@ -1018,6 +1082,7 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
     method private _showMath = win#mathOrListNotebook#goto_page  0
     method private _showList = win#mathOrListNotebook#goto_page  1
     method private _showList2 = win#mathOrListNotebook#goto_page 5
+    method private _showSearch = win#mathOrListNotebook#goto_page 6
     method private _showGviz = win#mathOrListNotebook#goto_page  3
     method private _showHBugs = win#mathOrListNotebook#goto_page 4
 
@@ -1044,6 +1109,8 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
           | `About `Us -> self#egg ()
           | `About `CoercionsFull -> self#coerchgraph false ()
           | `About `Coercions -> self#coerchgraph true ()
+          | `About `TeX -> self#tex ()
+          | `About `Grammar -> self#grammar () 
           | `Check term -> self#_loadCheck term
           | `Cic (term, metasenv) -> self#_loadTermCic term metasenv
           | `Dir dir -> self#_loadDir dir
@@ -1072,15 +1139,21 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       Lazy.force load_easter_egg
 
     method private redraw_gviz ?center_on () =
-      let tmpfile, oc = Filename.open_temp_file "matita" ".dot" in
-      let fmt = Format.formatter_of_out_channel oc in
-      MetadataDeps.DepGraph.render fmt gviz_graph;
-      close_out oc;
-      gviz#load_graph_from_file ~gviz_cmd:"tred | dot" tmpfile;
-      (match center_on with
-      | None -> ()
-      | Some uri -> gviz#center_on_href (UriManager.string_of_uri uri));
-      HExtlib.safe_remove tmpfile
+      if Sys.command "which dot" = 0 then
+       let tmpfile, oc = Filename.open_temp_file "matita" ".dot" in
+       let fmt = Format.formatter_of_out_channel oc in
+       MetadataDeps.DepGraph.render fmt gviz_graph;
+       close_out oc;
+       gviz#load_graph_from_file ~gviz_cmd:"tred | dot" tmpfile;
+       (match center_on with
+       | None -> ()
+       | Some uri -> gviz#center_on_href (UriManager.string_of_uri uri));
+       HExtlib.safe_remove tmpfile
+      else
+       MatitaGtkMisc.report_error ~title:"graphviz error"
+        ~message:("Graphviz is not installed but is necessary to render "^
+         "the graph of dependencies amoung objects. Please install it.")
+        ~parent:win#toplevel ()
 
     method private dependencies direction uri () =
       let dbd = LibraryDb.instance () in
@@ -1096,16 +1169,55 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       load_coerchgraph tred ();
       self#_showGviz
 
+    method private tex () =
+      let b = Buffer.create 1000 in
+      Printf.bprintf b "UTF-8 equivalence classes (rotate with ALT-L):\n\n";
+      List.iter 
+        (fun l ->
+           List.iter (fun sym ->
+             Printf.bprintf b "  %s" (Glib.Utf8.from_unichar sym) 
+           ) l;
+           Printf.bprintf b "\n";
+        )
+        (List.sort 
+          (fun l1 l2 -> compare (List.hd l1) (List.hd l2))
+          (Virtuals.get_all_eqclass ()));
+      Printf.bprintf b "\n\nVirtual keys (trigger with ALT-L):\n\n";
+      List.iter 
+        (fun tag, items -> 
+           Printf.bprintf b "  %s:\n" tag;
+           List.iter 
+             (fun names, symbol ->
+                Printf.bprintf b "  \t%s\t%s\n" 
+                  (Glib.Utf8.from_unichar symbol)
+                  (String.concat ", " names))
+             (List.sort 
+               (fun (_,a) (_,b) -> compare a b)
+               items);
+           Printf.bprintf b "\n")
+        (List.sort 
+          (fun (a,_) (b,_) -> compare a b)
+          (Virtuals.get_all_virtuals ()));
+      self#_loadText (Buffer.contents b)
+
+    method private _loadText text =
+      searchText#source_buffer#set_text text;
+      win#entrySearch#misc#grab_focus ();
+      self#_showSearch
+
+    method private grammar () =
+      self#_loadText (Print_grammar.ebnf_of_term ());
+
     method private home () =
       self#_showMath;
       match self#script#grafite_status.proof_status with
       | Proof  (uri, metasenv, _subst, bo, ty, attrs) ->
           let name = UriManager.name_of_uri (HExtlib.unopt uri) in
-          let obj = Cic.CurrentProof (name, metasenv, bo, ty, [], attrs) in
+          let obj = Cic.CurrentProof (name, metasenv, Lazy.force bo, ty, [], attrs) in
           self#_loadObj obj
       | Incomplete_proof { proof = (uri, metasenv, _subst, bo, ty, attrs) } ->
           let name = UriManager.name_of_uri (HExtlib.unopt uri) in
-          let obj = Cic.CurrentProof (name, metasenv, bo, ty, [], attrs) in
+          let obj = Cic.CurrentProof (name, metasenv, Lazy.force bo, ty, [], attrs) in
           self#_loadObj obj
       | _ -> self#blank ()
 
@@ -1146,7 +1258,7 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       self#_showHBugs
 
     method private setEntry entry =
-      win#browserUri#entry#set_text (MatitaTypes.string_of_entry entry);
+      win#browserUri#set_text (MatitaTypes.string_of_entry entry);
       current_entry <- entry
 
     method private _loadObj obj =