--- a/Tools__ObjectModuleInformation.st Tue Oct 13 09:19:03 2009 +0200
+++ b/Tools__ObjectModuleInformation.st Tue Oct 13 10:46:57 2009 +0200
@@ -9,7 +9,7 @@
selectedInfoIndexHolder canBrowseSelectedModule
canUnloadSelectedModule classNamesShown classInfoShown
vmInfoShown canUnloadSelectedModulesPackage
- canBrowseSelectedModulesExtensions'
+ canBrowseSelectedModulesExtensions canUnloadSelectedDLL'
classVariableNames:''
poolDictionaries:''
category:'Monitors-ST/X'
@@ -197,6 +197,15 @@
(Menu
(
(MenuItem
+ label: 'Dynamically Loaded ClassLibraries Only'
+ translateLabel: true
+ hideMenuOnActivated: false
+ itemValue: showOnlyDynamicallyLoadedClassLibraries
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
label: 'Builtin'
translateLabel: true
hideMenuOnActivated: false
@@ -252,6 +261,15 @@
translateLabel: true
)
(MenuItem
+ enabled: canBrowseSelectedModulesExtensions
+ label: 'Browse Extensions'
+ itemValue: browseModuleExtensions
+ translateLabel: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
enabled: canCopyClassNameList
label: 'Copy Version Info to Clipboard'
itemValue: copyClassOrVMNameList
@@ -261,20 +279,28 @@
label: '-'
)
(MenuItem
+ label: 'Load Package...'
+ itemValue: loadPackage
+ translateLabel: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
enabled: canUnloadSelectedModulesPackage
- label: 'Unload Package'
+ label: 'Unload Package...'
itemValue: unloadSelectedModulesPackage
translateLabel: true
)
(MenuItem
- enabled: canUnloadSelectedModule
- label: 'Remove Classes && Unload DLL'
+ enabled: canUnloadSelectedDLL
+ label: 'Remove Classes && Unload DLL...'
itemValue: unloadSelectedModuleAndRemoveClasses
translateLabel: true
)
(MenuItem
enabled: canUnloadSelectedModule
- label: 'Unload DLL'
+ label: 'Unload DLL...'
itemValue: unloadSelectedModule
translateLabel: true
)
@@ -381,7 +407,10 @@
itemValue: browseModuleExtensions
translateLabel: true
)
- (MenuItem
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
enabled: canCopyClassNameList
label: 'Copy Version Info to Clipboard'
itemValue: copyClassOrVMNameList
@@ -392,22 +421,30 @@
)
(MenuItem
enabled: canUnloadSelectedModulesPackage
- label: 'Unload Package'
+ label: 'Unload Package...'
itemValue: unloadSelectedModulesPackage
translateLabel: true
)
(MenuItem
enabled: canUnloadSelectedModule
- label: 'Remove Classes && Unload DLL'
+ label: 'Remove Classes && Unload DLL...'
itemValue: unloadSelectedModuleAndRemoveClasses
translateLabel: true
)
(MenuItem
- enabled: canUnloadSelectedModule
- label: 'Unload DLL'
+ enabled: canUnloadSelectedDLL
+ label: 'Unload DLL...'
itemValue: unloadSelectedModule
translateLabel: true
)
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Update'
+ itemValue: menuUpdateModuleList
+ translateLabel: true
+ )
)
nil
nil
@@ -563,6 +600,15 @@
"Modified: / 05-10-2007 / 10:51:39 / cg"
!
+canUnloadSelectedDLL
+ canUnloadSelectedDLL isNil ifTrue:[
+ canUnloadSelectedDLL := false asValue
+ ].
+ ^ canUnloadSelectedDLL.
+
+ "Modified: / 05-10-2007 / 10:51:39 / cg"
+!
+
canUnloadSelectedModule
canUnloadSelectedModule isNil ifTrue:[
canUnloadSelectedModule := false asValue
@@ -698,6 +744,15 @@
"Modified: / 05-10-2007 / 12:43:02 / cg"
!
+showOnlyDynamicallyLoadedClassLibraries
+ self showBuiltIn value:false withoutNotifying:self.
+ self showCObjects value:false withoutNotifying:self.
+ self showMethods value:false withoutNotifying:self.
+ self showOthers value:false withoutNotifying:self.
+ self showClassLibs value:true withoutNotifying:self.
+ self filterChanged.
+!
+
showOthers
showOthers isNil ifTrue:[
showOthers := true asValue.
@@ -744,19 +799,16 @@
!
selectedModuleIndexChanged
- |module info canBrowse canUnload canBrowseExtensions|
+ |module info |
info := self selectedModuleInfo.
module := self selectedModule.
- 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.
+ self canBrowseSelectedModule value:false.
+ self canBrowseSelectedModulesExtensions value:false.
+ self canUnloadSelectedDLL value:false.
+ self canUnloadSelectedModule value:false.
+ self canUnloadSelectedModulesPackage value:false.
classNamesShown := nil.
classInfoShown := nil.
@@ -794,7 +846,18 @@
showInfoForClassLib:info
" selected a lib-package; fill bottom list with class-info "
- |rows libraryName defClassName libraryDefinition mgr defClassNames|
+ |rows libraryName defClassName libraryDefinition mgr defClassNames
+ canUnload canUnloadPackage|
+
+ self canBrowseSelectedModule value:true.
+
+ self canBrowseSelectedModulesExtensions
+ value:(info classNames contains:[:nm | self isExtensionName:nm]).
+
+ canUnload := info dynamic and:[self readOnly not].
+ self canUnloadSelectedModule value:canUnload.
+ canUnloadPackage := canUnload and:[ self selectedModulesProjectDefinitionClass notNil ].
+ self canUnloadSelectedModulesPackage value:canUnloadPackage.
self middleLabelHolder value:'Contains Components:'.
@@ -896,11 +959,14 @@
module isMethodHandle ifTrue:[
|method nm entry1 entry2 entry3|
+ self canUnloadSelectedDLL value:true.
+
self middleLabelHolder value:'Compiled Method:'.
(method := module method) isNil ifTrue:[
nm := '** removed **'.
] ifFalse:[
+ self canBrowseSelectedModule value:true.
"/ menu := PopUpMenu
"/ labels:#('Inspect' 'Browse')
"/ selectors:#(inspect browse).
@@ -967,6 +1033,8 @@
|l|
+ self canBrowseSelectedModule value:false.
+
self middleLabelHolder value:'Contains Components:'.
l := (ObjectMemory getVMIdentificationStrings).
@@ -1075,13 +1143,23 @@
!
browseModule
- |module classes|
+ |module classes method|
module := self selectedModule.
- classes := module classNames collect:[:nm | Smalltalk classNamed:nm].
- UserPreferences systemBrowserClass
- browseClasses:classes
- label:(resources string:'Classes in %1' with:module libraryName)
+ module isMethodHandle ifTrue:[
+ method := module method.
+ (method notNil and:[method mclass notNil]) ifFalse:[
+ Dialog information:'The method has been redefined/removed'.
+ ^ self.
+ ].
+ UserPreferences systemBrowserClass
+ openInMethod:method
+ ] ifFalse:[
+ classes := module classNames collect:[:nm | Smalltalk classNamed:nm].
+ UserPreferences systemBrowserClass
+ browseClasses:classes
+ label:(resources string:'Classes in %1' with:module libraryName)
+ ]
!
browseModuleExtensions
@@ -1102,6 +1180,20 @@
self window setClipboardText:text.
!
+loadPackage
+ |package ok|
+
+ package := Dialog request:'Name of Package (module:directory)'.
+ package isEmptyOrNil ifTrue:[^ self].
+ self withWaitCursorDo:[
+ ok := Smalltalk loadPackage:package.
+ ].
+ ok ifFalse:[
+ Dialog information:'Package not loaded'
+ ].
+ self updateModuleList
+!
+
menuUpdateModuleList
self updateModuleList
@@ -1114,6 +1206,20 @@
"Modified: / 05-10-2007 / 13:11:45 / cg"
!
+selectedModulesProjectDefinitionClass
+ |module info classNames classes definitionClasses|
+
+ module := self selectedModule.
+ info := self selectedModuleInfo.
+ classNames := (self shownClassNamesFor:info) asSortedCollection.
+ classes := classNames collect:[:nm | Smalltalk classNamed:nm].
+ definitionClasses := classes select:[:cls | cls isProjectDefinition].
+ definitionClasses size == 1 ifTrue:[
+ ^ definitionClasses first
+ ].
+ ^ nil
+!
+
unloadSelectedModule
self unloadSelectedModuleRemoveClasses:false
!
@@ -1125,7 +1231,7 @@
unloadSelectedModuleRemoveClasses:doRemoveClasses
(Dialog
confirm:'This is a possibly dangerous operation, as the DLL is unloaded without caring for
-proper package-deinstallation procedures. Please only use this in repair situations and when the
+proper package-deinstallation procedures. Please use this only in repair situations and when the
regular unloadPackage operation fails.
Continue ?')
@@ -1157,6 +1263,20 @@
].
self updateModuleList.
]
+!
+
+unloadSelectedModulesPackage
+ |definitionClass|
+
+ definitionClass := self selectedModulesProjectDefinitionClass.
+ definitionClass isNil ifTrue:[^ self].
+
+ (Dialog
+ confirm:(resources stringWithCRs:'About to unload the package\\ %1\\Continue' with:definitionClass package allBold))
+ ifFalse:[
+ ^ self
+ ].
+ Smalltalk unloadPackage:definitionClass package.
! !
!ObjectModuleInformation methodsFor:'private'!
@@ -1248,6 +1368,7 @@
self listOfModuleNames contents:listOfModuleNames.
objectHandles := handles.
+ self selectedModuleIndexChanged.
"Modified: / 05-10-2007 / 12:45:37 / cg"
! !