- (* developments win *)
- let model =
- new MatitaGtkMisc.multiStringListModel
- ~cols:2 develList#developmentsTreeview
- in
- let refresh_devels_win () =
- model#list_store#clear ();
- List.iter
- (fun (name, root) -> model#easy_mappend [name;root])
- (MatitamakeLib.list_known_developments ())
- in
- let get_devel_selected () =
- match model#easy_mselection () with
- | [[name;_]] -> MatitamakeLib.development_for_name name
- | _ -> None
- in
- let refresh () =
- while Glib.Main.pending () do
- ignore(Glib.Main.iteration false);
- done
- in
- connect_button develList#newButton
- (fun () ->
- next_devel_must_contain <- None;
- newDevel#toplevel#misc#show());
- connect_button develList#deleteButton
- (locker (fun () ->
- (match get_devel_selected () with
- | None -> ()
- | Some d -> MatitamakeLib.destroy_development_in_bg refresh d);
- refresh_devels_win ()));
- connect_button develList#buildButton
- (locker (fun () ->
- match get_devel_selected () with
- | None -> ()
- | Some d ->
- let build = locker
- (fun () -> MatitamakeLib.build_development_in_bg refresh d)
- in
- ignore(build ())));
- connect_button develList#cleanButton
- (locker (fun () ->
- match get_devel_selected () with
- | None -> ()
- | Some d ->
- let clean = locker
- (fun () -> MatitamakeLib.clean_development_in_bg refresh d)
- in
- ignore(clean ())));
- connect_button develList#publishButton
- (locker (fun () ->
- match get_devel_selected () with
- | None -> ()
- | Some d ->
- let publish = locker (fun () ->
- MatitamakeLib.publish_development_in_bg refresh d) in
- ignore(publish ())));
- connect_button develList#graphButton (fun () ->
- match get_devel_selected () with
- | None -> ()
- | Some d ->
- (match MatitamakeLib.dot_for_development d with
- | None -> ()
- | Some _ ->
- let browser = MatitaMathView.cicBrowser () in
- browser#load (`Development
- (MatitamakeLib.name_for_development d))));
- connect_button develList#closeButton
- (fun () -> develList#toplevel#misc#hide());
- ignore(develList#toplevel#event#connect#delete
- (fun _ -> develList#toplevel#misc#hide();true));
- connect_menu_item main#developmentsMenuItem
- (fun () -> refresh_devels_win ();develList#toplevel#misc#show ());
-
- (* add development win *)
- let check_if_root_contains root =
- match next_devel_must_contain with
- | None -> true
- | Some path ->
- let is_prefix_of d1 d2 =
- let len1 = String.length d1 in
- let len2 = String.length d2 in
- if len2 < len1 then
- false
- else
- let pref = String.sub d2 0 len1 in
- pref = d1
- in
- is_prefix_of root path
- in
- connect_button newDevel#addButton
- (fun () ->
- let name = newDevel#nameEntry#text in
- let root = newDevel#rootEntry#text in
- if check_if_root_contains root then
- begin
- ignore (MatitamakeLib.initialize_development name root);
- refresh_devels_win ();
- newDevel#nameEntry#set_text "";
- newDevel#rootEntry#set_text "";
- newDevel#toplevel#misc#hide()
- end
- else
- HLog.error ("The selected root does not contain " ^
- match next_devel_must_contain with
- | Some x -> x
- | _ -> assert false));
- connect_button newDevel#chooseRootButton
- (fun () ->
- let path = self#chooseDir () in
- match path with
- | Some path -> newDevel#rootEntry#set_text path
- | None -> ());
- connect_button newDevel#cancelButton
- (fun () -> newDevel#toplevel#misc#hide ());
- ignore(newDevel#toplevel#event#connect#delete
- (fun _ -> newDevel#toplevel#misc#hide();true));