| 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
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;
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 =
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
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
(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
(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)
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
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
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
~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
"^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
| 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
[ "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
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);
* @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
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
projects / helm.git / blobdiff