--- a/Tools__NewSystemBrowser.st Thu Dec 22 10:13:37 2011 +0100
+++ b/Tools__NewSystemBrowser.st Thu Dec 22 11:05:46 2011 +0100
@@ -29196,6 +29196,22 @@
"Modified: / 01-03-2007 / 17:47:32 / cg"
!
+checkOutClass:aClass askForRevision:askForRevision usingManager: manager
+ "check-out a single class from the source repository.
+ Offer a chance to either merge-in a version, or overload the current version.
+ If askForRevision is false, fetch the newest revision(s),
+ otherwise ask for the revision."
+
+ self withActivityNotificationsRedirectedToInfoLabelDo:[
+ manager utilities
+ checkoutClass:aClass askForRevision:askForRevision askForMerge:true.
+ ]
+
+ "Modified: / 01-03-2007 / 17:47:32 / cg"
+ "Created: / 11-10-2011 / 23:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:26:27 / cg"
+!
+
checkOutClasses:classes askForRevision:askForRevision
"check-out a bunch of classes from the source repository.
Offer chance to either overwrite the current version,
@@ -29203,6 +29219,18 @@
If askForRevision is false, fetch the newest revision(s),
otherwise ask for the revision."
+ self checkOutClasses:classes askForRevision:askForRevision usingManager:nil
+
+ "Modified: / 22-12-2011 / 11:05:05 / cg"
+!
+
+checkOutClasses:classes askForRevision:askForRevision usingManager:aManagerOrNil
+ "check-out a bunch of classes from the source repository.
+ Offer chance to either overwrite the current version,
+ or merge-in the repository version.
+ If askForRevision is false, fetch the newest revision(s),
+ otherwise ask for the revision."
+
|alreadyCheckedOut|
(self askIfModified:'Code was modified.\\CheckOut anyway ?')
@@ -29237,7 +29265,12 @@
ex proceed.
] do:[
self withActivityNotificationsRedirectedToInfoLabelDo:[
- SourceCodeManagerUtilities
+ |utilities|
+
+ utilities := aManagerOrNil notNil
+ ifTrue:[ aManagerOrNil utilities ]
+ ifFalse:[ SourceCodeManagerUtilities default ].
+ utilities
checkoutClass:cls askForRevision:askForRevision askForMerge:true askForConfirmation:false.
].
alreadyCheckedOut add:cls.
@@ -29260,7 +29293,7 @@
AbortAllOperationRequest raise "/ cancel
].
answer == true ifTrue:[
- self checkOutClass:owner askForRevision:askForRevision.
+ self checkOutClass:owner askForRevision:askForRevision usingManager:aManagerOrNil.
alreadyCheckedOut add:owner.
].
]
@@ -29269,7 +29302,8 @@
].
self normalLabel.
- "Modified: / 09-02-2011 / 14:01:59 / cg"
+ "Created: / 11-10-2011 / 23:11:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:15:33 / cg"
!
classMenuCheckIn
@@ -29527,6 +29561,31 @@
self checkOutClasses:(self selectedClasses value) askForRevision:false
!
+classMenuCheckOutNewestUsingManager: manager
+ "check-out the newest version of the selected class(es) from the source repository.
+ Offer chance to either overwrite the current version,
+ or merge-in the repository version.
+ "
+
+ self checkOutClasses:(self selectedClasses value) askForRevision:false usingManager: manager
+
+ "Modified: / 11-10-2011 / 23:09:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:16:21 / cg"
+!
+
+classMenuCheckOutUsingManager: manager
+ "check-out selected class(es) from the source repository.
+ Individually ask for class revisions.
+ Offer chance to either overwrite the current version,
+ or merge-in the repository version.
+ "
+
+ self checkOutClasses:(self selectedClasses value) askForRevision:true usingManager: manager
+
+ "Modified: / 11-10-2011 / 23:10:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:16:41 / cg"
+!
+
classMenuCompareAgainstNewestInRepository
"open a diff-textView comparing the current (in-image) version
with the the newest version found in the repository.
@@ -29576,6 +29635,106 @@
"Modified: / 21-12-2011 / 22:49:35 / cg"
!
+classMenuCompareAgainstOriginalInRepositoryUsingManager: manager
+ "open a diff-textView comparing the current (in-image) version
+ with the the base version found in the repository.
+ That is the version on which the class was based upon, not the most recent one."
+
+ |currentClass
+ aStream comparedSource currentSource rev revInfo revString thisRevString mgr
+ nm msg newestRev brwsr|
+
+ currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
+ currentClass isNil ifTrue:[
+ self warn:'Cannot compare unloaded classes.'.
+ ^ self.
+ ].
+
+ nm := currentClass name.
+ mgr := manager.
+ mgr isNil ifTrue:[
+ ^ self
+ ].
+ revInfo := currentClass revisionInfoOfManager: manager.
+ revInfo ifNil:[
+ self warn:('The class seems to have no repository information for %1.' bindWith: mgr managerTypeName).
+ ^ self
+ ].
+ rev := revInfo revision.
+ rev isNil ifTrue:[
+ self warn:'The class seems to have no repository information.'.
+ ^ self
+ ].
+ "/
+ "/ class in repository - ask for revision
+ "/
+ msg := 'extracting revision %1'.
+ self busyLabel:msg with:rev.
+ self withActivityNotificationsRedirectedToInfoLabelDo:[
+ aStream := mgr getSourceStreamFor:currentClass revision:rev.
+ ].
+
+ 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 busyLabel:'generating current source ...' with:nil.
+
+ aStream := '' writeStream.
+ Method flushSourceStreamCache.
+ currentClass fileOutOn:aStream withTimeStamp:false.
+ currentSource := aStream contents asString.
+ aStream close.
+
+ self busyLabel:'comparing ...' with:nil.
+
+ comparedSource = currentSource ifTrue:[
+ self information:'Versions are identical.'.
+ ] ifFalse:[
+ thisRevString := currentClass revision.
+ thisRevString isNil ifTrue:[
+ thisRevString := 'no revision'
+ ].
+
+ revString := rev.
+ "/ this takes some time ... is it worth ?
+ (newestRev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
+ newestRev ~= rev ifTrue:[
+ revString := rev , ' (newest is ' , newestRev , ')'
+ ]
+ ].
+
+ self busyLabel:'comparing ...' with:nil.
+
+ brwsr := (UserPreferences versionDiffViewerClass)
+ openOnClass:currentClass
+ labelA:('repository: ' , revString)
+ sourceA:comparedSource
+ labelB:('current: (based on: ' , rev , ')')
+ sourceB:currentSource
+ title:('comparing ' , currentClass name)
+ ifSame:[self normalLabel. self information:'Versions are identical.'. ^ self].
+
+ brwsr classChangeSet
+ classBeingCompared:currentClass;
+ versionA:rev;
+ versionB:rev , 'mod'.
+ ].
+ self normalLabel.
+
+ "Modified: / 11-10-2011 / 14:37:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:28:18 / cg"
+!
+
classMenuCompareAgainstOriginalInRepositoryUsingManagerNamed:aManagerName
"open a diff-textView comparing the current (in-image) version
with the the base version found in the repository.
@@ -29759,6 +29918,12 @@
"Modified: / 21-12-2011 / 20:21:14 / cg"
!
+classMenuCompareExtensionsWithRepositoryUsingManager: aManager
+ ^ Dialog warn: 'Not yet implemented'
+
+ "Created: / 21-12-2011 / 20:28:28 / cg"
+!
+
classMenuCompareTwoRepositoryVersions
"open a diff-textView comparing two versions found in the repository."
@@ -29815,6 +29980,71 @@
"Modified: / 08-02-2011 / 10:26:45 / cg"
!
+classMenuCompareTwoRepositoryVersionsUsingManager: manager
+ "open a diff-textView comparing two versions found in the repository."
+
+ |currentClass source1 source2 mgr
+ nm rev1 rev2 versionsAreTheSame|
+
+ currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
+ currentClass isNil ifTrue:[
+ self warn:'Cannot compare unloaded classes.'.
+ ^ self.
+ ].
+
+ nm := currentClass name.
+ mgr := manager.
+ mgr isNil ifTrue:[
+ ^ self
+ ].
+
+ self normalLabel.
+ rev1 := manager utilities
+ askForExistingRevision:(resources string:'Compare which revision:')
+ title:(resources string:'Compare which repository version')
+ class:currentClass.
+ rev1 isNil ifTrue:[^ self].
+
+ rev2 := manager utilities
+ askForExistingRevision:(resources string:'Against which revision:')
+ title:(resources string:'Against which repository version')
+ class:currentClass.
+ rev2 isNil ifTrue:[^ self].
+
+ source1 := self getClassSourceFor:currentClass revision:rev1 usingManager: manager.
+ source2 := self getClassSourceFor:currentClass revision:rev2 usingManager: manager.
+
+ self busyLabel:'comparing ...' with:nil.
+ versionsAreTheSame := (source1 = source2).
+ versionsAreTheSame ifFalse:[
+ self busyLabel:'comparing ...' with:nil.
+ (UserPreferences versionDiffViewerClass)
+ openOnClass:currentClass
+ labelA:(rev1)
+ sourceA:source1
+ labelB:(rev2)
+ sourceB:source2
+ title:('comparing ' , currentClass name)
+ ifSame:[versionsAreTheSame := true].
+
+ versionsAreTheSame ifTrue:[
+ self information:'Versions are identical.'.
+ ].
+ ].
+ self normalLabel.
+
+ "Modified: / 11-10-2011 / 23:07:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:28:43 / cg"
+!
+
+classMenuCompareTwoRepositoryVersionsUsingManagerNamed: aManagerName
+ "open a diff-textView comparing two versions found in the repository."
+
+ self classMenuCompareTwoRepositoryVersionsUsingManager:(Smalltalk at:aManagerName asSymbol)
+
+ "Created: / 21-12-2011 / 23:13:40 / cg"
+!
+
classMenuCompareWithFile
"compare the class against a version in a file"
@@ -29933,6 +30163,198 @@
"Modified: / 29-11-2011 / 13:19:13 / cg"
!
+classMenuCompareWithRepositoryUsingManager: manager
+ "open a diff-textView comparing the current (in-image) version
+ with the some version found in the repository."
+
+ |currentClass
+ aStream comparedSource currentSource revInfo rev revString thisRevString mgr
+ nm msg rev2 newestRev
+ containerModule containerPackage containerFile rslt
+ pkg info mod dir versionsAreTheSame|
+
+ currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
+ currentClass isNil ifTrue:[
+ self warn:'Cannot compare unloaded classes.'.
+ ^ self.
+ ].
+
+ nm := currentClass name.
+ mgr := manager.
+ mgr isNil ifTrue:[
+ ^ self
+ ].
+ "Use revision of manager"
+ rev := currentClass binaryRevision.
+ revInfo := mgr revisionInfoOfManager: mgr.
+ revInfo notNil ifTrue:[
+ rev2 := revInfo revision.
+ ].
+ rev2 notNil ifTrue:[
+ rev := rev2
+ ].
+ rev isNil ifTrue:[
+ "/
+ "/ class not in repository - allow compare against any other containers newest contents
+ "/
+ self normalLabel.
+
+ pkg := currentClass package.
+ (pkg notNil and:[pkg ~= PackageId noProjectID]) 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.
+ ].
+ rslt := manager utilities
+ askForContainer:(resources string:'The class seems to have no repository information.\\Do you want to compare it against an existing containers contents ?')
+ title:'Container to compare' note:nil
+ initialModule:containerModule
+ initialPackage:containerPackage
+ initialFileName:(currentClass nameWithoutPrefix , '.st')
+ forNewContainer:false.
+ rslt isNil ifTrue:[
+ "/ canel
+ ^ self
+ ].
+ containerModule := rslt at:#module.
+ containerPackage := rslt at:#package.
+ containerFile := rslt at:#fileName.
+ SourceCodeManagerUtilities lastModule:containerModule.
+ SourceCodeManagerUtilities lastPackage:containerPackage.
+ ] ifFalse:[
+ "/
+ "/ 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)
+ ].
+
+ self normalLabel.
+ rev := manager utilities
+ askForExistingRevision:msg
+ title:'Compare with repository'
+ class:currentClass
+ ].
+
+ versionsAreTheSame := false.
+ (rev notNil or:[containerFile notNil]) ifTrue:[
+ rev notNil ifTrue:[
+ rev withoutSpaces isEmpty ifTrue:[
+ msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
+ "/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
+ rev := newestRev.
+ revString := 'newest'.
+ ] ifFalse:[
+ msg := 'extracting previous %1'.
+ revString := rev
+ ].
+ aStream := mgr getSourceStreamFor:currentClass revision: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 := '???'
+ ].
+ self busyLabel:msg with:nm.
+
+ aStream isNil ifTrue:[
+ info := mgr sourceInfoOfClass:currentClass.
+ info notNil ifTrue:[
+ mod := info at:#module ifAbsent:'??'.
+ dir := info at:#directory ifAbsent:'??'.
+ ].
+
+ self warn:(resources
+ string:'Could not extract source from repository (for module: ''%1'' , directory: ''%2'' , revision: ''%3'')'
+ with:mod with:dir with:revString).
+ ^ 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 busyLabel:'generating current source ...' with:nil.
+
+ aStream := '' writeStream.
+ Method flushSourceStreamCache.
+ "/ currentClass fileOutOn:aStream withTimeStamp:false.
+ "/ currentSource := aStream contents asString.
+
+ Class fileOutErrorSignal handle:[:ex |
+ ex proceed
+ ] do:[
+ currentSource := currentClass source asString.
+ ].
+
+ self busyLabel:'comparing ...' with:nil.
+ versionsAreTheSame := (comparedSource = currentSource).
+ versionsAreTheSame ifFalse:[
+ thisRevString := currentClass revision.
+ thisRevString isNil ifTrue:[
+ thisRevString := 'no revision'
+ ].
+
+ revString = '(newest)' ifTrue:[
+ (rev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
+ revString := '(newest is ' , rev , ')'
+ ]
+ ].
+
+ self busyLabel:'comparing ...' with:nil.
+ (UserPreferences versionDiffViewerClass)
+ openOnClass:currentClass
+ labelA:('repository: ' , revString)
+ sourceA:comparedSource
+ labelB:('current: (based on: ' , thisRevString , ')')
+ sourceB:currentSource
+ title:('comparing ' , currentClass name)
+ ifSame:[versionsAreTheSame := true].
+ ].
+ versionsAreTheSame ifTrue:[
+ ((currentClass revision = newestRev)
+ and:[currentClass hasUnsavedChanges]) ifTrue:[
+ (self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs) ifTrue:[
+ ChangeSet current condenseChangesForClass:currentClass.
+ ].
+ ] ifFalse:[
+ self information:'Versions are identical.'.
+ ]
+ ].
+ ].
+ self normalLabel.
+
+ "Modified: / 11-10-2011 / 16:25:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:28:48 / cg"
+!
+
+classMenuCompareWithRepositoryUsingManagerNamed:aManagerName
+ "open a diff-textView comparing the current (in-image) version
+ with the some version found in the repository."
+
+ self classMenuCompareWithRepositoryUsingManager:(Smalltalk at:aManagerName asSymbol)
+
+ "Created: / 21-12-2011 / 22:51:56 / cg"
+!
+
classMenuCompareWithSmallTeamVersionOnHost:hostName
"compare the class against a version on another SmallTeam host"
@@ -30038,12 +30460,24 @@
"Created: / 17-02-2011 / 10:29:59 / cg"
!
+classMenuEditVersionInRepositoryUsingManager: aManager
+ ^ Dialog warn: 'Not yet implemented'
+
+ "Created: / 21-12-2011 / 20:28:57 / cg"
+!
+
classMenuQuickCheckIn
"check a class into the source repository (without checks)"
^ self classMenuCheckIn:false
!
+classMenuQuickCheckInUsingManager: argument
+ ^ Dialog warn: 'Not yet implemented'
+
+ "Created: / 21-12-2011 / 20:29:04 / cg"
+!
+
classMenuRevisionLog
"show a classes revision log"
@@ -30100,6 +30534,77 @@
self normalLabel.
!
+classMenuRevisionLog:shortOrNot usingManager: manager
+ "show a classes revision log"
+
+ |codeView|
+
+ (self askIfModified:'Code was modified.\\Show log anyway ?')
+ ifFalse:[^ self].
+
+ self codeAspect:#repositoryLog.
+ self selectedMethods value:nil.
+ self selectProtocols:nil.
+
+ codeView := self codeView.
+ codeView contents:nil.
+ codeView modified:false.
+ navigationState realModifiedState:false.
+
+ self
+ selectedClassesNonMetaDo:
+ [:cls |
+ self
+ showRepositoryLogOf:cls short:shortOrNot usingManager: manager
+ beforeLogDo:[:s |
+ self selectedClasses value size > 1 ifTrue:[
+ s nextPutLine:'-----------------------------------------------------------'.
+ s nextPutLine:('%1 log for %2:'
+ bindWith:(shortOrNot ifTrue:['Short'] ifFalse:['Full'])
+ with:cls name).
+ s nextPutLine:'-----------------------------------------------------------'.
+ s cr.
+ ]
+ ]
+ ]
+ ifUnloaded:
+ [:cls |
+ true.
+ ]
+ ifPrivate:
+ [:cls |
+ |owner|
+ owner := cls owningClass.
+ (self selectedClasses value includes:owner) ifFalse:[
+ self warn:'cannot show log of private class: %1\\Please see the log of the owning class (%2).'
+ with:cls nameWithoutPrefix allBold
+ with:owner name.
+ ]
+ ].
+ self normalLabel.
+
+ "Created: / 11-10-2011 / 20:32:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:26:08 / cg"
+!
+
+classMenuRevisionLogUsingManager: manager
+ "show a classes revision log"
+
+ self classMenuRevisionLog:false usingManager: manager
+
+ "Modified: / 11-10-2011 / 20:31:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:17:12 / cg"
+!
+
+classMenuRevisionLogUsingManagerNamed: aManagerName
+ "show a classes revision log"
+
+ self classMenuRevisionLog:false usingManager:(Smalltalk at:aManagerName asSymbol)
+
+ "Modified: / 11-10-2011 / 20:31:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 23:02:10 / cg"
+!
+
classMenuSetTag
|classes tag knownTags|
@@ -30136,12 +30641,35 @@
"Modified: / 08-02-2011 / 10:30:49 / cg"
!
+classMenuSetTagUsingManager: aManager
+ ^ Dialog warn: 'Not yet implemented'
+
+ "Created: / 21-12-2011 / 20:29:13 / cg"
+!
+
classMenuShortRevisionLog
"show a short (last 20 entries) classes repository log"
self classMenuRevisionLog:true
!
+classMenuShortRevisionLogUsingManager: manager
+ "show a short (last 20 entries) classes repository log"
+
+ self classMenuRevisionLog:true usingManager: manager
+
+ "Modified: / 11-10-2011 / 20:31:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:17:24 / cg"
+!
+
+classMenuShortRevisionLogUsingManagerNamed: aManagerName
+ "show a short (last 20 entries) classes repository log"
+
+ self classMenuShortRevisionLogUsingManager:(Smalltalk at:aManagerName asSymbol)
+
+ "Created: / 21-12-2011 / 23:12:15 / cg"
+!
+
compareAgainstNewestInRepository:aClass
"open a diff-textView comparing the current (in-image) version
with the the newest version found in the repository.
@@ -30511,6 +31039,35 @@
"Created: / 08-02-2011 / 10:24:50 / cg"
!
+getClassSourceFor:aClass revision:revision usingManager: manager
+ "ask aClass's sourceCodeManager to retrieve a (possibly older or newer) version's source code"
+
+ |msg stream source|
+
+ msg := 'extracting previous %1'.
+ self busyLabel:msg with:revision.
+
+ stream := manager getSourceStreamFor:aClass revision:revision.
+ stream isNil ifTrue:[
+ self warn:(resources
+ string:'Could not extract source of rev %1 from repository'
+ with:revision).
+ ^ nil
+ ].
+ stream class readErrorSignal handle:[:ex |
+ self warn:('read error while reading extracted source\\' , ex description) withCRs.
+ stream close.
+ ^ nil
+ ] do:[
+ source := stream contents asString.
+ ].
+ stream close.
+ ^ source
+
+ "Created: / 11-10-2011 / 23:06:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:25:39 / cg"
+!
+
repositoryHistoryForProjects:projectListOrNil
(self askIfModified:'Code was modified.\\Show history anyway ?')
ifFalse:[^ self].
@@ -30703,6 +31260,45 @@
self normalLabel
!
+showRepositoryLogOf:aClass short:shortOrNot usingManager: manager beforeLogDo:aBlock
+ "show a classes repository log - append to codeView.
+ CAVEAT: that is almost the same code as found in SystemBrowser;
+ move to SourceCodeManagerUtilities."
+
+ |codeView aStream|
+
+ aStream := WriteStream on:(String new:200).
+
+ Processor activeProcess
+ withPriority:Processor activePriority-1 to:Processor activePriority
+ do:[
+ self busyLabel:'Extracting log of %1' with:aClass name.
+ aBlock value:aStream.
+ manager utilities repositoryLogOf:aClass short:shortOrNot onto:aStream
+ ].
+
+ self codeAspect:#repositoryLog.
+ self selectedMethods value:nil.
+ self selectProtocols:nil.
+
+ codeView := self codeView.
+ codeView contents:(codeView contents ,
+ Character cr asString ,
+ Character cr asString ,
+ aStream contents).
+
+ codeView modified:false.
+ navigationState realModifiedState:false.
+
+"/ self clearAcceptAction.
+"/ self clearExplainAction.
+
+ self normalLabel
+
+ "Created: / 11-10-2011 / 20:33:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-12-2011 / 20:24:55 / cg"
+!
+
sourceStreamForRepositorySourceOfClass:aClass
"ask for a classes revision and return a stream on this revisions source; nil on error"
@@ -30804,663 +31400,6 @@
"Created: / 21-12-2011 / 20:11:25 / cg"
! !
-!NewSystemBrowser methodsFor:'menu actions-class repository-new'!
-
-checkOutClass:aClass askForRevision:askForRevision usingManager: manager
- "check-out a single class from the source repository.
- Offer a chance to either merge-in a version, or overload the current version.
- If askForRevision is false, fetch the newest revision(s),
- otherwise ask for the revision."
-
- self withActivityNotificationsRedirectedToInfoLabelDo:[
- manager utilities
- checkoutClass:aClass askForRevision:askForRevision askForMerge:true.
- ]
-
- "Modified: / 01-03-2007 / 17:47:32 / cg"
- "Created: / 11-10-2011 / 23:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:26:27 / cg"
-!
-
-checkOutClasses:classes askForRevision:askForRevision usingManager: manager
- "check-out a bunch of classes from the source repository.
- Offer chance to either overwrite the current version,
- or merge-in the repository version.
- If askForRevision is false, fetch the newest revision(s),
- otherwise ask for the revision."
-
- |alreadyCheckedOut|
-
- (self askIfModified:'Code was modified.\\CheckOut anyway ?')
- ifFalse:[^ self].
-
- classes isEmpty ifTrue:[
- Dialog warn:'No classes to checkout'.
-"/ SourceCodeManagerUtilities
-"/ checkoutClass:nil
-"/ askForRevision:true
-"/ askForMerge:false.
- ^ self
- ].
-
- alreadyCheckedOut := IdentitySet new.
-
- "abortAll is handled, and also asked for here!!"
- AbortAllOperationRequest handleAndAnswerQueryIn:[
- self
- classes:classes
- nonMetaDo:
- [:cls |
-
- UserInformation handle:[:ex |
- classes size > 1 ifTrue:[
- Transcript showCR:ex description.
- ] ifFalse:[
- (Dialog confirm:ex description noLabel:'Cancel') ifFalse:[
- AbortSignal raise
- ].
- ].
- ex proceed.
- ] do:[
- self withActivityNotificationsRedirectedToInfoLabelDo:[
- manager utilities
- checkoutClass:cls askForRevision:askForRevision askForMerge:true askForConfirmation:false.
- ].
- alreadyCheckedOut add:cls.
- ]
- ]
- ifUnloaded:
- [:cls | true]
- ifPrivate:
- [:cls | |owner answer|
-
- owner := cls topOwningClass.
- (alreadyCheckedOut includes:owner) ifFalse:[
- (self selectedClasses value includes:owner) ifFalse:[
- answer := Dialog
- confirmWithCancel:(resources string:'Cannot checkOut private class: %1\\Shall the owner ''%2'' be checked out ?'
- with:cls nameWithoutPrefix allBold
- with:owner name) withCRs
- default:true.
- answer == nil ifTrue:[
- AbortAllOperationRequest raise "/ cancel
- ].
- answer == true ifTrue:[
- self checkOutClass:owner askForRevision:askForRevision usingManager: manager.
- alreadyCheckedOut add:owner.
- ].
- ]
- ]
- ].
- ].
- self normalLabel.
-
- "Created: / 11-10-2011 / 23:11:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:15:33 / cg"
-!
-
-classMenuCheckOutNewestUsingManager: manager
- "check-out the newest version of the selected class(es) from the source repository.
- Offer chance to either overwrite the current version,
- or merge-in the repository version.
- "
-
- self checkOutClasses:(self selectedClasses value) askForRevision:false usingManager: manager
-
- "Modified: / 11-10-2011 / 23:09:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:16:21 / cg"
-!
-
-classMenuCheckOutUsingManager: manager
- "check-out selected class(es) from the source repository.
- Individually ask for class revisions.
- Offer chance to either overwrite the current version,
- or merge-in the repository version.
- "
-
- self checkOutClasses:(self selectedClasses value) askForRevision:true usingManager: manager
-
- "Modified: / 11-10-2011 / 23:10:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:16:41 / cg"
-!
-
-classMenuCompareAgainstOriginalInRepositoryUsingManager: manager
- "open a diff-textView comparing the current (in-image) version
- with the the base version found in the repository.
- That is the version on which the class was based upon, not the most recent one."
-
- |currentClass
- aStream comparedSource currentSource rev revInfo revString thisRevString mgr
- nm msg newestRev brwsr|
-
- currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
- currentClass isNil ifTrue:[
- self warn:'Cannot compare unloaded classes.'.
- ^ self.
- ].
-
- nm := currentClass name.
- mgr := manager.
- mgr isNil ifTrue:[
- ^ self
- ].
- revInfo := currentClass revisionInfoOfManager: manager.
- revInfo ifNil:[
- self warn:('The class seems to have no repository information for %1.' bindWith: mgr managerTypeName).
- ^ self
- ].
- rev := revInfo revision.
- rev isNil ifTrue:[
- self warn:'The class seems to have no repository information.'.
- ^ self
- ].
- "/
- "/ class in repository - ask for revision
- "/
- msg := 'extracting revision %1'.
- self busyLabel:msg with:rev.
- self withActivityNotificationsRedirectedToInfoLabelDo:[
- aStream := mgr getSourceStreamFor:currentClass revision:rev.
- ].
-
- 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 busyLabel:'generating current source ...' with:nil.
-
- aStream := '' writeStream.
- Method flushSourceStreamCache.
- currentClass fileOutOn:aStream withTimeStamp:false.
- currentSource := aStream contents asString.
- aStream close.
-
- self busyLabel:'comparing ...' with:nil.
-
- comparedSource = currentSource ifTrue:[
- self information:'Versions are identical.'.
- ] ifFalse:[
- thisRevString := currentClass revision.
- thisRevString isNil ifTrue:[
- thisRevString := 'no revision'
- ].
-
- revString := rev.
- "/ this takes some time ... is it worth ?
- (newestRev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
- newestRev ~= rev ifTrue:[
- revString := rev , ' (newest is ' , newestRev , ')'
- ]
- ].
-
- self busyLabel:'comparing ...' with:nil.
-
- brwsr := (UserPreferences versionDiffViewerClass)
- openOnClass:currentClass
- labelA:('repository: ' , revString)
- sourceA:comparedSource
- labelB:('current: (based on: ' , rev , ')')
- sourceB:currentSource
- title:('comparing ' , currentClass name)
- ifSame:[self normalLabel. self information:'Versions are identical.'. ^ self].
-
- brwsr classChangeSet
- classBeingCompared:currentClass;
- versionA:rev;
- versionB:rev , 'mod'.
- ].
- self normalLabel.
-
- "Modified: / 11-10-2011 / 14:37:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:28:18 / cg"
-!
-
-classMenuCompareExtensionsWithRepositoryUsingManager: aManager
- ^ Dialog warn: 'Not yet implemented'
-
- "Created: / 21-12-2011 / 20:28:28 / cg"
-!
-
-classMenuCompareTwoRepositoryVersionsUsingManager: manager
- "open a diff-textView comparing two versions found in the repository."
-
- |currentClass source1 source2 mgr
- nm rev1 rev2 versionsAreTheSame|
-
- currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
- currentClass isNil ifTrue:[
- self warn:'Cannot compare unloaded classes.'.
- ^ self.
- ].
-
- nm := currentClass name.
- mgr := manager.
- mgr isNil ifTrue:[
- ^ self
- ].
-
- self normalLabel.
- rev1 := manager utilities
- askForExistingRevision:(resources string:'Compare which revision:')
- title:(resources string:'Compare which repository version')
- class:currentClass.
- rev1 isNil ifTrue:[^ self].
-
- rev2 := manager utilities
- askForExistingRevision:(resources string:'Against which revision:')
- title:(resources string:'Against which repository version')
- class:currentClass.
- rev2 isNil ifTrue:[^ self].
-
- source1 := self getClassSourceFor:currentClass revision:rev1 usingManager: manager.
- source2 := self getClassSourceFor:currentClass revision:rev2 usingManager: manager.
-
- self busyLabel:'comparing ...' with:nil.
- versionsAreTheSame := (source1 = source2).
- versionsAreTheSame ifFalse:[
- self busyLabel:'comparing ...' with:nil.
- (UserPreferences versionDiffViewerClass)
- openOnClass:currentClass
- labelA:(rev1)
- sourceA:source1
- labelB:(rev2)
- sourceB:source2
- title:('comparing ' , currentClass name)
- ifSame:[versionsAreTheSame := true].
-
- versionsAreTheSame ifTrue:[
- self information:'Versions are identical.'.
- ].
- ].
- self normalLabel.
-
- "Modified: / 11-10-2011 / 23:07:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:28:43 / cg"
-!
-
-classMenuCompareTwoRepositoryVersionsUsingManagerNamed: aManagerName
- "open a diff-textView comparing two versions found in the repository."
-
- self classMenuCompareTwoRepositoryVersionsUsingManager:(Smalltalk at:aManagerName asSymbol)
-
- "Created: / 21-12-2011 / 23:13:40 / cg"
-!
-
-classMenuCompareWithRepositoryUsingManager: manager
- "open a diff-textView comparing the current (in-image) version
- with the some version found in the repository."
-
- |currentClass
- aStream comparedSource currentSource revInfo rev revString thisRevString mgr
- nm msg rev2 newestRev
- containerModule containerPackage containerFile rslt
- pkg info mod dir versionsAreTheSame|
-
- currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
- currentClass isNil ifTrue:[
- self warn:'Cannot compare unloaded classes.'.
- ^ self.
- ].
-
- nm := currentClass name.
- mgr := manager.
- mgr isNil ifTrue:[
- ^ self
- ].
- "Use revision of manager"
- rev := currentClass binaryRevision.
- revInfo := mgr revisionInfoOfManager: mgr.
- revInfo notNil ifTrue:[
- rev2 := revInfo revision.
- ].
- rev2 notNil ifTrue:[
- rev := rev2
- ].
- rev isNil ifTrue:[
- "/
- "/ class not in repository - allow compare against any other containers newest contents
- "/
- self normalLabel.
-
- pkg := currentClass package.
- (pkg notNil and:[pkg ~= PackageId noProjectID]) 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.
- ].
- rslt := manager utilities
- askForContainer:(resources string:'The class seems to have no repository information.\\Do you want to compare it against an existing containers contents ?')
- title:'Container to compare' note:nil
- initialModule:containerModule
- initialPackage:containerPackage
- initialFileName:(currentClass nameWithoutPrefix , '.st')
- forNewContainer:false.
- rslt isNil ifTrue:[
- "/ canel
- ^ self
- ].
- containerModule := rslt at:#module.
- containerPackage := rslt at:#package.
- containerFile := rslt at:#fileName.
- SourceCodeManagerUtilities lastModule:containerModule.
- SourceCodeManagerUtilities lastPackage:containerPackage.
- ] ifFalse:[
- "/
- "/ 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)
- ].
-
- self normalLabel.
- rev := manager utilities
- askForExistingRevision:msg
- title:'Compare with repository'
- class:currentClass
- ].
-
- versionsAreTheSame := false.
- (rev notNil or:[containerFile notNil]) ifTrue:[
- rev notNil ifTrue:[
- rev withoutSpaces isEmpty ifTrue:[
- msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
- "/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
- rev := newestRev.
- revString := 'newest'.
- ] ifFalse:[
- msg := 'extracting previous %1'.
- revString := rev
- ].
- aStream := mgr getSourceStreamFor:currentClass revision: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 := '???'
- ].
- self busyLabel:msg with:nm.
-
- aStream isNil ifTrue:[
- info := mgr sourceInfoOfClass:currentClass.
- info notNil ifTrue:[
- mod := info at:#module ifAbsent:'??'.
- dir := info at:#directory ifAbsent:'??'.
- ].
-
- self warn:(resources
- string:'Could not extract source from repository (for module: ''%1'' , directory: ''%2'' , revision: ''%3'')'
- with:mod with:dir with:revString).
- ^ 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 busyLabel:'generating current source ...' with:nil.
-
- aStream := '' writeStream.
- Method flushSourceStreamCache.
- "/ currentClass fileOutOn:aStream withTimeStamp:false.
- "/ currentSource := aStream contents asString.
-
- Class fileOutErrorSignal handle:[:ex |
- ex proceed
- ] do:[
- currentSource := currentClass source asString.
- ].
-
- self busyLabel:'comparing ...' with:nil.
- versionsAreTheSame := (comparedSource = currentSource).
- versionsAreTheSame ifFalse:[
- thisRevString := currentClass revision.
- thisRevString isNil ifTrue:[
- thisRevString := 'no revision'
- ].
-
- revString = '(newest)' ifTrue:[
- (rev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
- revString := '(newest is ' , rev , ')'
- ]
- ].
-
- self busyLabel:'comparing ...' with:nil.
- (UserPreferences versionDiffViewerClass)
- openOnClass:currentClass
- labelA:('repository: ' , revString)
- sourceA:comparedSource
- labelB:('current: (based on: ' , thisRevString , ')')
- sourceB:currentSource
- title:('comparing ' , currentClass name)
- ifSame:[versionsAreTheSame := true].
- ].
- versionsAreTheSame ifTrue:[
- ((currentClass revision = newestRev)
- and:[currentClass hasUnsavedChanges]) ifTrue:[
- (self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs) ifTrue:[
- ChangeSet current condenseChangesForClass:currentClass.
- ].
- ] ifFalse:[
- self information:'Versions are identical.'.
- ]
- ].
- ].
- self normalLabel.
-
- "Modified: / 11-10-2011 / 16:25:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:28:48 / cg"
-!
-
-classMenuCompareWithRepositoryUsingManagerNamed:aManagerName
- "open a diff-textView comparing the current (in-image) version
- with the some version found in the repository."
-
- self classMenuCompareWithRepositoryUsingManager:(Smalltalk at:aManagerName asSymbol)
-
- "Created: / 21-12-2011 / 22:51:56 / cg"
-!
-
-classMenuEditVersionInRepositoryUsingManager: aManager
- ^ Dialog warn: 'Not yet implemented'
-
- "Created: / 21-12-2011 / 20:28:57 / cg"
-!
-
-classMenuQuickCheckInUsingManager: argument
- ^ Dialog warn: 'Not yet implemented'
-
- "Created: / 21-12-2011 / 20:29:04 / cg"
-!
-
-classMenuRevisionLog:shortOrNot usingManager: manager
- "show a classes revision log"
-
- |codeView|
-
- (self askIfModified:'Code was modified.\\Show log anyway ?')
- ifFalse:[^ self].
-
- self codeAspect:#repositoryLog.
- self selectedMethods value:nil.
- self selectProtocols:nil.
-
- codeView := self codeView.
- codeView contents:nil.
- codeView modified:false.
- navigationState realModifiedState:false.
-
- self
- selectedClassesNonMetaDo:
- [:cls |
- self
- showRepositoryLogOf:cls short:shortOrNot usingManager: manager
- beforeLogDo:[:s |
- self selectedClasses value size > 1 ifTrue:[
- s nextPutLine:'-----------------------------------------------------------'.
- s nextPutLine:('%1 log for %2:'
- bindWith:(shortOrNot ifTrue:['Short'] ifFalse:['Full'])
- with:cls name).
- s nextPutLine:'-----------------------------------------------------------'.
- s cr.
- ]
- ]
- ]
- ifUnloaded:
- [:cls |
- true.
- ]
- ifPrivate:
- [:cls |
- |owner|
- owner := cls owningClass.
- (self selectedClasses value includes:owner) ifFalse:[
- self warn:'cannot show log of private class: %1\\Please see the log of the owning class (%2).'
- with:cls nameWithoutPrefix allBold
- with:owner name.
- ]
- ].
- self normalLabel.
-
- "Created: / 11-10-2011 / 20:32:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:26:08 / cg"
-!
-
-classMenuRevisionLogUsingManager: manager
- "show a classes revision log"
-
- self classMenuRevisionLog:false usingManager: manager
-
- "Modified: / 11-10-2011 / 20:31:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:17:12 / cg"
-!
-
-classMenuRevisionLogUsingManagerNamed: aManagerName
- "show a classes revision log"
-
- self classMenuRevisionLog:false usingManager:(Smalltalk at:aManagerName asSymbol)
-
- "Modified: / 11-10-2011 / 20:31:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 23:02:10 / cg"
-!
-
-classMenuSetTagUsingManager: aManager
- ^ Dialog warn: 'Not yet implemented'
-
- "Created: / 21-12-2011 / 20:29:13 / cg"
-!
-
-classMenuShortRevisionLogUsingManager: manager
- "show a short (last 20 entries) classes repository log"
-
- self classMenuRevisionLog:true usingManager: manager
-
- "Modified: / 11-10-2011 / 20:31:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:17:24 / cg"
-!
-
-classMenuShortRevisionLogUsingManagerNamed: aManagerName
- "show a short (last 20 entries) classes repository log"
-
- self classMenuShortRevisionLogUsingManager:(Smalltalk at:aManagerName asSymbol)
-
- "Created: / 21-12-2011 / 23:12:15 / cg"
-!
-
-getClassSourceFor:aClass revision:revision usingManager: manager
- "ask aClass's sourceCodeManager to retrieve a (possibly older or newer) version's source code"
-
- |msg stream source|
-
- msg := 'extracting previous %1'.
- self busyLabel:msg with:revision.
-
- stream := manager getSourceStreamFor:aClass revision:revision.
- stream isNil ifTrue:[
- self warn:(resources
- string:'Could not extract source of rev %1 from repository'
- with:revision).
- ^ nil
- ].
- stream class readErrorSignal handle:[:ex |
- self warn:('read error while reading extracted source\\' , ex description) withCRs.
- stream close.
- ^ nil
- ] do:[
- source := stream contents asString.
- ].
- stream close.
- ^ source
-
- "Created: / 11-10-2011 / 23:06:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:25:39 / cg"
-!
-
-showRepositoryLogOf:aClass short:shortOrNot usingManager: manager beforeLogDo:aBlock
- "show a classes repository log - append to codeView.
- CAVEAT: that is almost the same code as found in SystemBrowser;
- move to SourceCodeManagerUtilities."
-
- |codeView aStream|
-
- aStream := WriteStream on:(String new:200).
-
- Processor activeProcess
- withPriority:Processor activePriority-1 to:Processor activePriority
- do:[
- self busyLabel:'Extracting log of %1' with:aClass name.
- aBlock value:aStream.
- manager utilities repositoryLogOf:aClass short:shortOrNot onto:aStream
- ].
-
- self codeAspect:#repositoryLog.
- self selectedMethods value:nil.
- self selectProtocols:nil.
-
- codeView := self codeView.
- codeView contents:(codeView contents ,
- Character cr asString ,
- Character cr asString ,
- aStream contents).
-
- codeView modified:false.
- navigationState realModifiedState:false.
-
-"/ self clearAcceptAction.
-"/ self clearExplainAction.
-
- self normalLabel
-
- "Created: / 11-10-2011 / 20:33:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 21-12-2011 / 20:24:55 / cg"
-! !
-
!NewSystemBrowser methodsFor:'menu actions-code'!
codeMenuAddClassVariable:newName inClass:aClass asValueHolder:asValueHolder
@@ -54731,11 +54670,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1674 2011-12-22 09:13:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1675 2011-12-22 10:05:46 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1674 2011-12-22 09:13:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1675 2011-12-22 10:05:46 cg Exp $'
!
version_SVN