--- a/ProjectV.st Tue Dec 12 14:47:12 1995 +0100
+++ b/ProjectV.st Tue Dec 12 16:53:46 1995 +0100
@@ -11,10 +11,10 @@
"
StandardSystemView subclass:#ProjectView
- instanceVariableNames:'myProject toggle'
- classVariableNames:'ActiveProjectView'
- poolDictionaries:''
- category:'Interface-Smalltalk'
+ instanceVariableNames:'myProject toggle'
+ classVariableNames:'ActiveProjectView'
+ poolDictionaries:''
+ category:'Interface-Smalltalk'
!
!ProjectView class methodsFor:'documentation'!
@@ -38,26 +38,34 @@
ProjectViews basically offer two functionalities:
- keep a group of windows in order to organize the desktop
- (I am not sure, if this is really a useful feature, now that we
- have modern windowManagers which have multiple desktops as well).
+ (I am not sure, if this is really a useful feature, now that we
+ have modern windowManagers which have multiple desktops as well).
- All views as created while some project was active are remembered
- and can be hidden/shown altogether.
- (this has nothing to do with windowGroups)
+ All views as created while a project is active are remembered
+ and can be hidden/shown altogether.
+ (this has nothing to do with windowGroups)
- Also, it is possible to close down all those windows (by destroying the project).
+ Also, it is possible to close down all those windows (by destroying the project).
- keep defaults for various system activities:
- - the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)
+ - the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)
- - keep the source module/package
- thats the default offered when classes are checkedIn the very first time
+ - keep the source module/package
+ thats the default offered when classes are checkedIn the very first time
+
+ - keep a default package-identifier assigned when classes/methods are created/modified.
+ thats mostly useful to browse all classes/methods that have been touched
+ in a projects context
- - keep a default package-identifier assigned when classes/methods are created/modified.
- thats mostly useful to browse all classes/methods that have been touched
- in a projects context
+ - keep a per-project changeList
+
+ - allow opening a browser on all classes/methods which were created or modified
+ while a project was active.
- - keep a per-project changeList
+ - allow opening a browser on this projects changeList (which contains the subset of changes
+ which were done while this project was active)
+
+ - allow removal of all classes/methods which have the current projects packageIdentifier
"
! !
@@ -106,90 +114,90 @@
|labels selectors|
SourceCodeManager isNil ifTrue:[
- labels := #(
- 'rename ...'
- '-'
- 'changes'
- 'browse'
- '-'
- 'fileOut directory ...'
- 'package name ...'
- '-'
- 'show'
- 'hide'
- '-'
- 'remove package classes/methods'
- 'destroy'
- ).
+ labels := #(
+ 'rename ...'
+ '-'
+ 'changes'
+ 'browse'
+ '-'
+ 'fileOut directory ...'
+ 'package name ...'
+ '-'
+ 'show'
+ 'hide'
+ '-'
+ 'remove package classes/methods'
+ 'remove project'
+ ).
- selectors := #(
- renameProject
- nil
- browseChanges
- browsePackage
- nil
- projectDirectory
- projectPackage
- nil
- showProject
- hideProject
- nil
- removePackage
- destroy
- )
+ selectors := #(
+ renameProject
+ nil
+ browseChanges
+ browsePackage
+ nil
+ projectDirectory
+ projectPackage
+ nil
+ showProject
+ hideProject
+ nil
+ removePackage
+ destroy
+ )
] ifFalse:[
- labels := #(
- 'rename ...'
- '-'
- 'changes'
- 'browse'
- '-'
- 'fileOut directory ...'
- 'repository module ...'
- 'repository directory ...'
- 'package name ...'
+ labels := #(
+ 'rename ...'
+ '-'
+ 'changes'
+ 'browse'
+ '-'
+ 'fileOut directory ...'
+ 'repository module ...'
+ 'repository directory ...'
+ 'package name ...'
"/ '-'
"/ 'save project code'
"/ 'build'
- '-'
- 'show'
- 'hide'
- '-'
- 'remove package code'
- 'destroy'
- ).
+ '-'
+ 'show'
+ 'hide'
+ '-'
+ 'remove package code'
+ 'remove project'
+ ).
- selectors := #(
- renameProject
- nil
- browseChanges
- browsePackage
- nil
- projectDirectory
- projectModule
- projectRepository
- projectPackage
+ selectors := #(
+ renameProject
+ nil
+ browseChanges
+ browsePackage
+ nil
+ projectDirectory
+ projectModule
+ projectRepository
+ projectPackage
"/ nil
"/ saveProjectFiles
"/ buildProject
- nil
- showProject
- hideProject
- nil
- removePackage
- destroy
- )
+ nil
+ showProject
+ hideProject
+ nil
+ removePackage
+ destroy
+ )
].
toggle middleButtonMenu:(
- PopUpMenu
- labels:labels
- selectors:selectors
- receiver:self
+ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+ receiver:self
)
"Created: 25.11.1995 / 18:06:32 / cg"
- "Modified: 10.12.1995 / 00:05:41 / cg"
+ "Modified: 12.12.1995 / 16:48:31 / cg"
! !
!ProjectView methodsFor:'menu actions'!
@@ -198,46 +206,41 @@
|b|
b := ChangeSetBrowser openOn:(myProject changeSet).
- b label:'Changes in ' , myProject name
+ b label:(resources string:'Changes in %1' with:myProject name)
!
browsePackage
- "launch browsers for all classes/methods which are defined in this package"
+ "launch browsers for all classes/methods which are defined in this package
+ (i.e. whose packageIdentifier is the same as my Projects packageIdentifier)"
self topView withWaitCursorDo:[
- |classes packageName methods methodList|
+ |classes packageName methods methodList anyClasses anyMethods ignoredClasses|
+
+ anyMethods := anyClasses := false.
- packageName := myProject packageName.
- classes := myProject classes.
- (classes notNil and:[classes notEmpty]) ifTrue:[
- SystemBrowser browseClasses:classes
- title:'classes in package ' , packageName.
+ packageName := myProject packageName.
+ classes := myProject classes.
+ (classes notNil and:[classes notEmpty]) ifTrue:[
+ anyClasses := true.
+ ].
- classes := classes asIdentitySet.
- classes addAll:(classes collect:[:c | c class]).
- ] ifFalse:[
- classes := #()
- ].
-"/ SystemBrowser browseMethodsWhere:[:cls :mthd :sel |
-"/ mthd package = packageName
-"/ and:[(classes includes:cls) not]
-"/ ]
-"/ title:'individual methods in package ' , packageName.
-
- methods := myProject individualMethods.
- methodList := methods collect:[:m |
- |who|
-
- who := m who.
- (who at:1) name , ' ' , (who at:2)
- ].
- methodList notEmpty ifTrue:[
- SystemBrowser browseMethods:methodList
- title:'individual methods in package ' , packageName.
- ]
+ methods := myProject individualMethods.
+ methods notEmpty ifTrue:[
+ anyMethods := true.
+ SystemBrowser browseMethods:methods
+ title:(resources string:'individual methods in package %1' with:packageName).
+ ].
+ anyClasses ifTrue:[
+ SystemBrowser browseClasses:classes
+ title:(resources string:'classes in package %1' with:packageName).
+ ].
+ (anyClasses or:[anyMethods]) ifFalse:[
+ self information:(resources string:'no classes or methods in this project (yet)')
+ ]
]
"Created: 10.12.1995 / 00:08:58 / cg"
+ "Modified: 12.12.1995 / 16:35:07 / cg"
!
browseProps
@@ -260,33 +263,17 @@
destroy
(myProject views notNil
and:[myProject views notEmpty]) ifTrue:[
- |box|
+ |box|
- box := YesNoBox new.
- box title:'Destroying a project will discard all changes made
-for that project and destroy all views opened for it.
-
-Do you really want to do this ?'.
- box okText:'yes'.
- (box confirm) ifFalse:[^ self]
+ box := YesNoBox new.
+ box title:(resources string:'PROJECT_DESTROY') withCRs.
+ box okText:(resources string:'yes').
+ (box confirm) ifFalse:[^ self]
].
self doDestroy
-!
-destroyProject
- |box|
-
- box := YesNoBox new.
- box title:'Destroying a project will discard all changes made
-for that project and destroy all views opened for it.
-
-Do you really want to do this ?'.
- box okText:'yes'.
- box yesAction:[
- self doDestroyProject
- ].
- box showAtPointer
+ "Modified: 12.12.1995 / 16:44:54 / cg"
!
doDestroy
@@ -307,26 +294,26 @@
box := FilenameEnterBox new.
box directoriesOnly.
- box title:(resources string:'Directory of project (fileOuts will go there):').
+ box title:(resources string:'PROJECT_DIRECTPORY') withCRs.
(d := myProject directory) notNil ifTrue:[
- box initialText:d
+ box initialText:d
].
box action:[:dirName |
- (OperatingSystem isDirectory:dirName) ifFalse:[
- (OperatingSystem isValidPath:dirName) ifTrue:[
- self warn:(resources string:'%1 is not a valid directory' with:dirName).
- ^ self
- ].
- (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[
- (OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[
- self warn:(resources string:'cannot create %1' with:dirName)
- ]
- ].
- ].
- "did it work ?"
- (OperatingSystem isDirectory:dirName) ifTrue:[
- myProject directory:dirName
- ].
+ (OperatingSystem isDirectory:dirName) ifFalse:[
+ (OperatingSystem isValidPath:dirName) ifTrue:[
+ self warn:(resources string:'%1 is not a valid directory' with:dirName).
+ ^ self
+ ].
+ (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[
+ (OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[
+ self warn:(resources string:'cannot create %1' with:dirName)
+ ]
+ ].
+ ].
+ "did it work ?"
+ (OperatingSystem isDirectory:dirName) ifTrue:[
+ myProject directory:dirName
+ ].
].
box showAtPointer
!
@@ -336,12 +323,12 @@
box := FilenameEnterBox new.
box directoriesOnly.
- box title:(resources string:'Module in repository (new source containers / packages will go there):').
+ box title:(resources string:'PROJECT_MODULEDIR') withCRs.
(d := myProject repositoryModule) notNil ifTrue:[
- box initialText:d
+ box initialText:d
].
box action:[:dirName |
- myProject repositoryModule:dirName
+ myProject repositoryModule:dirName
].
box showAtPointer
@@ -351,62 +338,62 @@
projectPackage
self topView withWaitCursorDo:[
- |box p existingPackages allClasses|
+ |box p existingPackages allClasses|
- existingPackages := Set new.
- (allClasses := Smalltalk allClasses) do:[:aClass |
- |p|
+ existingPackages := Set new.
+ (allClasses := Smalltalk allClasses) do:[: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)
- ]
- ].
- ].
+ (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|
+ box := ListSelectionBox title:(resources string:'PROJECT_PACKAGENAME') withCRs.
+ box list:(existingPackages asOrderedCollection sort).
+ (p := myProject packageName) notNil ifTrue:[
+ box initialText:p
+ ].
+ box action:[:packageName |
+ |someClass module directory|
- "/ (try) to extract the module & repository directory from someClass which
- "/ is already contained in that package
+ "/ (try) to extract the module & repository directory from someClass which
+ "/ is already contained in that package
- Smalltalk allClasses
- detect:[:cls |
- |info|
+ Smalltalk allClasses
+ detect:[:cls |
+ |info|
- (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].
- ]
- ifNone:nil.
+ (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].
+ ]
+ ifNone:nil.
- module notNil ifTrue:[
- myProject repositoryModule:module
- ].
- directory notNil ifTrue:[
- myProject repositoryDirectory:directory
- ].
- myProject packageName:packageName.
+ module notNil ifTrue:[
+ myProject repositoryModule:module
+ ].
+ directory notNil ifTrue:[
+ myProject repositoryDirectory:directory
+ ].
+ myProject packageName:packageName.
- ].
- box showAtPointer
+ ].
+ box showAtPointer
]
"Created: 9.12.1995 / 16:50:45 / cg"
@@ -418,12 +405,12 @@
box := FilenameEnterBox new.
box directoriesOnly.
- box title:(resources string:'Relative path of package in repository (new source containers will go there):').
+ box title:(resources string:'PROJECT_PACKAGEDIR') withCRs.
(d := myProject repositoryDirectory) notNil ifTrue:[
- box initialText:d
+ box initialText:d
].
box action:[:dirName |
- myProject repositoryDirectory:dirName
+ myProject repositoryDirectory:dirName
].
box showAtPointer
@@ -442,70 +429,69 @@
(myProject isNil
or:[(theProject := myProject packageName) isNil]) ifTrue:[
- self warn:'No current package'.
- ^ self
+ self warn:(resources string:'No current package.').
+ ^ self
].
classesToRemove := IdentitySet new.
methodsToRemove := IdentitySet new.
Smalltalk allClassesDo:[:aClass |
- |p|
+ |p|
- (p := aClass package) notNil ifTrue:[
- p = theProject ifTrue:[
- classesToRemove add:aClass
- ]
- ].
+ (p := aClass package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ classesToRemove add:aClass
+ ]
+ ].
].
Smalltalk allClassesDo:[:aClass |
- |p|
+ |p|
- (classesToRemove includes:aClass) ifFalse:[
- aClass methodArray do:[:aMethod |
- (p := aMethod package) notNil ifTrue:[
- p = theProject ifTrue:[
- methodsToRemove add:aMethod
- ]
- ]
- ].
- aClass class methodArray do:[:aMethod |
- (p := aMethod package) notNil ifTrue:[
- p = theProject ifTrue:[
- methodsToRemove add:aMethod
- ]
- ]
- ].
- ].
+ (classesToRemove includes:aClass) ifFalse:[
+ aClass methodArray do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ methodsToRemove add:aMethod
+ ]
+ ]
+ ].
+ aClass class methodArray do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ methodsToRemove add:aMethod
+ ]
+ ]
+ ].
+ ].
].
(classesToRemove isEmpty
and:[methodsToRemove isEmpty]) ifTrue:[
- self warn:('Nothing found in ' , theProject).
- ^ self
+ self warn:(resources string:'No classes or methods found in %1' with:theProject).
+ ^ self
].
- (self confirm:('About to remove '
- , classesToRemove size printString
- , ' classes and '
- , methodsToRemove size printString
- , ' additional methods.\\Are you certain you want this ?') withCRs)
- ifTrue:[
- classesToRemove do:[:aClass |
- ('PROJECT: removing ' , aClass name) infoPrintNL.
- Smalltalk removeClass:aClass.
- ].
- methodsToRemove do:[:aMethod |
- |where|
+ (self confirm:(resources
+ string:'About to remove %1 classes and %2 additional methods.\\Are you certain you want this ?'
+ with:classesToRemove size printString
+ with:methodsToRemove size printString) withCRs)
+ ifTrue:[
+ classesToRemove do:[:aClass |
+ ('PROJECT: removing ' , aClass name) infoPrintNL.
+ Smalltalk removeClass:aClass.
+ ].
+ methodsToRemove do:[:aMethod |
+ |where|
- ('PROJECT: removing ' , aMethod displayString) infoPrintNL.
- where := aMethod who.
- where isNil ifTrue:[
- 'PROJECT: oops, some method is gone' infoPrintNL.
- ] ifFalse:[
- (where at:1) removeSelector:(where at:2)
- ]
- ]
+ ('PROJECT: removing ' , aMethod displayString) infoPrintNL.
+ where := aMethod who.
+ where isNil ifTrue:[
+ 'PROJECT: oops, some method is gone' infoPrintNL.
+ ] ifFalse:[
+ (where at:1) removeSelector:(where at:2)
+ ]
+ ]
].
!
@@ -513,15 +499,17 @@
|box|
box := EnterBox new.
- box title:'new name of project:'.
- box okText:'rename'.
+ box title:(resources string:'new name of project:').
+ box okText:(resources string:'rename').
box initialText:(myProject name).
box action:[:newName |
- myProject name:newName.
- self setProject:myProject.
- self windowGroup process name:'Project: ' , newName.
+ myProject name:newName.
+ self setProject:myProject.
+ self windowGroup process name:'Project: ' , newName.
].
box showAtPointer
+
+ "Modified: 12.12.1995 / 16:22:48 / cg"
!
saveProjectFiles
@@ -574,4 +562,4 @@
!ProjectView class methodsFor:'documentation'!
version
-^ '$Header: /cvs/stx/stx/libtool/Attic/ProjectV.st,v 1.24 1995-12-12 12:23:08 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libtool/Attic/ProjectV.st,v 1.25 1995-12-12 15:53:46 cg Exp $'! !
--- a/ProjectView.st Tue Dec 12 14:47:12 1995 +0100
+++ b/ProjectView.st Tue Dec 12 16:53:46 1995 +0100
@@ -11,10 +11,10 @@
"
StandardSystemView subclass:#ProjectView
- instanceVariableNames:'myProject toggle'
- classVariableNames:'ActiveProjectView'
- poolDictionaries:''
- category:'Interface-Smalltalk'
+ instanceVariableNames:'myProject toggle'
+ classVariableNames:'ActiveProjectView'
+ poolDictionaries:''
+ category:'Interface-Smalltalk'
!
!ProjectView class methodsFor:'documentation'!
@@ -38,26 +38,34 @@
ProjectViews basically offer two functionalities:
- keep a group of windows in order to organize the desktop
- (I am not sure, if this is really a useful feature, now that we
- have modern windowManagers which have multiple desktops as well).
+ (I am not sure, if this is really a useful feature, now that we
+ have modern windowManagers which have multiple desktops as well).
- All views as created while some project was active are remembered
- and can be hidden/shown altogether.
- (this has nothing to do with windowGroups)
+ All views as created while a project is active are remembered
+ and can be hidden/shown altogether.
+ (this has nothing to do with windowGroups)
- Also, it is possible to close down all those windows (by destroying the project).
+ Also, it is possible to close down all those windows (by destroying the project).
- keep defaults for various system activities:
- - the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)
+ - the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)
- - keep the source module/package
- thats the default offered when classes are checkedIn the very first time
+ - keep the source module/package
+ thats the default offered when classes are checkedIn the very first time
+
+ - keep a default package-identifier assigned when classes/methods are created/modified.
+ thats mostly useful to browse all classes/methods that have been touched
+ in a projects context
- - keep a default package-identifier assigned when classes/methods are created/modified.
- thats mostly useful to browse all classes/methods that have been touched
- in a projects context
+ - keep a per-project changeList
+
+ - allow opening a browser on all classes/methods which were created or modified
+ while a project was active.
- - keep a per-project changeList
+ - allow opening a browser on this projects changeList (which contains the subset of changes
+ which were done while this project was active)
+
+ - allow removal of all classes/methods which have the current projects packageIdentifier
"
! !
@@ -106,90 +114,90 @@
|labels selectors|
SourceCodeManager isNil ifTrue:[
- labels := #(
- 'rename ...'
- '-'
- 'changes'
- 'browse'
- '-'
- 'fileOut directory ...'
- 'package name ...'
- '-'
- 'show'
- 'hide'
- '-'
- 'remove package classes/methods'
- 'destroy'
- ).
+ labels := #(
+ 'rename ...'
+ '-'
+ 'changes'
+ 'browse'
+ '-'
+ 'fileOut directory ...'
+ 'package name ...'
+ '-'
+ 'show'
+ 'hide'
+ '-'
+ 'remove package classes/methods'
+ 'remove project'
+ ).
- selectors := #(
- renameProject
- nil
- browseChanges
- browsePackage
- nil
- projectDirectory
- projectPackage
- nil
- showProject
- hideProject
- nil
- removePackage
- destroy
- )
+ selectors := #(
+ renameProject
+ nil
+ browseChanges
+ browsePackage
+ nil
+ projectDirectory
+ projectPackage
+ nil
+ showProject
+ hideProject
+ nil
+ removePackage
+ destroy
+ )
] ifFalse:[
- labels := #(
- 'rename ...'
- '-'
- 'changes'
- 'browse'
- '-'
- 'fileOut directory ...'
- 'repository module ...'
- 'repository directory ...'
- 'package name ...'
+ labels := #(
+ 'rename ...'
+ '-'
+ 'changes'
+ 'browse'
+ '-'
+ 'fileOut directory ...'
+ 'repository module ...'
+ 'repository directory ...'
+ 'package name ...'
"/ '-'
"/ 'save project code'
"/ 'build'
- '-'
- 'show'
- 'hide'
- '-'
- 'remove package code'
- 'destroy'
- ).
+ '-'
+ 'show'
+ 'hide'
+ '-'
+ 'remove package code'
+ 'remove project'
+ ).
- selectors := #(
- renameProject
- nil
- browseChanges
- browsePackage
- nil
- projectDirectory
- projectModule
- projectRepository
- projectPackage
+ selectors := #(
+ renameProject
+ nil
+ browseChanges
+ browsePackage
+ nil
+ projectDirectory
+ projectModule
+ projectRepository
+ projectPackage
"/ nil
"/ saveProjectFiles
"/ buildProject
- nil
- showProject
- hideProject
- nil
- removePackage
- destroy
- )
+ nil
+ showProject
+ hideProject
+ nil
+ removePackage
+ destroy
+ )
].
toggle middleButtonMenu:(
- PopUpMenu
- labels:labels
- selectors:selectors
- receiver:self
+ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+ receiver:self
)
"Created: 25.11.1995 / 18:06:32 / cg"
- "Modified: 10.12.1995 / 00:05:41 / cg"
+ "Modified: 12.12.1995 / 16:48:31 / cg"
! !
!ProjectView methodsFor:'menu actions'!
@@ -198,46 +206,41 @@
|b|
b := ChangeSetBrowser openOn:(myProject changeSet).
- b label:'Changes in ' , myProject name
+ b label:(resources string:'Changes in %1' with:myProject name)
!
browsePackage
- "launch browsers for all classes/methods which are defined in this package"
+ "launch browsers for all classes/methods which are defined in this package
+ (i.e. whose packageIdentifier is the same as my Projects packageIdentifier)"
self topView withWaitCursorDo:[
- |classes packageName methods methodList|
+ |classes packageName methods methodList anyClasses anyMethods ignoredClasses|
+
+ anyMethods := anyClasses := false.
- packageName := myProject packageName.
- classes := myProject classes.
- (classes notNil and:[classes notEmpty]) ifTrue:[
- SystemBrowser browseClasses:classes
- title:'classes in package ' , packageName.
+ packageName := myProject packageName.
+ classes := myProject classes.
+ (classes notNil and:[classes notEmpty]) ifTrue:[
+ anyClasses := true.
+ ].
- classes := classes asIdentitySet.
- classes addAll:(classes collect:[:c | c class]).
- ] ifFalse:[
- classes := #()
- ].
-"/ SystemBrowser browseMethodsWhere:[:cls :mthd :sel |
-"/ mthd package = packageName
-"/ and:[(classes includes:cls) not]
-"/ ]
-"/ title:'individual methods in package ' , packageName.
-
- methods := myProject individualMethods.
- methodList := methods collect:[:m |
- |who|
-
- who := m who.
- (who at:1) name , ' ' , (who at:2)
- ].
- methodList notEmpty ifTrue:[
- SystemBrowser browseMethods:methodList
- title:'individual methods in package ' , packageName.
- ]
+ methods := myProject individualMethods.
+ methods notEmpty ifTrue:[
+ anyMethods := true.
+ SystemBrowser browseMethods:methods
+ title:(resources string:'individual methods in package %1' with:packageName).
+ ].
+ anyClasses ifTrue:[
+ SystemBrowser browseClasses:classes
+ title:(resources string:'classes in package %1' with:packageName).
+ ].
+ (anyClasses or:[anyMethods]) ifFalse:[
+ self information:(resources string:'no classes or methods in this project (yet)')
+ ]
]
"Created: 10.12.1995 / 00:08:58 / cg"
+ "Modified: 12.12.1995 / 16:35:07 / cg"
!
browseProps
@@ -260,33 +263,17 @@
destroy
(myProject views notNil
and:[myProject views notEmpty]) ifTrue:[
- |box|
+ |box|
- box := YesNoBox new.
- box title:'Destroying a project will discard all changes made
-for that project and destroy all views opened for it.
-
-Do you really want to do this ?'.
- box okText:'yes'.
- (box confirm) ifFalse:[^ self]
+ box := YesNoBox new.
+ box title:(resources string:'PROJECT_DESTROY') withCRs.
+ box okText:(resources string:'yes').
+ (box confirm) ifFalse:[^ self]
].
self doDestroy
-!
-destroyProject
- |box|
-
- box := YesNoBox new.
- box title:'Destroying a project will discard all changes made
-for that project and destroy all views opened for it.
-
-Do you really want to do this ?'.
- box okText:'yes'.
- box yesAction:[
- self doDestroyProject
- ].
- box showAtPointer
+ "Modified: 12.12.1995 / 16:44:54 / cg"
!
doDestroy
@@ -307,26 +294,26 @@
box := FilenameEnterBox new.
box directoriesOnly.
- box title:(resources string:'Directory of project (fileOuts will go there):').
+ box title:(resources string:'PROJECT_DIRECTPORY') withCRs.
(d := myProject directory) notNil ifTrue:[
- box initialText:d
+ box initialText:d
].
box action:[:dirName |
- (OperatingSystem isDirectory:dirName) ifFalse:[
- (OperatingSystem isValidPath:dirName) ifTrue:[
- self warn:(resources string:'%1 is not a valid directory' with:dirName).
- ^ self
- ].
- (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[
- (OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[
- self warn:(resources string:'cannot create %1' with:dirName)
- ]
- ].
- ].
- "did it work ?"
- (OperatingSystem isDirectory:dirName) ifTrue:[
- myProject directory:dirName
- ].
+ (OperatingSystem isDirectory:dirName) ifFalse:[
+ (OperatingSystem isValidPath:dirName) ifTrue:[
+ self warn:(resources string:'%1 is not a valid directory' with:dirName).
+ ^ self
+ ].
+ (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[
+ (OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[
+ self warn:(resources string:'cannot create %1' with:dirName)
+ ]
+ ].
+ ].
+ "did it work ?"
+ (OperatingSystem isDirectory:dirName) ifTrue:[
+ myProject directory:dirName
+ ].
].
box showAtPointer
!
@@ -336,12 +323,12 @@
box := FilenameEnterBox new.
box directoriesOnly.
- box title:(resources string:'Module in repository (new source containers / packages will go there):').
+ box title:(resources string:'PROJECT_MODULEDIR') withCRs.
(d := myProject repositoryModule) notNil ifTrue:[
- box initialText:d
+ box initialText:d
].
box action:[:dirName |
- myProject repositoryModule:dirName
+ myProject repositoryModule:dirName
].
box showAtPointer
@@ -351,62 +338,62 @@
projectPackage
self topView withWaitCursorDo:[
- |box p existingPackages allClasses|
+ |box p existingPackages allClasses|
- existingPackages := Set new.
- (allClasses := Smalltalk allClasses) do:[:aClass |
- |p|
+ existingPackages := Set new.
+ (allClasses := Smalltalk allClasses) do:[: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)
- ]
- ].
- ].
+ (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|
+ box := ListSelectionBox title:(resources string:'PROJECT_PACKAGENAME') withCRs.
+ box list:(existingPackages asOrderedCollection sort).
+ (p := myProject packageName) notNil ifTrue:[
+ box initialText:p
+ ].
+ box action:[:packageName |
+ |someClass module directory|
- "/ (try) to extract the module & repository directory from someClass which
- "/ is already contained in that package
+ "/ (try) to extract the module & repository directory from someClass which
+ "/ is already contained in that package
- Smalltalk allClasses
- detect:[:cls |
- |info|
+ Smalltalk allClasses
+ detect:[:cls |
+ |info|
- (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].
- ]
- ifNone:nil.
+ (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].
+ ]
+ ifNone:nil.
- module notNil ifTrue:[
- myProject repositoryModule:module
- ].
- directory notNil ifTrue:[
- myProject repositoryDirectory:directory
- ].
- myProject packageName:packageName.
+ module notNil ifTrue:[
+ myProject repositoryModule:module
+ ].
+ directory notNil ifTrue:[
+ myProject repositoryDirectory:directory
+ ].
+ myProject packageName:packageName.
- ].
- box showAtPointer
+ ].
+ box showAtPointer
]
"Created: 9.12.1995 / 16:50:45 / cg"
@@ -418,12 +405,12 @@
box := FilenameEnterBox new.
box directoriesOnly.
- box title:(resources string:'Relative path of package in repository (new source containers will go there):').
+ box title:(resources string:'PROJECT_PACKAGEDIR') withCRs.
(d := myProject repositoryDirectory) notNil ifTrue:[
- box initialText:d
+ box initialText:d
].
box action:[:dirName |
- myProject repositoryDirectory:dirName
+ myProject repositoryDirectory:dirName
].
box showAtPointer
@@ -442,70 +429,69 @@
(myProject isNil
or:[(theProject := myProject packageName) isNil]) ifTrue:[
- self warn:'No current package'.
- ^ self
+ self warn:(resources string:'No current package.').
+ ^ self
].
classesToRemove := IdentitySet new.
methodsToRemove := IdentitySet new.
Smalltalk allClassesDo:[:aClass |
- |p|
+ |p|
- (p := aClass package) notNil ifTrue:[
- p = theProject ifTrue:[
- classesToRemove add:aClass
- ]
- ].
+ (p := aClass package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ classesToRemove add:aClass
+ ]
+ ].
].
Smalltalk allClassesDo:[:aClass |
- |p|
+ |p|
- (classesToRemove includes:aClass) ifFalse:[
- aClass methodArray do:[:aMethod |
- (p := aMethod package) notNil ifTrue:[
- p = theProject ifTrue:[
- methodsToRemove add:aMethod
- ]
- ]
- ].
- aClass class methodArray do:[:aMethod |
- (p := aMethod package) notNil ifTrue:[
- p = theProject ifTrue:[
- methodsToRemove add:aMethod
- ]
- ]
- ].
- ].
+ (classesToRemove includes:aClass) ifFalse:[
+ aClass methodArray do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ methodsToRemove add:aMethod
+ ]
+ ]
+ ].
+ aClass class methodArray do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ methodsToRemove add:aMethod
+ ]
+ ]
+ ].
+ ].
].
(classesToRemove isEmpty
and:[methodsToRemove isEmpty]) ifTrue:[
- self warn:('Nothing found in ' , theProject).
- ^ self
+ self warn:(resources string:'No classes or methods found in %1' with:theProject).
+ ^ self
].
- (self confirm:('About to remove '
- , classesToRemove size printString
- , ' classes and '
- , methodsToRemove size printString
- , ' additional methods.\\Are you certain you want this ?') withCRs)
- ifTrue:[
- classesToRemove do:[:aClass |
- ('PROJECT: removing ' , aClass name) infoPrintNL.
- Smalltalk removeClass:aClass.
- ].
- methodsToRemove do:[:aMethod |
- |where|
+ (self confirm:(resources
+ string:'About to remove %1 classes and %2 additional methods.\\Are you certain you want this ?'
+ with:classesToRemove size printString
+ with:methodsToRemove size printString) withCRs)
+ ifTrue:[
+ classesToRemove do:[:aClass |
+ ('PROJECT: removing ' , aClass name) infoPrintNL.
+ Smalltalk removeClass:aClass.
+ ].
+ methodsToRemove do:[:aMethod |
+ |where|
- ('PROJECT: removing ' , aMethod displayString) infoPrintNL.
- where := aMethod who.
- where isNil ifTrue:[
- 'PROJECT: oops, some method is gone' infoPrintNL.
- ] ifFalse:[
- (where at:1) removeSelector:(where at:2)
- ]
- ]
+ ('PROJECT: removing ' , aMethod displayString) infoPrintNL.
+ where := aMethod who.
+ where isNil ifTrue:[
+ 'PROJECT: oops, some method is gone' infoPrintNL.
+ ] ifFalse:[
+ (where at:1) removeSelector:(where at:2)
+ ]
+ ]
].
!
@@ -513,15 +499,17 @@
|box|
box := EnterBox new.
- box title:'new name of project:'.
- box okText:'rename'.
+ box title:(resources string:'new name of project:').
+ box okText:(resources string:'rename').
box initialText:(myProject name).
box action:[:newName |
- myProject name:newName.
- self setProject:myProject.
- self windowGroup process name:'Project: ' , newName.
+ myProject name:newName.
+ self setProject:myProject.
+ self windowGroup process name:'Project: ' , newName.
].
box showAtPointer
+
+ "Modified: 12.12.1995 / 16:22:48 / cg"
!
saveProjectFiles
@@ -574,4 +562,4 @@
!ProjectView class methodsFor:'documentation'!
version
-^ '$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.24 1995-12-12 12:23:08 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.25 1995-12-12 15:53:46 cg Exp $'! !