"
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'
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:'utilities'!
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."
|box y component resources
moduleHolder packageHolder fileNameHolder
module package fileName
knownContainers knownPackages packageUpdater
packageBoxComponent|
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 , ':'.
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.
].
moduleHolder := initialModule asValue.
packageHolder := initialPackage asValue.
fileNameHolder := initialFileName asValue.
resources := ResourcePack for:self.
"/
"/ 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:'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:false; cursorMovementWhenUpdating:#beginOfLine.
packageUpdater value.
moduleHolder onChangeEvaluate:packageUpdater.
box addVerticalSpace.
y := box yPosition.
component := box addTextLabel:'Filename:'.
component width:0.4; adjust:#right.
box yPosition:y.
component := box addInputFieldOn:fileNameHolder tabable:true.
component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
box addVerticalSpace.
notice notNil ifTrue:[
component := box addTextLabel:notice.
component adjust:#left; borderWidth:0.
].
box addVerticalSpace.
box addAbortAndOkButtons.
box showAtPointer.
box accepted ifFalse:[
box destroy.
^ nil
].
box destroy.
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 asText allBold , ' [' , date , ' by ' , who , ']'
].
revisions := revisions collect:[:each | each at:#revision].
] ifFalse:[
newestRev := aSourceCodeManager newestRevisionInFile:fileName directory:package module:module.
revisions := items := nil.
].
revisionHolder := newestRev asValue.
resources := ResourcePack for:self.
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.
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
#error
(and maybe more in the future)"
|badStuff whatIsBad msg|
badStuff := #(
( #halt 'sent of #halt without descriptive message - better use halt:''some message''' )
( #error 'sent of #error without descriptive message - better use error:''some message''' )
).
whatIsBad := Set new.
aClass theNonMetaclass allSelectorsAndMethodsDo:[:sel :mthd |
|setOfSentMessages|
setOfSentMessages := mthd messagesSent.
badStuff do:[:eachEntry |
(setOfSentMessages includes:eachEntry first) ifTrue:[
whatIsBad add:eachEntry second
]
].
].
whatIsBad notEmpty ifTrue:[
msg := 'Your class contains the following (considered bad style) message sends:\\'.
whatIsBad do:[:each |
msg := msg , ' ' , each , '\'
].
msg := msg , '\\' , 'Do you really want to check in this class ?'.
^ self confirm:msg withCRs
].
^ true.
"
self checkAndWarnAboutBadMessagesInClass:SMC::RuleItem
"
!
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|
aClass isLoaded ifFalse:[
self information:'cannot checkin unloaded classes (' , aClass name , ').'.
^ false.
].
mgr := (aClass sourceCodeManager).
mgr isNil ifTrue:[
self halt:'oops'.
(self confirm:'Class does not seem to privide a valid sourceCodeManager.\\Assume CVS ?' withCRs) ifFalse:[
^ false
].
mgr := CVSSourceCodeManager.
].
aLogMessageOrNil isNil ifTrue:[
logMessage := SourceCodeManagerUtilities getLogMessageFor:aClass name asText allBold.
logMessage isNil ifTrue:[^ self].
] ifFalse:[
logMessage := aLogMessageOrNil
].
resources := ResourcePack for:self.
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 a container for ''' , aClass name , ''''.
] ifTrue:[
freshCreated := true.
].
]
].
doCheckClass ifTrue:[
"/ check if the class contains halts, error-sends etc.
(self checkAndWarnAboutBadMessagesInClass:aClass) ifFalse:[
^ false
].
].
freshCreated ifFalse:[
aborted := false.
Object abortSignal handle:[:ex |
aborted := true.
ex return.
^ false.
] do:[
(mgr checkinClass:aClass logMessage:logMessage) ifFalse:[
Transcript showCR:'checkin of ''' , aClass name , ''' failed'.
self warn:'checkin of ''' , aClass name asText allBold , ''' failed'.
^ false.
].
].
aborted ifTrue:[
Transcript showCR:'checkin of ''' , aClass name , ''' aborted'.
self warn:'checkin of ''' , aClass name , ''' aborted'.
^ false.
].
].
].
^ true
!
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."
|classes logMessage resources|
"/ 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.
].
resources := ResourcePack for:self.
(logMessage := aLogMessageOrNil) isNil ifTrue:[
logMessage := SourceCodeManagerUtilities getLogMessageFor:(resources string:'%1 classes to checkin' with:aCollectionOfClasses size).
logMessage isNil ifTrue:[
^ self
].
].
classes do:[:aClass |
(self checkAndWarnAboutBadMessagesInClass:aClass) ifTrue:[
self activityNotification:(resources string:'checking in %1' with:aClass name).
"/ ca does not want boxes to pop up all over ...
InformationSignal handle:[:ex |
Transcript showCR:ex errorString
] do:[
self checkinClass:aClass withLog:logMessage
].
].
]
!
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 info mgr pri resources module package i containerFileName|
resources := ResourcePack for:self.
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.
containerFileName := 'extensions.st'.
aLogMessageOrNil isNil ifTrue:[
logMessage := SourceCodeManagerUtilities getLogMessageFor:containerFileName asText allBold.
logMessage isNil ifTrue:[^ self].
] ifFalse:[
logMessage := aLogMessageOrNil
].
"/
"/ check for the module
"/
(mgr checkForExistingModule:module) ifFalse:[
(Dialog
confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs
noLabel:'cancel')
ifFalse:[
^ false.
].
(mgr createModule:module) ifFalse:[
self warn:(resources string:'cannot create new module: %1' with:module).
^ false.
]
].
LastModule := module.
"/
"/ check for the package
"/
(mgr checkForExistingModule:module package:package) ifFalse:[
(Dialog
confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs
noLabel:'cancel')
ifFalse:[
^ false.
].
(mgr createModule:module package:package) ifFalse:[
self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module).
^ false.
]
].
LastPackage := package.
self activityNotification:(resources string:'checking in %1' with:containerFileName).
pri := Processor activePriority.
Processor activeProcess withPriority:pri-1 to:pri
do:[
|s methodSource|
s := '' writeStream.
s nextPutAll:'"{ Package: '''.
s nextPutAll:aPackageID asString.
s nextPutAll:''' }"'; cr; nextPutChunkSeparator; cr; cr.
"/ s nextPutAll:(Smalltalk timeStamp).
"/ s nextPutChunkSeparator.
"/ s cr; cr.
aCollectionOfMethods do:[:aMethod |
aMethod mclass fileOutMethod:aMethod on:s.
s cr.
].
methodSource := s contents.
InformationSignal handle:[:ex |
Transcript showCR:ex errorString
] 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 asText allBold , ''' failed'.
^ false.
].
].
].
^ true
!
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 v rev revString thisRevString mgr
nm msg rev2 newestRev
containerModule containerPackage containerFile rslt
lastModule lastPackage pkg|
resources := ResourcePack for:self.
currentClass := aClass theNonMetaclass.
nm := currentClass name.
mgr := currentClass sourceCodeManager.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - check settings'.
^ 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 asText 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 errorString) 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:'versions are identical'.
] 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 current 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 := ResourcePack for:self.
^ self
defineSourceContainerForClass:aClass
title:(resources string:'Repository information for %1' with:aClass name)
text:(resources string:'CREATE_REPOSITORY' with:aClass name)
createDirectories:true
createContainer:true.
!
defineSourceContainerForClass:aClass title:title text:boxText createDirectories:createDirs createContainer:createContainer
"let user specify the source-repository values for aClass"
|box className
oldModule oldPackage oldFileName
module package fileName nameSpace nameSpacePrefix
y component info project nm mgr creatingNew msg
answer doCheckinWithoutAsking forceCheckIn resources rslt note
requiredPackage|
resources := ResourcePack for:self.
aClass isLoaded ifFalse:[
self warn:'please load the class first'.
^ 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.
"/
info := (mgr := aClass sourceCodeManager) sourceInfoOfClass:aClass.
info notNil ifTrue:[
module ~= LastModule ifTrue:[
(info includesKey:#module) ifTrue:[
module := (info at:#module).
].
].
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:[
aClass nameSpace ~~ Smalltalk ifTrue:[
fileName := aClass nameWithoutPrefix , '.st'.
] ifFalse:[
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.
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 package:requiredPackage.
aClass allSelectorsAndMethodsDo:[:sel :mthd | mthd package:requiredPackage].
].
info := aClass revisionInfo.
info notNil ifTrue:[
(info includesKey:#repositoryPathName) ifFalse:[
info := nil
]
].
info isNil ifTrue:[
creatingNew ifFalse:[
doCheckinWithoutAsking ifFalse:[
(Dialog
confirm:(resources string:'The repository already contains a container named "%3" in "%1/%2" !!\\Checkin %4 anyway ? (DANGER - be careful)'
withArgs:(Array with:module with:package with:fileName with:className)) withCRs
noLabel:'cancel')
ifFalse:[
^ false
].
]
].
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:#( 'cancel' 'no' 'yes').
answer isNil ifTrue:[^ false].
] ifTrue:[
answer := true.
].
answer ifTrue:[
aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass
inModule:module
package:package
container:fileName).
].
].
"/
"/ check for the module
"/
(mgr checkForExistingModule:module) ifFalse:[
(createDirs or:[creatingNew]) ifFalse:[
self warn:(resources string:'a module named %1 does not exist in the source code management' with:module).
^ false
].
(Dialog
confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs
noLabel:'cancel')
ifFalse:[
^ false.
].
(mgr createModule:module) ifFalse:[
self warn:(resources string:'cannot create new module: %1' with:module).
^ false.
]
].
LastModule := module.
"/
"/ check for the package
"/
(mgr checkForExistingModule:module package:package) ifFalse:[
(createDirs or:[creatingNew]) ifFalse:[
self warn:(resources string:'a package named %1 does not exist module %2' with:module with:package).
^ false
].
(Dialog
confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs
noLabel:'cancel')
ifFalse:[
^ false.
].
(mgr createModule:module package:package) ifFalse:[
self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module).
^ 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
!
getLogMessageFor:aString
"get a log message for checking in a class.
Return the message or nil if aborted."
|resources logMsg|
resources := ResourcePack for:self.
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'
"
!
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 := ResourcePack for:self.
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')
"
!
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 := ResourcePack for:self.
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
! !
!SourceCodeManagerUtilities class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.23 2000-10-27 18:46:02 cg Exp $'
! !