--- a/BrowserView.st Tue Dec 12 13:23:08 1995 +0100
+++ b/BrowserView.st Tue Dec 12 13:24:40 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'
@@ -106,7 +106,7 @@
!BrowserView methodsFor:'change & update'!
update:something with:someArgument from:changedObject
- |list|
+ |list selector oldMethod|
"
avoid update/warn after my own changes
@@ -177,16 +177,26 @@
its the current class that has changed
"
something == #methodDictionary ifTrue:[
- (someArgument isSymbol) ifTrue:[
+
+ "/ new feature: changeArg may be an array consisting of
+ "/ the selector and the oldMethod
+ someArgument isArray ifTrue:[
+ oldMethod := someArgument at:2.
+ selector := someArgument at:1.
+ ] ifFalse:[
+ selector := someArgument
+ ].
+
+ (selector isSymbol) ifTrue:[
|changedMethod|
"
- the method with selector someArgument was changed or removed
+ the method with selector was changed or removed
"
self updateMethodCategoryListWithScroll:false.
self updateMethodListWithScroll:false.
- someArgument == currentSelector ifTrue:[
+ selector == currentSelector ifTrue:[
"
special care here: the currently shown method has been
changed somehow in another browser (or via fileIn)
@@ -1089,160 +1099,160 @@
(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 := #(
- '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
- ).
- ]
- ]
- ].
- ].
+ 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
@@ -1632,34 +1642,34 @@
"check a class into the source repository"
currentClass isLoaded ifFalse:[
- self warn:'cannot checkin unloaded classes.'.
- ^ self.
+ self warn:'cannot checkin unloaded classes.'.
+ ^ self.
].
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.
- ]
+ |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"
@@ -1671,47 +1681,47 @@
with the most recent version found in the repository."
currentClass isLoaded ifFalse:[
- self warn:'cannot compare unloaded classes.'.
- ^ self.
+ self warn:'cannot compare unloaded classes.'.
+ ^ self.
].
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
- ].
- aStream isNil ifTrue:[
- self warn:'could not extract source from repository'.
- ^ self
- ].
- 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.
- ]
+ |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
+ ].
+ aStream isNil ifTrue:[
+ self warn:'could not extract source from repository'.
+ ^ self
+ ].
+ 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"
@@ -1736,8 +1746,8 @@
check y component info fn project nm mgr|
aClass isLoaded ifFalse:[
- self warn:'please load the class first'.
- ^ self.
+ self warn:'please load the class first'.
+ ^ self.
].
"/
@@ -1750,14 +1760,14 @@
"/ try to extract some useful defaults from the current project
"/
(Project notNil and:[(project := Project current) notNil]) ifTrue:[
- (nm := project repositoryDirectory) isNil ifTrue:[
- nm := project name
- ].
- packageHolder value:nm.
-
- (nm := project repositoryModule) notNil ifTrue:[
- moduleHolder value:nm
- ].
+ (nm := project repositoryDirectory) isNil ifTrue:[
+ nm := project name
+ ].
+ packageHolder value:nm.
+
+ (nm := project repositoryModule) notNil ifTrue:[
+ moduleHolder value:nm
+ ].
].
"/
@@ -1766,23 +1776,23 @@
"/
info := (mgr := aClass sourceCodeManager) sourceInfoOfClass:aClass.
info notNil ifTrue:[
- (info includesKey:#module) ifTrue:[
- moduleHolder value:(info at:#module).
- ].
- (info includesKey:#directory) ifTrue:[
- packageHolder value:(info at:#directory).
- ].
- (info includesKey:#expectedFileName) ifTrue:[
- fn := (info at:#expectedFileName).
- ] ifFalse:[
- (info includesKey:#classFileName) ifTrue:[
- fn := (info at:#classFileName).
- ]
- ]
+ (info includesKey:#module) ifTrue:[
+ moduleHolder value:(info at:#module).
+ ].
+ (info includesKey:#directory) ifTrue:[
+ packageHolder value:(info at:#directory).
+ ].
+ (info includesKey:#expectedFileName) ifTrue:[
+ fn := (info at:#expectedFileName).
+ ] ifFalse:[
+ (info includesKey:#classFileName) ifTrue:[
+ fn := (info at:#classFileName).
+ ]
+ ]
].
fn isNil ifTrue:[
- fn := (Smalltalk fileNameForClass:aClass) , '.st'.
+ fn := (Smalltalk fileNameForClass:aClass) , '.st'.
].
fileNameHolder := fn asValue.
@@ -1831,60 +1841,60 @@
box showAtPointer.
box accepted ifTrue:[
- aClass revisionString isNil ifTrue:[
- (self confirm:(resources string:'%1 does not have any revision info (#version method)\\Shall I create one ?' with:aClass name) withCRs)
- ifFalse:[
- ^ self
- ].
- aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass).
- ].
-
- module := moduleHolder value withoutSpaces.
- package := packageHolder value withoutSpaces.
- fileName := fileNameHolder value withoutSpaces.
-
- "/
- "/ check for the module
- "/
- (mgr checkForExistingModule:module) ifFalse:[
- (self confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs) ifFalse:[
- ^ self.
- ].
- (mgr createModule:module) ifFalse:[
- self warn:(resources string:'cannot create new module: %1' with:module).
- ^ self.
- ]
- ].
-
- "/
- "/ check for the package
- "/
- (mgr checkForExistingModule:module package:package) ifFalse:[
- (self confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs) ifFalse:[
- ^ self.
- ].
- (mgr createModule:module package:package) ifFalse:[
- self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module).
- ^ self.
- ]
- ].
-
- "/
- "/ check for the container itself
- "/
- (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[
- self warn:(resources string:'container for %1 already exists in %2/%3.\\You have to destroy the old one or use another name.' with:fileName with:module with:package) withCRs.
- ^ self
- ].
-
- (mgr
- createContainerFor:aClass
- inModule:module
- package:package
- container:fileName) ifFalse:[
- self warn:(resources string:'failed to create container.').
- ^ self.
- ].
+ aClass revisionString isNil ifTrue:[
+ (self confirm:(resources string:'%1 does not have any revision info (#version method)\\Shall I create one ?' with:aClass name) withCRs)
+ ifFalse:[
+ ^ self
+ ].
+ aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass).
+ ].
+
+ module := moduleHolder value withoutSpaces.
+ package := packageHolder value withoutSpaces.
+ fileName := fileNameHolder value withoutSpaces.
+
+ "/
+ "/ check for the module
+ "/
+ (mgr checkForExistingModule:module) ifFalse:[
+ (self confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs) ifFalse:[
+ ^ self.
+ ].
+ (mgr createModule:module) ifFalse:[
+ self warn:(resources string:'cannot create new module: %1' with:module).
+ ^ self.
+ ]
+ ].
+
+ "/
+ "/ check for the package
+ "/
+ (mgr checkForExistingModule:module package:package) ifFalse:[
+ (self confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs) ifFalse:[
+ ^ self.
+ ].
+ (mgr createModule:module package:package) ifFalse:[
+ self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module).
+ ^ self.
+ ]
+ ].
+
+ "/
+ "/ check for the container itself
+ "/
+ (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[
+ self warn:(resources string:'container for %1 already exists in %2/%3.\\You have to destroy the old one or use another name.' with:fileName with:module with:package) withCRs.
+ ^ self
+ ].
+
+ (mgr
+ createContainerFor:aClass
+ inModule:module
+ package:package
+ container:fileName) ifFalse:[
+ self warn:(resources string:'failed to create container.').
+ ^ self.
+ ].
].
box destroy
@@ -1896,67 +1906,67 @@
upgrade a class to the newest revision"
currentClass isLoaded ifFalse:[
- self warn:'cannot load specific releases of autoloaded classes.'.
- ^ self.
+ self warn:'cannot load specific releases of autoloaded classes.'.
+ ^ self.
].
self doClassMenu:[:currentClass |
- |aStream comparedSource currentSource v rev revString what mgr keep className
- newClass|
-
- rev := Dialog request:'load which revision: (empty for newest)'.
- rev notNil ifTrue:[
- className := currentClass name.
- (className includesString:'_rev_') ifTrue:[
- self warn:'select the original class and try again.'.
- ^ self
- ].
-
- mgr := currentClass sourceCodeManager.
-
- rev withoutSpaces isEmpty ifTrue:[
- what := className , '(newest)'.
- self busyLabel:'extracting %1' with:what.
- aStream := mgr mostRecentSourceStreamForClassNamed:className.
- revString := 'newest'.
- keep := false.
- ] ifFalse:[
- what := className , '(' , rev , ')'.
- self busyLabel:'extracting %1' with:what.
- aStream := mgr sourceStreamFor:currentClass revision:rev.
- revString := rev.
- keep := true.
- ].
- self busyLabel:'loading %1' with:what .
-
- [
- Class withoutUpdatingChangesDo:[
- "/ rename the current class - for backup
- Smalltalk renameClass:currentClass to:className , '_saved'.
- aStream fileIn.
-
- "/ did that work ?
- newClass := Smalltalk at:className ifAbsent:nil.
- newClass isNil ifTrue:[
- self warn:'fileIn failed - undoing changes ...'.
- Smalltalk renameClass:currentClass to:className.
- ] ifFalse:[
- "/
- "/ if we loaded an old version, rename that one and fix the name of the
- "/ current class
- "/
- keep ifTrue:[
- Smalltalk renameClass:newClass to:(className , '_rev_' , rev).
- Smalltalk renameClass:currentClass to:className
- ]
- ]
- ].
- ] valueNowOrOnUnwindDo:[
- aStream close.
- self normalLabel.
- Smalltalk changed.
- ].
- ]
+ |aStream comparedSource currentSource v rev revString what mgr keep className
+ newClass|
+
+ rev := Dialog request:'load which revision: (empty for newest)'.
+ rev notNil ifTrue:[
+ className := currentClass name.
+ (className includesString:'_rev_') ifTrue:[
+ self warn:'select the original class and try again.'.
+ ^ self
+ ].
+
+ mgr := currentClass sourceCodeManager.
+
+ rev withoutSpaces isEmpty ifTrue:[
+ what := className , '(newest)'.
+ self busyLabel:'extracting %1' with:what.
+ aStream := mgr mostRecentSourceStreamForClassNamed:className.
+ revString := 'newest'.
+ keep := false.
+ ] ifFalse:[
+ what := className , '(' , rev , ')'.
+ self busyLabel:'extracting %1' with:what.
+ aStream := mgr sourceStreamFor:currentClass revision:rev.
+ revString := rev.
+ keep := true.
+ ].
+ self busyLabel:'loading %1' with:what .
+
+ [
+ Class withoutUpdatingChangesDo:[
+ "/ rename the current class - for backup
+ Smalltalk renameClass:currentClass to:className , '_saved'.
+ aStream fileIn.
+
+ "/ did that work ?
+ newClass := Smalltalk at:className ifAbsent:nil.
+ newClass isNil ifTrue:[
+ self warn:'fileIn failed - undoing changes ...'.
+ Smalltalk renameClass:currentClass to:className.
+ ] ifFalse:[
+ "/
+ "/ if we loaded an old version, rename that one and fix the name of the
+ "/ current class
+ "/
+ keep ifTrue:[
+ Smalltalk renameClass:newClass to:(className , '_rev_' , rev).
+ Smalltalk renameClass:currentClass to:className
+ ]
+ ]
+ ].
+ ] valueNowOrOnUnwindDo:[
+ aStream close.
+ self normalLabel.
+ Smalltalk changed.
+ ].
+ ]
]
"Created: 14.11.1995 / 16:43:15 / cg"
@@ -1967,59 +1977,59 @@
"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
+ |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"
@@ -6162,6 +6172,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.66 1995-12-09 21:40:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.67 1995-12-12 12:24:40 cg Exp $'
! !
BrowserView initialize!