first attempt in 'create project' function
authorClaus Gittinger <cg@exept.de>
Sat, 22 Jan 2000 18:53:18 +0100
changeset 2562 da7680fe8407
parent 2561 6f19bef93a30
child 2563 1367d7f1b0a8
first attempt in 'create project' function
FileBrowser.st
--- a/FileBrowser.st	Fri Jan 21 18:16:57 2000 +0100
+++ b/FileBrowser.st	Sat Jan 22 18:53:18 2000 +0100
@@ -1006,6 +1006,12 @@
                   #enabled: #hasSelection
                 )
                #(#MenuItem
+                  #label: 'Create Smalltalk Project'
+                  #translateLabel: true
+                  #value: #createProjectAndOpenProjectBrowser
+                  #enabled: #canCreateNewProject
+                )
+               #(#MenuItem
                   #label: 'Editor'
                   #translateLabel: true
                   #value: #openEditor
@@ -1222,6 +1228,16 @@
     "Modified: / 1.2.1999 / 20:38:42 / cg"
 !
 
+canCreateNewProject
+    ^ [ 
+        currentDirectory notNil
+        and:[((currentDirectory directoryContents 
+                select:[:f| f endsWith:'.prj']) size == 0)
+        and:[((currentDirectory directoryContents 
+                select:[:f| f endsWith:'.st']) size > 0)
+      ]]]
+!
+
 canDoTerminal
     ^ OperatingSystem isUNIXlike
       or:[OperatingSystem isMSWINDOWSlike]
@@ -3591,6 +3607,28 @@
     ].
 !
 
+createProjectAndOpenProjectBrowser
+    |nm f s|
+
+    nm := currentDirectory baseName.
+    f := (currentDirectory construct:nm) withSuffix:'prj'.
+    f exists ifTrue:[
+        self warn:'A file named ' , f baseName , ' alredy exists.'.
+        ^ self.
+    ].
+    s := f writeStream.
+    s nextPutAll:'
+name            ''' , nm , '''
+type            #classLibrary
+package         #''private:' , nm , '''
+prerequisites   nil
+
+classes      #( )
+'.
+    s close.
+    ProjectBrowser openOnFile:f.
+!
+
 menuExit
     self closeRequest
 
@@ -6944,5 +6982,5 @@
 !FileBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.361 2000-01-17 10:33:31 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.362 2000-01-22 17:53:18 cg Exp $'
 ! !