--- a/Tools__ObjectModuleInformation.st Mon Oct 12 18:52:43 2009 +0200
+++ b/Tools__ObjectModuleInformation.st Mon Oct 12 19:27:33 2009 +0200
@@ -8,7 +8,7 @@
showClassLibs table1VisibleHolder table2VisibleHolder
selectedInfoIndexHolder canBrowseSelectedModule
canUnloadSelectedModule classNamesShown classInfoShown
- vmInfoShown'
+ vmInfoShown canUnloadSelectedModulesPackage'
classVariableNames:''
poolDictionaries:''
category:'Monitors-ST/X'
@@ -84,13 +84,13 @@
collection: (
(MenuPanelSpec
name: 'ToolBar1'
- layout: (LayoutFrame 0 0 0 0 0 1 30 0)
+ layout: (LayoutFrame 0 0 0 0 0 1 40 0)
menu: toolbarMenu
textDefault: true
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
- layout: (LayoutFrame 0 0 30 0 0 1 0 1)
+ layout: (LayoutFrame 0 0 40 0 0 1 0 1)
component:
(SpecCollection
collection: (
@@ -260,17 +260,23 @@
label: '-'
)
(MenuItem
- enabled: canUnloadSelectedModule
- label: 'Unload'
- itemValue: unloadSelectedModule
+ enabled: canUnloadSelectedModulesPackage
+ label: 'Unload Package'
+ itemValue: unloadSelectedModulesPackage
translateLabel: true
)
(MenuItem
enabled: canUnloadSelectedModule
- label: 'Remove Classes && Unload'
+ label: 'Remove Classes && Unload DLL'
itemValue: unloadSelectedModuleAndRemoveClasses
translateLabel: true
)
+ (MenuItem
+ enabled: canUnloadSelectedModule
+ label: 'Unload DLL'
+ itemValue: unloadSelectedModule
+ translateLabel: true
+ )
)
nil
nil
@@ -378,14 +384,20 @@
label: '-'
)
(MenuItem
+ enabled: canUnloadSelectedModulesPackage
+ label: 'Unload Package'
+ itemValue: unloadSelectedModulesPackage
+ translateLabel: true
+ )
+ (MenuItem
enabled: canUnloadSelectedModule
- label: 'Remove Classes && Unload'
+ label: 'Remove Classes && Unload DLL'
itemValue: unloadSelectedModuleAndRemoveClasses
translateLabel: true
)
(MenuItem
enabled: canUnloadSelectedModule
- label: 'Unload'
+ label: 'Unload DLL'
itemValue: unloadSelectedModule
translateLabel: true
)
@@ -393,6 +405,37 @@
nil
nil
)
+!
+
+toolbarMenu
+ "This resource specification was automatically generated
+ by the MenuEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the MenuEditor may not be able to read the specification."
+
+ "
+ MenuEditor new openOnClass:Tools::ObjectModuleInformation andSelector:#toolbarMenu
+ (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation toolbarMenu)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+ #(Menu
+ (
+ (MenuItem
+ enabled: canBrowseSelectedModule
+ label: 'Action'
+ itemValue: browseModule
+ translateLabel: true
+ isButton: true
+ labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
+ )
+ )
+ nil
+ nil
+ )
! !
!ObjectModuleInformation class methodsFor:'tableColumns specs'!
@@ -505,6 +548,13 @@
"Modified: / 05-10-2007 / 10:51:39 / cg"
!
+canUnloadSelectedModulesPackage
+ canUnloadSelectedModulesPackage isNil ifTrue:[
+ canUnloadSelectedModulesPackage := false asValue
+ ].
+ ^ canUnloadSelectedModulesPackage.
+!
+
infoTable1ListHolder
^ builder valueAspectFor:#'infoTable1ListHolder' initialValue:#()
@@ -707,16 +757,40 @@
!
showInfoForClassLib:info
- "/ selected a package; fill bottom list with class-info
+ " selected a lib-package; fill bottom list with class-info "
+
+ |rows libraryName defClassName libraryDefinition mgr defClassNames|
+
+ 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 ]].
- |rows|
-
- self middleLabelHolder value:'Contains Modules:'.
+ 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 |
- |cls entry rev listEntry revisionInfo|
+ |cls entry rev listEntry revisionInfo versionString dateString|
listEntry := InfoRow new.
listEntry name:cName.
@@ -724,8 +798,16 @@
cls := Smalltalk classNamed:cName.
cls isNil ifTrue:[
(cName endsWith:'_extensions') ifFalse:[
- listEntry version:'(class removed)'.
- ]
+ versionString := '(class removed)'.
+ ] ifTrue:[
+ libraryDefinition notNil ifTrue:[
+ mgr := libraryDefinition sourceCodeManager.
+ versionString := libraryDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
+ versionString notNil ifTrue:[
+ versionString := '(bin: ',(mgr revisionInfoFromString:versionString) revision,')'.
+ ]
+ ].
+ ].
] ifFalse:[
rev := cls binaryRevision.
rev notNil ifTrue:[
@@ -738,18 +820,19 @@
entry := entry , ' / src: ' , (cls revision printString)
].
entry := entry , ')'.
- listEntry version:entry
+ versionString := entry
] ifFalse:[
- cls revision notNil ifTrue:[
- listEntry version:'(overloaded by: ' , cls revision , ')'
- ]
+ cls revision notNil ifTrue:[
+ versionString := '(overloaded by: ' , cls revision , ')'
+ ]
].
revisionInfo := cls revisionInfo.
revisionInfo notNil ifTrue:[
- listEntry date:(revisionInfo at:#date)
+ dateString := (revisionInfo at:#date)
].
].
- listEntry
+ listEntry version:versionString.
+ listEntry date:dateString
].
classInfoShown := rows.
@@ -762,7 +845,7 @@
!
showInfoForNonClassLib:sel
- "/ selected a method, cObject or unknown
+ " selected a method, cObject or unknown "
|module fileName list entry|
@@ -845,11 +928,11 @@
!
showInfoForVM
- "/ show file versions in lower view.
+ " show file versions of vm info in lower view. "
|l|
- self middleLabelHolder value:'Contains Modules:'.
+ self middleLabelHolder value:'Contains Components:'.
l := (ObjectMemory getVMIdentificationStrings).
l := l select:[:entry | entry includesString:'$Header'].
@@ -952,6 +1035,7 @@
packageID := (selectedClassName copyWithoutLast:('_extensions' size)) asSymbol.
methods := Smalltalk allExtensionsForPackage:packageID.
(UserPreferences browserClass) browseMethods:methods title:('Extensions for ',packageID).
+ ^ self.
].
self halt.
!
@@ -994,6 +1078,16 @@
!
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
+regular unloadPackage operation fails.
+
+Continue ?')
+ ifFalse:[
+ ^ self
+ ].
+
self withWaitCursorDo:[
|info idx handle pathName|
@@ -1163,4 +1257,8 @@
version
^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
! !