diff -r 060a35c37056 -r 441ede629ea8 Tools__ObjectModuleInformation.st --- 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|