]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/matita/matitaGui.ml
matitamake is integrated with matita
[helm.git] / helm / matita / matitaGui.ml
index 652c720b96dadf7c0b502d35ca5747777c081618..51b17451e9caa1c1bbd9d964930dcd46368dd61b 100644 (file)
@@ -110,6 +110,8 @@ class gui () =
   let about = new aboutWin () in
   let fileSel = new fileSelectionWin () in
   let findRepl = new findReplWin () in
+  let develList = new develListWin () in
+  let newDevel = new newDevelopmentWin () in
   let keyBindingBoxes = (* event boxes which should receive global key events *)
     [ main#mainWinEventBox ]
   in
@@ -131,8 +133,10 @@ class gui () =
   object (self)
     val mutable chosen_file = None
     val mutable _ok_not_exists = false
+    val mutable _only_directory = false
     val mutable script_fname = None
     val mutable font_size = default_font_size
+    val mutable next_devel_must_contain = None
    
     initializer
         (* glade's check widgets *)
@@ -195,6 +199,94 @@ class gui () =
       ignore(self#main#findReplMenuItem#connect#activate
         ~callback:show_find_Repl);
       ignore (findRepl#findEntry#connect#activate ~callback:find_forward);
+        (* 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
+        | _ -> assert false 
+      in
+      connect_button develList#newButton
+        (fun () -> 
+          next_devel_must_contain <- None;
+          newDevel#toplevel#misc#show());
+      connect_button develList#deleteButton
+        (fun () -> 
+          (match get_devel_selected () with
+          | None -> ()
+          | Some d -> MatitamakeLib.destroy_development d);
+          refresh_devels_win ());
+      connect_button develList#buildButton 
+        (fun () -> 
+          match get_devel_selected () with
+          | None -> ()
+          | Some d -> ignore(MatitamakeLib.build_development d));
+      connect_button develList#cleanButton 
+        (fun () -> 
+          match get_devel_selected () with
+          | None -> ()
+          | Some d -> ignore(MatitamakeLib.clean_development d));
+      connect_button develList#closeButton 
+        (fun () -> develList#toplevel#misc#hide());
+      ignore(develList#toplevel#event#connect#delete 
+        (fun _ -> develList#toplevel#misc#hide();true));
+      let selected_devel = ref None in
+      connect_menu_item self#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
+            MatitaLog.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));
+      
         (* file selection win *)
       ignore (fileSel#fileSelectionWin#event#connect#delete (fun _ -> true));
       ignore (fileSel#fileSelectionWin#connect#response (fun event ->
@@ -207,9 +299,17 @@ class gui () =
         | `OK ->
             let fname = fileSel#fileSelectionWin#filename in
             if Sys.file_exists fname then
-              (if is_regular fname then return (Some fname))
+              begin
+                if is_regular fname && not(_only_directory) then 
+                  return (Some fname) 
+                else if _only_directory && is_dir fname then 
+                  return (Some fname)
+              end
             else
-              (if _ok_not_exists then return (Some fname))
+              begin
+                if _ok_not_exists then 
+                  return (Some fname)
+              end
         | `CANCEL -> return None
         | `HELP -> ()
         | `DELETE_EVENT -> return None));
@@ -218,7 +318,7 @@ class gui () =
       main#helpMenu#set_right_justified true;
         (* console *)
       let adj = main#logScrolledWin#vadjustment in
-      ignore (adj#connect#changed
+        ignore (adj#connect#changed
                 (fun _ -> adj#set_value (adj#upper -. adj#page_size)));
       console#message (sprintf "\tMatita version %s\n" BuildTimeConf.version);
         (* toolbar *)
@@ -478,6 +578,8 @@ class gui () =
     method fileSel = fileSel
     method findRepl = findRepl
     method main = main
+    method develList = develList
+    method newDevel = newDevel
 
     method newBrowserWin () =
       object (self)
@@ -523,9 +625,22 @@ class gui () =
 
     method chooseFile ?(ok_not_exists = false) () =
       _ok_not_exists <- ok_not_exists;
+      _only_directory <- false;
+      fileSel#fileSelectionWin#show ();
+      GtkThread.main ();
+      chosen_file
+
+    method private chooseDir ?(ok_not_exists = false) () =
+      _ok_not_exists <- ok_not_exists;
+      _only_directory <- true;
       fileSel#fileSelectionWin#show ();
       GtkThread.main ();
+      (* we should check that this is a directory *)
       chosen_file
+  
+    method createDevelopment ~containing =
+      next_devel_must_contain <- containing;
+      newDevel#toplevel#misc#show()
 
     method askText ?(title = "") ?(msg = "") () =
       let dialog = new textDialog () in