diff -r 0912680e1fa7 -r 93db2a1edbe6 Tools__ObjectModuleInformation.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__ObjectModuleInformation.st	Fri Oct 05 11:57:15 2007 +0200
@@ -0,0 +1,713 @@
+"{ Package: 'stx:libtool2' }"
+
+"{ NameSpace: Tools }"
+
+ApplicationModel subclass:#ObjectModuleInformation
+	instanceVariableNames:'listOfModuleNames selectedModuleIndexHolder allModules'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Monitors-ST/X'
+!
+
+Object subclass:#InfoRow
+	instanceVariableNames:'name version date'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:ObjectModuleInformation
+!
+
+!ObjectModuleInformation class methodsFor:'documentation'!
+
+documentation
+"
+    Shows the modules (dll's) of ST/X.
+    Both builtIn modules, and dynamically loaded modules are listed.
+
+    [author:]
+        cg
+"
+!
+
+examples
+"
+  Starting the application:
+                                                                [exBegin]
+    ObjectModuleInformation open
+
+                                                                [exEnd]
+"
+! !
+
+!ObjectModuleInformation class methodsFor:'info'!
+
+defaultLabel
+    ^ 'Process Monitor'
+
+    "Created: / 05-10-2007 / 11:56:59 / cg"
+! !
+
+!ObjectModuleInformation class methodsFor:'interface specs'!
+
+windowSpec
+    "This resource specification was automatically generated
+     by the UIPainter of ST/X."
+
+    "Do not manually edit this!! If it is corrupted,
+     the UIPainter may not be able to read the specification."
+
+    "
+     UIPainter new openOnClass:ObjectModuleInformation andSelector:#windowSpec
+     ObjectModuleInformation new openInterface:#windowSpec
+     ObjectModuleInformation open
+    "
+
+    <resource: #canvas>
+
+    ^ 
+     #(FullSpec
+        name: windowSpec
+        window: 
+       (WindowSpec
+          label: 'ST/X Module & Version Information'
+          name: 'ST/X Module & Version Information'
+          min: (Point 0 0)
+          bounds: (Rectangle 0 0 505 567)
+          menu: mainMenu
+        )
+        component: 
+       (SpecCollection
+          collection: (
+           (MenuPanelSpec
+              name: 'ToolBar1'
+              layout: (LayoutFrame 0 0 0 0 0 1 30 0)
+              menu: toolbarMenu
+              textDefault: true
+            )
+           (VariableVerticalPanelSpec
+              name: 'VariableVerticalPanel1'
+              layout: (LayoutFrame 0 0 30 0 0 1 0 1)
+              component: 
+             (SpecCollection
+                collection: (
+                 (SequenceViewSpec
+                    name: 'List1'
+                    model: selectedModuleIndexHolder
+                    hasHorizontalScrollBar: true
+                    hasVerticalScrollBar: true
+                    useIndex: true
+                    sequenceList: listOfModuleNames
+                  )
+                 (ViewSpec
+                    name: 'Box1'
+                    component: 
+                   (SpecCollection
+                      collection: (
+                       (LabelSpec
+                          name: 'Label1'
+                          layout: (LayoutFrame 0 0 0 0 0 1 30 0)
+                          translateLabel: true
+                          labelChannel: middleLabelHolder
+                          adjust: left
+                        )
+                       (DataSetSpec
+                          name: 'Table1'
+                          layout: (LayoutFrame 0 0 30 0 0 1 0 1)
+                          model: selectedInfoIndexHolder
+                          hasHorizontalScrollBar: true
+                          hasVerticalScrollBar: true
+                          dataList: infoTableListHolder
+                          columnHolder: tableColumns
+                          separatorOneDColor: (Color 66.999313344015 66.999313344015 66.999313344015)
+                        )
+                       )
+                     
+                    )
+                  )
+                 )
+               
+              )
+              handles: (Any 0.35195530726257 1.0)
+            )
+           )
+         
+        )
+      )
+! !
+
+!ObjectModuleInformation class methodsFor:'menu specs'!
+
+mainMenu
+    "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:ObjectModuleInformation andSelector:#mainMenu
+     (Menu new fromLiteralArrayEncoding:(ObjectModuleInformation mainMenu)) startUp
+    "
+
+    <resource: #menu>
+
+    ^ 
+     #(Menu
+        (
+         (MenuItem
+            label: 'File'
+            translateLabel: true
+            submenu: 
+           (Menu
+              (
+               (MenuItem
+                  label: 'Exit'
+                  itemValue: closeRequest
+                  translateLabel: true
+                )
+               )
+              nil
+              nil
+            )
+          )
+         (MenuItem
+            label: 'View'
+            translateLabel: true
+            submenu: 
+           (Menu
+              (
+               (MenuItem
+                  label: 'Builtin'
+                  translateLabel: true
+                  indication: showBuiltIn
+                )
+               (MenuItem
+                  label: 'Class Libraries'
+                  translateLabel: true
+                  indication: showClassLibs
+                )
+               (MenuItem
+                  label: 'Methods'
+                  translateLabel: true
+                  indication: showMethods
+                )
+               (MenuItem
+                  label: 'C-Objects'
+                  translateLabel: true
+                  indication: showCObjects
+                )
+               (MenuItem
+                  label: 'Others'
+                  translateLabel: true
+                  indication: showOthers
+                )
+               )
+              nil
+              nil
+            )
+          )
+         (MenuItem
+            label: 'Module'
+            translateLabel: true
+            submenu: 
+           (Menu
+              (
+               (MenuItem
+                  label: 'Unload'
+                  translateLabel: true
+                )
+               )
+              nil
+              nil
+            )
+          )
+         (MenuItem
+            label: 'Help'
+            translateLabel: true
+            startGroup: conditionalRight
+            submenu: 
+           (Menu
+              (
+               (MenuItem
+                  label: 'Documentation'
+                  itemValue: openDocumentation
+                  translateLabel: true
+                )
+               (MenuItem
+                  label: '-'
+                )
+               (MenuItem
+                  label: 'About this Application...'
+                  itemValue: openAboutThisApplication
+                  translateLabel: true
+                )
+               )
+              nil
+              nil
+            )
+          )
+         )
+        nil
+        nil
+      )
+! !
+
+!ObjectModuleInformation class methodsFor:'tableColumns specs'!
+
+tableColumns
+    "This resource specification was automatically generated
+     by the DataSetBuilder of ST/X."
+
+    "Do not manually edit this!! If it is corrupted,
+     the DataSetBuilder may not be able to read the specification."
+
+    "
+     DataSetBuilder new openOnClass:ObjectModuleInformation andSelector:#tableColumns
+    "
+
+    <resource: #tableColumns>
+
+    ^#(
+      (DataSetColumnSpec
+         label: 'Name'
+         activeHelpKey: ''
+         labelButtonType: Button
+         width: 0.5
+         model: name
+         canSelect: false
+       )
+      (DataSetColumnSpec
+         label: 'Version'
+         activeHelpKey: ''
+         labelButtonType: Button
+         model: version
+         canSelect: false
+       )
+      (DataSetColumnSpec
+         label: 'Date'
+         activeHelpKey: ''
+         labelButtonType: Button
+         model: date
+         canSelect: false
+       )
+      )
+    
+! !
+
+!ObjectModuleInformation methodsFor:'aspects'!
+
+infoTableListHolder
+    ^ builder valueAspectFor:#'infoTableListHolder' initialValue:#()
+
+    "Created: / 05-10-2007 / 11:07:50 / cg"
+!
+
+listOfModuleNames
+    listOfModuleNames isNil ifTrue:[
+        listOfModuleNames := List new.
+    ].
+    ^ listOfModuleNames.
+
+    "Modified: / 05-10-2007 / 10:49:19 / cg"
+!
+
+middleLabelHolder
+    ^ builder valueAspectFor:#'middleLabelHolder' initialValue:''
+
+    "Created: / 05-10-2007 / 11:05:08 / cg"
+!
+
+selectedModuleIndexHolder
+    selectedModuleIndexHolder isNil ifTrue:[
+        selectedModuleIndexHolder := ValueHolder new.
+        selectedModuleIndexHolder onChangeSend:#selectedModuleIndexChanged to:self.
+    ].
+    ^ selectedModuleIndexHolder.
+
+    "Modified: / 05-10-2007 / 10:51:39 / cg"
+!
+
+showBuiltIn
+    ^ builder valueAspectFor:#'showBuiltIn' initialValue:true
+
+    "Modified: / 05-10-2007 / 10:35:20 / cg"
+!
+
+showCObjects
+    ^ builder valueAspectFor:#'showCObjects' initialValue:true
+
+    "Modified: / 05-10-2007 / 10:35:23 / cg"
+!
+
+showClassLibs
+    ^ builder valueAspectFor:#'showClassLibs' initialValue:true
+
+    "Modified: / 05-10-2007 / 10:35:27 / cg"
+!
+
+showMethods
+    ^ builder valueAspectFor:#'showMethods' initialValue:true
+
+    "Modified: / 05-10-2007 / 10:35:30 / cg"
+!
+
+showOthers
+    ^ builder valueAspectFor:#'showOthers' initialValue:true
+
+    "Modified: / 05-10-2007 / 10:35:32 / cg"
+! !
+
+!ObjectModuleInformation methodsFor:'change & update'!
+
+selectedModuleIndexChanged
+    |sel info|
+
+    sel := self selectedModuleIndexHolder value.
+
+    (self showClassLibs value or:[self showBuiltIn value]) ifTrue:[
+        info := allModules at:sel ifAbsent:nil.
+    ].
+    info isNil ifTrue:[
+        "/ selected a method, cObject or unknown
+        self showInfoForNonClassLib:sel.
+        ^ self.
+    ].
+    info == #VM ifTrue:[
+        "/ selected the pseudo entry for the VM itself
+        self showInfoForVM.
+        ^ self.
+    ].
+    "/ selected a class-library package
+    self showInfoForClassLib:info.
+
+    "Modified: / 05-10-2007 / 11:02:05 / cg"
+!
+
+showInfoForClassLib:info
+    "/ selected a package; fill bottom list with class-info
+
+    |classNames|
+
+    self middleLabelHolder value:'Contains Modules:'.
+
+    classNames := info classNames asSortedCollection.
+    classNames := classNames select:[:cName |
+                    |cls|
+
+                    cls := Smalltalk classNamed:cName.
+                    cls isNil ifTrue:[
+                        true "a removed class"
+                    ] ifFalse:[
+                        cls isPrivate not
+                    ].
+                  ].
+
+    classNames := classNames collect:[:cName |
+                    |cls entry rev listEntry revisionInfo|
+
+                    listEntry := InfoRow new.
+                    listEntry name:cName.
+
+                    cls := Smalltalk classNamed:cName.
+                    cls isNil ifTrue:[
+                        listEntry version:'(class removed)'.
+                    ] ifFalse:[
+                        rev := cls binaryRevision.
+                        rev notNil ifTrue:[
+                            cls isLoaded ifFalse:[
+                                entry := '(stub for: ' , rev.
+                            ] ifTrue:[
+                                entry :='(bin: ' , rev.
+                            ].    
+                            cls revision ~= rev ifTrue:[
+                                entry := entry , ' / src: ' , (cls revision printString)
+                            ].
+                            entry := entry , ')'.
+                            listEntry version:entry
+                        ] ifFalse:[
+                           cls revision notNil ifTrue:[
+                                listEntry version:'(overloaded by: ' , cls revision , ')' 
+                           ]
+                        ].
+                        revisionInfo := cls revisionInfo.
+                        revisionInfo notNil ifTrue:[
+                            listEntry date:(revisionInfo at:#date)
+                        ].
+                    ].
+                    listEntry
+                  ].
+
+    self infoTableListHolder value:classNames.
+
+    "Modified: / 05-10-2007 / 11:26:13 / cg"
+!
+
+showInfoForNonClassLib:sel
+    "/ selected a method, cObject or unknown
+
+    |objectHandles module fileName list entry|
+
+    module := objectHandles at:sel.
+    fileName := module pathName.
+
+    module isMethodHandle ifTrue:[
+        |method nm entry1 entry2 entry3|
+
+        self middleLabelHolder value:'Contains Compiled Method:'.
+
+        (method := module method) isNil ifTrue:[
+            nm := '** removed **'.
+        ] ifFalse:[
+"/            menu := PopUpMenu
+"/                        labels:#('Inspect' 'Browse')
+"/                        selectors:#(inspect browse).
+"/            menu actionAt:#inspect put:[ method inspect ].
+"/            menu actionAt:#browse put:[ |who|
+"/                                        who := method who.
+"/                                        UserPreferences systemBrowserClass
+"/                                            openInClass:(who methodClass) 
+"/                                            selector:(who methodSelector) 
+"/                                      ].
+"/            listView1 middleButtonMenu:menu.
+
+            nm := (method whoString) asText emphasizeAllWith:(#color->Color blue).
+        ].
+        entry1 := InfoRow new.
+        entry1 name:'compiled method'; version:nm.
+
+        entry2 := InfoRow new.
+        entry2 name:'path'; version:fileName.
+
+        entry3 := InfoRow new.
+        entry3 name:'address'; version:('(16r) ' , (method code address hexPrintString leftPaddedTo:8 with:$0)).
+
+        self infoTableListHolder value:(Array with:entry1 with:entry2 with:entry3).
+        ^ self.
+    ].
+
+    (module isFunctionObjectHandle 
+    and:[module functions notEmpty]) ifTrue:[
+        self middleLabelHolder value:'Contains Functions:'.
+
+"/        menu := PopUpMenu
+"/                    labels:#('Inspect')
+"/                    selectors:#(inspect).
+"/        menu actionAt:#inspect put:[ module functions inspect  ].
+"/        listView1 middleButtonMenu:menu.
+"/
+        list := (module functions select:[:f | f notNil])
+                        collect:[:f | |entry|
+                                        entry := InfoRow new.
+                                        entry name:(f name asText emphasizeAllWith:(#color->Color blue)).
+                                        entry version:('address: (16r) ' , (f code address hexPrintString leftPaddedTo:8 with:$0)).
+                                        entry
+                                ].
+        self infoTableListHolder value:list.
+        ^ self.
+    ].
+
+    entry := InfoRow new.
+    entry name:'Unknown'.
+    self infoTableListHolder value:(Array with:entry).
+
+    "Modified: / 05-10-2007 / 11:51:38 / cg"
+!
+
+showInfoForVM
+    "/ show file versions in lower view.
+
+    |l|
+
+    self middleLabelHolder value:'Contains Modules:'.
+
+    l := (ObjectMemory getVMIdentificationStrings).
+    l := l select:[:entry | entry includesString:'$Header'].
+    l := l select:[:entry | entry includesString:',v'].
+    l := l collect:[:entry |
+        |i1 i2 file revision date listEntry|
+
+        listEntry := InfoRow new.
+
+        i1 := entry indexOfSubCollection:'librun'.
+        i1 ~~ 0 ifTrue:[
+            i2 := entry indexOfSubCollection:',v' startingAt:i1.
+            i2 ~~ 0 ifTrue:[
+                file := entry copyFrom:i1+7 to:(i2-1).
+                listEntry name:file.
+
+                i1 := i2+3.
+                i2 := entry indexOfSeparatorStartingAt:i1.
+                revision := entry copyFrom:i1 to:(i2-1).
+                listEntry version:revision.
+
+                i1 := i2+1.
+                i2 := entry indexOfSeparatorStartingAt:i1.
+                date := entry copyFrom:i1 to:(i2-1).
+                listEntry date:date.
+            ].
+        ].
+        listEntry.
+    ].
+    self infoTableListHolder value:l.
+
+"/    readOnly ifFalse:[
+"/        unloadButton disable.
+"/        unloadAndRemoveButton disable.
+"/    ]
+
+    "Modified: / 05-10-2007 / 11:15:08 / cg"
+! !
+
+!ObjectModuleInformation methodsFor:'initialization'!
+
+postBuildWith:aBuilder
+    |canDoIt|
+
+    super postBuildWith:aBuilder.
+
+    canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
+    self showBuiltIn value:canDoIt.
+    self showCObjects value:canDoIt.
+    self showClassLibs value:canDoIt.
+    self showMethods value:canDoIt.
+    self showOthers value:canDoIt.
+
+    self updateModuleList
+
+    "Created: / 05-10-2007 / 10:50:27 / cg"
+! !
+
+!ObjectModuleInformation methodsFor:'menu actions'!
+
+openDocumentation
+
+    "Modified: / 05-10-2007 / 11:56:07 / cg"
+! !
+
+!ObjectModuleInformation methodsFor:'private'!
+
+updateModuleList
+    |showClassLibs showBuiltIn showMethods showCObjects showOthers
+     listOfModuleNames allObjects handles|
+
+    showClassLibs := self showClassLibs value.
+    showBuiltIn := self showBuiltIn value.
+    showMethods := self showMethods value.
+    showCObjects := self showCObjects value.
+    showOthers := self showOthers value.
+
+    listOfModuleNames := OrderedCollection new.
+    handles := OrderedCollection new.
+
+    allObjects := ObjectFileLoader loadedObjectHandles.
+
+    (showClassLibs or:[showBuiltIn]) ifTrue:[
+        |moduleNames|
+
+        allModules := ObjectMemory binaryModuleInfo asOrderedCollection.
+        (showBuiltIn and:[showClassLibs]) ifFalse:[
+            allModules := allModules select:
+                                        [:i |
+                                            |wantToSee|
+
+                                            wantToSee := i dynamic.
+                                            showBuiltIn ifTrue:[
+                                                wantToSee := wantToSee not
+                                            ].
+                                            wantToSee
+                                        ]
+        ].
+
+        "/ sorting by reverse id brings newest ones to the top (a side effect)
+        allModules sort:[:a :b | (a id) > (b id)].
+        moduleNames := allModules collect:[:entry | entry name].
+        listOfModuleNames addAll:moduleNames.
+        handles addAll:allModules.
+    ].
+
+    showMethods ifTrue:[
+        |methodObjects methodNames|
+
+        methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray.
+        methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[
+                                                        'compiled method - removed' " , ' (in ' , mH pathName , ')' "
+                                                    ] ifFalse:[
+                                                        'compiled method ' , mH method whoString  " , ' (in ' , mH pathName , ')' "
+                                                    ].
+                                             ].
+        listOfModuleNames addAll:methodNames.
+        handles addAll:methodObjects.
+    ].
+
+    showCObjects ifTrue:[
+        |cObjects cObjectNames|
+
+        cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray.
+        cObjectNames := cObjects collect:[:entry | entry pathName].
+        listOfModuleNames addAll:cObjectNames.
+        handles addAll:cObjects.
+    ].
+
+    showOthers ifTrue:[
+        |otherObjects otherObjectNames|
+
+        otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle
+                                                 or:[h isMethodHandle
+                                                 or:[h isClassLibHandle]]) not]) asArray.
+        otherObjectNames := otherObjects collect:[:entry | entry pathName].
+        listOfModuleNames addAll:otherObjectNames.
+        handles addAll:otherObjects.
+    ].
+
+    showBuiltIn ifTrue:[
+        listOfModuleNames addFirst:'VM'.
+        handles addFirst:#VM.
+        allModules addFirst:#VM.
+    ].
+
+    self listOfModuleNames contents:listOfModuleNames.
+
+"/    readOnly ifFalse:[
+"/        unloadButton disable.
+"/        unloadAndRemoveButton disable.
+"/    ]
+
+    "Created: / 05-10-2007 / 10:46:18 / cg"
+! !
+
+!ObjectModuleInformation::InfoRow methodsFor:'accessing'!
+
+date
+    ^ date
+!
+
+date:something
+    date := something.
+!
+
+name
+    ^ name
+!
+
+name:something
+    name := something.
+!
+
+name:nameArg version:versionArg date:dateArg 
+    name := nameArg.
+    version := versionArg.
+    date := dateArg.
+!
+
+version
+    ^ version
+!
+
+version:something
+    version := something.
+! !
+
+!ObjectModuleInformation class methodsFor:'documentation'!
+
+version
+    ^ '$Header$'
+! !