--- a/Tools__ObjectModuleInformation.st Mon Oct 12 20:19:23 2009 +0200
+++ b/Tools__ObjectModuleInformation.st Tue Oct 13 09:19:03 2009 +0200
@@ -8,7 +8,8 @@
showClassLibs table1VisibleHolder table2VisibleHolder
selectedInfoIndexHolder canBrowseSelectedModule
canUnloadSelectedModule classNamesShown classInfoShown
- vmInfoShown canUnloadSelectedModulesPackage'
+ vmInfoShown canUnloadSelectedModulesPackage
+ canBrowseSelectedModulesExtensions'
classVariableNames:''
poolDictionaries:''
category:'Monitors-ST/X'
@@ -374,6 +375,12 @@
itemValue: browseModule
translateLabel: true
)
+ (MenuItem
+ enabled: canBrowseSelectedModulesExtensions
+ label: 'Browse Extensions'
+ itemValue: browseModuleExtensions
+ translateLabel: true
+ )
(MenuItem
enabled: canCopyClassNameList
label: 'Copy Version Info to Clipboard'
@@ -430,7 +437,15 @@
itemValue: browseModule
translateLabel: true
isButton: true
- labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
+ labelImage: (ResourceRetriever ToolbarIconLibrary startSystemBrowserIcon)
+ )
+ (MenuItem
+ enabled: canBrowseSelectedModulesExtensions
+ label: 'Browse the Selected Module''s Extensions'
+ itemValue: browseModuleExtensions
+ translateLabel: true
+ isButton: true
+ labelImage: (ResourceRetriever ToolbarIconLibrary browseClassExtensionsIcon)
)
)
nil
@@ -532,6 +547,15 @@
"Modified: / 05-10-2007 / 10:51:39 / cg"
!
+canBrowseSelectedModulesExtensions
+ canBrowseSelectedModulesExtensions isNil ifTrue:[
+ canBrowseSelectedModulesExtensions := false asValue
+ ].
+ ^ canBrowseSelectedModulesExtensions.
+
+ "Modified: / 05-10-2007 / 10:51:39 / cg"
+!
+
canCopyClassNameList
^ [table1VisibleHolder value
and:[classInfoShown notEmptyOrNil or:[vmInfoShown notEmptyOrNil] ]]
@@ -704,6 +728,10 @@
!ObjectModuleInformation methodsFor:'change & update'!
+isExtensionName:nm
+ ^ (nm endsWith:'_extensions')
+!
+
selectedInfoIndexChanged
!
@@ -716,13 +744,19 @@
!
selectedModuleIndexChanged
- |module info|
+ |module info canBrowse canUnload canBrowseExtensions|
info := self selectedModuleInfo.
module := self selectedModule.
- self canBrowseSelectedModule value:(info notNil and:[info ~~ #VM and:[module notNil]]).
- self canUnloadSelectedModule value:(self readOnly not and:[info ~~ #VM and:[info notNil and:[info dynamic]]]).
+ canBrowse := info notNil and:[info ~~ #VM and:[module notNil]].
+ canUnload := info notNil and:[info ~~ #VM and:[info dynamic and:[self readOnly not]]].
+ canBrowseExtensions := canBrowse
+ and:[ info classNames contains:[:nm | self isExtensionName:nm] ].
+
+ self canBrowseSelectedModule value:canBrowse.
+ self canBrowseSelectedModulesExtensions value:canBrowseExtensions.
+ self canUnloadSelectedModule value:canUnload.
classNamesShown := nil.
classInfoShown := nil.
@@ -738,6 +772,7 @@
self showInfoForVM.
^ self.
].
+
"/ selected a class-library package
self showInfoForClassLib:info.
@@ -797,7 +832,7 @@
cls := Smalltalk classNamed:cName.
cls isNil ifTrue:[
- (cName endsWith:'_extensions') ifFalse:[
+ (self isExtensionName:cName) ifFalse:[
versionString := '(class removed)'.
] ifTrue:[
libraryDefinition notNil ifTrue:[
@@ -1017,7 +1052,7 @@
!ObjectModuleInformation methodsFor:'menu actions'!
browseClass
- |module info classNames selectedClassName selectedClass packageID methods|
+ |module info classNames selectedClassName selectedClass|
module := self selectedModule.
info := self selectedModuleInfo.
@@ -1031,13 +1066,12 @@
].
"/ clicked on an extensions-module ?
- (selectedClassName endsWith:'_extensions') ifTrue:[
- packageID := (selectedClassName copyWithoutLast:('_extensions' size)) asSymbol.
- methods := Smalltalk allExtensionsForPackage:packageID.
- (UserPreferences browserClass) browseMethods:methods title:('Extensions for ',packageID).
+ (self isExtensionName:selectedClassName) ifTrue:[
+ self browseModuleExtensions.
^ self.
].
-self halt.
+
+ self breakPoint:#cg.
!
browseModule
@@ -1050,6 +1084,17 @@
label:(resources string:'Classes in %1' with:module libraryName)
!
+browseModuleExtensions
+ |module name packageID methods|
+
+ module := self selectedModule.
+
+ name := module classNames detect:[:nm | self isExtensionName:nm].
+ packageID := (name copyWithoutLast:('_extensions' size)) asSymbol.
+ methods := Smalltalk allExtensionsForPackage:packageID.
+ (UserPreferences browserClass) browseMethods:methods title:('Extensions for ',packageID).
+!
+
copyClassOrVMNameList
|text|