--- a/Tools__ObjectModuleInformation.st Tue May 11 18:17:07 2010 +0200
+++ b/Tools__ObjectModuleInformation.st Wed May 12 10:56:16 2010 +0200
@@ -887,10 +887,13 @@
!
showInfoForClassLib:info
- " selected a lib-package; fill bottom list with class-info "
+ "selected a lib-package; fill bottom list with class-info"
+
+ |rows projectDefinitionClass mgr canUnload canUnloadPackage|
- |rows libraryName defClassName libraryDefinition mgr defClassNames
- canUnload canUnloadPackage|
+ self middleLabelHolder value:'Components:'.
+
+ projectDefinitionClass := self selectedModulesProjectDefinitionClass.
self canBrowseSelectedModule value:true.
@@ -899,63 +902,39 @@
canUnload := info dynamic and:[self readOnly not].
self canUnloadSelectedModule value:canUnload.
- canUnloadPackage := canUnload and:[ self selectedModulesProjectDefinitionClass notNil ].
+ canUnloadPackage := canUnload
+ and:[projectDefinitionClass notNil
+ and:[projectDefinitionClass projectIsLoaded]].
self canUnloadSelectedModulesPackage value:canUnloadPackage.
- self middleLabelHolder value:'Contains Components:'.
-
- "/ try to figure out, what the definitionClass is inside that module.
- "/ in the future, we should always find one there, however, old libs or
- "/ special libraries (hand built) might be without a projectDefinition.
- defClassNames := (info classNames ? #())
- select:[:nm |
- |cls|
- cls := Smalltalk classNamed:nm.
- cls isBehavior and:[ cls isProjectDefinition ]].
-
- defClassNames size == 1 ifTrue:[
- libraryName := defClassNames first
- ] ifFalse:[
- "/ fallback - some heuristics...
- libraryName := info libraryName.
- (libraryName notNil and:[ libraryName startsWith:'lib' ]) ifTrue:[
- defClassName := libraryName copyFrom:4
- ] ifFalse:[
- "/ self halt.
- ].
- ].
- defClassName notNil ifTrue:[
- libraryDefinition := Smalltalk classNamed:defClassName.
- ].
classNamesShown := self shownClassNamesFor:info.
-
- rows := classNamesShown collect:[:cName |
+ rows := classNamesShown collect:[:eachClassName |
|cls entry rev listEntry revisionInfo versionString dateString|
listEntry := InfoRow new.
- listEntry name:cName.
+ listEntry name:eachClassName.
- cls := Smalltalk classNamed:cName.
+ cls := Smalltalk classNamed:eachClassName.
cls isNil ifTrue:[
- (self isExtensionName:cName) ifFalse:[
- versionString := '(class removed)'.
- ] ifTrue:[
- libraryDefinition notNil ifTrue:[
- mgr := libraryDefinition sourceCodeManager.
- versionString := libraryDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
+ (self isExtensionName:eachClassName) ifTrue:[
+ projectDefinitionClass notNil ifTrue:[
+ mgr := projectDefinitionClass sourceCodeManager.
+ versionString := projectDefinitionClass perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
versionString notNil ifTrue:[
versionString := '(bin: ',(mgr revisionInfoFromString:versionString) revision,')'.
]
].
+ ] ifFalse:[
+ versionString := '(class removed)'.
].
] ifFalse:[
rev := cls binaryRevision.
rev notNil ifTrue:[
- cls isLoaded ifFalse:[
+ cls isLoaded ifTrue:[
+ entry :='(bin: ' , rev.
+ ] ifFalse:[
entry := '(stub for: ' , rev.
- ] ifTrue:[
- entry :='(bin: ' , rev.
].
cls revision ~= rev ifTrue:[
entry := entry , ' / src: ' , (cls revision printString)
@@ -969,11 +948,11 @@
].
revisionInfo := cls revisionInfo.
revisionInfo notNil ifTrue:[
- dateString := (revisionInfo at:#date)
+ dateString := revisionInfo at:#date.
].
].
listEntry version:versionString.
- listEntry date:dateString
+ listEntry date:dateString.
].
classInfoShown := rows.
@@ -1080,42 +1059,41 @@
!
showInfoForVM
- " show file versions of vm info in lower view. "
+ "show file versions of vm info in lower view."
|l|
self canBrowseSelectedModule value:false.
-
- self middleLabelHolder value:'Contains Components:'.
+ self middleLabelHolder value:'VM Components:'.
- l := (ObjectMemory getVMIdentificationStrings).
- l := l select:[:entry | entry includesString:'$Header'].
- l := l select:[:entry | entry includesString:',v'].
- l := l collect:[:entry |
- |i1 i2 file revision date listEntry|
+ l := ObjectMemory getVMIdentificationStrings
+ select:[:entry | (entry includesString:'$Header')
+ and:[entry includesString:',v']]
+ thenCollect:[:entry |
+ |i1 i2 file revision date listEntry|
- listEntry := InfoRow new.
+ listEntry := InfoRow new.
- i1 := entry indexOfSubCollection:'librun'.
- i1 ~~ 0 ifTrue:[
- i2 := entry indexOfSubCollection:',v' startingAt:i1.
- i2 ~~ 0 ifTrue:[
- file := entry copyFrom:i1+7 to:(i2-1).
- listEntry name:file.
+ i1 := entry indexOfSubCollection:'librun'.
+ i1 ~~ 0 ifTrue:[
+ i2 := entry indexOfSubCollection:',v' startingAt:i1.
+ i2 ~~ 0 ifTrue:[
+ file := entry copyFrom:i1+7 to:(i2-1).
+ listEntry name:file.
- i1 := i2+3.
- i2 := entry indexOfSeparatorStartingAt:i1.
- revision := entry copyFrom:i1 to:(i2-1).
- listEntry version:revision.
+ i1 := i2+3.
+ i2 := entry indexOfSeparatorStartingAt:i1.
+ revision := entry copyFrom:i1 to:(i2-1).
+ listEntry version:revision.
- i1 := i2+1.
- i2 := entry indexOfSeparatorStartingAt:i1.
- date := entry copyFrom:i1 to:(i2-1).
- listEntry date:date.
+ i1 := i2+1.
+ i2 := entry indexOfSeparatorStartingAt:i1.
+ date := entry copyFrom:i1 to:(i2-1).
+ listEntry date:date.
+ ].
+ ].
+ listEntry.
].
- ].
- listEntry.
- ].
vmInfoShown := l.
self infoTable1ListHolder value:l.
@@ -1306,15 +1284,28 @@
!
selectedModulesProjectDefinitionClass
- | info classNames classes definitionClasses|
+ "try to figure out, what the definitionClass is inside that module.
+ in the future, we should always find one there, however, old libs or
+ special libraries (hand built) might be without a projectDefinition."
+
+ |info classNames definitionClasses libraryName|
info := self selectedModuleInfo.
classNames := (self shownClassNamesFor:info) asSortedCollection.
- classes := classNames collect:[:nm | Smalltalk classNamed:nm].
- definitionClasses := classes select:[:cls | cls isProjectDefinition].
+ definitionClasses := classNames ? #()
+ collect:[:nm | Smalltalk classNamed:nm]
+ thenSelect:[:cls | cls isProjectDefinition].
+
definitionClasses size == 1 ifTrue:[
^ definitionClasses first
+ ] ifFalse:[
+ "/ 0 or more definition classes - fall back - some heuristics...
+ libraryName := info libraryName. "maybe something like 'libstx_libbasic'"
+ (libraryName notNil and:[ libraryName startsWith:'lib' ]) ifTrue:[
+ ^ Smalltalk classNamed:(libraryName copyFrom:4).
+ ].
].
+
^ nil
!