added askFor... utility.
Object subclass:#SourceCodeManagerUtilities
instanceVariableNames:''
classVariableNames:'LastSourceLogMessage LastModule LastPackage'
poolDictionaries:''
category:'System-SourceCodeManagement'
!
!SourceCodeManagerUtilities class methodsFor:'documentation'!
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|
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 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.
component := box addInputFieldOn:packageHolder tabable:true.
component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
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'
"
!
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."
|logMessage info mgr pri resources|
aClass isLoaded ifFalse:[
self information:'cannot checkin unloaded classes (' , aClass name , ').'.
^ false.
].
aLogMessageOrNil isNil ifTrue:[
logMessage := SourceCodeManagerUtilities getLogMessageFor:aClass name.
logMessage isNil ifTrue:[^ self].
] ifFalse:[
logMessage := aLogMessageOrNil
].
resources := ResourcePack for:self.
mgr := (aClass sourceCodeManager).
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.
].
]
].
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:aClass
"check a collection of classes into the source repository.
Asks interactively for log-message."
^ self checkinClasses:aClass 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|
resources := ResourcePack for:self.
(logMessage := aLogMessageOrNil) isNil ifTrue:[
logMessage := SourceCodeManagerUtilities getLogMessageFor:(resources string:'classes to checkin').
].
"/ ignore private classes
classes := aCollectionOfClasses select:[:aClass | aClass owningClass isNil].
classes do:[:aClass |
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
].
]
!
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|
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:$/.
].
OperatingSystem isMSDOSlike ifTrue:[
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'
].
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:[
(Dialog
confirm:(resources string:'%1 does not have any (usable) revision info (#version method)\\Shall I create one ?' with:className) withCRs
noLabel:'cancel')
ifFalse:[
^ false
].
].
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'
"
! !
!SourceCodeManagerUtilities class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.7 2000-02-02 12:41:14 cg Exp $'
! !