"{ 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$'
! !