--- a/SourceCodeManagerUtilities.st Thu Mar 11 16:39:08 2004 +0100
+++ b/SourceCodeManagerUtilities.st Fri Mar 12 10:36:02 2004 +0100
@@ -98,415 +98,50 @@
!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."
-
- ^ 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 , ':'.
+setPackageOfAllMethodsIn:aClass to:aPackage
+ "make all methods belong to the classes project"
- 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 := 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.
+ |anyChange anyChangeHere|
- 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.
+ 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].
].
-
- 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.
- ].
+ anyChange ifTrue:[
+ Smalltalk changed:#projectOrganization
].
-
- (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'
- "
+ ^ anyChange
!
-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 := ResourcePack for:self.
-
- revisionHolder onChangeEvaluate:[
- "/ cut off everything after revision
- |s first words|
+sourceCodeManagerFor:aClass
+ |mgr|
- 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
- ]
+ 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
].
].
- ].
- 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 , '\'
+ (self confirm:'Class does not seem to provide a valid sourceCodeManager.\\Assume CVS ?' withCRs) ifFalse:[
+ ^ nil
].
- 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 ?'
- form:(InfoBox iconBitmap)
- buttonLabels:labels
- values:values
- default:#yesToAll
- onCancel:nil.
- answer isNil ifTrue:[
- AbortSignal raise.
- ].
- answer == #cancelAll ifTrue:[
- AbortAllSignal raise.
- ].
+ mgr := CVSSourceCodeManager.
+ ].
+ ^ mgr
+! !
- 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-cvs'!
checkForExistingModule:module package:package container:containerFileName using:mgr allowCreate:allowCreate
|resources moduleName packageName containerName|
@@ -1730,284 +1365,6 @@
^ true
!
-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 := ResourcePack for:self.
- 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 := 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')
- "
-!
-
-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
- "
-!
-
-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|
-
- 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.
- w := s upToSeparator.
- w notNil ifTrue:[
- enc := withoutQuotes value.
- (CharacterEncoder encoderFor:enc 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
-!
-
removeSourceContainerForClass:aClass
"show container & let user confirm twice."
@@ -2189,53 +1546,704 @@
]
]
]
+! !
+
+!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 := ResourcePack for:self.
+ 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 := 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')
+ "
+!
+
+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
!
-setPackageOfAllMethodsIn:aClass to:aPackage
- "make all methods belong to the classes project"
+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 := 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.
- |anyChange anyChangeHere|
+ 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
+ ].
- anyChange := false.
- aClass withAllPrivateClassesDo:[:eachClass |
- anyChangeHere := false.
- eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- mthd package ~= aPackage ifTrue:[
- mthd setPackage:aPackage.
- anyChangeHere := true.
+ 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 := 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.
+
+ 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
+ ]
].
].
- anyChangeHere ifTrue:[
- eachClass changed:#projectOrganization
+ ].
+ 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 , '\'
].
- anyChangeHere ifTrue:[anyChange := true].
+ 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 ?'
+ form:(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
+ ]
].
- anyChange ifTrue:[
- Smalltalk changed:#projectOrganization
+ ^ 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|
+
+ 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.
+ w := s upToSeparator.
+ w notNil ifTrue:[
+ enc := withoutQuotes value.
+ (CharacterEncoder encoderFor:enc ifAbsent:nil) notNil ifTrue:[
+ ^ enc asSymbol
+ ].
+ enc size >=3 ifTrue:[
+ Transcript showCR:'Unknown encoding: ' , withoutQuotes value.
+ ]
+ ].
+ ].
].
- ^ anyChange
+ ^ nil
!
-sourceCodeManagerFor:aClass
- |mgr|
+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
+ ].
- 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
+ "/ 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.99 2004-03-11 15:39:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.100 2004-03-12 09:36:02 cg Exp $'
! !