*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Fri, 25 Jan 2008 10:12:18 +0100
changeset 2253 a282d11e1ec4
parent 2252 e2804df19f8c
child 2254 06ada9ab1a8a
*** empty log message ***
Tools__ObjectModuleInformation.st
--- a/Tools__ObjectModuleInformation.st	Mon Jan 21 14:32:26 2008 +0100
+++ b/Tools__ObjectModuleInformation.st	Fri Jan 25 10:12:18 2008 +0100
@@ -5,7 +5,10 @@
 ToolApplicationModel subclass:#ObjectModuleInformation
 	instanceVariableNames:'readOnly listOfModuleNames selectedModuleIndexHolder allModules
 		objectHandles showOthers showCObjects showBuiltIn showMethods
-		showClassLibs table1VisibleHolder table2VisibleHolder'
+		showClassLibs table1VisibleHolder table2VisibleHolder
+		selectedInfoIndexHolder canBrowseSelectedModule
+		canUnloadSelectedModule classNamesShown classInfoShown
+		vmInfoShown'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Monitors-ST/X'
@@ -26,7 +29,7 @@
     Both builtIn modules, and dynamically loaded modules are listed.
 
     [author:]
-        cg
+        Claus Gittinger
 "
 !
 
@@ -94,6 +97,7 @@
                  (SequenceViewSpec
                     name: 'List1'
                     model: selectedModuleIndexHolder
+                    menu: moduleMenu
                     hasHorizontalScrollBar: true
                     hasVerticalScrollBar: true
                     useIndex: true
@@ -116,6 +120,7 @@
                           layout: (LayoutFrame 0 0 30 0 0 1 0 1)
                           visibilityChannel: table1VisibleHolder
                           model: selectedInfoIndexHolder
+                          menu: moduleItemMenu
                           hasHorizontalScrollBar: true
                           hasVerticalScrollBar: true
                           dataList: infoTable1ListHolder
@@ -231,11 +236,33 @@
             submenu: 
            (Menu
               (
+              (MenuItem
+                 enabled: canBrowseSelectedModule
+                 label: 'Browse'
+                 itemValue: browseModule
+                 translateLabel: true
+               )
+               (MenuItem   
+                  enabled: canCopyClassNameList
+                  label: 'Copy Version Info to Clipboard'
+                  itemValue: copyClassOrVMNameList
+                  translateLabel: true
+                )
                (MenuItem
-                  enabled: notReadOnly
+                  label: '-'
+                )
+               (MenuItem
+                  enabled: canUnloadSelectedModule
                   label: 'Unload'
                   translateLabel: true
+                 itemValue: unloadSelectedModule
                 )
+                (MenuItem
+                   enabled: canUnloadSelectedModule
+                   label: 'Remove Classes && Unload'
+                   itemValue: unloadSelectedModuleAndRemoveClasses
+                   translateLabel: true
+                 )
                )
               nil
               nil
@@ -270,6 +297,94 @@
         nil
         nil
       )
+!
+
+moduleItemMenu
+    "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:#moduleItemMenu
+     (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation moduleItemMenu)) startUp
+    "
+
+    <resource: #menu>
+
+    ^ 
+     #(Menu
+        (
+         (MenuItem   
+            enabled: canBrowseSelectedClass
+            label: 'Browse'
+            itemValue: browseClass
+            translateLabel: true
+          )
+         (MenuItem   
+            label: '-'
+          )
+         (MenuItem   
+            enabled: canCopyClassNameList
+            label: 'Copy Version Info to Clipboard'
+            itemValue: copyClassOrVMNameList
+            translateLabel: true
+          )
+         )
+        nil
+        nil
+      )
+!
+
+moduleMenu
+    "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:#moduleMenu
+     (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation moduleMenu)) startUp
+    "
+
+    <resource: #menu>
+
+    ^ 
+     #(Menu
+        (
+         (MenuItem
+            enabled: canBrowseSelectedModule
+            label: 'Browse'
+            itemValue: browseModule
+            translateLabel: true
+          )
+         (MenuItem   
+            enabled: canCopyClassNameList
+            label: 'Copy Version Info to Clipboard'
+            itemValue: copyClassOrVMNameList
+            translateLabel: true
+          )
+         (MenuItem
+            label: '-'
+          )
+         (MenuItem
+            enabled: canUnloadSelectedModule
+            label: 'Remove Classes && Unload'
+            itemValue: unloadSelectedModuleAndRemoveClasses
+            translateLabel: true
+          )
+         (MenuItem
+            enabled: canUnloadSelectedModule
+            label: 'Unload'
+            itemValue: unloadSelectedModule
+            translateLabel: true
+          )
+         )
+        nil
+        nil
+      )
 ! !
 
 !ObjectModuleInformation class methodsFor:'tableColumns specs'!
@@ -349,6 +464,39 @@
 
 !ObjectModuleInformation methodsFor:'aspects'!
 
+canBrowseSelectedClass
+    ^ [classNamesShown notEmptyOrNil
+       and:[ self selectedInfoIndex notNil
+       and:[ self selectedInfoIndex ~~ 0 ]]]
+
+    "Modified: / 05-10-2007 / 10:51:39 / cg"
+!
+
+canBrowseSelectedModule
+    canBrowseSelectedModule isNil ifTrue:[
+        canBrowseSelectedModule := false asValue
+    ].
+    ^ canBrowseSelectedModule.
+
+    "Modified: / 05-10-2007 / 10:51:39 / cg"
+!
+
+canCopyClassNameList
+    ^ [table1VisibleHolder value 
+    and:[classInfoShown notEmptyOrNil or:[vmInfoShown notEmptyOrNil] ]]
+
+    "Modified: / 05-10-2007 / 10:51:39 / cg"
+!
+
+canUnloadSelectedModule
+    canUnloadSelectedModule isNil ifTrue:[
+        canUnloadSelectedModule := false asValue
+    ].
+    ^ canUnloadSelectedModule.
+
+    "Modified: / 05-10-2007 / 10:51:39 / cg"
+!
+
 infoTable1ListHolder
     ^ builder valueAspectFor:#'infoTable1ListHolder' initialValue:#()
 
@@ -388,6 +536,36 @@
     "Created: / 05-10-2007 / 13:05:51 / cg"
 !
 
+readOnly:aBoolean
+    readOnly := aBoolean
+
+    "Created: / 05-10-2007 / 13:05:51 / cg"
+!
+
+selectedInfoIndex
+    |sel|
+
+    sel := self selectedInfoIndexHolder value.
+    ^ sel
+!
+
+selectedInfoIndexHolder
+    selectedInfoIndexHolder isNil ifTrue:[
+        selectedInfoIndexHolder := ValueHolder new.
+        selectedInfoIndexHolder onChangeSend:#selectedInfoIndexChanged to:self.
+    ].
+    ^ selectedInfoIndexHolder.
+
+    "Modified: / 05-10-2007 / 10:51:39 / cg"
+!
+
+selectedModuleIndex
+    |sel|
+
+    sel := self selectedModuleIndexHolder value.
+    ^ sel
+!
+
 selectedModuleIndexHolder
     selectedModuleIndexHolder isNil ifTrue:[
         selectedModuleIndexHolder := ValueHolder new.
@@ -468,19 +646,33 @@
 
 !ObjectModuleInformation methodsFor:'change & update'!
 
-selectedModuleIndexChanged
-    |sel info|
+selectedInfoIndexChanged
+!
+
+selectedModule
+    |sel|
+
+    sel := self selectedModuleIndex.
+    sel isNil ifTrue:[^ nil].
+    ^ objectHandles at:sel.
+!
 
-    sel := self selectedModuleIndexHolder value.
-    sel notNil ifTrue:[
-        (self showClassLibs value or:[self showBuiltIn value]) ifTrue:[
-            info := allModules at:sel ifAbsent:nil.
-        ].
-    ].
+selectedModuleIndexChanged
+    |module info|
+
+    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:[module notNil and:[module dynamic]]]).
+
+    classNamesShown := nil.
+    classInfoShown := nil.
+    vmInfoShown := nil.
 
     info isNil ifTrue:[
         "/ selected a method, cObject or unknown
-        self showInfoForNonClassLib:sel.
+        self showInfoForNonClassLib:(self selectedModuleIndex).
         ^ self.
     ].
     info == #VM ifTrue:[
@@ -494,6 +686,18 @@
     "Modified: / 05-10-2007 / 12:56:13 / cg"
 !
 
+selectedModuleInfo
+    |sel info|
+
+    sel := self selectedModuleIndex.
+    sel notNil ifTrue:[
+        (self showClassLibs value or:[self showBuiltIn value]) ifTrue:[
+            info := allModules at:sel ifAbsent:nil.
+        ].
+    ].
+    ^ info
+!
+
 showInfoForClassLib:info
     "/ selected a package; fill bottom list with class-info
 
@@ -513,6 +717,8 @@
                     ].
                   ].
 
+    classNamesShown := classNames.
+
     rows := classNames collect:[:cName |
                     |cls entry rev listEntry revisionInfo|
 
@@ -550,6 +756,8 @@
                     listEntry
                   ].
 
+    classInfoShown := rows.
+
     self infoTable1ListHolder value:rows.
     self table1VisibleHolder value:true.
     self table2VisibleHolder value:false.
@@ -562,6 +770,12 @@
 
     |module fileName list entry|
 
+    sel isNil ifTrue:[
+        self table1VisibleHolder value:false.
+        self table2VisibleHolder value:false.
+        ^ self.
+    ].
+
     module := objectHandles at:sel.
     fileName := module pathName.
 
@@ -669,6 +883,8 @@
         ].
         listEntry.
     ].
+
+    vmInfoShown := l.
     self infoTable1ListHolder value:l.
     self table1VisibleHolder value:true.
     self table2VisibleHolder value:false.
@@ -702,10 +918,75 @@
 
 !ObjectModuleInformation methodsFor:'menu actions'!
 
+browseClass
+    |module info classNames selectedClassName selectedClass|
+
+    module := self selectedModule.
+    info := self selectedModuleInfo.
+    classNames := info classNames asSortedCollection.
+    selectedClassName := classNames at:(self selectedInfoIndex).
+    selectedClass := Smalltalk classNamed:selectedClassName.
+
+    UserPreferences systemBrowserClass 
+        openInClass:selectedClass
+!
+
+browseModule
+    |module classes|
+
+    module := self selectedModule.
+    classes := module classNames collect:[:nm | Smalltalk classNamed:nm].
+    UserPreferences systemBrowserClass 
+        browseClasses:classes
+        label:(resources string:'Classes in %1' with:module libraryName)
+!
+
+copyClassOrVMNameList
+    |text|
+
+    text := ((classInfoShown ? vmInfoShown)collect:[:eachRow | eachRow infoString]) asStringCollection asString.
+    self window setClipboardText:text.
+!
+
 openDocumentation
     self openHTMLDocument: 'tools/misc/TOP.html#MODULEINFO'
 
     "Modified: / 05-10-2007 / 13:11:45 / cg"
+!
+
+unloadModule
+    self unloadModuleRemoveClasses:false
+!
+
+unloadModuleAndRemoveClasses
+    self unloadModuleRemoveClasses:true
+!
+
+unloadModuleRemoveClasses:doRemoveClasses
+    self withWaitCursorDo:[
+        |info idx handle pathName|
+
+        info := self selectedModuleInfo.
+        self selectedModuleIndexHolder value:nil.
+        handle := objectHandles at:(self selectedModuleIndex).
+
+        info isNil ifTrue:[
+            "/ selected a method
+            "/ idx := idx - allModules size.
+            pathName := handle pathName.
+        ] ifFalse:[
+            "/ selected a package
+            pathName := info pathName.
+        ].
+        pathName notNil ifTrue:[
+            doRemoveClasses ifTrue:[
+                ObjectFileLoader unloadObjectFileAndRemoveClasses:pathName.
+            ] ifFalse:[
+                ObjectFileLoader unloadObjectFile:pathName.
+            ]
+        ].
+        self updateModuleList.
+    ]
 ! !
 
 !ObjectModuleInformation methodsFor:'private'!
@@ -841,6 +1122,12 @@
     version := something.
 ! !
 
+!ObjectModuleInformation::InfoRow methodsFor:'info'!
+
+infoString
+    ^ name , ' ', (version ? '-') , ' ', (date ? '-') printString
+! !
+
 !ObjectModuleInformation class methodsFor:'documentation'!
 
 version