--- a/AbstractSourceCodeManager.st Wed Aug 09 21:51:55 2006 +0200
+++ b/AbstractSourceCodeManager.st Thu Aug 10 00:16:05 2006 +0200
@@ -396,46 +396,70 @@
Raises abortSignal if checkIn is to be suppressed.
returns:
#base - only check in methods from the classes package
- #all - check in all"
+ #all - check in all
- |checkInClassPackageOnly clsPackage otherPackages otherPackagesNames methodsFromOtherPackages
+ the old code looked for all extensions, and allowed them to be moved to the base-package.
+ This was dangerous, as if one presses yes too quickly, extensions move to the base too easy.
+ The new code only allows for extensions from the __NOPROJECT__ package to be moved.
+ Extensions always remain extensions, and must be moved by an explicit method-menu action.
+ "
+
+ |checkInClassPackageOnly clsPackage otherPackages otherPackageNames methodsFromOtherPackages
methodCategoriesInOtherPackages methodCategoryInOtherPackages
- msg answer isDefaultAnswer defaultAnswer labels actions|
+ msg answer isDefaultAnswer defaultAnswer labels actions hasUnassignedExtensions
+ unassignedMethods methodCategoriesWithUnassignedMethods methodCategoryWithUnassignedMethods
+ args|
checkInClassPackageOnly := false.
clsPackage := aClass package.
+
otherPackages := Set new.
- methodsFromOtherPackages := IdentitySet new.
+ methodsFromOtherPackages := OrderedCollection new.
+ hasUnassignedExtensions := false.
+ unassignedMethods := OrderedCollection new.
+ methodCategoriesWithUnassignedMethods := Set new.
+ methodCategoriesInOtherPackages := Set new.
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mthdPackage|
(mthdPackage := mthd package) ~= clsPackage ifTrue:[
- methodsFromOtherPackages add:mthd.
- otherPackages add:mthdPackage.
+ mthdPackage == Project noProjectID ifTrue:[
+ hasUnassignedExtensions := true.
+ unassignedMethods add:mthd.
+ methodCategoriesWithUnassignedMethods add:(mthd category).
+ ] ifFalse:[
+ methodsFromOtherPackages add:mthd.
+ otherPackages add:mthdPackage.
+ methodCategoriesInOtherPackages add:(mthd category).
+ ].
]
].
- otherPackages isEmpty ifTrue:[
+
+ hasUnassignedExtensions ifFalse:[
aClass allPrivateClassesDo:[:eachPrivateClass |
aClass setPackage:clsPackage.
eachPrivateClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd setPackage:clsPackage
]
].
- ^ #all
+ ^ #base
].
+
otherPackages := otherPackages asOrderedCollection sort.
- otherPackagesNames := String streamContents:[:stream|
+ otherPackageNames := String streamContents:[:stream|
otherPackages
do:[:eachPackageName| eachPackageName printOn:stream]
separatedBy:[stream nextPutAll:', '].
].
- methodCategoriesInOtherPackages := (methodsFromOtherPackages collect:[:eachMethod | eachMethod category]) asSet.
methodCategoriesInOtherPackages size == 1 ifTrue:[
methodCategoryInOtherPackages := methodCategoriesInOtherPackages anElement.
].
+ methodCategoriesWithUnassignedMethods size == 1 ifTrue:[
+ methodCategoryWithUnassignedMethods := methodCategoriesWithUnassignedMethods anElement.
+ ].
isDefaultAnswer := false.
(SourceCodeManagerUtilities yesToAllNotification notNil
@@ -443,37 +467,44 @@
answer := isDefaultAnswer := true.
] ifFalse:[
defaultAnswer := false.
- msg := 'The class ''' , aClass name allBold.
- otherPackages size == 1 ifTrue:[
- msg := msg , ''' contains %4 method(s) for the ''%1'' package'.
- defaultAnswer := (otherPackages first = Project defaultProject package).
+
+ methodCategoriesWithUnassignedMethods size == 1 ifTrue:[
+ unassignedMethods size == 1 ifTrue:[
+ msg := 'The class ''%1'' contains the unassigned method: %6'.
+ msg := msg , '\(In the ''%4'' category).'.
+ ] ifFalse:[
+ msg := 'The class ''%1'' contains %3 unassigned method(s)'.
+ msg := msg , '\(In the ''%4'' category).'.
+ ]
] ifFalse:[
- msg := msg , ''' contains %4 method(s) for %2 other packages:\ %1'.
+ msg := 'The class ''%1'' contains %3 unassigned methods in %5 categories.'.
].
- methodCategoriesInOtherPackages size == 1 ifTrue:[
- msg := msg , ' (in category: ''%5'').'.
+ unassignedMethods size == 1 ifTrue:[
+ msg := msg , '\\Move this method to the ''%2'' package ?'.
] ifFalse:[
- msg := msg , ' (in %6 categories).'.
+ msg := msg , '\\Move those to the ''%2'' package ?'.
].
- msg := msg , '\\Change those to belong to the ''%3'' package ?'.
+ args := Array
+ with:aClass name allBold
+ with:clsPackage allBold
+ with:unassignedMethods size
+ with:methodCategoryWithUnassignedMethods
+ with:methodCategoriesWithUnassignedMethods size
+ with:unassignedMethods first selector allBold.
SourceCodeManagerUtilities yesToAllNotification isHandled
ifTrue:[
labels := #('Cancel' 'No' 'Browse' 'Yes to all' 'Yes').
- actions := #(nil false #browse #yesToAll true).
+ actions := #(#cancel false #browse #yesToAll true).
] ifFalse:[
labels := #('Cancel' 'No' 'Browse' 'Yes').
- actions := #(nil false #browse true).
+ actions := #(#cancel false #browse true).
].
answer := OptionBox
- request:(msg bindWith:otherPackagesNames allBold
- with:(otherPackages size)
- with:clsPackage allBold
- with:methodsFromOtherPackages size
- with:methodCategoryInOtherPackages
- with:methodCategoriesInOtherPackages size
- ) withCRs
+ request:(SystemBrowser classResources
+ stringWithCRs:msg
+ withArgs:args)
label:'Change packageID ?'
image:(InfoBox iconBitmap)
buttonLabels:(Dialog resources array:labels)
@@ -485,49 +516,26 @@
browseMethods:methodsFromOtherPackages
title:('Extensions in %1' bindWith:aClass name)
sort:true.
- AbortSignal raise
+ answer := #cancel.
].
].
+ answer == #cancel ifTrue:[
+ AbortSignal raise
+ ].
answer == #yesToAll ifTrue:[
SourceCodeManagerUtilities yesToAllNotification raiseWith:true.
answer := true.
].
+ "/ ok, move them over
answer == true ifTrue:[
- ((otherPackages size > 1)
- or:[otherPackages first ~= Project defaultProject package]) ifTrue:[
- isDefaultAnswer ifFalse:[
- msg := ''
- ] ifTrue:[
- msg := 'The %1 class contains methods from '.
- otherPackages == 1 ifTrue:[
- msg := msg , 'the %3 package(s).\\'.
- ] ifFalse:[
- otherPackages size == 2 ifTrue:[
- msg := msg , 'the %3 and the %4 packages.\\'.
- ] ifFalse:[
- msg := msg , '%2 other packages.\\'.
- ]
- ].
- ].
- msg := msg , 'Are you certain to check the other packages methods with the class into the %5 package ?'.
- msg := msg
- bindWith:aClass name
- with:otherPackages size printString
- with:(otherPackages at:1 ifAbsent:'')
- with:(otherPackages at:2 ifAbsent:'')
- with:clsPackage.
-
- (self confirm:msg withCRs) ifFalse:[
- AbortSignal raise
- ]
- ].
-
"/ change all method's packageID to the classes packageId
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- mthd makeLocalStringSource.
- mthd setPackage:clsPackage
+ mthd package == Project noProjectID ifTrue:[
+ mthd makeLocalStringSource.
+ mthd setPackage:clsPackage
+ ]
].
aClass allPrivateClassesDo:[:eachPrivateClass |
aClass setPackage:clsPackage.
@@ -538,20 +546,8 @@
].
aClass changed:#projectOrganization.
Smalltalk changed:#projectOrganization with:(Array with:aClass).
- ^ #all
].
- answer == false ifTrue:[
- answer :=
- Dialog
- confirmWithCancel:'Ignore those methods in the classes container\\(i.e. checkin basePackage methods only) ?' withCRs
- default:true.
- answer == nil ifTrue:[AbortSignal raise].
- answer ifTrue:[
- ^ #base
- ]
- ].
-
- AbortSignal raise
+ ^ #base
"Modified: / 21.3.2003 / 14:31:00 / cg"
!
@@ -1043,7 +1039,6 @@
]
].
-
packageMode := self checkMethodPackagesOf:aClass.
packageMode == #base ifTrue:[
filter := [:mthd | mthd package = aClass package].
@@ -2113,7 +2108,7 @@
!AbstractSourceCodeManager class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/AbstractSourceCodeManager.st,v 1.178 2006-06-21 11:15:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/AbstractSourceCodeManager.st,v 1.179 2006-08-09 22:16:05 cg Exp $'
! !
AbstractSourceCodeManager initialize!