LibraryMisc.obj_file_of_baseuri ~must_exist:false ~baseuri
~writable:true in
let save () =
- let metadata_fname =
- LibraryMisc.metadata_file_of_baseuri
- ~must_exist:false ~baseuri ~writable:true in
let lexicon_fname =
LibraryMisc.lexicon_file_of_baseuri
~must_exist:false ~baseuri ~writable:true
in
GrafiteMarshal.save_moo moo_fname
grafite_status.GrafiteTypes.moo_content_rev;
- LibraryNoDb.save_metadata metadata_fname
- lexicon_status.LexiconEngine.metadata;
LexiconMarshal.save_lexicon lexicon_fname
lexicon_status.LexiconEngine.lexicon_content_rev
in
(let loc_row = tree_store#append () in
begin
match lll with
- [passes,envs_and_diffs,_] ->
+ [passes,envs_and_diffs,_,_] ->
tree_store#set ~row:loc_row ~column:id_col
("Error location " ^ string_of_int (!idx1+1) ^
", error message " ^ string_of_int (!idx1+1) ^ ".1" ^
Some loc_row) in
let idx2 = ref ~-1 in
List.iter
- (fun passes,envs_and_diffs,_ ->
+ (fun passes,envs_and_diffs,_,_ ->
incr idx2;
let msg_row =
if List.length lll = 1 then
end
-let rec interactive_error_interp ?(all_passes=false) source_buffer notify_exn
- offset errorll
+let rec interactive_error_interp ?(all_passes=false) (source_buffer:GSourceView.source_buffer) notify_exn offset errorll
=
+ assert (List.flatten errorll <> []);
let errorll' =
- if all_passes then errorll else List.rev (List.tl (List.tl (List.rev errorll))) in
+ let remove_non_significant =
+ List.filter (fun (_env,_diff,_loc,_msg,significant) -> significant) in
+ let annotated_errorll () =
+ List.rev
+ (snd
+ (List.fold_left (fun (pass,res) item -> pass+1,(pass+1,item)::res) (0,[])
+ errorll)) in
+ if all_passes then annotated_errorll () else
+ let safe_list_nth l n = try List.nth l n with Failure _ -> [] in
+ (* We remove passes 1,2 and 5,6 *)
+ let res =
+ (1,[])::(2,[])
+ ::(3,remove_non_significant (safe_list_nth errorll 2))
+ ::(4,remove_non_significant (safe_list_nth errorll 3))
+ ::(5,[])::(6,[])::[]
+ in
+ if List.flatten (List.map snd res) <> [] then res
+ else
+ (* all errors (if any) are not significant: we keep them *)
+ let res =
+ (1,[])::(2,[])
+ ::(3,(safe_list_nth errorll 2))
+ ::(4,(safe_list_nth errorll 3))
+ ::(5,[])::(6,[])::[]
+ in
+ if List.flatten (List.map snd res) <> [] then
+ begin
+ HLog.warn
+ "All disambiguation errors are not significant. Showing them anyway." ;
+ res
+ end
+ else
+ begin
+ HLog.warn
+ "No errors in phases 2 and 3. Showing all errors in all phases" ;
+ annotated_errorll ()
+ end
+ in
let choices =
- let pass = ref 0 in
List.flatten
(List.map
- (fun l ->
- incr pass;
+ (fun (pass,l) ->
List.map
- (fun (env,diff,offset,msg) ->
- offset, [[!pass], [[!pass], env, diff], msg]) l
+ (fun (env,diff,offset,msg,significant) ->
+ offset, [[pass], [[pass], env, diff], msg, significant]) l
) errorll') in
(* Here we are doing a stable sort and list_uniq returns the latter
"equal" element. I.e. we are showing the error corresponding to the
most advanced disambiguation pass *)
let choices =
let choices_compare (o1,_) (o2,_) = compare o1 o2 in
- let choices_compare_by_passes (p1,_,_) (p2,_,_) =
+ let choices_compare_by_passes (p1,_,_,_) (p2,_,_,_) =
compare p1 p2 in
let rec uniq =
function
List.sort choices_compare_by_passes
(uniq_by_env (List.stable_sort choices_compare_by_env errors))
in
- let choices_compare_by_msg (_,_,m1) (_,_,m2) =
+ let choices_compare_by_msg (_,_,m1,_) (_,_,m2,_) =
compare (Lazy.force m1) (Lazy.force m2) in
let rec uniq_by_msg =
function
[] -> []
| h::[] -> [h]
- | (p1,i1,m1)::(p2,i2,m2)::tl when Lazy.force m1 = Lazy.force m2 ->
- uniq_by_msg ((p1@p2,merge_by_env (i1@i2),m2) :: tl)
+ | (p1,i1,m1,s1)::(p2,i2,m2,s2)::tl
+ when Lazy.force m1 = Lazy.force m2 && s1 = s2 ->
+ uniq_by_msg ((p1@p2,merge_by_env (i1@i2),m2,s2) :: tl)
| h1::tl -> h1 :: uniq_by_msg tl
in
List.sort choices_compare_by_msg
uniq ((o1,res) :: tl)
| h1::tl -> h1 :: uniq tl
in
- List.map (fun o,l -> o,List.sort choices_compare_by_passes l)
- (uniq (List.stable_sort choices_compare choices))
+ (* Errors in phase 3 that are not also in phase 4 are filtered out *)
+ let filter_phase_3 choices =
+ if all_passes then choices
+ else
+ let filter =
+ HExtlib.filter_map
+ (function
+ (loffset,messages) ->
+ let filtered_messages =
+ HExtlib.filter_map
+ (function
+ [3],_,_,_ -> None
+ | item -> Some item
+ ) messages
+ in
+ if filtered_messages = [] then
+ None
+ else
+ Some (loffset,filtered_messages))
+ in
+ filter choices
+ in
+ filter_phase_3
+ (List.map (fun o,l -> o,List.sort choices_compare_by_passes l)
+ (uniq (List.stable_sort choices_compare choices)))
in
match choices with
[] -> assert false
- | [loffset,[_,envs_and_diffs,msg]] ->
+ | [loffset,[_,envs_and_diffs,msg,significant]] ->
let _,env,diff = List.hd envs_and_diffs in
notify_exn
(GrafiteDisambiguator.DisambiguationError
- (offset,[[env,diff,loffset,msg]]));
+ (offset,[[env,diff,loffset,msg,significant]]));
| _::_ ->
let dialog = new disambiguationErrors () in
dialog#check_widgets ();
let model = new interpErrorModel dialog#treeview choices in
dialog#disambiguationErrors#set_title "Disambiguation error";
dialog#disambiguationErrorsLabel#set_label
- "Click on an interpretation to see the corresponding error message:";
- ignore (dialog#treeview#connect#cursor_changed (fun _ ->
- let tree_path =
- match fst (dialog#treeview#get_cursor ()) with
- None -> assert false
- | Some tp -> tp in
- let idx1,idx2,idx3 = model#get_interp_no tree_path in
- let loffset,lll = List.nth choices idx1 in
- let _,envs_and_diffs,msg =
- match idx2 with
- Some idx2 -> List.nth lll idx2
- | None -> [],[],lazy "Multiple error messages. Please select one." in
- let _,env,diff =
- match idx3 with
- Some idx3 -> List.nth envs_and_diffs idx3
- | None -> [],[],[] (* dymmy value, used *) in
- let script = MatitaScript.current () in
- let error_tag = script#error_tag in
- source_buffer#remove_tag error_tag
- ~start:source_buffer#start_iter
- ~stop:source_buffer#end_iter;
- notify_exn
- (GrafiteDisambiguator.DisambiguationError
- (offset,[[env,diff,loffset,msg]]))
- ));
+ "Click on an error to see the corresponding message:";
+ ignore (dialog#treeview#connect#cursor_changed
+ (fun _ ->
+ let tree_path =
+ match fst (dialog#treeview#get_cursor ()) with
+ None -> assert false
+ | Some tp -> tp in
+ let idx1,idx2,idx3 = model#get_interp_no tree_path in
+ let loffset,lll = List.nth choices idx1 in
+ let _,envs_and_diffs,msg,significant =
+ match idx2 with
+ Some idx2 -> List.nth lll idx2
+ | None ->
+ [],[],lazy "Multiple error messages. Please select one.",true
+ in
+ let _,env,diff =
+ match idx3 with
+ Some idx3 -> List.nth envs_and_diffs idx3
+ | None -> [],[],[] (* dymmy value, used *) in
+ let script = MatitaScript.current () in
+ let error_tag = script#error_tag in
+ source_buffer#remove_tag error_tag
+ ~start:source_buffer#start_iter
+ ~stop:source_buffer#end_iter;
+ notify_exn
+ (GrafiteDisambiguator.DisambiguationError
+ (offset,[[env,diff,loffset,msg,significant]]))
+ ));
let return _ =
dialog#disambiguationErrors#destroy ();
GMain.Main.quit ()
in
let fail _ = return () in
- ignore (dialog#disambiguationErrors#event#connect#delete (fun _ -> true));
- connect_button dialog#disambiguationErrorsOkButton (fun _ -> return ());
+ ignore(dialog#disambiguationErrors#event#connect#delete (fun _ -> true));
+ connect_button dialog#disambiguationErrorsOkButton
+ (fun _ ->
+ let tree_path =
+ match fst (dialog#treeview#get_cursor ()) with
+ None -> assert false
+ | Some tp -> tp in
+ let idx1,idx2,idx3 = model#get_interp_no tree_path in
+ let diff =
+ match idx2,idx3 with
+ Some idx2, Some idx3 ->
+ let _,lll = List.nth choices idx1 in
+ let _,envs_and_diffs,_,_ = List.nth lll idx2 in
+ let _,_,diff = List.nth envs_and_diffs idx3 in
+ diff
+ | _,_ -> assert false
+ in
+ let newtxt =
+ String.concat "\n"
+ ("" ::
+ List.map
+ (fun k,value ->
+ DisambiguatePp.pp_environment
+ (DisambiguateTypes.Environment.add k value
+ DisambiguateTypes.Environment.empty))
+ diff) ^ "\n"
+ in
+ source_buffer#insert
+ ~iter:
+ (source_buffer#get_iter_at_mark
+ (`NAME "beginning_of_statement")) newtxt ;
+ return ()
+ );
connect_button dialog#disambiguationErrorsMoreErrors
(fun _ -> return () ;
interactive_error_interp ~all_passes:true source_buffer notify_exn offset
unlock_world ()
with
| GrafiteDisambiguator.DisambiguationError (offset,errorll) ->
- interactive_error_interp source_buffer notify_exn offset errorll ;
+ (try
+ interactive_error_interp source_buffer notify_exn offset
+ errorll
+ with
+ exc -> notify_exn exc);
unlock_world ()
| exc ->
notify_exn exc;
unlock_world ()
in
- worker_thread := Some (Thread.create thread_main ()) in
+ (*thread_main ();*)
+ worker_thread := Some (Thread.create thread_main ())
+ in
let kill_worker =
(* the following lines are from Xavier Leroy: http://alan.petitepomme.net/cwn/2005.11.08.html *)
let interrupt = ref None in
(fun () -> MatitamakeLib.clean_development_in_bg refresh d)
in
ignore(clean ())));
+ (* publish button hidden, use command line
connect_button develList#publishButton
(locker (fun () ->
match get_devel_selected () with
let publish = locker (fun () ->
MatitamakeLib.publish_development_in_bg refresh d) in
ignore(publish ())));
+ *)
+ develList#publishButton#misc#hide ();
connect_button develList#graphButton (fun () ->
match get_devel_selected () with
| None -> ()
| None -> true
| Some path ->
let is_prefix_of d1 d2 =
+ let d1 = MatitamakeLib.normalize_path d1 in
+ let d2 = MatitamakeLib.normalize_path d2 in
let len1 = String.length d1 in
let len2 = String.length d2 in
if len2 < len1 then
ignore (adj#connect#changed
(fun _ -> adj#set_value (adj#upper -. adj#page_size)));
console#message (sprintf "\tMatita version %s\n" BuildTimeConf.version);
- (* toolbar *)
- let module A = GrafiteAst in
- let hole = CicNotationPt.UserInput in
- let loc = HExtlib.dummy_floc in
- let tac ast _ =
- if (MatitaScript.current ())#onGoingProof () then
- (MatitaScript.current ())#advance
- ~statement:("\n"
- ^ GrafiteAstPp.pp_tactical ~term_pp:CicNotationPp.pp_term
- ~lazy_term_pp:CicNotationPp.pp_term (A.Tactic (loc, ast)))
- ()
- in
- let tac_w_term ast _ =
- if (MatitaScript.current ())#onGoingProof () then
- let buf = source_buffer in
- buf#insert ~iter:(buf#get_iter_at_mark (`NAME "locked"))
- ("\n"
- ^ GrafiteAstPp.pp_tactic ~term_pp:CicNotationPp.pp_term
- ~lazy_term_pp:CicNotationPp.pp_term ast)
- in
- let tbar = main in
- connect_button tbar#introsButton (tac (A.Intros (loc, None, [])));
- connect_button tbar#applyButton (tac_w_term (A.Apply (loc, hole)));
- connect_button tbar#exactButton (tac_w_term (A.Exact (loc, hole)));
- connect_button tbar#elimButton (tac_w_term
- (A.Elim (loc, hole, None, None, [])));
- connect_button tbar#elimTypeButton (tac_w_term
- (A.ElimType (loc, hole, None, None, [])));
- connect_button tbar#splitButton (tac (A.Split loc));
- connect_button tbar#leftButton (tac (A.Left loc));
- connect_button tbar#rightButton (tac (A.Right loc));
- connect_button tbar#existsButton (tac (A.Exists loc));
- connect_button tbar#reflexivityButton (tac (A.Reflexivity loc));
- connect_button tbar#symmetryButton (tac (A.Symmetry loc));
- connect_button tbar#transitivityButton
- (tac_w_term (A.Transitivity (loc, hole)));
- connect_button tbar#assumptionButton (tac (A.Assumption loc));
- connect_button tbar#cutButton (tac_w_term (A.Cut (loc, None, hole)));
- connect_button tbar#autoButton (tac (A.Auto (loc,[])));
- MatitaGtkMisc.toggle_widget_visibility
- ~widget:(main#tacticsButtonsHandlebox :> GObj.widget)
- ~check:main#tacticsBarMenuItem;
+ (* TO BE REMOVED *)
+ main#tacticsButtonsHandlebox#misc#hide ();
+ main#tacticsBarMenuItem#misc#hide ();
+ main#scriptNotebook#remove_page 1;
+ main#scriptNotebook#set_show_tabs false;
+ (* / TO BE REMOVED *)
let module Hr = Helm_registry in
- if
- not (Hr.get_opt_default Hr.bool ~default:false "matita.tactics_bar")
- then
- main#tacticsBarMenuItem#set_active false;
- MatitaGtkMisc.toggle_callback
+ MatitaGtkMisc.toggle_callback ~check:main#fullscreenMenuItem
~callback:(function
| true -> main#toplevel#fullscreen ()
- | false -> main#toplevel#unfullscreen ())
- ~check:main#fullscreenMenuItem;
+ | false -> main#toplevel#unfullscreen ());
main#fullscreenMenuItem#set_active false;
+ MatitaGtkMisc.toggle_callback ~check:main#ppNotationMenuItem
+ ~callback:(function
+ | true ->
+ CicNotation.set_active_notations
+ (List.map fst (CicNotation.get_all_notations ()))
+ | false ->
+ CicNotation.set_active_notations []);
+ MatitaGtkMisc.toggle_callback ~check:main#hideCoercionsMenuItem
+ ~callback:(fun enabled -> Acic2content.hide_coercions := enabled);
+ MatitaGtkMisc.toggle_callback ~check:main#unicodeAsTexMenuItem
+ ~callback:(fun enabled ->
+ Helm_registry.set_bool "matita.paste_unicode_as_tex" enabled);
+ main#unicodeAsTexMenuItem#set_active
+ (Helm_registry.get_bool "matita.paste_unicode_as_tex");
(* log *)
HLog.set_log_callback self#console#log_callback;
GtkSignal.user_handler :=
connect_menu_item main#saveMenuItem saveScript;
connect_menu_item main#saveAsMenuItem saveAsScript;
connect_menu_item main#newMenuItem newScript;
+ connect_menu_item main#showCoercionsGraphMenuItem
+ (fun _ ->
+ let c = MatitaMathView.cicBrowser () in
+ c#load (`About `Coercions));
+ connect_menu_item main#showAutoGuiMenuItem
+ (fun _ -> MatitaAutoGui.auto_dialog Auto.get_auto_status);
(* script monospace font stuff *)
self#updateFontSize ();
(* debug menu *)
main#debugMenu#misc#hide ();
- (* status bar *)
+ (* HBUGS *)
+ main#hintNotebook#misc#hide ();
+ (*
main#hintLowImage#set_file (image_path "matita-bulb-low.png");
main#hintMediumImage#set_file (image_path "matita-bulb-medium.png");
main#hintHighImage#set_file (image_path "matita-bulb-high.png");
+ *)
(* focus *)
self#sourceView#misc#grab_focus ();
(* main win dimension *)
end
method setStar name b =
- let l = main#scriptLabel in
+ let w = main#toplevel in
+ let set x = w#set_title x in
+ let name = "Matita - " ^ name in
if b then
- l#set_text (name ^ " *")
+ set (name ^ " *")
else
- l#set_text (name)
+ set (name)
method private _enableSaveTo file =
script_fname <- Some file;
| Some uris -> uris)
let interactive_interp_choice () text prefix_len choices =
-(* List.iter (fun (l,_,_) ->
- List.iter (fun l -> let start, stop = HExtlib.loc_of_floc l in
- Printf.eprintf "(%d,%d)" start stop) l; prerr_endline "")
- ((List.hd choices)); *)
+(*List.iter (fun l -> prerr_endline "==="; List.iter (fun (_,id,dsc) -> prerr_endline (id ^ " = " ^ dsc)) l) choices;*)
let filter_choices filter =
let rec is_compatible filter =
function
[] -> true
- | (_,id,dsc)::tl ->
+ | ([],_,_)::tl -> is_compatible filter tl
+ | (loc::tlloc,id,dsc)::tl ->
try
- if List.assoc id filter = dsc then
- is_compatible filter tl
+ if List.assoc (loc,id) filter = dsc then
+ is_compatible filter ((tlloc,id,dsc)::tl)
else
false
with
in
List.filter (fun (_,interp) -> is_compatible filter interp)
in
- let rec get_choices id =
+ let rec get_choices loc id =
function
[] -> []
| (_,he)::tl ->
- let _,_,dsc = List.find (fun (_,id',_) -> id = id') he in
- dsc :: (List.filter (fun dsc' -> dsc <> dsc') (get_choices id tl))
+ let _,_,dsc =
+ List.find (fun (locs,id',_) -> id = id' && List.mem loc locs) he
+ in
+ dsc :: (List.filter (fun dsc' -> dsc <> dsc') (get_choices loc id tl))
in
let example_interp =
match choices with
let rec classify ids filter partial_interpretations =
match ids with
[] -> List.map fst partial_interpretations
- | (locs,id,_)::tl ->
- let choices = get_choices id partial_interpretations in
+ | ([],_,_)::tl -> classify tl filter partial_interpretations
+ | (loc::tlloc,id,dsc)::tl ->
+ let choices = get_choices loc id partial_interpretations in
let chosen_dsc =
match choices with
- [dsc] -> dsc
+ [] -> prerr_endline ("NO CHOICES FOR " ^ id); assert false
+ | [dsc] -> dsc
| _ ->
- match ask_user id locs choices with
+ match ask_user id [loc] choices with
[x] -> x
| _ -> assert false
in
- let filter = (id,chosen_dsc)::filter in
- let compatible_interps = filter_choices filter partial_interpretations in
- classify tl filter compatible_interps in
+ let filter = ((loc,id),chosen_dsc)::filter in
+ let compatible_interps = filter_choices filter partial_interpretations in
+ classify ((tlloc,id,dsc)::tl) filter compatible_interps
+ in
let enumerated_choices =
let idx = ref ~-1 in
List.map (fun interp -> incr idx; !idx,interp) choices
projects / helm.git / blobdiff