"{ Package: 'stx:libtool2' }"
"{ NameSpace: Tools }"
ToolApplicationModel subclass:#ObjectModuleInformation
instanceVariableNames:'readOnly listOfModuleNames selectedModuleIndexHolder allModules
objectHandles showOthers showCObjects showBuiltIn showMethods
showClassLibs table1VisibleHolder table2VisibleHolder'
classVariableNames:''
poolDictionaries:''
category:'Monitors-ST/X'
!
Object subclass:#InfoRow
instanceVariableNames:'name version date value'
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
^ 'Object Module Info'
"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:Tools::ObjectModuleInformation andSelector:#windowSpec
Tools::ObjectModuleInformation new openInterface:#windowSpec
Tools::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)
visibilityChannel: table1VisibleHolder
model: selectedInfoIndexHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
dataList: infoTable1ListHolder
columnHolder: tableColumns
separatorOneDColor: (Color 66.999313344015 66.999313344015 66.999313344015)
)
(DataSetSpec
name: 'Table2'
layout: (LayoutFrame 0 0 30 0 0 1 0 1)
initiallyInvisible: true
visibilityChannel: table2VisibleHolder
model: selectedInfoIndexHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
dataList: infoTable2ListHolder
columnHolder: tableColumnsForSingleInfo
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:Tools::ObjectModuleInformation andSelector:#mainMenu
(Menu new fromLiteralArrayEncoding:(Tools::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
hideMenuOnActivated: false
indication: showBuiltIn
)
(MenuItem
label: 'Class Libraries'
translateLabel: true
hideMenuOnActivated: false
indication: showClassLibs
)
(MenuItem
label: 'Methods'
translateLabel: true
hideMenuOnActivated: false
indication: showMethods
)
(MenuItem
label: 'C-Objects'
translateLabel: true
hideMenuOnActivated: false
indication: showCObjects
)
(MenuItem
label: 'Others'
translateLabel: true
hideMenuOnActivated: false
indication: showOthers
)
)
nil
nil
)
)
(MenuItem
label: 'Module'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: notReadOnly
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
)
)
!
tableColumnsForSingleInfo
"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:Tools::ObjectModuleInformation andSelector:#tableColumnsForSingleInfo
"
<resource: #tableColumns>
^#(
(DataSetColumnSpec
label: ''
activeHelpKey: ''
labelButtonType: None
width: 0.3
model: name
canSelect: false
)
(DataSetColumnSpec
label: ''
activeHelpKey: ''
labelButtonType: None
model: value
canSelect: false
)
)
! !
!ObjectModuleInformation methodsFor:'aspects'!
infoTable1ListHolder
^ builder valueAspectFor:#'infoTable1ListHolder' initialValue:#()
"Created: / 05-10-2007 / 12:48:06 / cg"
!
infoTable2ListHolder
^ builder valueAspectFor:#'infoTable2ListHolder' initialValue:#()
"Created: / 05-10-2007 / 12:48:10 / 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"
!
notReadOnly
^ self readOnly not
"Created: / 05-10-2007 / 13:06:00 / cg"
!
readOnly
^ readOnly ? false
"Created: / 05-10-2007 / 13:05:51 / cg"
!
selectedModuleIndexHolder
selectedModuleIndexHolder isNil ifTrue:[
selectedModuleIndexHolder := ValueHolder new.
selectedModuleIndexHolder onChangeSend:#selectedModuleIndexChanged to:self.
].
^ selectedModuleIndexHolder.
"Modified: / 05-10-2007 / 10:51:39 / cg"
!
showBuiltIn
showBuiltIn isNil ifTrue:[
showBuiltIn := true asValue.
showBuiltIn onChangeSend:#filterChanged to:self.
].
^ showBuiltIn
"Modified: / 05-10-2007 / 12:43:23 / cg"
!
showCObjects
showCObjects isNil ifTrue:[
showCObjects := true asValue.
showCObjects onChangeSend:#filterChanged to:self.
].
^ showCObjects
"Modified: / 05-10-2007 / 12:43:16 / cg"
!
showClassLibs
showClassLibs isNil ifTrue:[
showClassLibs := true asValue.
showClassLibs onChangeSend:#filterChanged to:self.
].
^ showClassLibs
"Modified: / 05-10-2007 / 12:43:10 / cg"
!
showMethods
showMethods isNil ifTrue:[
showMethods := true asValue.
showMethods onChangeSend:#filterChanged to:self.
].
^ showMethods
"Modified: / 05-10-2007 / 12:43:02 / cg"
!
showOthers
showOthers isNil ifTrue:[
showOthers := true asValue.
showOthers onChangeSend:#filterChanged to:self.
].
^ showOthers
"Modified: / 05-10-2007 / 12:42:54 / cg"
!
table1VisibleHolder
table1VisibleHolder isNil ifTrue:[
table1VisibleHolder := true asValue.
].
^ table1VisibleHolder.
"Modified: / 05-10-2007 / 12:53:05 / cg"
!
table2VisibleHolder
table2VisibleHolder isNil ifTrue:[
table2VisibleHolder := false asValue.
].
^ table2VisibleHolder.
"Modified: / 05-10-2007 / 12:53:14 / cg"
! !
!ObjectModuleInformation methodsFor:'change & update'!
selectedModuleIndexChanged
|sel info|
sel := self selectedModuleIndexHolder value.
sel notNil ifTrue:[
(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 / 12:56:13 / cg"
!
showInfoForClassLib:info
"/ selected a package; fill bottom list with class-info
|classNames rows|
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
].
].
rows := classNames collect:[:cName |
|cls entry rev listEntry revisionInfo|
listEntry := InfoRow new.
listEntry name:cName.
cls := Smalltalk classNamed:cName.
cls isNil ifTrue:[
(cName endsWith:'_extensions') ifFalse:[
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 infoTable1ListHolder value:rows.
self table1VisibleHolder value:true.
self table2VisibleHolder value:false.
"Modified: / 05-10-2007 / 13:03:56 / cg"
!
showInfoForNonClassLib:sel
"/ selected a method, cObject or unknown
|module fileName list entry|
module := objectHandles at:sel.
fileName := module pathName.
module isMethodHandle ifTrue:[
|method nm entry1 entry2 entry3|
self middleLabelHolder value:'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'; value:nm.
entry2 := InfoRow new.
entry2 name:'Path'; value:fileName.
entry3 := InfoRow new.
entry3 name:'Address'; value:('(16r) ' , (method code address hexPrintString leftPaddedTo:8 with:$0)).
self infoTable2ListHolder value:(Array with:entry1 with:entry2 with:entry3).
self table1VisibleHolder value:false.
self table2VisibleHolder value:true.
^ self.
].
(module isFunctionObjectHandle
and:[module functions notEmpty]) ifTrue:[
self middleLabelHolder value:'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 value:('address: (16r) ' , (f code address hexPrintString leftPaddedTo:8 with:$0)).
entry
].
self infoTable2ListHolder value:list.
self table1VisibleHolder value:false.
self table2VisibleHolder value:true.
^ self.
].
entry := InfoRow new.
entry name:'Unknown'.
self infoTable2ListHolder value:(Array with:entry).
self table1VisibleHolder value:false.
self table2VisibleHolder value:true.
"Modified: / 05-10-2007 / 13:01:33 / 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 infoTable1ListHolder value:l.
self table1VisibleHolder value:true.
self table2VisibleHolder value:false.
"/ readOnly ifFalse:[
"/ unloadButton disable.
"/ unloadAndRemoveButton disable.
"/ ]
"Modified: / 05-10-2007 / 12:53:44 / 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
self openHTMLDocument: 'tools/misc/TOP.html#MODULEINFO'
"Modified: / 05-10-2007 / 13:11:45 / cg"
! !
!ObjectModuleInformation methodsFor:'private'!
filterChanged
self updateModuleList
"Created: / 05-10-2007 / 12:43:36 / cg"
!
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.
objectHandles := handles.
"Modified: / 05-10-2007 / 12:45:37 / 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.
!
value
^ value
!
value:something
value := something.
!
version
^ version
!
version:something
version := something.
! !
!ObjectModuleInformation class methodsFor:'documentation'!
version
^ '$Header$'
! !