Mercurial Mercurial > hg > stx-libtool / changeset
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | raw | zip | gz | bz2 | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
better defaults when creating a container
authorClaus Gittinger <cg@exept.de>
Sat, 09 Dec 1995 18:41:15 +0100
changeset 259 c651fecef457
parent 258 666b701b5c7e
child 260 9b5aa1495864
better defaults when creating a container
ProjectV.st file | annotate | diff | comparison | revisions
ProjectView.st file | annotate | diff | comparison | revisions 
--- a/ProjectV.st	Sat Dec 09 18:36:44 1995 +0100
+++ b/ProjectV.st	Sat Dec 09 18:41:15 1995 +0100
@@ -333,37 +333,65 @@
 
 projectPackage
     self topView withWaitCursorDo:[
-	|box p existingPackages|
+        |box p existingPackages allClasses|
+
+        existingPackages := Set new.
+        (allClasses := Smalltalk allClasses) do:[:aClass |
+            |p|
 
-	existingPackages := Set new.
-	Smalltalk allClassesDo:[:aClass |
-	    |p|
+            (p := aClass package) notNil ifTrue:[
+                existingPackages add:(p asString)
+            ].
+            aClass methodArray do:[:aMethod |
+                (p := aMethod package) notNil ifTrue:[
+                    existingPackages add:(p asString)
+                ]
+            ].
+            aClass class methodArray do:[:aMethod |
+                (p := aMethod package) notNil ifTrue:[
+                    existingPackages add:(p asString)
+                ]
+            ].
+        ].
+
+        box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
+        box list:(existingPackages asOrderedCollection sort).
+        (p := myProject packageName) notNil ifTrue:[
+            box initialText:p
+        ].
+        box action:[:packageName |
+            |someClass module directory|
 
-	    (p := aClass package) notNil ifTrue:[
-		existingPackages add:(p asString)
-	    ].
-	    aClass methodArray do:[:aMethod |
-		(p := aMethod package) notNil ifTrue:[
-		    existingPackages add:(p asString)
-		]
-	    ].
-	    aClass class methodArray do:[:aMethod |
-		(p := aMethod package) notNil ifTrue:[
-		    existingPackages add:(p asString)
-		]
-	    ].
-	].
+            "/ (try) to extract the module & repository directory from someClass which
+            "/ is already contained in that package
+
+            Smalltalk allClasses 
+                detect:[:cls | 
+                                |info|
 
-	box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
-	box list:(existingPackages asOrderedCollection sort).
-	(p := myProject packageName) notNil ifTrue:[
-	    box initialText:p
-	].
-	box action:[:packageName |
-	    myProject packageName:packageName
-	].
-	box showAtPointer
+                                (cls package = packageName) ifTrue:[
+                                    (info := cls packageSourceCodeInfo) notNil ifTrue:[
+                                        module := info at:#module ifAbsent:nil.
+                                        directory := info at:#directory ifAbsent:nil.
+                                    ]
+                                ].
+                                module notNil and:[directory notNil].
+                          ].
+
+            module notNil ifTrue:[
+                myProject repositoryModule:module
+            ].
+            directory notNil ifTrue:[
+                myProject repositoryDirectory:directory
+            ].
+            myProject packageName:packageName.
+
+        ].
+        box showAtPointer
     ]
+
+    "Created: 9.12.1995 / 16:50:45 / cg"
+    "Modified: 9.12.1995 / 17:13:22 / cg"
 !
 
 projectRepository
@@ -527,4 +555,4 @@
 !ProjectView class methodsFor:'documentation'!
 
 version
-^ '$Header: /cvs/stx/stx/libtool/Attic/ProjectV.st,v 1.21 1995-11-25 18:04:47 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libtool/Attic/ProjectV.st,v 1.22 1995-12-09 17:41:15 cg Exp $'! !
--- a/ProjectView.st	Sat Dec 09 18:36:44 1995 +0100
+++ b/ProjectView.st	Sat Dec 09 18:41:15 1995 +0100
@@ -333,37 +333,65 @@
 
 projectPackage
     self topView withWaitCursorDo:[
-	|box p existingPackages|
+        |box p existingPackages allClasses|
+
+        existingPackages := Set new.
+        (allClasses := Smalltalk allClasses) do:[:aClass |
+            |p|
 
-	existingPackages := Set new.
-	Smalltalk allClassesDo:[:aClass |
-	    |p|
+            (p := aClass package) notNil ifTrue:[
+                existingPackages add:(p asString)
+            ].
+            aClass methodArray do:[:aMethod |
+                (p := aMethod package) notNil ifTrue:[
+                    existingPackages add:(p asString)
+                ]
+            ].
+            aClass class methodArray do:[:aMethod |
+                (p := aMethod package) notNil ifTrue:[
+                    existingPackages add:(p asString)
+                ]
+            ].
+        ].
+
+        box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
+        box list:(existingPackages asOrderedCollection sort).
+        (p := myProject packageName) notNil ifTrue:[
+            box initialText:p
+        ].
+        box action:[:packageName |
+            |someClass module directory|
 
-	    (p := aClass package) notNil ifTrue:[
-		existingPackages add:(p asString)
-	    ].
-	    aClass methodArray do:[:aMethod |
-		(p := aMethod package) notNil ifTrue:[
-		    existingPackages add:(p asString)
-		]
-	    ].
-	    aClass class methodArray do:[:aMethod |
-		(p := aMethod package) notNil ifTrue:[
-		    existingPackages add:(p asString)
-		]
-	    ].
-	].
+            "/ (try) to extract the module & repository directory from someClass which
+            "/ is already contained in that package
+
+            Smalltalk allClasses 
+                detect:[:cls | 
+                                |info|
 
-	box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
-	box list:(existingPackages asOrderedCollection sort).
-	(p := myProject packageName) notNil ifTrue:[
-	    box initialText:p
-	].
-	box action:[:packageName |
-	    myProject packageName:packageName
-	].
-	box showAtPointer
+                                (cls package = packageName) ifTrue:[
+                                    (info := cls packageSourceCodeInfo) notNil ifTrue:[
+                                        module := info at:#module ifAbsent:nil.
+                                        directory := info at:#directory ifAbsent:nil.
+                                    ]
+                                ].
+                                module notNil and:[directory notNil].
+                          ].
+
+            module notNil ifTrue:[
+                myProject repositoryModule:module
+            ].
+            directory notNil ifTrue:[
+                myProject repositoryDirectory:directory
+            ].
+            myProject packageName:packageName.
+
+        ].
+        box showAtPointer
     ]
+
+    "Created: 9.12.1995 / 16:50:45 / cg"
+    "Modified: 9.12.1995 / 17:13:22 / cg"
 !
 
 projectRepository
@@ -527,4 +555,4 @@
 !ProjectView class methodsFor:'documentation'!
 
 version
-^ '$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.21 1995-11-25 18:04:47 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.22 1995-12-09 17:41:15 cg Exp $'! !
hg/stx-libtool