*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Tue, 13 Oct 2009 09:19:03 +0200
changeset 2618 441ede629ea8
parent 2617 060a35c37056
child 2619 09ab6a49e5ce
*** empty log message ***
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|