--- /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$'
+! !