--- a/BrowserView.st Thu Dec 07 21:49:40 1995 +0100
+++ b/BrowserView.st Thu Dec 07 23:59:35 1995 +0100
@@ -12,12 +12,12 @@
StandardSystemView subclass:#BrowserView
instanceVariableNames:'classCategoryListView classListView methodCategoryListView
- methodListView classMethodListView codeView classToggle
- instanceToggle currentClassCategory currentClassHierarchy
- currentClass currentMethodCategory currentMethod currentSelector
- showInstance actualClass fullClass lastMethodCategory aspect
- variableListView fullProtocol lockUpdates autoSearch myLabel
- acceptClass lastSourceLogMessage'
+ methodListView classMethodListView codeView classToggle
+ instanceToggle currentClassCategory currentClassHierarchy
+ currentClass currentMethodCategory currentMethod currentSelector
+ showInstance actualClass fullClass lastMethodCategory aspect
+ variableListView fullProtocol lockUpdates autoSearch myLabel
+ acceptClass lastSourceLogMessage'
classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon'
poolDictionaries:''
category:'Interface-Browsers'
@@ -1089,161 +1089,165 @@
(device ctrlDown
and:[currentClass notNil]) ifTrue:[
- labels := #(
- 'inspect class'
- '-'
- 'primitive definitions'
- 'primitive variables'
- 'primitive functions'
- ).
- selectors := #(
- classInspect
- nil
- classPrimitiveDefinitions
- classPrimitiveVariables
- classPrimitiveFunctions
- ).
-
- labels := labels , #(
- '-'
- 'revision info'
- 'compare with repository'
- '-'
- 'check into source repository'
- 'fileIn from repository'
- ).
-
- selectors := selectors , #(
- nil
- classRevisionInfo
- classCompareWithNewestInRepository
- nil
- classCheckin
- classLoadRevision
- ).
+ labels := #(
+ 'inspect class'
+ '-'
+ 'primitive definitions'
+ 'primitive variables'
+ 'primitive functions'
+ ).
+ selectors := #(
+ classInspect
+ nil
+ classPrimitiveDefinitions
+ classPrimitiveVariables
+ classPrimitiveFunctions
+ ).
+
+ labels := labels , #(
+ '-'
+ 'revision info'
+ 'compare with repository'
+ '-'
+ 'check into source repository'
+ 'fileIn from repository'
+ ).
+
+ selectors := selectors , #(
+ nil
+ classRevisionInfo
+ classCompareWithNewestInRepository
+ nil
+ classCheckin
+ classLoadRevision
+ ).
] ifFalse:[
- currentClass isNil ifTrue:[
- labels := #(
- 'new class'
- ).
- selectors := #(
- classNewClass
- ).
- ] ifFalse:[
- currentClass isLoaded ifFalse:[
- labels := #(
- 'new class'
- '-'
- 'load '
- ).
- selectors := #(
- classNewClass
- nil
- classLoad
- ).
- ] ifTrue:[
- fullProtocol ifTrue:[
- labels := #(
- 'hierarchy'
- 'definition'
- 'comment'
- 'class instvars'
- ).
- selectors := #(
- classHierarchy
- classDefinition
- classComment
- classClassInstVars
- ).
- ] ifFalse:[
- labels := #(
- 'fileOut'
- 'printOut'
- 'printOut protocol'
- " 'printOut full protocol' "
- '-'
- 'SPAWN_CLASS'
- 'spawn full protocol'
- 'spawn hierarchy'
- 'spawn subclasses'
- '-'
- ).
- selectors := #(
- classFileOut
- classPrintOut
- classPrintOutProtocol
- " classPrintOutFullProtocol "
- nil
- classSpawn
- classSpawnFullProtocol
- classSpawnHierarchy
- classSpawnSubclasses
- nil
- ).
-
- fullClass ifFalse:[
- labels := labels , #(
- 'hierarchy'
- 'definition'
- 'comment'
- 'class instvars'
- "/ 'protocols'
- '-'
- ).
- selectors := selectors , #(
- classHierarchy
- classDefinition
- classComment
- classClassInstVars
- "/ classProtocols
- nil
- ).
- ].
-
- labels := labels , #(
- "/ 'variable search'
- 'class refs'
- '-'
- 'new class'
- 'new subclass'
- 'rename ...'
- 'remove'
- ).
- selectors := selectors , #(
- "/ variables
- classRefs
- nil
- classNewClass
- classNewSubclass
- classRename
- classRemove
- ).
- currentClass wasAutoloaded ifTrue:[
- labels := labels , #(
- 'unload'
- ).
- selectors := selectors , #(
- classUnload
- ).
- ]
- ]
- ].
- ].
+ currentClass isNil ifTrue:[
+ labels := #(
+ 'new class'
+ ).
+ selectors := #(
+ classNewClass
+ ).
+ ] ifFalse:[
+ currentClass isLoaded ifFalse:[
+ labels := #(
+ 'definition'
+ '-'
+ 'new class'
+ '-'
+ 'load '
+ ).
+ selectors := #(
+ classDefinition
+ nil
+ classNewClass
+ nil
+ classLoad
+ ).
+ ] ifTrue:[
+ fullProtocol ifTrue:[
+ labels := #(
+ 'hierarchy'
+ 'definition'
+ 'comment'
+ 'class instvars'
+ ).
+ selectors := #(
+ classHierarchy
+ classDefinition
+ classComment
+ classClassInstVars
+ ).
+ ] ifFalse:[
+ labels := #(
+ 'fileOut'
+ 'printOut'
+ 'printOut protocol'
+ " 'printOut full protocol' "
+ '-'
+ 'SPAWN_CLASS'
+ 'spawn full protocol'
+ 'spawn hierarchy'
+ 'spawn subclasses'
+ '-'
+ ).
+ selectors := #(
+ classFileOut
+ classPrintOut
+ classPrintOutProtocol
+ " classPrintOutFullProtocol "
+ nil
+ classSpawn
+ classSpawnFullProtocol
+ classSpawnHierarchy
+ classSpawnSubclasses
+ nil
+ ).
+
+ fullClass ifFalse:[
+ labels := labels , #(
+ 'hierarchy'
+ 'definition'
+ 'comment'
+ 'class instvars'
+ "/ 'protocols'
+ '-'
+ ).
+ selectors := selectors , #(
+ classHierarchy
+ classDefinition
+ classComment
+ classClassInstVars
+ "/ classProtocols
+ nil
+ ).
+ ].
+
+ labels := labels , #(
+ "/ 'variable search'
+ 'class refs'
+ '-'
+ 'new class'
+ 'new subclass'
+ 'rename ...'
+ 'remove'
+ ).
+ selectors := selectors , #(
+ "/ variables
+ classRefs
+ nil
+ classNewClass
+ classNewSubclass
+ classRename
+ classRemove
+ ).
+ currentClass wasAutoloaded ifTrue:[
+ labels := labels , #(
+ 'unload'
+ ).
+ selectors := selectors , #(
+ classUnload
+ ).
+ ]
+ ]
+ ].
+ ].
].
m := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors.
+ labels:(resources array:labels)
+ selectors:selectors.
(currentClass isNil
or:[currentClass sourceCodeManager isNil]) ifTrue:[
- m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository).
+ m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository).
].
^ m
- "Modified: 7.12.1995 / 13:19:57 / cg"
+ "Modified: 7.12.1995 / 23:56:14 / cg"
!
classNewClass
@@ -1624,6 +1628,82 @@
!BrowserView methodsFor:'class list source administration'!
+classCheckin
+ "check a class into the source repository"
+
+ self doClassMenu:[:currentClass |
+ |logMessage info mgr|
+
+ mgr := (currentClass sourceCodeManager).
+ (info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[
+ ^ self classCreateSourceContainerFor:currentClass
+ ].
+
+ logMessage := Dialog
+ request:'enter a log message:'
+ initialAnswer:lastSourceLogMessage
+ onCancel:nil.
+
+ logMessage notNil ifTrue:[
+ lastSourceLogMessage := logMessage.
+ self busyLabel:'checking in %1' with:currentClass name.
+ (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[
+ self warn:'checkin failed'.
+ ].
+ aspect == #revisionInfo ifTrue:[
+ self classListUpdate
+ ].
+ self normalLabel.
+ ]
+ ]
+
+ "Created: 23.11.1995 / 11:41:38 / cg"
+ "Modified: 7.12.1995 / 13:17:43 / cg"
+!
+
+classCompareWithNewestInRepository
+ "open a diff-textView comparing the current (in-image) version
+ with the most recent version found in the repository."
+
+ self doClassMenu:[:currentClass |
+ |aStream comparedSource currentSource v rev revString mgr|
+
+ mgr := currentClass sourceCodeManager.
+
+ rev := Dialog request:'compare to revision: (empty for newest)'.
+ rev notNil ifTrue:[
+ rev withoutSpaces isEmpty ifTrue:[
+ self busyLabel:'extracting newest %1' with:currentClass name.
+ aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name.
+ revString := 'newest'
+ ] ifFalse:[
+ self busyLabel:'extracting previous %1' with:currentClass name.
+ aStream := mgr sourceStreamFor:currentClass revision:rev.
+ revString := rev
+ ].
+ comparedSource := aStream contents.
+ aStream close.
+
+ self busyLabel:'generating current source ...' with:nil.
+
+ aStream := '' writeStream.
+ currentClass fileOutOn:aStream withTimeStamp:false.
+ currentSource := aStream contents.
+ aStream close.
+
+ self busyLabel:'comparing ...' with:nil.
+ v := DiffTextView
+ openOn:currentSource label:'current (' , currentClass revision , ')'
+ and:comparedSource label:'repository (' , revString , ')'.
+ v label:'comparing ' , currentClass name.
+ self normalLabel.
+ ]
+ ]
+
+ "Created: 14.11.1995 / 16:43:15 / cg"
+ "Modified: 7.12.1995 / 13:18:12 / cg"
+!
+
classCreateSourceContainerFor:aClass
"let user specify the source-repository values for aClass"
@@ -1708,142 +1788,6 @@
"Modified: 7.12.1995 / 13:18:37 / cg"
!
-classCheckin
- "check a class into the source repository"
-
- self doClassMenu:[:currentClass |
- |logMessage info mgr|
-
- mgr := (currentClass sourceCodeManager).
- (info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[
- ^ self classCreateSourceContainerFor:currentClass
- ].
-
- logMessage := Dialog
- request:'enter a log message:'
- initialAnswer:lastSourceLogMessage
- onCancel:nil.
-
- logMessage notNil ifTrue:[
- lastSourceLogMessage := logMessage.
- self busyLabel:'checking in %1' with:currentClass name.
- (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[
- self warn:'checkin failed'.
- ].
- aspect == #revisionInfo ifTrue:[
- self classListUpdate
- ].
- self normalLabel.
- ]
- ]
-
- "Created: 23.11.1995 / 11:41:38 / cg"
- "Modified: 7.12.1995 / 13:17:43 / cg"
-!
-
-classCompareWithNewestInRepository
- "open a diff-textView comparing the current (in-image) version
- with the most recent version found in the repository."
-
- self doClassMenu:[:currentClass |
- |aStream comparedSource currentSource v rev revString mgr|
-
- mgr := currentClass sourceCodeManager.
-
- rev := Dialog request:'compare to revision: (empty for newest)'.
- rev notNil ifTrue:[
- rev withoutSpaces isEmpty ifTrue:[
- self busyLabel:'extracting newest %1' with:currentClass name.
- aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name.
- revString := 'newest'
- ] ifFalse:[
- self busyLabel:'extracting previous %1' with:currentClass name.
- aStream := mgr sourceStreamFor:currentClass revision:rev.
- revString := rev
- ].
- comparedSource := aStream contents.
- aStream close.
-
- self busyLabel:'generating current source ...' with:nil.
-
- aStream := '' writeStream.
- currentClass fileOutOn:aStream withTimeStamp:false.
- currentSource := aStream contents.
- aStream close.
-
- self busyLabel:'comparing ...' with:nil.
- v := DiffTextView
- openOn:currentSource label:'current (' , currentClass revision , ')'
- and:comparedSource label:'repository (' , revString , ')'.
- v label:'comparing ' , currentClass name.
- self normalLabel.
- ]
- ]
-
- "Created: 14.11.1995 / 16:43:15 / cg"
- "Modified: 7.12.1995 / 13:18:12 / cg"
-!
-
-classRevisionInfo
- "show current classes revision info in codeView"
-
- self doClassMenu:[:currentClass |
- |aStream info info2 s rv mgr|
-
- aStream := WriteStream on:(String new:200).
- currentClass notNil ifTrue:[
- self busyLabel:'extracting revision info' with:nil.
- info := currentClass revisionInfo.
-
- rv := currentClass binaryRevision.
- rv notNil ifTrue:[
- aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr.
- aStream nextPutAll:' Binary based upon : ' , rv; cr.
- aStream cr.
- ].
-
- info notNil ifTrue:[
- aStream nextPutAll:'**** Classes source information ****'; cr; cr.
- s := info at:#repositoryPath ifAbsent:nil.
- s notNil ifTrue:[
- aStream nextPut:' Source repository : ' , s; cr
- ].
- aStream nextPutAll:' Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
- aStream nextPutAll:' Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
- aStream nextPutAll:' Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
- aStream nextPutAll:' Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
-
- (info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[
- aStream nextPutAll:' Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
- aStream nextPutAll:' Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
- ].
- aStream nextPutAll:' Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
- aStream cr.
-
- (mgr := currentClass sourceCodeManager) notNil ifTrue:[
- aStream nextPutAll:'**** Repository information ****'; cr; cr.
- mgr writeRevisionLogOf:currentClass to:aStream.
- ]
- ] ifFalse:[
- aStream nextPutAll:'No revision info found'
- ]
- ].
- codeView contents:(aStream contents).
-
- codeView modified:false.
- codeView acceptAction:nil.
- codeView explainAction:nil.
- methodListView notNil ifTrue:[
- methodListView deselect
- ].
- aspect := #revisionInfo.
- self normalLabel
- ]
-
- "Created: 14.11.1995 / 16:43:15 / cg"
- "Modified: 7.12.1995 / 13:20:42 / cg"
-!
-
classLoadRevision
"load a specific revision into the system - especially useful to
upgrade a class to the newest revision"
@@ -1883,6 +1827,69 @@
"Created: 14.11.1995 / 16:43:15 / cg"
"Modified: 7.12.1995 / 13:19:06 / cg"
+!
+
+classRevisionInfo
+ "show current classes revision info in codeView"
+
+ self doClassMenu:[:currentClass |
+ |aStream info info2 s rv mgr|
+
+ aStream := WriteStream on:(String new:200).
+ currentClass notNil ifTrue:[
+ self busyLabel:'extracting revision info' with:nil.
+ info := currentClass revisionInfo.
+
+ rv := currentClass binaryRevision.
+ rv notNil ifTrue:[
+ aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr.
+ aStream nextPutAll:' Binary based upon : ' , rv; cr.
+ aStream cr.
+ ].
+
+ info notNil ifTrue:[
+ aStream nextPutAll:'**** Classes source information ****'; cr; cr.
+ s := info at:#repositoryPath ifAbsent:nil.
+ s notNil ifTrue:[
+ aStream nextPut:' Source repository : ' , s; cr
+ ].
+ aStream nextPutAll:' Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
+ aStream nextPutAll:' Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
+ aStream nextPutAll:' Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
+ aStream nextPutAll:' Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
+
+ (info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[
+ aStream nextPutAll:' Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
+ aStream nextPutAll:' Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
+ ].
+ aStream nextPutAll:' Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
+ aStream cr.
+
+ (mgr := currentClass sourceCodeManager) notNil ifTrue:[
+ aStream nextPutAll:'**** Repository information ****'; cr; cr.
+ mgr writeRevisionLogOf:currentClass to:aStream.
+ ]
+ ] ifFalse:[
+ aStream nextPutAll:'No revision info found'; cr.
+ currentClass isLoaded ifFalse:[
+ aStream cr; nextPutAll:'This is an autoloaded class - you may see more after its loaded.'
+ ]
+ ]
+ ].
+ codeView contents:(aStream contents).
+
+ codeView modified:false.
+ codeView acceptAction:nil.
+ codeView explainAction:nil.
+ methodListView notNil ifTrue:[
+ methodListView deselect
+ ].
+ aspect := #revisionInfo.
+ self normalLabel
+ ]
+
+ "Created: 14.11.1995 / 16:43:15 / cg"
+ "Modified: 7.12.1995 / 23:54:04 / cg"
! !
!BrowserView methodsFor:'class stuff'!
@@ -4963,6 +4970,36 @@
self label:('System Browser - ' , (resources string:what with:someArgument))
!
+checkSelectionChangeAllowed
+ "return true, if selection change is ok;
+ its not ok, if code has been changed.
+ in this case, return the result of a user query"
+
+ |what m src v|
+
+ currentMethod notNil ifTrue:[
+ m := actualClass compiledMethodAt:currentSelector.
+ m notNil ifTrue:[
+ (src := m source) = codeView contents ifFalse:[
+ what := self checkSelectionChangeAllowedWithCompare:true.
+ what == #compare ifTrue:[
+ v := DiffTextView
+ openOn:codeView contents label:'code here (to be accepted ?)'
+ and:src label:'methods actual code'.
+ v label:'comparing method versions'.
+ ^ false
+ ].
+ ^ what
+ ]
+ ]
+ ].
+
+ ^ self checkSelectionChangeAllowedWithCompare:false
+
+ "Created: 24.11.1995 / 11:03:33 / cg"
+ "Modified: 24.11.1995 / 11:05:49 / cg"
+!
+
checkSelectionChangeAllowedWithCompare:compareOffered
"return true, if selection change is ok;
its not ok, if code has been changed.
@@ -4998,36 +5035,6 @@
"Created: 24.11.1995 / 10:54:46 / cg"
!
-checkSelectionChangeAllowed
- "return true, if selection change is ok;
- its not ok, if code has been changed.
- in this case, return the result of a user query"
-
- |what m src v|
-
- currentMethod notNil ifTrue:[
- m := actualClass compiledMethodAt:currentSelector.
- m notNil ifTrue:[
- (src := m source) = codeView contents ifFalse:[
- what := self checkSelectionChangeAllowedWithCompare:true.
- what == #compare ifTrue:[
- v := DiffTextView
- openOn:codeView contents label:'code here (to be accepted ?)'
- and:src label:'methods actual code'.
- v label:'comparing method versions'.
- ^ false
- ].
- ^ what
- ]
- ]
- ].
-
- ^ self checkSelectionChangeAllowedWithCompare:false
-
- "Created: 24.11.1995 / 11:03:33 / cg"
- "Modified: 24.11.1995 / 11:05:49 / cg"
-!
-
classHierarchyDo:aBlock
"eavluate the 2-arg block for every class,
starting at Object; passing class and nesting level to the block."
@@ -6021,5 +6028,5 @@
!BrowserView class methodsFor:'documentation'!
version
-^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.60 1995-12-07 20:07:36 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.61 1995-12-07 22:59:35 cg Exp $'! !
BrowserView initialize!
--- a/BrwsrView.st Thu Dec 07 21:49:40 1995 +0100
+++ b/BrwsrView.st Thu Dec 07 23:59:35 1995 +0100
@@ -12,12 +12,12 @@
StandardSystemView subclass:#BrowserView
instanceVariableNames:'classCategoryListView classListView methodCategoryListView
- methodListView classMethodListView codeView classToggle
- instanceToggle currentClassCategory currentClassHierarchy
- currentClass currentMethodCategory currentMethod currentSelector
- showInstance actualClass fullClass lastMethodCategory aspect
- variableListView fullProtocol lockUpdates autoSearch myLabel
- acceptClass lastSourceLogMessage'
+ methodListView classMethodListView codeView classToggle
+ instanceToggle currentClassCategory currentClassHierarchy
+ currentClass currentMethodCategory currentMethod currentSelector
+ showInstance actualClass fullClass lastMethodCategory aspect
+ variableListView fullProtocol lockUpdates autoSearch myLabel
+ acceptClass lastSourceLogMessage'
classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon'
poolDictionaries:''
category:'Interface-Browsers'
@@ -1089,161 +1089,165 @@
(device ctrlDown
and:[currentClass notNil]) ifTrue:[
- labels := #(
- 'inspect class'
- '-'
- 'primitive definitions'
- 'primitive variables'
- 'primitive functions'
- ).
- selectors := #(
- classInspect
- nil
- classPrimitiveDefinitions
- classPrimitiveVariables
- classPrimitiveFunctions
- ).
-
- labels := labels , #(
- '-'
- 'revision info'
- 'compare with repository'
- '-'
- 'check into source repository'
- 'fileIn from repository'
- ).
-
- selectors := selectors , #(
- nil
- classRevisionInfo
- classCompareWithNewestInRepository
- nil
- classCheckin
- classLoadRevision
- ).
+ labels := #(
+ 'inspect class'
+ '-'
+ 'primitive definitions'
+ 'primitive variables'
+ 'primitive functions'
+ ).
+ selectors := #(
+ classInspect
+ nil
+ classPrimitiveDefinitions
+ classPrimitiveVariables
+ classPrimitiveFunctions
+ ).
+
+ labels := labels , #(
+ '-'
+ 'revision info'
+ 'compare with repository'
+ '-'
+ 'check into source repository'
+ 'fileIn from repository'
+ ).
+
+ selectors := selectors , #(
+ nil
+ classRevisionInfo
+ classCompareWithNewestInRepository
+ nil
+ classCheckin
+ classLoadRevision
+ ).
] ifFalse:[
- currentClass isNil ifTrue:[
- labels := #(
- 'new class'
- ).
- selectors := #(
- classNewClass
- ).
- ] ifFalse:[
- currentClass isLoaded ifFalse:[
- labels := #(
- 'new class'
- '-'
- 'load '
- ).
- selectors := #(
- classNewClass
- nil
- classLoad
- ).
- ] ifTrue:[
- fullProtocol ifTrue:[
- labels := #(
- 'hierarchy'
- 'definition'
- 'comment'
- 'class instvars'
- ).
- selectors := #(
- classHierarchy
- classDefinition
- classComment
- classClassInstVars
- ).
- ] ifFalse:[
- labels := #(
- 'fileOut'
- 'printOut'
- 'printOut protocol'
- " 'printOut full protocol' "
- '-'
- 'SPAWN_CLASS'
- 'spawn full protocol'
- 'spawn hierarchy'
- 'spawn subclasses'
- '-'
- ).
- selectors := #(
- classFileOut
- classPrintOut
- classPrintOutProtocol
- " classPrintOutFullProtocol "
- nil
- classSpawn
- classSpawnFullProtocol
- classSpawnHierarchy
- classSpawnSubclasses
- nil
- ).
-
- fullClass ifFalse:[
- labels := labels , #(
- 'hierarchy'
- 'definition'
- 'comment'
- 'class instvars'
- "/ 'protocols'
- '-'
- ).
- selectors := selectors , #(
- classHierarchy
- classDefinition
- classComment
- classClassInstVars
- "/ classProtocols
- nil
- ).
- ].
-
- labels := labels , #(
- "/ 'variable search'
- 'class refs'
- '-'
- 'new class'
- 'new subclass'
- 'rename ...'
- 'remove'
- ).
- selectors := selectors , #(
- "/ variables
- classRefs
- nil
- classNewClass
- classNewSubclass
- classRename
- classRemove
- ).
- currentClass wasAutoloaded ifTrue:[
- labels := labels , #(
- 'unload'
- ).
- selectors := selectors , #(
- classUnload
- ).
- ]
- ]
- ].
- ].
+ currentClass isNil ifTrue:[
+ labels := #(
+ 'new class'
+ ).
+ selectors := #(
+ classNewClass
+ ).
+ ] ifFalse:[
+ currentClass isLoaded ifFalse:[
+ labels := #(
+ 'definition'
+ '-'
+ 'new class'
+ '-'
+ 'load '
+ ).
+ selectors := #(
+ classDefinition
+ nil
+ classNewClass
+ nil
+ classLoad
+ ).
+ ] ifTrue:[
+ fullProtocol ifTrue:[
+ labels := #(
+ 'hierarchy'
+ 'definition'
+ 'comment'
+ 'class instvars'
+ ).
+ selectors := #(
+ classHierarchy
+ classDefinition
+ classComment
+ classClassInstVars
+ ).
+ ] ifFalse:[
+ labels := #(
+ 'fileOut'
+ 'printOut'
+ 'printOut protocol'
+ " 'printOut full protocol' "
+ '-'
+ 'SPAWN_CLASS'
+ 'spawn full protocol'
+ 'spawn hierarchy'
+ 'spawn subclasses'
+ '-'
+ ).
+ selectors := #(
+ classFileOut
+ classPrintOut
+ classPrintOutProtocol
+ " classPrintOutFullProtocol "
+ nil
+ classSpawn
+ classSpawnFullProtocol
+ classSpawnHierarchy
+ classSpawnSubclasses
+ nil
+ ).
+
+ fullClass ifFalse:[
+ labels := labels , #(
+ 'hierarchy'
+ 'definition'
+ 'comment'
+ 'class instvars'
+ "/ 'protocols'
+ '-'
+ ).
+ selectors := selectors , #(
+ classHierarchy
+ classDefinition
+ classComment
+ classClassInstVars
+ "/ classProtocols
+ nil
+ ).
+ ].
+
+ labels := labels , #(
+ "/ 'variable search'
+ 'class refs'
+ '-'
+ 'new class'
+ 'new subclass'
+ 'rename ...'
+ 'remove'
+ ).
+ selectors := selectors , #(
+ "/ variables
+ classRefs
+ nil
+ classNewClass
+ classNewSubclass
+ classRename
+ classRemove
+ ).
+ currentClass wasAutoloaded ifTrue:[
+ labels := labels , #(
+ 'unload'
+ ).
+ selectors := selectors , #(
+ classUnload
+ ).
+ ]
+ ]
+ ].
+ ].
].
m := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors.
+ labels:(resources array:labels)
+ selectors:selectors.
(currentClass isNil
or:[currentClass sourceCodeManager isNil]) ifTrue:[
- m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository).
+ m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository).
].
^ m
- "Modified: 7.12.1995 / 13:19:57 / cg"
+ "Modified: 7.12.1995 / 23:56:14 / cg"
!
classNewClass
@@ -1624,6 +1628,82 @@
!BrowserView methodsFor:'class list source administration'!
+classCheckin
+ "check a class into the source repository"
+
+ self doClassMenu:[:currentClass |
+ |logMessage info mgr|
+
+ mgr := (currentClass sourceCodeManager).
+ (info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[
+ ^ self classCreateSourceContainerFor:currentClass
+ ].
+
+ logMessage := Dialog
+ request:'enter a log message:'
+ initialAnswer:lastSourceLogMessage
+ onCancel:nil.
+
+ logMessage notNil ifTrue:[
+ lastSourceLogMessage := logMessage.
+ self busyLabel:'checking in %1' with:currentClass name.
+ (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[
+ self warn:'checkin failed'.
+ ].
+ aspect == #revisionInfo ifTrue:[
+ self classListUpdate
+ ].
+ self normalLabel.
+ ]
+ ]
+
+ "Created: 23.11.1995 / 11:41:38 / cg"
+ "Modified: 7.12.1995 / 13:17:43 / cg"
+!
+
+classCompareWithNewestInRepository
+ "open a diff-textView comparing the current (in-image) version
+ with the most recent version found in the repository."
+
+ self doClassMenu:[:currentClass |
+ |aStream comparedSource currentSource v rev revString mgr|
+
+ mgr := currentClass sourceCodeManager.
+
+ rev := Dialog request:'compare to revision: (empty for newest)'.
+ rev notNil ifTrue:[
+ rev withoutSpaces isEmpty ifTrue:[
+ self busyLabel:'extracting newest %1' with:currentClass name.
+ aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name.
+ revString := 'newest'
+ ] ifFalse:[
+ self busyLabel:'extracting previous %1' with:currentClass name.
+ aStream := mgr sourceStreamFor:currentClass revision:rev.
+ revString := rev
+ ].
+ comparedSource := aStream contents.
+ aStream close.
+
+ self busyLabel:'generating current source ...' with:nil.
+
+ aStream := '' writeStream.
+ currentClass fileOutOn:aStream withTimeStamp:false.
+ currentSource := aStream contents.
+ aStream close.
+
+ self busyLabel:'comparing ...' with:nil.
+ v := DiffTextView
+ openOn:currentSource label:'current (' , currentClass revision , ')'
+ and:comparedSource label:'repository (' , revString , ')'.
+ v label:'comparing ' , currentClass name.
+ self normalLabel.
+ ]
+ ]
+
+ "Created: 14.11.1995 / 16:43:15 / cg"
+ "Modified: 7.12.1995 / 13:18:12 / cg"
+!
+
classCreateSourceContainerFor:aClass
"let user specify the source-repository values for aClass"
@@ -1708,142 +1788,6 @@
"Modified: 7.12.1995 / 13:18:37 / cg"
!
-classCheckin
- "check a class into the source repository"
-
- self doClassMenu:[:currentClass |
- |logMessage info mgr|
-
- mgr := (currentClass sourceCodeManager).
- (info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[
- ^ self classCreateSourceContainerFor:currentClass
- ].
-
- logMessage := Dialog
- request:'enter a log message:'
- initialAnswer:lastSourceLogMessage
- onCancel:nil.
-
- logMessage notNil ifTrue:[
- lastSourceLogMessage := logMessage.
- self busyLabel:'checking in %1' with:currentClass name.
- (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[
- self warn:'checkin failed'.
- ].
- aspect == #revisionInfo ifTrue:[
- self classListUpdate
- ].
- self normalLabel.
- ]
- ]
-
- "Created: 23.11.1995 / 11:41:38 / cg"
- "Modified: 7.12.1995 / 13:17:43 / cg"
-!
-
-classCompareWithNewestInRepository
- "open a diff-textView comparing the current (in-image) version
- with the most recent version found in the repository."
-
- self doClassMenu:[:currentClass |
- |aStream comparedSource currentSource v rev revString mgr|
-
- mgr := currentClass sourceCodeManager.
-
- rev := Dialog request:'compare to revision: (empty for newest)'.
- rev notNil ifTrue:[
- rev withoutSpaces isEmpty ifTrue:[
- self busyLabel:'extracting newest %1' with:currentClass name.
- aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name.
- revString := 'newest'
- ] ifFalse:[
- self busyLabel:'extracting previous %1' with:currentClass name.
- aStream := mgr sourceStreamFor:currentClass revision:rev.
- revString := rev
- ].
- comparedSource := aStream contents.
- aStream close.
-
- self busyLabel:'generating current source ...' with:nil.
-
- aStream := '' writeStream.
- currentClass fileOutOn:aStream withTimeStamp:false.
- currentSource := aStream contents.
- aStream close.
-
- self busyLabel:'comparing ...' with:nil.
- v := DiffTextView
- openOn:currentSource label:'current (' , currentClass revision , ')'
- and:comparedSource label:'repository (' , revString , ')'.
- v label:'comparing ' , currentClass name.
- self normalLabel.
- ]
- ]
-
- "Created: 14.11.1995 / 16:43:15 / cg"
- "Modified: 7.12.1995 / 13:18:12 / cg"
-!
-
-classRevisionInfo
- "show current classes revision info in codeView"
-
- self doClassMenu:[:currentClass |
- |aStream info info2 s rv mgr|
-
- aStream := WriteStream on:(String new:200).
- currentClass notNil ifTrue:[
- self busyLabel:'extracting revision info' with:nil.
- info := currentClass revisionInfo.
-
- rv := currentClass binaryRevision.
- rv notNil ifTrue:[
- aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr.
- aStream nextPutAll:' Binary based upon : ' , rv; cr.
- aStream cr.
- ].
-
- info notNil ifTrue:[
- aStream nextPutAll:'**** Classes source information ****'; cr; cr.
- s := info at:#repositoryPath ifAbsent:nil.
- s notNil ifTrue:[
- aStream nextPut:' Source repository : ' , s; cr
- ].
- aStream nextPutAll:' Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
- aStream nextPutAll:' Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
- aStream nextPutAll:' Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
- aStream nextPutAll:' Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
-
- (info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[
- aStream nextPutAll:' Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
- aStream nextPutAll:' Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
- ].
- aStream nextPutAll:' Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
- aStream cr.
-
- (mgr := currentClass sourceCodeManager) notNil ifTrue:[
- aStream nextPutAll:'**** Repository information ****'; cr; cr.
- mgr writeRevisionLogOf:currentClass to:aStream.
- ]
- ] ifFalse:[
- aStream nextPutAll:'No revision info found'
- ]
- ].
- codeView contents:(aStream contents).
-
- codeView modified:false.
- codeView acceptAction:nil.
- codeView explainAction:nil.
- methodListView notNil ifTrue:[
- methodListView deselect
- ].
- aspect := #revisionInfo.
- self normalLabel
- ]
-
- "Created: 14.11.1995 / 16:43:15 / cg"
- "Modified: 7.12.1995 / 13:20:42 / cg"
-!
-
classLoadRevision
"load a specific revision into the system - especially useful to
upgrade a class to the newest revision"
@@ -1883,6 +1827,69 @@
"Created: 14.11.1995 / 16:43:15 / cg"
"Modified: 7.12.1995 / 13:19:06 / cg"
+!
+
+classRevisionInfo
+ "show current classes revision info in codeView"
+
+ self doClassMenu:[:currentClass |
+ |aStream info info2 s rv mgr|
+
+ aStream := WriteStream on:(String new:200).
+ currentClass notNil ifTrue:[
+ self busyLabel:'extracting revision info' with:nil.
+ info := currentClass revisionInfo.
+
+ rv := currentClass binaryRevision.
+ rv notNil ifTrue:[
+ aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr.
+ aStream nextPutAll:' Binary based upon : ' , rv; cr.
+ aStream cr.
+ ].
+
+ info notNil ifTrue:[
+ aStream nextPutAll:'**** Classes source information ****'; cr; cr.
+ s := info at:#repositoryPath ifAbsent:nil.
+ s notNil ifTrue:[
+ aStream nextPut:' Source repository : ' , s; cr
+ ].
+ aStream nextPutAll:' Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
+ aStream nextPutAll:' Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
+ aStream nextPutAll:' Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
+ aStream nextPutAll:' Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
+
+ (info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[
+ aStream nextPutAll:' Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
+ aStream nextPutAll:' Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
+ ].
+ aStream nextPutAll:' Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
+ aStream cr.
+
+ (mgr := currentClass sourceCodeManager) notNil ifTrue:[
+ aStream nextPutAll:'**** Repository information ****'; cr; cr.
+ mgr writeRevisionLogOf:currentClass to:aStream.
+ ]
+ ] ifFalse:[
+ aStream nextPutAll:'No revision info found'; cr.
+ currentClass isLoaded ifFalse:[
+ aStream cr; nextPutAll:'This is an autoloaded class - you may see more after its loaded.'
+ ]
+ ]
+ ].
+ codeView contents:(aStream contents).
+
+ codeView modified:false.
+ codeView acceptAction:nil.
+ codeView explainAction:nil.
+ methodListView notNil ifTrue:[
+ methodListView deselect
+ ].
+ aspect := #revisionInfo.
+ self normalLabel
+ ]
+
+ "Created: 14.11.1995 / 16:43:15 / cg"
+ "Modified: 7.12.1995 / 23:54:04 / cg"
! !
!BrowserView methodsFor:'class stuff'!
@@ -4963,6 +4970,36 @@
self label:('System Browser - ' , (resources string:what with:someArgument))
!
+checkSelectionChangeAllowed
+ "return true, if selection change is ok;
+ its not ok, if code has been changed.
+ in this case, return the result of a user query"
+
+ |what m src v|
+
+ currentMethod notNil ifTrue:[
+ m := actualClass compiledMethodAt:currentSelector.
+ m notNil ifTrue:[
+ (src := m source) = codeView contents ifFalse:[
+ what := self checkSelectionChangeAllowedWithCompare:true.
+ what == #compare ifTrue:[
+ v := DiffTextView
+ openOn:codeView contents label:'code here (to be accepted ?)'
+ and:src label:'methods actual code'.
+ v label:'comparing method versions'.
+ ^ false
+ ].
+ ^ what
+ ]
+ ]
+ ].
+
+ ^ self checkSelectionChangeAllowedWithCompare:false
+
+ "Created: 24.11.1995 / 11:03:33 / cg"
+ "Modified: 24.11.1995 / 11:05:49 / cg"
+!
+
checkSelectionChangeAllowedWithCompare:compareOffered
"return true, if selection change is ok;
its not ok, if code has been changed.
@@ -4998,36 +5035,6 @@
"Created: 24.11.1995 / 10:54:46 / cg"
!
-checkSelectionChangeAllowed
- "return true, if selection change is ok;
- its not ok, if code has been changed.
- in this case, return the result of a user query"
-
- |what m src v|
-
- currentMethod notNil ifTrue:[
- m := actualClass compiledMethodAt:currentSelector.
- m notNil ifTrue:[
- (src := m source) = codeView contents ifFalse:[
- what := self checkSelectionChangeAllowedWithCompare:true.
- what == #compare ifTrue:[
- v := DiffTextView
- openOn:codeView contents label:'code here (to be accepted ?)'
- and:src label:'methods actual code'.
- v label:'comparing method versions'.
- ^ false
- ].
- ^ what
- ]
- ]
- ].
-
- ^ self checkSelectionChangeAllowedWithCompare:false
-
- "Created: 24.11.1995 / 11:03:33 / cg"
- "Modified: 24.11.1995 / 11:05:49 / cg"
-!
-
classHierarchyDo:aBlock
"eavluate the 2-arg block for every class,
starting at Object; passing class and nesting level to the block."
@@ -6021,5 +6028,5 @@
!BrowserView class methodsFor:'documentation'!
version
-^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.60 1995-12-07 20:07:36 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.61 1995-12-07 22:59:35 cg Exp $'! !
BrowserView initialize!