X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2FmatitaMathView.ml;h=486866013dc2ed7c4129f22399f4ba0473e8cf6e;hb=da415a61eb8ecfc58817196363fad86b35efe490;hp=6254829aa0c04bb2e00262065bdebb046e0d5861;hpb=ba8cc5139a92a95a1d743d052995c826d41cd543;p=helm.git

diff --git a/matita/matitaMathView.ml b/matita/matitaMathView.ml
index 6254829aa..486866013 100644
--- a/matita/matitaMathView.ml
+++ b/matita/matitaMathView.ml
@@ -154,10 +154,12 @@ type selected_term =
   | SelTerm of Cic.term * string option (* term, parent hypothesis (if any) *)
   | SelHyp of string * Cic.context (* hypothesis, context *)
 
-let href_of_elt elt =
+let hrefs_of_elt elt =
   let localName = href_ds in
   if elt#hasAttributeNS ~namespaceURI:xlink_ns ~localName then
-    Some (elt#getAttributeNS ~namespaceURI:xlink_ns ~localName)#to_string
+    let text =
+      (elt#getAttributeNS ~namespaceURI:xlink_ns ~localName)#to_string in
+    Some (HExtlib.split text)
   else
     None
 
@@ -175,7 +177,6 @@ object (self)
 
   val normal_cursor = Gdk.Cursor.create `LEFT_PTR
   val href_cursor = Gdk.Cursor.create `HAND1
-(*   val href_tooltips = GData.tooltips ~delay:1 () *)
 
   initializer
     self#set_font_size !current_font_size;
@@ -189,6 +190,9 @@ object (self)
   val mutable button_press_x = -1.
   val mutable button_press_y = -1.
   val mutable selection_changed = false
+  val mutable href_statusbar_msg:
+    (GMisc.statusbar_context * Gtk.statusbar_message) option = None
+    (* <statusbar ctxt, statusbar msg> *)
 
   method private selection_get_cb ctxt ~info ~time =
     let text =
@@ -224,33 +228,42 @@ object (self)
     let win () = self#misc#window in
     let leave_href () =
       Gdk.Window.set_cursor (win ()) normal_cursor;
-(*       href_tooltips#disable (); *)
+      HExtlib.iter_option (fun (ctxt, msg) -> ctxt#remove msg)
+        href_statusbar_msg
     in
     match elt_opt with
     | Some elt ->
-        (match href_of_elt elt with
-        | Some text ->
-(*             href_tooltips#enable ();
-            href_tooltips#set_tip ~text (self :> GObj.widget); *)
-            Gdk.Window.set_cursor (win ()) href_cursor
-        | None -> leave_href ())
+        (match hrefs_of_elt elt with
+        | Some ((_ :: _) as hrefs) ->
+            Gdk.Window.set_cursor (win ()) href_cursor;
+            let msg_text = (* now create statusbar msg and store it *)
+              match hrefs with
+              | [ href ] -> sprintf "Hyperlink to %s" href
+              | _ -> sprintf "Hyperlinks to: %s" (String.concat ", " hrefs) in
+            let ctxt = (get_gui ())#main#statusBar#new_context ~name:"href" in
+            let msg = ctxt#push msg_text in
+            href_statusbar_msg <- Some (ctxt, msg)
+        | _ -> leave_href ())
     | None -> leave_href ()
 
+
+  method private tactic_text_pattern_of_node node =
+   let id = id_of_node node in
+   let cic_info, unsh_sequent = self#get_cic_info id in
+   match self#get_term_by_id cic_info id with
+   | SelTerm (t, father_hyp) ->
+       let sequent = self#sequent_of_id ~paste_kind:`Pattern id in
+       let text = self#string_of_cic_sequent sequent in
+       (match father_hyp with
+       | None -> None, [], Some text
+       | Some hyp_name -> None, [ hyp_name, text ], None)
+   | SelHyp (hyp_name, _ctxt) -> None, [ hyp_name, "%" ], None
+
     (** @return a pattern structure which contains pretty printed terms *)
   method private tactic_text_pattern_of_selection =
     match self#get_selections with
     | [] -> assert false (* this method is invoked only if there's a sel. *)
-    | node :: _ ->
-        let id = id_of_node node in
-        let cic_info, unsh_sequent = self#get_cic_info id in
-        match self#get_term_by_id cic_info id with
-        | SelTerm (t, father_hyp) ->
-            let sequent = self#sequent_of_id ~paste_kind:`Pattern id in
-            let text = self#string_of_cic_sequent sequent in
-            (match father_hyp with
-            | None -> None, [], Some text
-            | Some hyp_name -> None, [ hyp_name, text ], None)
-        | SelHyp (hyp_name, _ctxt) -> None, [ hyp_name, "%" ], None
+    | node :: _ -> self#tactic_text_pattern_of_node node
 
   method private popup_contextual_menu time =
     let menu = GMenu.menu () in
@@ -258,9 +271,13 @@ object (self)
       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
     menu#append reductions_menu_item;
+    menu#append tactics_menu_item;
     let reductions = GMenu.menu () in
+    let tactics = GMenu.menu () in
     reductions_menu_item#set_submenu reductions;
+    tactics_menu_item#set_submenu tactics;
     let normalize = add_menu_item ~menu:reductions ~label:"Normalize" () in
     let reduce = add_menu_item ~menu:reductions ~label:"Reduce" () in
     let simplify = add_menu_item ~menu:reductions ~label:"Simplify" () in
@@ -303,20 +320,20 @@ object (self)
           (match self#get_element_at x y with
           | None -> ()
           | Some elt ->
-              (match href_of_elt elt with
-              | Some href -> self#invoke_href_callback href gdk_button
+              (match hrefs_of_elt elt with
+              | Some hrefs -> self#invoke_href_callback hrefs gdk_button
               | None -> ignore (self#action_toggle elt)))
     end;
     false
 
-  method private invoke_href_callback href_value gdk_button =
+  method private invoke_href_callback hrefs gdk_button =
     let button = GdkEvent.Button.button gdk_button in
     if button = left_button then
       let time = GdkEvent.Button.time gdk_button in
       match href_callback with
       | None -> ()
       | Some f ->
-          (match HExtlib.split href_value with
+          (match hrefs with
           | [ uri ] ->  f uri
           | uris ->
               let menu = GMenu.menu () in
@@ -324,7 +341,8 @@ object (self)
                 (fun uri ->
                   let menu_item =
                     GMenu.menu_item ~label:uri ~packing:menu#append () in
-                  connect_menu_item menu_item (fun () -> f uri))
+                  connect_menu_item menu_item 
+                  (fun () -> try f uri with Not_found -> assert false))
                 uris;
               menu#popup ~button ~time)
 
@@ -402,14 +420,17 @@ object (self)
   method private string_of_node ~(paste_kind:paste_kind) node =
     if node#hasAttributeNS ~namespaceURI:helm_ns ~localName:xref_ds
     then
-      let id = id_of_node node in
-      self#string_of_cic_sequent (self#sequent_of_id ~paste_kind id)
+     let tactic_text_pattern =  self#tactic_text_pattern_of_node node in
+      GrafiteAstPp.pp_tactic_pattern
+       ~term_pp:(fun s -> s) ~lazy_term_pp:(fun _ -> assert false)
+       tactic_text_pattern
     else string_of_dom_node node
 
   method private string_of_cic_sequent cic_sequent =
     let script = MatitaScript.current () in
     let metasenv =
       if script#onGoingProof () then script#proofMetasenv else [] in
+    (*
     let _, (acic_sequent, _, _, ids_to_inner_sorts, _) =
       Cic2acic.asequent_of_sequent metasenv cic_sequent in
     let _, _, _, annterm = acic_sequent in
@@ -418,6 +439,9 @@ object (self)
     let pped_ast = TermContentPres.pp_ast ast in
     let markup = CicNotationPres.render ids_to_uris pped_ast in
     BoxPp.render_to_string text_width markup
+    *)
+    ApplyTransformation.txt_of_cic_sequent_conclusion 
+      text_width metasenv cic_sequent
 
   method private pattern_of term context unsh_sequent =
     let context_len = List.length context in
@@ -547,8 +571,8 @@ end
 let tab_label meta_markup =
   let rec aux =
     function
-    | `Current m -> sprintf "<b>%s</b>" (aux m)
     | `Closed m -> sprintf "<s>%s</s>" (aux m)
+    | `Current m -> sprintf "<b>%s</b>" (aux m)
     | `Shift (pos, m) -> sprintf "|<sub>%d</sub>: %s" pos (aux m)
     | `Meta n -> sprintf "?%d" n
   in
@@ -670,7 +694,8 @@ class sequentsViewer ~(notebook:GPack.notebook) ~(cicMathView:cicMathView) () =
         ~env:(fun depth tag (pos, sw) ->
           let markup =
             match depth, pos with
-            | 0, _ -> `Current (render_switch sw)
+            | 0, 0 -> `Current (render_switch sw)
+            | 0, _ -> `Shift (pos, `Current (render_switch sw))
             | 1, pos when Stack.head_tag stack = `BranchTag ->
                 `Shift (pos, render_switch sw)
             | _ -> render_switch sw
@@ -750,7 +775,9 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       "^cic:/([^/]+/)*[^/]+\\.(con|ind|var)(#xpointer\\(\\d+(/\\d+)+\\))?$"
   in
   let dir_RE = Pcre.regexp "^cic:((/([^/]+/)*[^/]+(/)?)|/|)$" in
-  let whelp_query_RE = Pcre.regexp "^\\s*whelp\\s+([^\\s]+)\\s+(.*)$" in
+  let whelp_query_RE = Pcre.regexp
+    "^\\s*whelp\\s+([^\\s]+)\\s+(\"|\\()(.*)(\\)|\")$" 
+  in
   let is_whelp txt = Pcre.pmatch ~rex:whelp_RE txt in
   let is_uri txt = Pcre.pmatch ~rex:uri_RE txt in
   let is_dir txt = Pcre.pmatch ~rex:dir_RE txt in
@@ -765,17 +792,17 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       | h::_ when String.lowercase h = q' -> i
       | _::tl -> aux (i+1) tl
     in
+    win#queryInputText#set_text input;
     combo#set_active (aux 0 queries);
-    win#queryInputText#set_text input
   in
   let set_whelp_query txt =
     let query, arg = 
       try
         let q = Pcre.extract ~rex:whelp_query_RE txt in
-        q.(1), q.(2)
-      with Invalid_argument _ -> failwith "Malformed Whelp query"
+        q.(1), q.(3)
+      with Not_found -> failwith "Malformed Whelp query"
     in
-    activate_combo_query arg query
+    activate_combo_query arg query;
   in
   let toplevel = win#toplevel in
   let mathView = cicMathView ~packing:win#scrolledBrowser#add () in
@@ -787,17 +814,29 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
     [ "dir", GdkPixbuf.from_file (MatitaMisc.image_path "matita-folder.png");
       "obj", GdkPixbuf.from_file (MatitaMisc.image_path "matita-object.png") ]
   in
+  let b = (not (Helm_registry.get_bool "matita.debug")) in
   let handle_error f =
     try
       f ()
     with exn ->
-      if not (Helm_registry.get_bool "matita.debug") then
+      if b then
         fail (snd (MatitaExcPp.to_string exn))
       else raise exn
   in
   let handle_error' f = (fun () -> handle_error (fun () -> f ())) in
   let load_easter_egg = lazy (
-    win#easterEggImage#set_file (MatitaMisc.image_path "meegg.png"))
+    win#browserImage#set_file (MatitaMisc.image_path "meegg.png"))
+  in
+  let load_coerchgraph () = 
+      let str = CoercGraph.generate_dot_file () in
+      let filename, oc = Filename.open_temp_file "xx" ".dot" in
+      output_string oc str;
+      close_out oc;
+      let ps = Filename.temp_file "yy" ".png" in
+      ignore (Unix.system ("/usr/bin/dot -Tpng -o" ^ ps ^ " " ^ filename));
+      Sys.remove filename;
+      at_exit (fun _ -> Sys.remove ps);
+      win#browserImage#set_file ps
   in
   object (self)
     inherit scriptAccessor
@@ -808,9 +847,17 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       activate_combo_query "" "locate";
       win#whelpBarComboVbox#add combo#coerce;
       let start_query () = 
-        let query = String.lowercase (List.nth queries combo#active) in
-        let input = win#queryInputText#text in
-        let statement = "whelp " ^ query ^ " " ^ input ^ "." in
+       let query = 
+         try
+           String.lowercase (List.nth queries combo#active) 
+         with Not_found -> assert false in
+       let input = win#queryInputText#text in
+       let statement = 
+         if query = "locate" then
+             "whelp " ^ query ^ " \"" ^ input ^ "\"." 
+           else
+             "whelp " ^ query ^ " (" ^ input ^ ")." 
+       in
         (MatitaScript.current ())#advance ~statement ()
       in
       ignore(win#queryInputText#connect#activate ~callback:start_query);
@@ -905,12 +952,14 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       * @param uri string *)
     method private _load ?(force=false) entry =
       handle_error (fun () ->
-       if entry <> current_entry || entry = `About `Current_proof || force then
+       if entry <> current_entry || entry = `About `Current_proof || entry =
+         `About `Coercions || force then
         begin
           (match entry with
           | `About `Current_proof -> self#home ()
           | `About `Blank -> self#blank ()
           | `About `Us -> self#egg ()
+          | `About `Coercions -> self#coerchgraph ()
           | `Check term -> self#_loadCheck term
           | `Cic (term, metasenv) -> self#_loadTermCic term metasenv
           | `Dir dir -> self#_loadDir dir
@@ -934,6 +983,10 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
       win#mathOrListNotebook#goto_page 2;
       Lazy.force load_easter_egg
 
+    method private coerchgraph () =
+      win#mathOrListNotebook#goto_page 2;
+      load_coerchgraph ()
+
     method private home () =
       self#_showMath;
       match self#script#grafite_status.proof_status with