# HG changeset patch # User Claus Gittinger # Date 1255368453 -7200 # Node ID 01e597429c474f54dc4bd41ac0524c2f780cb9d0 # Parent 347a0b26e21053b1936ef55d49da82070ab83f75 preps for package unloading diff -r 347a0b26e210 -r 01e597429c47 Tools__ObjectModuleInformation.st --- 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 + " + + + + ^ + #(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$' ! !