Commit 277ca2d3 authored by MARCHE Claude's avatar MARCHE Claude
Browse files

new IDE: expand/collapse status of rows seems to work now

parent 23d527c6
...@@ -439,14 +439,75 @@ install_no_local:: ...@@ -439,14 +439,75 @@ install_no_local::
install_local: bin/why3config install_local: bin/why3config
###############
# GUI
###############
ifeq (@enable_ide@,yes)
GUI_FILES = xml session gconfig db gmain
GUIMODULES = $(addprefix src/ide/, $(GUI_FILES))
GUIML = $(addsuffix .ml, $(GUIMODULES))
GUIMLI = $(addsuffix .mli, $(GUIMODULES))
GUICMO = $(addsuffix .cmo, $(GUIMODULES))
GUICMX = $(addsuffix .cmx, $(GUIMODULES))
$(GUICMO) $(GUICMX): INCLUDES += -I src/ide -I @SQLITE3LIB@
# build targets
byte: bin/why3gui.byte
opt: bin/why3gui.opt
bin/why3gui.opt bin/why3gui.byte: INCLUDES += -I @LABLGTK2LIB@ -I @SQLITE3LIB@
bin/why3gui.opt bin/why3gui.byte: EXTOBJS +=
bin/why3gui.opt bin/why3gui.byte: EXTLIBS += lablgtk lablgtksourceview2 sqlite3
bin/why3gui.opt: src/why.cmxa $(PGMCMX) $(GUICMX)
$(if $(QUIET), @echo 'Linking $@' &&) \
$(OCAMLOPT) $(OFLAGS) -o $@ $(EXTCMXA) $^
$(STRIP) $@
bin/why3gui.byte: src/why.cma $(PGMCMO) $(GUICMO)
$(if $(QUIET),@echo 'Linking $@' &&) \
$(OCAMLC) $(BFLAGS) -o $@ $(EXTCMA) $^
bin/why3gui: bin/why3gui.@OCAMLBEST@
ln -sf why3gui.@OCAMLBEST@ $@
# depend and clean targets
include .depend.gui
.depend.gui: src/ide/xml.ml
$(OCAMLDEP) -slash -I src -I src/ide $(GUIML) $(GUIMLI) > $@
depend: .depend.gui
clean::
rm -f src/ide/*.cm[iox] src/ide/*.o
rm -f src/ide/*.annot src/ide/*~
rm -f bin/why3gui.byte bin/why3gui.opt bin/why3gui
rm -f .depend.gui
install_no_local::
cp -f bin/why3gui.@OCAMLBEST@ $(BINDIR)/why3gui
install_local: bin/why3gui
endif
############### ###############
# IDE # IDE
############### ###############
ifeq (@enable_ide@,yes) ifeq (@enable_ide@,yes)
IDE_FILES = xml session gconfig db gmain # IDE_FILES = xml session gconfig db gmain
# IDE_FILES = xml session gconfig newmain IDE_FILES = xml session gconfig newmain
IDEMODULES = $(addprefix src/ide/, $(IDE_FILES)) IDEMODULES = $(addprefix src/ide/, $(IDE_FILES))
...@@ -455,16 +516,16 @@ IDEMLI = $(addsuffix .mli, $(IDEMODULES)) ...@@ -455,16 +516,16 @@ IDEMLI = $(addsuffix .mli, $(IDEMODULES))
IDECMO = $(addsuffix .cmo, $(IDEMODULES)) IDECMO = $(addsuffix .cmo, $(IDEMODULES))
IDECMX = $(addsuffix .cmx, $(IDEMODULES)) IDECMX = $(addsuffix .cmx, $(IDEMODULES))
$(IDECMO) $(IDECMX): INCLUDES += -I src/ide -I @SQLITE3LIB@ $(IDECMO) $(IDECMX): INCLUDES += -I src/ide
# build targets # build targets
byte: bin/why3ide.byte byte: bin/why3ide.byte
opt: bin/why3ide.opt opt: bin/why3ide.opt
bin/why3ide.opt bin/why3ide.byte: INCLUDES += -I @LABLGTK2LIB@ -I @SQLITE3LIB@ bin/why3ide.opt bin/why3ide.byte: INCLUDES += -I @LABLGTK2LIB@
bin/why3ide.opt bin/why3ide.byte: EXTOBJS += bin/why3ide.opt bin/why3ide.byte: EXTOBJS +=
bin/why3ide.opt bin/why3ide.byte: EXTLIBS += lablgtk lablgtksourceview2 sqlite3 bin/why3ide.opt bin/why3ide.byte: EXTLIBS += lablgtk lablgtksourceview2
bin/why3ide.opt: src/why.cmxa $(PGMCMX) $(IDECMX) bin/why3ide.opt: src/why.cmxa $(PGMCMX) $(IDECMX)
$(if $(QUIET), @echo 'Linking $@' &&) \ $(if $(QUIET), @echo 'Linking $@' &&) \
......
...@@ -351,14 +351,9 @@ module M = Session.Make ...@@ -351,14 +351,9 @@ module M = Session.Make
let set_row_status row b = let set_row_status row b =
if b then if b then
begin goals_model#set ~row:row#iter ~column:status_column !image_yes
(* goals_view#collapse_row row#path; *)
goals_model#set ~row:row#iter ~column:status_column !image_yes;
end
else else
begin goals_model#set ~row:row#iter ~column:status_column !image_unknown
goals_model#set ~row:row#iter ~column:status_column !image_unknown;
end
let set_proof_state ~obsolete a = let set_proof_state ~obsolete a =
let row = a.M.proof_key in let row = a.M.proof_key in
...@@ -392,7 +387,14 @@ let row_expanded b iter _path = ...@@ -392,7 +387,14 @@ let row_expanded b iter _path =
| M.Theory t -> | M.Theory t ->
eprintf "theory_expanded <- %b@." b; eprintf "theory_expanded <- %b@." b;
M.set_theory_expanded t b M.set_theory_expanded t b
| _ -> () | M.Goal g ->
eprintf "goal_expanded <- %b@." b;
M.set_goal_expanded g b
| M.Transformation tr ->
eprintf "transf_expanded <- %b@." b;
M.set_transf_expanded tr b
| M.Proof_attempt _ -> ()
let (_:GtkSignal.id) = let (_:GtkSignal.id) =
goals_view#connect#row_collapsed ~callback:(row_expanded false) goals_view#connect#row_collapsed ~callback:(row_expanded false)
...@@ -403,16 +405,22 @@ let (_:GtkSignal.id) = ...@@ -403,16 +405,22 @@ let (_:GtkSignal.id) =
let notify any = let notify any =
let row,exp = let row,exp =
match any with match any with
| M.Goal g -> (M.goal_key g),false (* g.M.file_expanded *) | M.Goal g ->
if M.goal_expanded g then
begin
let n =
Hashtbl.fold (fun _ _ acc -> acc+1) (M.external_proofs g) 0
in
eprintf "expand_row on a goal with %d proofs@." n;
end;
(M.goal_key g),(M.goal_expanded g)
| M.Theory t -> (M.theory_key t),(M.theory_expanded t) | M.Theory t -> (M.theory_key t),(M.theory_expanded t)
| M.File f -> f.M.file_key,f.M.file_expanded | M.File f -> f.M.file_key,f.M.file_expanded
| M.Proof_attempt a -> a.M.proof_key,false | M.Proof_attempt a -> a.M.proof_key,false
| M.Transformation tr -> tr.M.transf_key,false | M.Transformation tr -> tr.M.transf_key,tr.M.transf_expanded
in in
if exp then if exp then goals_view#expand_to_path row#path else
(eprintf "exp@."; goals_view#expand_row row#path) goals_view#collapse_row row#path;
else
((*eprintf "col@.";*) goals_view#collapse_row row#path);
match any with match any with
| M.Goal g -> | M.Goal g ->
set_row_status row (M.goal_proved g) set_row_status row (M.goal_proved g)
...@@ -439,7 +447,7 @@ let init = ...@@ -439,7 +447,7 @@ let init =
begin begin
Hashtbl.replace model_index ind any; Hashtbl.replace model_index ind any;
end; end;
goals_view#expand_row row#path; (* useless since it has no child: goals_view#expand_row row#path; *)
goals_model#set ~row:row#iter ~column:icon_column goals_model#set ~row:row#iter ~column:icon_column
(match any with (match any with
| M.Goal _ -> !image_file | M.Goal _ -> !image_file
...@@ -1130,12 +1138,15 @@ let save_file () = ...@@ -1130,12 +1138,15 @@ let save_file () =
let f = !current_file in let f = !current_file in
if f <> "" then if f <> "" then
begin begin
M.save_session ();
let s = source_view#source_buffer#get_text () in let s = source_view#source_buffer#get_text () in
let c = open_out f in let c = open_out f in
output_string c s; output_string c s;
close_out c; close_out c;
reload () reload ()
end end
else
info_window `ERROR "No file currently edited"
let (_ : GMenu.image_menu_item) = let (_ : GMenu.image_menu_item) =
file_factory#add_image_item ~key:GdkKeysyms._S file_factory#add_image_item ~key:GdkKeysyms._S
......
...@@ -153,6 +153,7 @@ and transf = ...@@ -153,6 +153,7 @@ and transf =
mutable transf_proved : bool; mutable transf_proved : bool;
transf_key : O.key; transf_key : O.key;
mutable subgoals : goal list; mutable subgoals : goal list;
mutable transf_expanded : bool;
} }
and theory = and theory =
...@@ -185,7 +186,6 @@ let theory_key t = t.theory_key ...@@ -185,7 +186,6 @@ let theory_key t = t.theory_key
let verified t = t.verified let verified t = t.verified
let goals t = t.goals let goals t = t.goals
let theory_expanded t = t.theory_expanded let theory_expanded t = t.theory_expanded
let set_theory_expanded t b = t.theory_expanded <- b
let get_theory t = let get_theory t =
...@@ -203,6 +203,8 @@ let goal_expl g = ...@@ -203,6 +203,8 @@ let goal_expl g =
let goal_key g = g.goal_key let goal_key g = g.goal_key
let goal_proved g = g.proved let goal_proved g = g.proved
let transformations g = g.transformations let transformations g = g.transformations
let external_proofs g = g.external_proofs
let goal_expanded g = g.goal_expanded
let get_task g = let get_task g =
match g.task with match g.task with
...@@ -217,7 +219,26 @@ let get_task g = ...@@ -217,7 +219,26 @@ let get_task g =
end end
| Some t -> t | Some t -> t
let set_file_expanded f b = f.file_expanded <- b
let rec set_goal_expanded g b =
g.goal_expanded <- b;
if not b then
Hashtbl.iter (fun _ tr -> set_transf_expanded tr b) g.transformations
and set_transf_expanded tr b =
tr.transf_expanded <- b;
if not b then
List.iter (fun g -> set_goal_expanded g b) tr.subgoals
let set_theory_expanded t b =
t.theory_expanded <- b;
if not b then
List.iter (fun th -> set_goal_expanded th b) t.goals
let set_file_expanded f b =
f.file_expanded <- b;
if not b then
List.iter (fun th -> set_theory_expanded th b) f.theories
let all_files : file list ref = ref [] let all_files : file list ref = ref []
...@@ -248,9 +269,8 @@ let save_status fmt s = ...@@ -248,9 +269,8 @@ let save_status fmt s =
| Done r -> save_result fmt r | Done r -> save_result fmt r
let save_proof_attempt fmt _key a = let save_proof_attempt fmt _key a =
fprintf fmt "@\n@[<v 1><proof prover=\"%s\" edited=\"%s\">" fprintf fmt "@\n@[<v 1><proof prover=\"%s\" edited=\"%s\" obsolete=\"%b\">"
a.prover.prover_id a.prover.prover_id a.edited_as a.proof_obsolete;
a.edited_as;
save_status fmt a.proof_state; save_status fmt a.proof_state;
fprintf fmt "@]@\n</proof>" fprintf fmt "@]@\n</proof>"
...@@ -259,15 +279,15 @@ let opt lab fmt = function ...@@ -259,15 +279,15 @@ let opt lab fmt = function
| Some s -> fprintf fmt "%s=\"%s\" " lab s | Some s -> fprintf fmt "%s=\"%s\" " lab s
let rec save_goal fmt g = let rec save_goal fmt g =
fprintf fmt "@\n@[<v 1><goal name=\"%s\" %asum=\"%s\" proved=\"%b\">" fprintf fmt "@\n@[<v 1><goal name=\"%s\" %asum=\"%s\" proved=\"%b\" expanded=\"%b\">"
g.goal_name (opt "expl") g.goal_expl g.checksum g.proved; g.goal_name (opt "expl") g.goal_expl g.checksum g.proved g.goal_expanded;
Hashtbl.iter (save_proof_attempt fmt) g.external_proofs; Hashtbl.iter (save_proof_attempt fmt) g.external_proofs;
Hashtbl.iter (save_trans fmt) g.transformations; Hashtbl.iter (save_trans fmt) g.transformations;
fprintf fmt "@]@\n</goal>" fprintf fmt "@]@\n</goal>"
and save_trans fmt _ t = and save_trans fmt _ t =
fprintf fmt "@\n@[<v 1><transf name=\"%s\" proved=\"%b\">" fprintf fmt "@\n@[<v 1><transf name=\"%s\" proved=\"%b\" expanded=\"%b\">"
t.transf.transformation_name t.transf_proved; t.transf.transformation_name t.transf_proved t.transf_expanded;
List.iter (save_goal fmt) t.subgoals; List.iter (save_goal fmt) t.subgoals;
fprintf fmt "@]@\n</transf>" fprintf fmt "@]@\n</transf>"
...@@ -303,25 +323,14 @@ let notify_fun = ref (fun (_:any) -> ()) ...@@ -303,25 +323,14 @@ let notify_fun = ref (fun (_:any) -> ())
let check_file_verified f = let check_file_verified f =
let b = List.for_all (fun t -> t.verified) f.theories in let b = List.for_all (fun t -> t.verified) f.theories in
if f.file_verified <> b then f.file_verified <- b;
begin !notify_fun (File f)
f.file_verified <- b;
!notify_fun (File f)
end
else
!notify_fun (File f)
let check_theory_proved t = let check_theory_proved t =
let b = List.for_all (fun g -> g.proved) t.goals in let b = List.for_all (fun g -> g.proved) t.goals in
if t.verified <> b then t.verified <- b;
begin !notify_fun (Theory t);
t.verified <- b; check_file_verified t.theory_parent
!notify_fun (Theory t);
check_file_verified t.theory_parent
end
else
!notify_fun (Theory t)
let rec check_goal_proved g = let rec check_goal_proved g =
let b1 = Hashtbl.fold let b1 = Hashtbl.fold
...@@ -333,34 +342,23 @@ let rec check_goal_proved g = ...@@ -333,34 +342,23 @@ let rec check_goal_proved g =
let b = Hashtbl.fold let b = Hashtbl.fold
(fun _ t acc -> acc || t.transf_proved) g.transformations b1 (fun _ t acc -> acc || t.transf_proved) g.transformations b1
in in
if g.proved <> b then g.proved <- b;
begin !notify_fun (Goal g);
g.proved <- b; match g.parent with
!notify_fun (Goal g); | Parent_theory t -> check_theory_proved t
match g.parent with | Parent_transf t -> check_transf_proved t
| Parent_theory t -> check_theory_proved t
| Parent_transf t -> check_transf_proved t
end
else
!notify_fun (Goal g);
and check_transf_proved t = and check_transf_proved t =
let b = List.for_all (fun g -> g.proved) t.subgoals in let b = List.for_all (fun g -> g.proved) t.subgoals in
if t.transf_proved <> b then t.transf_proved <- b;
begin !notify_fun (Transformation t);
t.transf_proved <- b; check_goal_proved t.parent_goal
!notify_fun (Transformation t);
check_goal_proved t.parent_goal
end
let set_proof_state ~obsolete a res = let set_proof_state ~obsolete a res =
a.proof_state <- res; a.proof_state <- res;
a.proof_obsolete <- obsolete; a.proof_obsolete <- obsolete;
!notify_fun (Proof_attempt a); !notify_fun (Proof_attempt a);
match res with check_goal_proved a.proof_goal
| Done _ ->
check_goal_proved a.proof_goal
| _ -> ()
(*************************) (*************************)
(* Scheduler *) (* Scheduler *)
...@@ -587,7 +585,7 @@ let task_checksum t = ...@@ -587,7 +585,7 @@ let task_checksum t =
(* raw additions to the model *) (* raw additions to the model *)
(******************************) (******************************)
let raw_add_external_proof ~obsolete ~edit g p result = let raw_add_external_proof ~obsolete ~edit (g:goal) p result =
let key = O.create ~parent:g.goal_key () in let key = O.create ~parent:g.goal_key () in
let a = { prover = p; let a = { prover = p;
proof_goal = g; proof_goal = g;
...@@ -607,7 +605,7 @@ let raw_add_external_proof ~obsolete ~edit g p result = ...@@ -607,7 +605,7 @@ let raw_add_external_proof ~obsolete ~edit g p result =
(* [raw_add_goal parent name expl sum t] adds a goal to the given parent (* [raw_add_goal parent name expl sum t] adds a goal to the given parent
DOES NOT record the new goal in its parent, thus this should not be exported DOES NOT record the new goal in its parent, thus this should not be exported
*) *)
let raw_add_goal parent name expl sum topt = let raw_add_goal parent name expl sum topt exp =
let parent_key = match parent with let parent_key = match parent with
| Parent_theory mth -> mth.theory_key | Parent_theory mth -> mth.theory_key
| Parent_transf mtr -> mtr.transf_key | Parent_transf mtr -> mtr.transf_key
...@@ -626,19 +624,19 @@ let raw_add_goal parent name expl sum topt = ...@@ -626,19 +624,19 @@ let raw_add_goal parent name expl sum topt =
external_proofs = Hashtbl.create 7; external_proofs = Hashtbl.create 7;
transformations = Hashtbl.create 3; transformations = Hashtbl.create 3;
proved = false; proved = false;
goal_expanded = false; goal_expanded = exp;
} }
in in
let any = Goal goal in let any = Goal goal in
!init_fun key any; !init_fun key any;
!notify_fun any; !notify_fun any; (*useless ? *)
goal goal
(* [raw_add_transformation g name adds a transformation to the given goal g (* [raw_add_transformation g name adds a transformation to the given goal g
Adds no subgoals, thus this should not be exported Adds no subgoals, thus this should not be exported
*) *)
let raw_add_transformation g trans = let raw_add_transformation g trans exp =
let parent = g.goal_key in let parent = g.goal_key in
let key = O.create ~parent () in let key = O.create ~parent () in
let tr = { transf = trans; let tr = { transf = trans;
...@@ -646,6 +644,7 @@ let raw_add_transformation g trans = ...@@ -646,6 +644,7 @@ let raw_add_transformation g trans =
transf_proved = false; transf_proved = false;
transf_key = key; transf_key = key;
subgoals = []; subgoals = [];
transf_expanded = exp;
} }
in in
Hashtbl.add g.transformations trans.transformation_name tr; Hashtbl.add g.transformations trans.transformation_name tr;
...@@ -682,7 +681,7 @@ let add_theory mfile name th = ...@@ -682,7 +681,7 @@ let add_theory mfile name th =
let id = (Task.task_goal t).Decl.pr_name in let id = (Task.task_goal t).Decl.pr_name in
let name = id.Ident.id_string in let name = id.Ident.id_string in
let expl = get_explanation id (Task.task_goal_fmla t) in let expl = get_explanation id (Task.task_goal_fmla t) in
let goal = raw_add_goal (Parent_theory mth) name expl "" (Some t) in let goal = raw_add_goal (Parent_theory mth) name expl "" (Some t) true in
goal :: acc) goal :: acc)
[] []
tasks tasks
...@@ -760,10 +759,10 @@ let reload_proof ~provers obsolete goal pid old_a = ...@@ -760,10 +759,10 @@ let reload_proof ~provers obsolete goal pid old_a =
let old_res = old_a.proof_state in let old_res = old_a.proof_state in
let obsolete = obsolete or old_a.proof_obsolete in let obsolete = obsolete or old_a.proof_obsolete in
(* eprintf "proof_obsolete : %b@." obsolete; *) (* eprintf "proof_obsolete : %b@." obsolete; *)
let _a = let a =
raw_add_external_proof ~obsolete ~edit:old_a.edited_as goal p old_res raw_add_external_proof ~obsolete ~edit:old_a.edited_as goal p old_res
in in
((* something TODO ?*)) !notify_fun (Goal a.proof_goal)
with Not_found -> with Not_found ->
eprintf eprintf
"Warning: prover %s appears in database but is not installed.@." "Warning: prover %s appears in database but is not installed.@."
...@@ -771,7 +770,8 @@ let reload_proof ~provers obsolete goal pid old_a = ...@@ -771,7 +770,8 @@ let reload_proof ~provers obsolete goal pid old_a =
let rec reload_any_goal ~provers parent gid gname sum t old_goal goal_obsolete = let rec reload_any_goal ~provers parent gid gname sum t old_goal goal_obsolete =
let info = get_explanation gid (Task.task_goal_fmla t) in let info = get_explanation gid (Task.task_goal_fmla t) in
let goal = raw_add_goal parent gname info sum (Some t) in let exp = match old_goal with None -> true | Some g -> g.goal_expanded in
let goal = raw_add_goal parent gname info sum (Some t) exp in
goal.task <- Some t; goal.task <- Some t;
begin begin
match old_goal with match old_goal with
...@@ -780,6 +780,7 @@ let rec reload_any_goal ~provers parent gid gname sum t old_goal goal_obsolete = ...@@ -780,6 +780,7 @@ let rec reload_any_goal ~provers parent gid gname sum t old_goal goal_obsolete =
Hashtbl.iter (reload_proof ~provers goal_obsolete goal) g.external_proofs; Hashtbl.iter (reload_proof ~provers goal_obsolete goal) g.external_proofs;
Hashtbl.iter (reload_trans ~provers goal_obsolete goal) g.transformations Hashtbl.iter (reload_trans ~provers goal_obsolete goal) g.transformations
end; end;
check_goal_proved goal;
goal goal
...@@ -910,6 +911,7 @@ let reload_theory ~provers mfile old_theories (_,tname,th) = ...@@ -910,6 +911,7 @@ let reload_theory ~provers mfile old_theories (_,tname,th) =
(fun goalsmap g -> Util.Mstr.add g.goal_name g goalsmap) (fun goalsmap g -> Util.Mstr.add g.goal_name g goalsmap)
Util.Mstr.empty old_goals Util.Mstr.empty old_goals
in in
!notify_fun (Theory mth);
let new_goals = List.fold_left let new_goals = List.fold_left
(fun acc t -> (fun acc t ->
let g = reload_root_goal ~provers mth tname goalsmap t in let g = reload_root_goal ~provers mth tname goalsmap t in
...@@ -929,6 +931,7 @@ let reload_file ~provers mf theories = ...@@ -929,6 +931,7 @@ let reload_file ~provers mf theories =
Util.Mstr.empty Util.Mstr.empty
mf.theories mf.theories
in in
!notify_fun (File new_mf);
let mths = List.fold_left let mths = List.fold_left
(fun acc th -> reload_theory ~provers new_mf old_theories th :: acc) (fun acc th -> reload_theory ~provers new_mf old_theories th :: acc)
[] theories [] theories
...@@ -941,9 +944,9 @@ let reload_file ~provers mf theories = ...@@ -941,9 +944,9 @@ let reload_file ~provers mf theories =
let reload_all provers = let reload_all provers =
let files = !all_files in let files = !all_files in
let all_theories = let all_theories =
List.map (fun mf -> List.map (fun mf ->
eprintf "[Reload] file '%s'@." mf.file_name; eprintf "[Reload] file '%s'@." mf.file_name;
(mf,read_file mf.file_name)) (mf,read_file mf.file_name))
files files
in in
all_files := []; all_files := [];
...@@ -1009,7 +1012,8 @@ let rec load_goal ~env ~provers parent acc g = ...@@ -1009,7 +1012,8 @@ let rec load_goal ~env ~provers parent acc g =
try List.assoc "sum" g.Xml.attributes try List.assoc "sum" g.Xml.attributes
with Not_found -> "" with Not_found -> ""
in in
let mg = raw_add_goal parent gname expl sum None in let exp = bool_attribute "expanded" g true in
let mg = raw_add_goal parent gname expl sum None exp in
List.iter (load_proof_or_transf ~env ~provers mg) g.Xml.elements;