# HG changeset patch # User Claus Gittinger # Date 818783626 -3600 # Node ID 9d33deca396c52c18cf09d774dc974624c962742 # Parent b4b2782bc733396b0fdc4fb65041eb9fd32fe8a4 better message (nationalized) diff -r b4b2782bc733 -r 9d33deca396c ProjectV.st --- 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 $'! ! diff -r b4b2782bc733 -r 9d33deca396c ProjectView.st --- 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 $'! !