"
COPYRIGHT (c) 2000 eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libbasic3' }"
Object subclass:#SourceCodeManagerUtilities
instanceVariableNames:''
classVariableNames:'LastSourceLogMessage LastModule LastPackage YesToAllQuery
YesToAllNotification'
poolDictionaries:''
category:'System-SourceCodeManagement'
!
!SourceCodeManagerUtilities class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2000 eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
utility code which is useful at more than one place
(extracted from the browser)
[author:]
Claus Gittinger (cg@exept)
[see also:]
[instance variables:]
[class variables:]
"
! !
!SourceCodeManagerUtilities class methodsFor:'Signal constants'!
yesToAllNotification
YesToAllNotification isNil ifTrue:[
YesToAllNotification := QuerySignal new.
].
^ YesToAllNotification
!
yesToAllQuery
YesToAllQuery isNil ifTrue:[
YesToAllQuery := QuerySignal new.
].
^ YesToAllQuery
! !
!SourceCodeManagerUtilities class methodsFor:'accessing'!
lastModule
"return the value of the static variable 'LastModule' (automatically generated)"
^ LastModule
!
lastModule:something
"set the value of the static variable 'LastModule' (automatically generated)"
LastModule := something.
!
lastPackage
"return the value of the static variable 'LastPackage' (automatically generated)"
^ LastPackage
!
lastPackage:something
"set the value of the static variable 'LastPackage' (automatically generated)"
LastPackage := something.
! !
!SourceCodeManagerUtilities class methodsFor:'utilities'!
setPackageOfAllMethodsIn:aClass to:aPackage
"make all methods belong to the classes project"
|anyChange anyChangeHere|
anyChange := false.
aClass withAllPrivateClassesDo:[:eachClass |
anyChangeHere := false.
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd package ~= aPackage ifTrue:[
mthd setPackage:aPackage.
anyChangeHere := true.
].
].
anyChangeHere ifTrue:[
eachClass changed:#projectOrganization
].
anyChangeHere ifTrue:[anyChange := true].
].
anyChange ifTrue:[
Smalltalk changed:#projectOrganization
].
^ anyChange
!
sourceCodeManagerFor:aClass
|mgr|
mgr := (aClass sourceCodeManager).
mgr isNil ifTrue:[
SourceCodeManager isNil ifTrue:[
(self warn:'SourceCodeManagement is disabled or not configured.\\Please setup in the Launcher.' withCRs) ifFalse:[
^ nil
].
].
(self confirm:'Class does not seem to provide a valid sourceCodeManager.\\Assume CVS ?' withCRs) ifFalse:[
^ nil
].
mgr := CVSSourceCodeManager.
].
^ mgr
! !
!SourceCodeManagerUtilities class methodsFor:'utilities-cvs'!
checkForExistingModule:module package:package container:containerFileName using:mgr allowCreate:allowCreate
|resources moduleName packageName containerName|
resources := self classResources.
moduleName := module allBold.
packageName := package allBold.
containerName := containerFileName allBold.
"/
"/ check for the container
"/
(mgr checkForExistingContainerInModule:module package:package container:containerFileName) ifFalse:[
allowCreate ifFalse:[
self warn:(resources string:'A container for ''%1'' does not exist in ''%2:%3'''
with:containerName with:moduleName with:packageName) withCRs.
^ false
].
(Dialog
confirm:(resources string:'''%1'' is a new container (in ''%2:%3'').\\Create it ?'
with:containerName with:moduleName with:packageName) withCRs
noLabel:'Cancel')
ifFalse:[
^ false.
].
(mgr createContainerForText:'' inModule:module package:package container:containerFileName) ifFalse:[
self warn:(resources string:'Cannot create new container: ''%1'' (in ''%2:%3'')'
with:containerName with:moduleName with:packageName).
^ false.
]
].
^ true.
!
checkForExistingModule:module package:package using:mgr allowCreate:allowCreate
|resources moduleName packageName|
resources := self classResources.
moduleName := module allBold.
packageName := package allBold.
"/
"/ check for the package
"/
(mgr checkForExistingModule:module package:package) ifFalse:[
allowCreate ifFalse:[
self warn:(resources string:'A package named ''%1'' does not exist in module ''%2'''
with:packageName with:moduleName) withCRs.
^ false
].
(Dialog
confirm:(resources string:'''%1'' is a new package in module ''%2''.\\create it ?'
with:packageName with:moduleName) withCRs
noLabel:'Cancel')
ifFalse:[
^ false.
].
(mgr createModule:module package:package) ifFalse:[
self warn:(resources string:'Cannot create new package: ''%1'' in module ''%2'''
with:packageName with:moduleName) withCRs.
^ false.
]
].
^ true.
!
checkForExistingModule:module using:mgr allowCreate:allowCreate
|resources moduleName|
(mgr checkForExistingModule:module) ifFalse:[
resources := self classResources.
moduleName := module allBold.
allowCreate ifFalse:[
self warn:(resources string:'A module named ''%1'' does not exist in the repository'
with:moduleName) withCRs.
^ false
].
(Dialog
confirm:(resources string:'''%1'' is a new module.\\create it ?' with:moduleName) withCRs
noLabel:'Cancel')
ifFalse:[
^ false.
].
(mgr createModule:module) ifFalse:[
self warn:(resources string:'Cannot create new module: ''%1''' with:moduleName) withCRs.
^ false.
]
].
^ true.
!
checkinClass:aClass
"check a class into the source repository.
Asks interactively for log-message."
^ self checkinClass:aClass withLog:nil
!
checkinClass:aClass withLog:aLogMessageOrNil
"check a class into the source repository.
If the argument, aLogMessageOrNil isNil, ask interactively for log-message."
^ self checkinClass:aClass withLog:aLogMessageOrNil withCheck:true
!
checkinClass:aClass withLog:aLogMessageOrNil withCheck:doCheckClass
"check a class into the source repository.
If the argument, aLogMessageOrNil isNil, ask interactively for log-message."
|logMessage info mgr pri resources newSelectors initialLog|
aClass isLoaded ifFalse:[
self information:'cannot checkin unloaded classes (' , aClass name , ').'.
^ false.
].
mgr := self sourceCodeManagerFor:aClass.
mgr isNil ifTrue:[
^ false
].
aLogMessageOrNil isNil ifTrue:[
newSelectors := aClass selectors asSet.
newSelectors addAll:(aClass class selectors).
newSelectors size == 1 ifTrue:[
initialLog := 'Added/changed #' , newSelectors first
"/ ] ifFalse:[
"/ newSelectors size > 1 ifTrue:[
"/ initialLog := 'Added/changed some methods'
"/ ]
].
logMessage := self
getLogMessageFor:aClass name
initialAnswer:initialLog.
logMessage isNil ifTrue:[^ false].
] ifFalse:[
logMessage := aLogMessageOrNil
].
resources := self classResources.
info := mgr sourceInfoOfClass:aClass.
(info isNil
or:[(info at:#fileName ifAbsent:nil) isNil
or:[(info at:#module ifAbsent:nil) isNil
or:[(info at:#directory ifAbsent:nil) isNil]]]) ifTrue:[
(self createSourceContainerForClass:aClass) ifFalse:[
"/ self warn:'did not create a container for ''' , aClass name , ''''.
^ false
].
^ true.
].
self activityNotification:(resources string:'checking in %1' with:aClass name).
pri := Processor activePriority.
Processor activeProcess withPriority:pri-1 to:pri
do:[
|revision aborted freshCreated|
freshCreated := false.
revision := aClass revision.
revision isNil ifTrue:[
"/ mhmh - check if it has a container.
(mgr checkForExistingContainerForClass:aClass) ifFalse:[
(self createSourceContainerForClass:aClass) ifFalse:[
self warn:'Did not create/change repository container for ''' , aClass name allBold , ''''.
^ false.
] ifTrue:[
freshCreated := true.
].
]
].
doCheckClass ifTrue:[
"/ check if the class contains halts, error-sends etc.
(self checkAndWarnAboutBadMessagesInClass:aClass) ifFalse:[
^ false
].
].
freshCreated ifFalse:[
aborted := false.
AbortOperationRequest handle:[:ex |
aborted := true.
ex return.
] do:[
(mgr checkinClass:aClass logMessage:logMessage) ifFalse:[
Transcript showCR:'checkin of ''' , aClass name , ''' failed'.
self warn:'checkin of ''' , aClass name allBold , ''' failed'.
^ false.
].
].
aborted ifTrue:[
Transcript showCR:'Checkin of ''' , aClass name , ''' aborted'.
AbortAllSignal isHandled ifTrue:[
(Dialog
confirm:('Checkin of ''' , aClass name , ''' aborted.\\Cancel all ?')withCRs
default:false)
ifTrue:[
AbortAllSignal raise.
]
].
^ false.
].
].
].
^ true
"Modified: / 16.11.2001 / 17:39:21 / cg"
!
checkinClasses:aCollectionOfClass
"check a collection of classes into the source repository.
Asks interactively for log-message."
^ self checkinClasses:aCollectionOfClass withLog:nil
!
checkinClasses:aCollectionOfClasses withLog:aLogMessageOrNil
"check a bunch of classes into the source repository.
If the argument, aLogMessageOrNil isNil, ask interactively for log-message."
^ self
checkinClasses:aCollectionOfClasses
withLog:aLogMessageOrNil
withCheck:(UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true)
!
checkinClasses:aCollectionOfClasses withLog:aLogMessageOrNil withCheck:doCheckClasses
"check a bunch of classes into the source repository.
If the argument, aLogMessageOrNil isNil, ask interactively for log-message."
|classes logMessage resources yesOrNoToAll|
"/ ignore private classes
classes := aCollectionOfClasses select:[:aClass | aClass owningClass isNil].
classes isEmpty ifTrue:[
self information:'Only private classes given - nothing checked in.'.
^ self
].
classes := classes select:[:aClass | aClass isLoaded].
classes isEmpty ifTrue:[
self information:'Only unloaded classes given - nothing checked in.'.
^ self
].
classes size == 1 ifTrue:[
^ self checkinClass:classes first withLog:aLogMessageOrNil withCheck:doCheckClasses.
].
resources := self classResources.
(logMessage := aLogMessageOrNil) isNil ifTrue:[
logMessage := SourceCodeManagerUtilities getLogMessageFor:(resources string:'%1 classes to checkin' with:aCollectionOfClasses size).
logMessage isNil ifTrue:[
^ self
].
].
AbortAllSignal handle:[:ex |
ex return
] do:[
self yesToAllNotification handle:[:ex |
yesOrNoToAll := ex parameter.
ex proceed
] do:[
self yesToAllQuery handle:[:ex |
ex proceedWith:yesOrNoToAll
] do:[
classes do:[:aClass |
self activityNotification:(resources string:'checking in %1' with:aClass name).
"/ ca does not want boxes to pop up all over ...
UserInformation handle:[:ex |
Transcript showCR:ex description
] do:[
AbortSignal handle:[:ex |
] do:[
self checkinClass:aClass withLog:logMessage withCheck:doCheckClasses
]
].
]
]
].
].
!
checkinExtensionMethods:aCollectionOfMethods forPackage:aPackageID withLog:aLogMessageOrNil
"checkin a projects extensions into the source repository.
If the argument, aLogMessageOrNil isNil, ask interactively for log-message."
|logMessage mgr pri resources module package i containerFileName s
methodSource methodsSortedByName|
resources := self classResources.
mgr := aCollectionOfMethods first mclass theNonMetaclass sourceCodeManager.
mgr isNil ifTrue:[
self warn:'No sourceCode manager defined - cannot checkin.'.
"/ self error:'No sourceCode manager defined' mayProceed:true.
^ false.
].
i := aPackageID indexOf:$:.
i == 0 ifTrue:[
self warn:'Cannot extract module/package from the packageID (invalid format)\\Please change the packageID to be of the form <module>:<subdirectory>,\and try again.\Or, alternatively, move the extensions to their classes project and checkIn the class(es).' withCRs.
"/ self error:'cannot extract module/package from packageID' mayProceed:true.
^ false.
].
module := aPackageID copyTo:i-1.
package := aPackageID copyFrom:i+1.
(package startsWith:$:) ifTrue:[
package := package copyFrom:2.
].
containerFileName := 'extensions.st'.
aLogMessageOrNil isNil ifTrue:[
logMessage := SourceCodeManagerUtilities getLogMessageFor:containerFileName allBold.
logMessage isNil ifTrue:[^ false].
] ifFalse:[
logMessage := aLogMessageOrNil
].
(self checkForExistingModule:module using:mgr allowCreate:true) ifFalse:[^ false].
LastModule := module.
(self checkForExistingModule:module package:package using:mgr allowCreate:true) ifFalse:[^ false].
LastPackage := package.
(self checkForExistingModule:module package:package container:containerFileName using:mgr allowCreate:true) ifFalse:[^ false].
self activityNotification:(resources string:'Checking in %1' with:containerFileName).
pri := Processor activePriority.
Processor activeProcess withPriority:pri-1 to:pri
do:[
s := '' writeStream.
s nextPutAll:'"{ Package: '''.
s nextPutAll:aPackageID asString.
s nextPutAll:''' }"'; cr; nextPutChunkSeparator; cr; cr.
"/ s nextPutAll:(Smalltalk timeStamp).
"/ s nextPutChunkSeparator.
"/ s cr; cr.
"/ sort them by name (to avoid conflict due to CVS merge)
methodsSortedByName := aCollectionOfMethods asOrderedCollection.
methodsSortedByName sort:[:a :b |
|clsA clsB|
clsA := a mclass name.
clsB := b mclass name.
clsA < clsB ifTrue:[
true
] ifFalse:[
clsA > clsB ifTrue:[
false
] ifFalse:[
a selector < b selector
]
]
].
methodsSortedByName do:[:aMethod |
aMethod mclass fileOutMethod:aMethod on:s.
s cr.
].
methodSource := s contents.
UserInformation handle:[:ex |
Transcript showCR:ex description.
ex proceed.
] do:[
(mgr
checkin:containerFileName
text:methodSource
directory:package
module:module
logMessage:aLogMessageOrNil
force:false)
ifFalse:[
Transcript showCR:'Checkin of ''' , containerFileName , ''' failed'.
self warn:'Checkin of ''' , containerFileName allBold , ''' failed'.
^ false.
].
mgr postCheckInExtensionsForPackage:aPackageID
].
].
^ true
"Modified: / 5.11.2001 / 17:06:00 / cg"
!
checkoutClass:aClass askForMerge:askForMerge
"check-out a class from the source repository."
self
checkoutClass:aClass
askForRevision:true
askForMerge:askForMerge
!
checkoutClass:aClass askForRevision:askForRevision askForMerge:askForMerge
"check-out a class from the source repository.
If askForRevision is false, check-out the newest version."
|mgr resources sourceInfo
currentClass inChangeSet
aStream sourceToLoad currentSource rev revString
nm msg rev2 newestRev
containerModule containerPackage containerFile rslt
pkg listHere listRep diffSet
changed onlyHere onlyInRep answer labels values singleChangeSelector
changedClasses default versionMethodsHere versionMethodsRep changedClassDefinitions|
aClass isNil ifTrue:[self error:'nil class'].
resources := self classResources.
currentClass := aClass theNonMetaclass.
nm := currentClass name.
mgr := self sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
^ self
].
sourceInfo := mgr sourceInfoOfClass:currentClass.
sourceInfo notNil ifTrue:[
currentClass package ~= Project defaultProject package ifTrue:[
containerPackage := mgr packageFromSourceInfo:sourceInfo.
containerModule := mgr moduleFromSourceInfo:sourceInfo.
].
containerFile := mgr containerFromSourceInfo:sourceInfo.
].
currentClass isLoaded ifTrue:[
rev := currentClass binaryRevision.
rev2 := currentClass revision.
rev isNil ifTrue:[
rev := rev2
].
rev isNil ifTrue:[
pkg := currentClass package.
(pkg notNil and:[pkg ~= Project defaultProject package]) ifTrue:[
containerModule := pkg upTo:$:.
containerPackage := pkg copyFrom:(containerModule size + 2).
].
containerModule size == 0 ifTrue:[
containerModule := (SourceCodeManagerUtilities lastModule ) ? Project current repositoryModule.
].
containerPackage size == 0 ifTrue:[
containerPackage := (SourceCodeManagerUtilities lastPackage ) ? Project current package.
].
answer := self confirmWithCancel:(resources
string:'The class %3 seems to have no (valid) repository information.\\I assume you want to check it out from: %1/%2.'
with:containerModule allBold
with:containerPackage allBold
with:currentClass name allBold) withCRs.
answer isNil ifTrue:[^ self "cancelled"].
answer ifFalse:[
rslt := SourceCodeManagerUtilities
askForContainer:(resources string:'The class seems to have no repository information.\\Do you want to checkOut from an existing containers contents ?')
title:'Container to load from' note:nil
initialModule:containerModule
initialPackage:containerPackage
initialFileName:(currentClass nameWithoutPrefix , '.st')
forNewContainer:false.
rslt isNil ifTrue:[
"/ canel
^ self
].
containerModule := "lastModule :=" rslt at:#module.
containerPackage := "lastPackage :=" rslt at:#package.
containerFile := rslt at:#fileName.
].
"/ rslt := SourceCodeManagerUtilities
"/ askForContainer:(resources string:'The class seems to have no (valid) repository information.\\Do you want to check it out from an existing container ?')
"/ title:'Container to checkOut' note:nil
"/ initialModule:containerModule
"/ initialPackage:containerPackage
"/ initialFileName:(currentClass name , '.st').
"/ forNewContainer:false.
"/ rslt isNil ifTrue:[^ self].
"/ self warn:(resources string:'Class %1 seems to be not yet in the repository' with:currentClass name allBold).
"/ ^ self
].
].
"/
"/ class in repository - ask for revision
"/
"/ newestRev := mgr newestRevisionOf:currentClass.
newestRev := mgr newestRevisionInFile:containerFile directory:containerPackage module:containerModule.
askForRevision ifFalse:[
rev := newestRev ? ''
] ifTrue:[
msg := resources string:'CheckOut which revision of ''%1'': (empty for newest)' with:nm allBold.
rev notNil ifTrue:[
msg := msg , '\\' , (resources string:'Current ''%1'' is based upon rev %2.'
with:nm allBold with:rev).
(rev2 notNil and:[rev2 ~= rev]) ifTrue:[
msg := msg , '\' , (resources string:'And has been checked into the repository as %1.'
with:rev2)
]
].
newestRev notNil ifTrue:[
msg := msg , '\' , (resources string:'Newest in reporitory is %1.'
with:newestRev)
].
rev := SourceCodeManagerUtilities
askForExistingRevision:msg
title:'CheckOut from repository'
class:currentClass.
rev isNil ifTrue:[
^ self "/ canceled
].
].
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
"/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
aStream := mgr getSourceStreamFor:currentClass revision:newestRev.
revString := '(newest: ' , (newestRev ? '???') , ')'.
] ifFalse:[
msg := 'extracting previous %1'.
"/ aStream := mgr getSourceStreamFor:currentClass revision:rev.
"/ revString := rev
aStream := mgr
streamForClass:currentClass
fileName:containerFile
revision:rev
directory:containerPackage
module:containerModule
cache:true.
].
aStream isNil ifTrue:[
self warn:(resources string:'could not extract source of %1 from repository' with:aClass name allBold).
^ self
].
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
^ self
] do:[
sourceToLoad := aStream contents asString.
].
aStream close.
currentClass isLoaded ifFalse:[
rev = newestRev ifTrue:[
currentClass autoload.
] ifFalse:[
sourceToLoad readStream fileIn.
].
^ self.
].
self activityNotification:'generating current source...'.
aStream := '' writeStream.
Method flushSourceStreamCache.
currentClass fileOutOn:aStream withTimeStamp:false.
currentSource := aStream contents asString.
aStream close.
self activityNotification:'comparing...'.
sourceToLoad = currentSource ifTrue:[
"/ make all methods belong to the classes project
self setPackageOfAllMethodsIn:aClass to:aClass package.
"/ (ChangeSet current includesChangeForClass:aClass) ifTrue:[
"/ (self confirm:(resources string:'Versions are identical: %1.\\Remove entries from changeSet ?' with:aClass name) withCRs)
"/ ifTrue:[
"/ self halt
"/ ]
"/ ] ifFalse:[
self information:(resources string:'Versions are identical: %1' with:aClass name).
"/ ].
^ self.
].
self activityNotification:'generating diffSet...'.
listHere := ChangeSet fromStream:(currentSource readStream).
listRep := ChangeSet fromStream:(sourceToLoad readStream).
versionMethodsHere := listHere select:[:change | (change isMethodChange
and:[change selector == #version
and:[change changeClass isMeta]])].
versionMethodsRep := listRep select:[:change | (change isMethodChange
and:[change selector == #version
and:[change changeClass isMeta]])].
"/ compare all but the version methods
listHere := listHere select:[:change | (change isMethodChange
and:[change selector == #version
and:[change changeClass isMeta]]) not].
listRep := listRep select:[:change | (change isMethodChange
and:[change selector == #version
and:[change changeClass isMeta]]) not].
diffSet := listHere diffSetsAgainst:listRep.
changed := diffSet changed.
onlyHere := diffSet onlyInReceiver.
onlyInRep := diffSet onlyInArg.
changedClassDefinitions := changed select:[:eachChangePair | eachChangePair first isClassDefinitionChange].
changed := changed reject:[:eachChangePair | eachChangePair first isClassDefinitionChange].
labels := #('Cancel' 'Merge' 'Load').
values := #(nil #merge #load).
default := askForRevision
ifTrue:[3. "i.e. load"]
ifFalse:[2. "i.e. merge"].
msg := 'About to load ''%4''.\\'.
onlyInRep size > 0 ifTrue:[
msg := msg , 'The repositories version contains %1 method(s) which are not in your current class.\'.
].
onlyHere size > 0 ifTrue:[
onlyInRep size > 0 ifTrue:[
msg := msg , 'And there '.
] ifFalse:[
msg := msg , 'There '.
].
msg := msg , 'are %2 methods in your current class, which are not in the repository.\'.
].
changed size > 0 ifTrue:[
changed size == 1 ifTrue:[
msg := msg , 'The ''%6''-method is different (present in both).\\'.
singleChangeSelector := changed first first selector allBold
] ifFalse:[
msg := msg , '%3 methods are different (present in both).\\'.
]
].
changedClassDefinitions size > 0 ifTrue:[
changedClassDefinitions size == 1 ifTrue:[
msg := msg , 'The class definition is different.\\'.
] ifFalse:[
msg := msg , '%5 class definitions are different.\\'.
]
].
inChangeSet := ChangeSet current includesChangeForClass:aClass.
onlyHere isEmpty ifTrue:[
onlyInRep isEmpty ifTrue:[
(changed isEmpty and:[changedClassDefinitions isEmpty]) ifTrue:[
"/ make all methods belong to the classes project
versionMethodsRep size == 1 ifTrue:[
"/ (self confirm:(resources string:'Versions are identical: %1\\Update the version-ID ?' with:aClass name) withCRs) ifTrue:[
versionMethodsRep first apply.
"/ ]
].
self setPackageOfAllMethodsIn:aClass to:aClass package.
^ self
].
inChangeSet ifTrue:[
msg := msg , '\Attention:\Load will undo your changes made to ''%4'' (if any were made).'.
].
labels := #('Cancel' 'Load').
values := #(nil #load).
default := askForRevision
ifTrue:[2. "i.e. load"]
ifFalse:[1. "i.e. cancel"].
] ifFalse:[
changed isEmpty ifTrue:[
msg := msg , '\Attention:\Load will load methods which are not present in ''%4''.'.
labels := #('Cancel' 'Load').
values := #(nil #load).
default := askForRevision
ifTrue:[2. "i.e. load"]
ifFalse:[1. "i.e. cancel"].
] ifFalse:[
inChangeSet ifTrue:[
msg := msg , '\Attention:\Load will undo your changes made to ''%4'' (if any were made);'.
].
msg := msg , '\Merge will only load methods which are not present in ''%4'' (i.e. undo removals but preserve changes).'.
].
]
] ifFalse:[
onlyInRep isEmpty ifTrue:[
inChangeSet ifTrue:[
msg := msg , '\Attention:\Load will undo your changes made to ''%4'' (if any were made),'.
msg := msg , '\and remove added methods which are not present in the repository version.'.
].
labels := #('Cancel' 'Load').
values := #(nil #load).
default := askForRevision
ifTrue:[2. "i.e. load"]
ifFalse:[1. "i.e. cancel"].
] ifFalse:[
inChangeSet ifTrue:[
msg := msg , '\Attention:\Load will undo your changes made to ''%4'' (if any were made);'.
msg := msg , '\Merge will only load methods which are not present in ''%4'' (i.e. undo removals but preserve changes).'.
]
]
].
msg := msg bindWith:onlyInRep size printString
with:onlyHere size printString
with:changed size printString
with:aClass name allBold
with:changedClassDefinitions size printString
with:singleChangeSelector.
answer := (Dialog confirmWithCancel:msg withCRs
labels:(resources array:labels)
values:values
default:default).
answer isNil ifTrue:[^ self].
self activityNotification:'updating...'.
changedClasses := IdentitySet new.
"/ Class withoutUpdatingChangesDo:[
answer == #load ifTrue:[
changedClassDefinitions do:[:eachChangeArr | "apply this change (go to rep-version)"
|cHere cRep|
cHere := eachChangeArr at:1.
cRep := eachChangeArr at:2.
cRep apply.
cRep isMethodChange ifTrue:[
cRep changeMethod setPackage:(cRep changeClass package).
changedClasses add:cRep changeClass.
]
].
].
onlyInRep do:[:eachChange | "apply this change (method only present in rep-version)"
eachChange apply.
eachChange isMethodChange ifTrue:[
eachChange changeMethod setPackage:(eachChange changeClass package).
changedClasses add:eachChange changeClass.
]
].
answer == #load ifTrue:[
onlyHere do:[:eachChange | "remove this change (method not present in rep-version)"
|cClass cSel|
eachChange isMethodChange ifTrue:[
cClass := eachChange changeClass.
cSel := eachChange selector.
cClass removeSelector:cSel.
]
].
changed do:[:eachChangeArr | "apply this change (go to rep-version)"
|cHere cRep|
cHere := eachChangeArr at:1.
cRep := eachChangeArr at:2.
cRep apply.
cRep isMethodChange ifTrue:[
cRep changeMethod setPackage:(cRep changeClass package).
changedClasses add:cRep changeClass.
]
].
"/ make all methods belong to the classes project
self setPackageOfAllMethodsIn:aClass to:aClass package.
versionMethodsRep size == 1 ifTrue:[
versionMethodsRep first apply.
self setPackageOfAllMethodsIn:aClass to:aClass package.
] ifFalse:[
self error:'too many version methods'.
].
].
"/ ].
changedClasses do:[:eachClass |
eachClass changed:#projectOrganization.
].
Smalltalk changed:#projectOrganization.
"Modified: / 7.2.2001 / 18:18:32 / ps"
!
compareClassWithRepository:aClass
"open a diff-textView comparing the current (in-image) version
against its orgiginal version found in the repository."
|currentClass resources
aStream comparedSource currentSource rev revString thisRevString mgr
nm msg rev2 newestRev
containerModule containerPackage containerFile|
resources := self classResources.
currentClass := aClass theNonMetaclass.
nm := currentClass name.
mgr := self sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
^ self
].
rev := currentClass binaryRevision.
rev2 := currentClass revision.
rev isNil ifTrue:[
rev := rev2
].
rev isNil ifTrue:[
self warn:'Class seems to be not yet in the repository'.
^ self
].
"/
"/ class in repository - ask for revision
"/
newestRev := mgr newestRevisionOf:currentClass.
msg := resources string:'compare to revision: (empty for newest)'.
rev notNil ifTrue:[
msg := msg , '\\' , (resources string:'Current %1 is based upon rev %2.'
with:nm allBold with:rev).
(rev2 notNil and:[rev2 ~= rev]) ifTrue:[
msg := msg , '\' , (resources string:'And has been checked into the repository as %1.'
with:rev2)
]
].
newestRev notNil ifTrue:[
msg := msg , '\' , (resources string:'Newest in reporitory is %1.'
with:newestRev)
].
rev := SourceCodeManagerUtilities
askForExistingRevision:msg
title:'Compare with repository'
class:currentClass.
(rev notNil or:[containerFile notNil]) ifTrue:[
rev notNil ifTrue:[
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
"/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
aStream := mgr getSourceStreamFor:currentClass revision:newestRev.
revString := '(newest: ' , (newestRev ? '???') , ')'.
] ifFalse:[
msg := 'extracting previous %1'.
aStream := mgr getSourceStreamFor:currentClass revision:rev.
revString := rev
].
] ifFalse:[
msg := 'extracting newest version from ' , containerModule , '/' , containerPackage, '/' , containerFile.
aStream := mgr streamForClass:nil fileName:containerFile revision:#newest directory:containerPackage module:containerModule cache:false.
revString := '???'
].
aStream isNil ifTrue:[
self warn:'could not extract source from repository'.
^ self
].
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
^ self
] do:[
comparedSource := aStream contents asString.
].
aStream close.
self activityNotification:'generating current source ...'.
aStream := '' writeStream.
Method flushSourceStreamCache.
currentClass fileOutOn:aStream withTimeStamp:false.
currentSource := aStream contents asString.
aStream close.
self activityNotification:'comparing ...'.
comparedSource = currentSource ifTrue:[
self information:(resources string:'Versions are identical: %1' with:currentClass name).
] ifFalse:[
thisRevString := currentClass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
revString = '(newest)' ifTrue:[
(rev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
revString := '(newest is ' , rev , ')'
]
].
self activityNotification:'comparing ...'.
(UserPreferences versionDiffViewerClass)
openOnClass:currentClass
labelA:('repository: ' , revString)
sourceA:comparedSource
labelB:('current: (based on: ' , thisRevString , ')')
sourceB:currentSource
title:('comparing ' , currentClass name).
].
].
"
self compareClassWithRepository:Array
"
!
createSourceContainerForClass:aClass
"let user specify the source-repository values for aClass"
|resources|
resources := self classResources.
^ self
defineSourceContainerForClass:aClass
title:(resources string:'Repository information for %1' with:aClass name)
text:(resources string:'Create new repository container for ''%1''' with:aClass name allBold)
createDirectories:true
createContainer:true.
!
defineSourceContainerForClass:aClass title:title text:boxText createDirectories:createDirs createContainer:createContainer
"let user specify the source-repository values for aClass"
| className
oldModule oldPackage oldFileName
module package fileName nameSpace nameSpacePrefix
info project nm mgr creatingNew msg
answer doCheckinWithoutAsking forceCheckIn resources rslt note
requiredPackage|
resources := self classResources.
aClass isLoaded ifFalse:[
self warn:(resources string:'Please load the %1-class first' with:aClass name).
^ false.
].
className := aClass name.
"/
"/ defaults, if nothing at all is known
"/
(module := LastModule) isNil ifTrue:[
module := (OperatingSystem getLoginName).
].
(package := LastPackage) isNil ifTrue:[
package := 'private'.
].
"/
"/ try to extract some useful defaults from the current project
"/
(Project notNil and:[(project := Project current) notNil]) ifTrue:[
package isNil ifTrue:[
(nm := project repositoryDirectory) isNil ifTrue:[
nm := project name
].
package := nm.
].
module isNil ifTrue:[
(nm := project repositoryModule) notNil ifTrue:[
module := nm
]
].
].
"/
"/ ask the sourceCodeManager if it knows anything about that class
"/ if so, take that as a default.
"/
mgr := self sourceCodeManagerFor:aClass.
mgr isNil ifTrue:[
^ false
].
info := mgr sourceInfoOfClass:aClass.
info notNil ifTrue:[
true "module ~= LastModule" ifTrue:[
(info includesKey:#module) ifTrue:[
module := (info at:#module).
].
].
true "package ~= LastPackage" ifTrue:[
(info includesKey:#directory) ifTrue:[
package := (info at:#directory).
].
].
fileName := mgr containerFromSourceInfo:info.
(nameSpace := aClass nameSpace) ~~ Smalltalk ifTrue:[
nameSpacePrefix := nameSpace name , '::'.
(fileName startsWith:nameSpacePrefix) ifTrue:[
fileName := fileName copyFrom:(nameSpacePrefix size + 1).
]
].
"/ (info includesKey:#fileName) ifTrue:[
"/ fileName := (info at:#fileName).
"/ ] ifFalse:[
"/ (info includesKey:#expectedFileName) ifTrue:[
"/ fileName := (info at:#expectedFileName).
"/ ] ifFalse:[
"/ (info includesKey:#classFileNameBase) ifTrue:[
"/ fileName := (info at:#classFileNameBase) , '.st'.
"/ ]
"/ ]
"/ ]
].
fileName isNil ifTrue:[
fileName := (Smalltalk fileNameForClass:aClass) , '.st'.
].
OperatingSystem isMSDOSlike ifTrue:[
module replaceAll:$\ with:$/.
package replaceAll:$\ with:$/.
].
"/
"/ check for conflicts (i.e. if such a container already exists) ...
"/
doCheckinWithoutAsking := false.
(mgr checkForExistingContainerInModule:module
package:package
container:fileName) ifTrue:[
answer := Dialog confirmWithCancel:(resources
string:'About to change the source container.
Notice: there is a container for %1 in:
%2 / %3 / %4
Do you want to change it or check right into that container ?'
with:className
with:module
with:package
with:fileName)
labels:(resources array:#('Cancel' 'Check in' 'Change')).
answer isNil ifTrue:[AbortSignal raise].
answer ifTrue:[
doCheckinWithoutAsking := false.
oldModule := module.
oldPackage := package.
oldFileName := fileName
] ifFalse:[
doCheckinWithoutAsking := true.
creatingNew := false.
].
].
doCheckinWithoutAsking ifFalse:[
"/
"/ open a dialog for this
"/
(mgr checkForExistingContainerInModule:module
package:package
container:fileName) ifFalse:[
note := 'Notice: class seems to have no container yet.'.
creatingNew := true.
] ifTrue:[
creatingNew := false.
].
rslt := self
askForContainer:boxText title:title note:note
initialModule:module initialPackage:package initialFileName:fileName
forNewContainer:true.
rslt isNil ifTrue:[
^ false
].
module := rslt at:#module.
package := rslt at:#package.
fileName := rslt at:#fileName.
].
(fileName endsWith:',v') ifTrue:[
fileName := fileName copyWithoutLast:2
].
(fileName endsWith:'.st') ifFalse:[
fileName := fileName , '.st'
].
"/ we require the packageID to be <module>:<container-dir>
"/ check for this ...
requiredPackage := ((module ? '') , ':' , (package ? '')) asSymbol.
requiredPackage ~= aClass package ifTrue:[
"/ doCheckinWithoutAsking ifFalse:[
"/ (self confirm:'Change the classes packageID to: ''', requiredPackage , ''' ?')
"/ ifFalse:[
"/ ^ false
"/ ]
"/ ].
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | mthd setPackage:requiredPackage].
aClass package:requiredPackage.
aClass changed:#projectOrganization.
Smalltalk changed:#projectOrganization with:(Array with:aClass).
].
info := aClass revisionInfo.
info notNil ifTrue:[
(info includesKey:#repositoryPathName) ifFalse:[
info := nil
]
].
info isNil ifTrue:[
true "doCheckinWithoutAsking" ifFalse:[
answer := Dialog
confirmWithCancel:(resources string:'%1 does not have any (usable) revision info (#version method)\\Shall I create one ?' with:className) withCRs
labels:(resources array:#( 'Cancel' 'No' 'Yes')).
answer isNil ifTrue:[^ false].
] ifTrue:[
answer := true.
].
answer ifTrue:[
aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass
inModule:module
package:package
container:fileName).
].
].
(self checkForExistingModule:module using:mgr allowCreate:(createDirs or:[creatingNew]))
ifFalse:[^ false].
LastModule := module.
(self checkForExistingModule:module package:package using:mgr allowCreate:(createDirs or:[creatingNew]))
ifFalse:[^ false].
LastPackage := package.
"/
"/ check for the container itself
"/
(mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[
creatingNew ifTrue:[
self warn:(resources string:'Container for %1 already exists in %2/%3.' with:fileName with:module with:package) withCRs.
].
"/ (oldModule notNil
"/ and:[(oldModule ~= module)
"/ or:[oldPackage ~= package
"/ or:[oldFileName ~= fileName]]])
"/ ifFalse:[
"/ self warn:(resources string:'no change').
"/ ^ false.
"/ ].
doCheckinWithoutAsking ifFalse:[
(Dialog
confirm:(resources string:'check %1 into the existing container
%2 / %3 / %4 ?'
with:className
with:module
with:package
with:fileName) withCRs
noLabel:'Cancel')
ifFalse:[
^ false.
].
].
aClass updateVersionMethodFor:'$' , 'Header' , '$'. "/ concatenated to avoid RCS-expansion
oldFileName notNil ifTrue:[
msg := ('forced checkin / source container change from ' , oldFileName).
] ifFalse:[
msg := 'defined source container'
].
(forceCheckIn := doCheckinWithoutAsking) ifFalse:[
(mgr
checkinClass:aClass
fileName:fileName
directory:package
module:module
logMessage:msg)
ifFalse:[
doCheckinWithoutAsking ifFalse:[
(Dialog
confirm:'No easy merge seems possible; force checkin (no merge) ?'
noLabel:'Cancel')
ifFalse:[
^ false.
].
].
forceCheckIn := true.
]
].
forceCheckIn ifTrue:[
(mgr
checkinClass:aClass
fileName:fileName
directory:package
module:module
logMessage:msg
force:true)
ifFalse:[
self warn:(resources string:'Failed to check into existing container.').
^ false.
].
].
^ true
] ifFalse:[
(createContainer or:[creatingNew]) ifFalse:[
(Dialog
confirm:(resources string:'No container exists for %1 in %2/%3\\create ?'
with:fileName with:module with:package) withCRs
noLabel:'Cancel') ifFalse:[
^ false
]
]
].
(mgr
createContainerFor:aClass
inModule:module
package:package
container:fileName) ifFalse:[
self warn:(resources string:'Failed to create container.').
^ false.
].
^ true
!
removeSourceContainerForClass:aClass
"show container & let user confirm twice."
^ self removeSourceContainerForClass:aClass confirm:true warn:true
!
removeSourceContainerForClass:aClass confirm:doConfirm warn:doWarn
"show container & optionally let user confirm twice."
|module package fileName info mgr resources|
resources := self classResources.
aClass isLoaded ifFalse:[
doWarn ifTrue:[
self warn:(resources string:'Please load the class first.').
].
^ false.
].
"/
"/ ask the sourceCodeManager if it knows anything about that class
"/ if so, take that as a default.
"/
mgr := aClass sourceCodeManager.
mgr isNil ifTrue:[
doWarn ifTrue:[
self warn:(resources string:'No sourceCodeManagement.').
].
^ false
].
info := mgr sourceInfoOfClass:aClass.
info notNil ifTrue:[
(info includesKey:#module) ifTrue:[
module := (info at:#module).
].
(info includesKey:#directory) ifTrue:[
package := (info at:#directory).
].
fileName := mgr containerFromSourceInfo:info.
].
module isNil ifTrue:[
doWarn ifTrue:[
self warn:(resources string:'classes module is unknown.\\It seems to not have a container.') withCRs.
].
^ false.
].
package isNil ifTrue:[
doWarn ifTrue:[
self warn:(resources string:'classes package is unknown.\\It seems to not have a container.') withCRs.
].
^ false.
].
fileName isNil ifTrue:[
doWarn ifTrue:[
self warn:(resources string:'classes container fileName is unknown.\\It seems to not have a container.') withCRs.
].
^ false.
].
OperatingSystem isMSDOSlike ifTrue:[
module replaceAll:$\ with:$/.
].
OperatingSystem isMSDOSlike ifTrue:[
package replaceAll:$\ with:$/.
].
(mgr checkForExistingContainerInModule:module
package:package
container:fileName) ifFalse:[
doWarn ifTrue:[
self warn:(resources string:'Class has no source container.') withCRs.
].
^ false.
].
doConfirm ifTrue:[
(Dialog
choose:(resources
string:'Please confirm removal of the container for %1:
container: %2 / %3 / %4
Really remove ?'
with:aClass name
with:module
with:package
with:fileName)
labels:(Array
with:(resources string:'No')
with:(resources string:'Remove'))
values:#(false true)
default:false) ifFalse:[
^ false.
].
].
(mgr removeContainerFor:aClass
inModule:module
package:package
container:fileName) ifFalse:[
doWarn ifTrue:[
self warn:(resources string:'failed to remove container.').
].
^ true.
].
^ false
!
repositoryLogOf:aClass onto:aStream
|info rv mgr info2 module fn msg s|
info := aClass revisionInfo.
rv := aClass binaryRevision.
rv notNil ifTrue:[
aStream nextPutLine:'**** Loaded classes binary information ****'; cr.
aStream nextPutLine:' Binary based upon : ' , rv.
aStream cr.
].
info notNil ifTrue:[
mgr := aClass sourceCodeManager.
(info includesKey:#revision) ifFalse:[
aStream nextPutLine:'WARNING:'; cr.
aStream nextPutLine:' The class seems not to be loaded from the repository.'.
aStream nextPutLine:' Check carefully before checking anything in.'.
aStream nextPutLine:' (i.e. compare with repository for renamed class(es), same-name but unrelated etc.)'.
aStream cr.
].
aStream nextPutLine:'**** Classes source information ****'; cr.
s := info at:#repositoryPath ifAbsent:nil.
s notNil ifTrue:[
aStream nextPutLine:' Source repository : ' , s
].
aStream nextPutLine:' Filename ........ : ' , (info at:#fileName ifAbsent:'?').
aStream nextPutLine:' Revision ........ : ' , (info at:#revision ifAbsent:'?').
aStream nextPutLine:' Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?').
aStream nextPutLine:' Checkin user .... : ' , (info at:#user ifAbsent:'?').
(info2 := aClass packageSourceCodeInfo) notNil ifTrue:[
aStream nextPutLine:' Repository: ..... : ' , (info2 at:#module ifAbsent:'?').
aStream nextPutLine:' Directory: ...... : ' , (info2 at:#directory ifAbsent:'?').
].
aStream nextPutLine:' Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?').
aStream cr.
mgr notNil ifTrue:[
aStream nextPutLine:'**** Repository information ****'; cr.
module := info2 at:#module ifAbsent:nil.
module notNil ifTrue:[
aStream nextPutLine:(' CVS Root ......: ' ,
((mgr repositoryNameForModule:module) ifNil:[mgr repositoryName , ' (default)'])).
].
mgr writeRevisionLogOf:aClass to:aStream.
]
] ifFalse:[
aStream nextPutLine:'No revision info found'.
aClass isLoaded ifFalse:[
aStream cr; nextPutAll:'This is an autoloaded class - you may see more after its loaded.'
] ifTrue:[
fn := aClass classFilename.
aClass wasAutoloaded ifTrue:[
msg := 'This class was autoloaded.'.
fn notNil ifTrue:[
msg := msg , ' (from ''' , fn , ''')'.
].
] ifFalse:[
fn notNil ifTrue:[
msg := 'This class was loaded from ''' , fn , '''.'
].
].
msg notNil ifTrue:[
aStream cr; nextPutAll:msg.
]
]
]
! !
!SourceCodeManagerUtilities class methodsFor:'utilities-cvs-helpers'!
getLogMessageFor:aString
"get a log message for checking in a class.
Return the message or nil if aborted."
^ self getLogMessageFor:aString initialAnswer:LastSourceLogMessage
"
SourceCodeManagerUtilities getLogMessageFor:'hello'
"
!
getLogMessageFor:aString initialAnswer:initialAnswer
"get a log message for checking in a class.
Return the message or nil if aborted."
|resources logMsg|
resources := self classResources.
logMsg := Dialog
requestText:(resources string:'Enter log message for: %1' with:aString allBold)
lines:10
columns:70
initialAnswer:(initialAnswer ? LastSourceLogMessage ? '').
logMsg notNil ifTrue:[
LastSourceLogMessage := logMsg
].
^ logMsg
"
SourceCodeManagerUtilities getLogMessageFor:'hello'
"
!
getLogMessageFor:aString withButton:additionalButton
"get a log message for checking in a class.
Return the message or nil if aborted."
|resources logMsg dialog textHolder|
resources := self classResources.
textHolder := '' asValue.
dialog := Dialog
forRequestText:(resources string:'enter log message for: %1' with:aString)
lines:10
columns:70
initialAnswer:LastSourceLogMessage
model:textHolder.
additionalButton notNil ifTrue:[
dialog addButton:additionalButton before:(dialog okButton).
].
dialog open.
dialog accepted ifFalse:[
^ nil.
].
logMsg := textHolder value.
"/ logMsg := Dialog
"/ requestText:(resources string:'enter log message for: %1' with:aString)
"/ lines:10
"/ columns:70
"/ initialAnswer:LastSourceLogMessage.
logMsg notNil ifTrue:[
LastSourceLogMessage := logMsg
].
^ logMsg
"
SourceCodeManagerUtilities getLogMessageFor:'hello'
SourceCodeManagerUtilities getLogMessageFor:'hello' withButton:(Button label:'foo')
"
!
getMethodVersionsOfClass:aClass selector:selector numberOfRevisions:numberOfRevisionsOrNil
"check-out all previous versions of aClass and retrieve the history of selector.
Return a dictionary associating revision with a changeList entries for that method.
Unfinished - need a GUI for that."
|mgr theClass revisionLog revisions items s entriesPerRevision previousVersion|
theClass := aClass theNonMetaclass.
mgr := self sourceCodeManagerFor:theClass.
mgr isNil ifTrue:[
self error:'no sourceCodeManager'.
].
revisionLog := mgr
revisionLogOf:theClass
numberOfRevisions:numberOfRevisionsOrNil.
revisions := revisionLog at:#revisions.
items := revisions collect:[:each | |rev date who|
rev := each at:#revision.
date := each at:#date.
who := each at:#author.
rev allBold , ' [' , date , ' by ' , who , ']'
].
revisions := revisions collect:[:each | each at:#revision].
revisions addFirst:#current.
entriesPerRevision := Dictionary new.
previousVersion := nil.
revisions reverseDo:[:eachRevision |
|srcStream entries thisVersion|
eachRevision == #current ifTrue:[
s := '' writeStream.
theClass fileOutOn:s withTimeStamp:false.
srcStream := s contents readStream.
] ifFalse:[
self activityNotification:('checking out revision ' , eachRevision , '...').
srcStream := mgr getSourceStreamFor:theClass revision:eachRevision.
].
entries := ChangeSet fromStream:srcStream.
srcStream close.
"/ remove all definitions
entries := entries select:[:each | each isMethodChange].
"/ remove all methods which are for other selectors
entries := entries select:[:each | each selector == selector].
"/ remove all methods which are for private subclasses
entries := entries select:[:each | each className = aClass name].
entries size == 1 ifTrue:[
"/ the method is there
thisVersion := entries first.
(previousVersion notNil and:[previousVersion sameAs:thisVersion]) ifTrue:[
"/ no change
] ifFalse:[
entriesPerRevision at:eachRevision put:thisVersion.
].
] ifFalse:[
"/ the method is not there
].
previousVersion := thisVersion.
].
self error:'unfinished code'.
"
self getMethodVersionsOfClass:MenuPanel selector:#'helpTextForItem:' numberOfRevisions:20
self getMethodVersionsOfClass:NewLauncher class selector:#'menu' numberOfRevisions:20
"
! !
!SourceCodeManagerUtilities class methodsFor:'utilities-cvs-user interaction'!
askForContainer:boxText title:title note:notice initialModule:initialModule initialPackage:initialPackage initialFileName:initialFileName
"open a dialog asking for a source container;
return a dictionary containing module, package and filename,
or nil if canceled."
^ self
askForContainer:boxText title:title note:notice
initialModule:initialModule initialPackage:initialPackage initialFileName:initialFileName
forNewContainer:true
!
askForContainer:boxText title:title note:notice initialModule:initialModule initialPackage:initialPackage initialFileName:initialFileName forNewContainer:forNewContainer
"open a dialog asking for a source container;
return a dictionary containing module, package and filename,
or nil if canceled."
|box y component resources answer
moduleHolder packageHolder fileNameHolder
module package fileName
knownContainers knownPackages packageUpdater
packageBoxComponent fileNameBoxComponent fileNameUpdater|
knownContainers := Set new.
Smalltalk allClassesDo:[:cls | |pckg|
pckg := cls package.
pckg size > 0 ifTrue:[
knownContainers add:(pckg upTo:$:)
]
].
knownContainers := knownContainers asOrderedCollection.
knownContainers := knownContainers select:[:module | module isBlank not].
knownContainers sort.
packageUpdater := [
|theModulePrefix|
theModulePrefix := moduleHolder value , ':'.
Cursor wait showWhile:[
knownPackages := Set new.
Smalltalk allClassesDo:[:cls | |pckg idx|
pckg := cls package.
pckg size > 0 ifTrue:[
(pckg startsWith:theModulePrefix) ifTrue:[
idx := pckg indexOf:$:.
knownPackages add:(pckg copyFrom:idx + 1)
]
]
].
knownPackages := knownPackages asOrderedCollection.
knownPackages := knownPackages select:[:package | package isBlank not].
knownPackages sort.
packageBoxComponent list:knownPackages.
].
].
fileNameUpdater := [
|module package files|
Cursor read showWhile:[
module := moduleHolder value ? '__NoProject__'.
package := packageHolder value ? '__NoProject__'.
files := SourceCodeManager getExistingContainersInModule:module package:package.
files := files asOrderedCollection.
files := files select:[:eachFile | eachFile asFilename hasSuffix:'st'].
files sort.
fileNameBoxComponent list:files.
].
].
moduleHolder := initialModule asValue.
packageHolder := initialPackage asValue.
fileNameHolder := initialFileName asValue.
resources := self classResources.
"/
"/ open a dialog for this
"/
box := DialogBox new.
box label:title.
component := box addTextLabel:boxText withCRs.
component adjust:#left; borderWidth:0.
box addVerticalSpace.
box addVerticalSpace.
y := box yPosition.
component := box addTextLabel:(resources string:'Module:').
component width:0.4; adjust:#right.
box yPosition:y.
component := box addComboBoxOn:moduleHolder tabable:true.
component list:knownContainers.
"/ component := box addInputFieldOn:moduleHolder tabable:true.
component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
box addVerticalSpace.
y := box yPosition.
component := box addTextLabel:(resources string:'Package:').
component width:0.4; adjust:#right.
box yPosition:y.
packageBoxComponent := component := box addComboBoxOn:packageHolder tabable:true.
"/ component := box addInputFieldOn:packageHolder tabable:true.
component width:0.6; left:0.4; "immediateAccept:true; "acceptOnLeave:true; cursorMovementWhenUpdating:#beginOfLine.
packageUpdater value.
moduleHolder onChangeEvaluate:packageUpdater.
box addVerticalSpace.
y := box yPosition.
component := box addTextLabel:(resources string:'Filename:').
component width:0.4; adjust:#right.
box yPosition:y.
forNewContainer ifTrue:[
component := box addInputFieldOn:fileNameHolder tabable:true.
component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
] ifFalse:[
fileNameBoxComponent := component := box addComboBoxOn:fileNameHolder tabable:true.
component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
fileNameUpdater value.
packageHolder onChangeEvaluate:fileNameUpdater.
].
box addVerticalSpace.
notice notNil ifTrue:[
component := box addTextLabel:notice.
component adjust:#left; borderWidth:0.
].
box addVerticalSpace.
box addAbortAndOkButtons.
(YesToAllNotification notNil and:[YesToAllNotification isHandled]) ifTrue:[
component := Button label:'Yes to all'.
component action:[
YesToAllNotification queryWith:true.
box doAccept.
].
(DialogBox defaultOKButtonAtLeft) ifTrue:[
box addButton:component after:nil.
] ifFalse:[
box addButton:component before:nil.
].
].
(AbortAllSignal isHandled) ifTrue:[
component := Button label:'Cancel all'.
component action:[
box hide.
AbortAllSignal raiseSignal.
].
(DialogBox defaultOKButtonAtLeft) ifTrue:[
box addButton:component before:nil.
] ifFalse:[
box addButton:component after:nil.
].
].
(YesToAllQuery notNil and:[YesToAllQuery isHandled]) ifTrue:[
answer := YesToAllQuery query.
].
answer isNil ifTrue:[
box showAtPointer.
answer := box accepted
].
box destroy.
answer ifFalse:[
^ nil
].
module := moduleHolder value withoutSpaces.
package := packageHolder value withoutSpaces.
fileName := fileNameHolder value withoutSpaces.
^ Dictionary new
at:#module put:module;
at:#package put:package;
at:#fileName put:fileName;
yourself
"
self
askForContainer:'enter container' title:'container' note:'some note'
initialModule:'foo' initialPackage:'bar' initialFileName:'baz'
"
!
askForExistingRevision:boxText title:title class:aClass
"open a dialog asking for a containers revision;
return a revision number, or nil if canceled."
|mgr sourceInfo module package fileName|
mgr := aClass sourceCodeManager.
sourceInfo := mgr sourceInfoOfClass:aClass.
sourceInfo isNil ifTrue:[^ nil].
package := mgr packageFromSourceInfo:sourceInfo.
module := mgr moduleFromSourceInfo:sourceInfo.
fileName := mgr containerFromSourceInfo:sourceInfo.
^ self
askForExistingRevision:boxText
title:title
class:aClass
manager:mgr
module:module package:package fileName:fileName
"
SourceCodeManagerUtilities
askForRevisionToCompare:'enter revision'
title:'revision'
class:Array
"
!
askForExistingRevision:boxText title:title class:clsOrNil manager:aSourceCodeManager module:module package:package fileName:fileName
"open a dialog asking for a containers revision;
return a revision number, or nil if canceled."
|partialLog revisions items newestRev
box y component resources
revisionHolder|
partialLog := aSourceCodeManager
revisionLogOf:clsOrNil
numberOfRevisions:20
fileName:fileName
directory:package
module:module.
partialLog notNil ifTrue:[
newestRev := partialLog at:#newestRevision.
revisions := partialLog at:#revisions.
items := revisions collect:[:each | |rev date who|
rev := each at:#revision.
date := each at:#date.
who := each at:#author.
rev allBold , ' [' , date , ' by ' , who , ']'
].
revisions := revisions collect:[:each | each at:#revision].
] ifFalse:[
newestRev := aSourceCodeManager newestRevisionInFile:fileName directory:package module:module.
revisions := items := nil.
newestRev isNil ifTrue:[
(aSourceCodeManager checkForExistingContainerInModule:module package:package container:fileName)
ifFalse:[
self warn:'Could not find/access the container for ',fileName,' in the repository.
This could be due to:
- invalid/wrong CVS-Root setting
- missing CVS access rights
(no access / not logged in)
- changed CVSRoot after compilation
(i.e. wrong CVS-path in classes version method)
'.
^ nil
]
]
].
revisionHolder := newestRev asValue.
resources := self classResources.
revisionHolder onChangeEvaluate:[
"/ cut off everything after revision
|s first words|
s := revisionHolder value.
words := s asCollectionOfWords.
words size > 0 ifTrue:[
first := words first string.
first ~= s ifTrue:[
revisionHolder value:first
]
]
].
"/
"/ open a dialog for this
"/
box := DialogBox new.
box label:title.
component := box addTextLabel:boxText withCRs.
component adjust:#left; borderWidth:0.
box addVerticalSpace.
box addVerticalSpace.
y := box yPosition.
component := box addTextLabel:(resources string:'Revision:').
component width:0.4; adjust:#right.
box yPosition:y.
component := box addComboBoxOn:revisionHolder tabable:true.
component list:items.
component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
box addVerticalSpace.
box addAbortAndOkButtons.
Object abortAllSignal isHandled ifTrue:[
(box addAbortButtonLabelled:'Cancel all') action:[AbortAllSignal raise].
].
box showAtPointer.
box accepted ifFalse:[
box destroy.
^ nil
].
box destroy.
^ revisionHolder value withoutSpaces.
"
SourceCodeManagerUtilities
askForRevisionToCompare:'enter revision'
title:'revision'
class:nil
manager:SourceCodeManager
module:'stx'
package:'libbasic'
fileName:'Array.st'
"
!
checkAndWarnAboutBadMessagesInClass:aClass
"check if a class contains message-sends to:
#halt
#halt:
#error
(and maybe more in the future)"
|badStuff whatIsBad msg answer labels values|
badStuff := #(
( #halt 'sent of #halt (use for debugging only) - better use #error:''some message''' )
( #halt: 'sent of #halt: (use for debugging only) - better use #error:' )
( #error 'sent of #error without descriptive message - better use #error:''some message''' )
).
whatIsBad := Set new.
aClass theNonMetaclass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|setOfLiterals setOfSentMessages|
setOfLiterals := mthd literals. "/ try without parsing first.
(badStuff contains:[:eachEntry | setOfLiterals includes:eachEntry first]) ifTrue:[
setOfSentMessages := mthd messagesSent.
badStuff do:[:eachEntry |
(setOfSentMessages includes:eachEntry first) ifTrue:[
whatIsBad add:eachEntry second
]
].
].
].
whatIsBad notEmpty ifTrue:[
(YesToAllQuery notNil and:[YesToAllQuery isHandled]) ifTrue:[
answer := YesToAllQuery query.
answer notNil ifTrue:[ ^ answer ].
].
msg := '%1 contains the following (considered bad style) message sends:\\'.
whatIsBad do:[:each |
msg := msg , ' ' , each , '\'
].
msg := msg , '\\' , 'Do you really want to checkIn the %1 class ?'.
msg := msg bindWith:aClass name.
(YesToAllNotification notNil and:[YesToAllNotification isHandled]) ifTrue:[
labels := #('Yes' 'Yes to all' 'No' 'No to all' 'Cancel').
values := #(true #yesToAll false #noToAll nil).
AbortAllSignal isHandled ifTrue:[
labels := labels , #('Cancel All').
values := values , #(#cancelAll).
].
answer := OptionBox
request:msg withCRs
label:'Really checkIn ?'
image:(InfoBox iconBitmap)
buttonLabels:labels
values:values
default:#yesToAll
onCancel:nil.
answer isNil ifTrue:[
AbortSignal raise.
].
answer == #cancelAll ifTrue:[
AbortAllSignal raise.
].
answer == #yesToAll ifTrue:[
YesToAllNotification queryWith:true.
^ true
].
answer == #noToAll ifTrue:[
YesToAllNotification queryWith:false.
^ false
].
^ answer
] ifFalse:[
^ self confirm:msg withCRs
]
].
^ true.
"
self checkAndWarnAboutBadMessagesInClass:(SourceCodeManagerUtilities)
"
! !
!SourceCodeManagerUtilities class methodsFor:'utilities-encoding'!
guessEncodingOfBuffer:buffer
"look for a string of the form
encoding #name
or:
encoding: name
within the given buffer
(which is usually the first few bytes of a textFile)."
|s idx w withoutQuotes lcBuffer enc quote|
withoutQuotes :=
[
((w startsWith:$") or:[(w startsWith:$')]) ifTrue:[
w := w copyFrom:2
].
((w endsWith:$") or:[(w endsWith:$')]) ifTrue:[
w := w copyWithoutLast:1
].
w
].
lcBuffer := buffer asLowercase.
#( 'charset' 'encoding' ) do:[:keyWord |
(idx := lcBuffer findString:keyWord) ~~ 0 ifTrue:[
s := ReadStream on:buffer.
s position1Based:idx.
s skip:keyWord size.
s skipSeparators.
['=:#' includes:s peek] whileTrue:[
s next.
s skipSeparators.
].
s skipSeparators.
('"''' includes:s peek) ifTrue:[
quote := s next.
w := s upTo:quote.
] ifFalse:[
w := s upToSeparator.
].
w notNil ifTrue:[
enc := withoutQuotes value.
(CharacterEncoder encoderFor:enc asSymbol ifAbsent:nil) notNil ifTrue:[
^ enc asSymbol
].
"/ enc size >=3 ifTrue:[
"/ Transcript showCR:'Unknown encoding: ' , withoutQuotes value.
"/ ]
].
].
].
^ nil
!
guessEncodingOfFile:aFilename
"look for a string
encoding #name
or:
encoding: name
within the given buffer
(which is usually the first few bytes of a textFile).
If thats not found, use heuristics (in CharacterArray) to guess."
|s buffer n "{Class: SmallInteger }"
binary enc|
s := aFilename asFilename readStreamOrNil.
s isNil ifTrue:[^ nil].
buffer := String new:2048.
n := buffer size.
n := s nextBytes:n into:buffer.
s close.
enc := self guessEncodingOfBuffer:buffer.
enc notNil ifTrue:[^ enc].
binary := false.
1 to:n do:[:i |
(buffer at:i) isPrintable ifFalse:[binary := true].
].
"/ look for JIS7 / EUC encoding
(buffer findString:(CharacterEncoder jisISO2022EscapeSequence)) ~~ 0 ifTrue:[
^ #'iso2020-jp'
].
(buffer findString:(CharacterEncoder jis7KanjiEscapeSequence)) ~~ 0 ifTrue:[
^ #jis7
].
(buffer findString:(CharacterEncoder jis7KanjiOldEscapeSequence)) ~~ 0 ifTrue:[
^ #jis7
].
"/ TODO:
"/ "/ look for EUC
"/ idx := aString findFirst:[:char | |ascii|
"/ ((ascii := char asciiValue) >= 16rA1)
"/ and:[ascii <= 16rFE]].
"/ idx ~~ 0 ifTrue:[
"/ ascii := (aString at:(idx + 1)) asciiValue.
"/ (ascii >= 16rA1 and:[ascii <= 16rFE]) ifTrue:[
"/ ^ #euc
"/ ]
"/ ].
"/ look for SJIS ...
^ nil
"
SourceCodeManagerUtilities guessEncodingOfFile:'../../libview2/resources/ApplicationModel_de.rs' asFilename
SourceCodeManagerUtilities guessEncodingOfFile:'../../libview2/resources/ApplicationModel_ru.rs' asFilename
"
!
guessEncodingOfStream:aStream
"look for a string of the form
encoding #name
or:
encoding: name
in the first few bytes of aStream."
|oldPosition buffer n|
buffer := String new:2048.
oldPosition := aStream position.
n := buffer size.
n := aStream nextBytes:n into:buffer.
aStream position:oldPosition.
^ self guessEncodingOfBuffer:buffer
! !
!SourceCodeManagerUtilities class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.104 2004-05-18 13:30:31 cg Exp $'
! !