--- a/NewLauncher.st Fri Jul 31 20:08:36 1998 +0200
+++ b/NewLauncher.st Fri Jul 31 20:13:25 1998 +0200
@@ -2802,317 +2802,9 @@
objectModuleDialog
"opens a moduleInfo dialog"
- |allModules moduleNames
- allObjects methodObjects methodNames
- cObjects cObjectNames
- otherObjects otherObjectNames
- box l handles unloadButton
- list1 list2 listView1 listView2
- y panel
- showBuiltIn showModules showMethods showCObjects showOthers
- moduleListUpdater check canDoIt menu|
-
- showBuiltIn := true asValue.
- canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
-
- showModules := canDoIt asValue.
- showMethods := canDoIt asValue.
- showCObjects := canDoIt asValue.
- showOthers := canDoIt asValue.
-
- list1 := SelectionInList new.
- list2 := SelectionInList new.
-
- moduleListUpdater := [
- |l|
-
- list2 list:nil.
-
- l := Array new.
- handles := Array new.
-
- (showModules value or:[showBuiltIn value]) ifTrue:[
- allModules := ObjectMemory binaryModuleInfo asOrderedCollection.
- (showBuiltIn value and:[showModules value]) ifFalse:[
- allModules := allModules select:[:i |
- |wantToSee|
-
- wantToSee := i dynamic.
- showBuiltIn value 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].
- l := l , moduleNames.
- handles := handles , allModules.
- ].
-
- showMethods value ifTrue:[
- allObjects := ObjectFileLoader loadedObjectHandles.
- 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 , ')'
- ].
- ].
- l := l , methodNames.
- handles := handles , methodObjects.
- ].
-
- showCObjects value ifTrue:[
- allObjects := ObjectFileLoader loadedObjectHandles.
- cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray.
- cObjectNames := cObjects collect:[:entry | entry pathName].
- l := l , cObjectNames.
- handles := handles , cObjects.
- ].
-
- showOthers value ifTrue:[
- allObjects := ObjectFileLoader loadedObjectHandles.
- otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle
- or:[h isMethodHandle
- or:[h isClassLibHandle]]) not]) asArray.
- otherObjectNames := otherObjects collect:[:entry | entry pathName].
- l := l , otherObjectNames.
- handles := handles , otherObjects.
- ].
-
- list1 list:l.
- unloadButton disable.
- ].
-
- showBuiltIn onChangeSend:#value to:moduleListUpdater.
- showModules onChangeSend:#value to:moduleListUpdater.
- showMethods onChangeSend:#value to:moduleListUpdater.
- showCObjects onChangeSend:#value to:moduleListUpdater.
- showOthers onChangeSend:#value to:moduleListUpdater.
-
- box := Dialog new.
- box label:(resources string:'Module dialog').
-
- listView1 := HVScrollableView for:SelectionInListView miniScrollerH:true.
- listView1 model:list1.
- listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.
- listView1 action:[:sel |
- |info classNames tabs module|
-
- listView1 middleButtonMenu:nil.
-
- box withWaitCursorDo:[
- |nm fileName addr entry1 entry2 entry3 method|
-
- tabs := TabulatorSpecification unit:#inch positions:#(0 2.6).
-
- (showModules value or:[showBuiltIn value]) ifTrue:[
- info := allModules at:sel ifAbsent:nil.
- ].
- info isNil ifTrue:[
- "/ selected a method, cObject or unknown
-
- module := handles at:sel.
- fileName := module pathName.
-
- module isMethodHandle ifTrue:[
-
- (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.
- SystemBrowser
- openInClass:(who methodClass)
- selector:(who methodSelector)
- ].
- listView1 middleButtonMenu:menu.
-
- nm := (method whoString) asText emphasizeAllWith:(#color->Color blue).
- ].
- entry1 := MultiColListEntry new:2 tabulatorSpecification:tabs.
- entry1 colAt:1 put:'compiled method'; colAt:2 put:nm.
-
- entry2 := MultiColListEntry new:2 tabulatorSpecification:tabs.
- entry2 colAt:1 put:'path'; colAt:2 put:fileName.
-
- entry3 := MultiColListEntry new:2 tabulatorSpecification:tabs.
- entry3 colAt:1 put:'address'; colAt:2 put:('(16r) ' , (method code hexPrintString leftPaddedTo:8 with:$0)).
-
- list2 list:(Array with:entry1 with:entry2 with:entry3).
- ] ifFalse:[
- (module isFunctionObjectHandle
- and:[module functions notEmpty]) ifTrue:[
-
- menu := PopUpMenu
- labels:#('inspect')
- selectors:#(inspect).
- menu actionAt:#inspect put:[ module functions inspect ].
- listView1 middleButtonMenu:menu.
-
- list2 list:((module functions select:[:f | f notNil])
- collect:[:f | |entry|
- entry := MultiColListEntry new:2 tabulatorSpecification:tabs.
- entry colAt:1 put:(f name asText emphasizeAllWith:(#color->Color blue)).
- entry colAt:2 put:('address: (16r) ' , (f code hexPrintString leftPaddedTo:8 with:$0)).
- entry
- ]).
- ] ifFalse:[
- list2 list:#('nothing known about contents (no functions have been extracted)').
- ]
- ].
-
- unloadButton enable.
- ] ifFalse:[
- "/ selected a package
-
- "/ fill bottom list with class-info
-
- classNames := info classNames asSortedCollection.
- classNames := classNames collect:[:cName |
- |cls entry rev listEntry|
-
- listEntry := MultiColListEntry new:2 tabulatorSpecification:tabs.
- listEntry colAt:1 put:cName.
-
- cls := Smalltalk classNamed:cName.
- cls isNil ifTrue:[
- listEntry colAt:2 put:'(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
- ].
- listEntry colAt:2 put:entry , ')'
- ] ifFalse:[
- cls revision notNil ifTrue:[
- listEntry colAt:2 put:'(overloaded by: ' , cls revision , ')'
- ]
- ]
- ].
- listEntry
- ].
- list2 list:classNames.
- info dynamic ifTrue:[
- unloadButton enable.
- ] ifFalse:[
- unloadButton disable.
- ].
- ]
- ]
- ].
-
-
- panel := HorizontalPanelView new.
-
- panel add:(l := Label label:(resources string:'show:')).
- l adjust:#left; borderWidth:0.
- panel add:(check := CheckBox label:(resources string:'builtin') model:showBuiltIn).
- box makeTabable:check.
- panel add:(check := CheckBox label:(resources string:'classLibs') model:showModules).
- canDoIt ifFalse:[
- check disable
- ] ifTrue:[
- box makeTabable:check.
- ].
- panel add:(check := CheckBox label:(resources string:'methods') model:showMethods).
- canDoIt ifFalse:[
- check disable
- ] ifTrue:[
- box makeTabable:check.
- ].
- panel add:(check := CheckBox label:(resources string:'c-objects') model:showCObjects).
- canDoIt ifFalse:[
- check disable
- ] ifTrue:[
- box makeTabable:check.
- ].
- panel add:(check := CheckBox label:(resources string:'others') model:showOthers).
- canDoIt ifFalse:[
- check disable
- ] ifTrue:[
- box makeTabable:check.
- ].
-
- panel horizontalLayout:#fitSpace.
- "/ panel horizontalLayout:#leftSpace.
-
- box addComponent:panel tabable:false.
-
- box addVerticalSpace.
- box addComponent:listView1 tabable:true.
- listView1 topInset:(View viewSpacing + panel preferredExtent y).
- listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.
-
- l := box addTextLabel:(resources string:(resources string:'contained classes/subsets:')).
- l adjust:#left; borderWidth:0.
- l origin:0.0@0.4 corner:1.0@0.4.
- l topInset:(View viewSpacing).
- l bottomInset:((l preferredExtent y) negated - View viewSpacing).
-
- listView2 := HVScrollableView for:SelectionInListView miniScrollerH:true.
- listView2 model:list2; printItems:false.
- box addComponent:listView2 tabable:true.
- listView2 origin:0.0@0.4 corner:1.0@1.0. "/ ; inset:2.
- listView2 disable.
-
- unloadButton := Button label:(resources string:'unload').
- unloadButton action:[
- self withWaitCursorDo:[
- box withWaitCursorDo:[
- |info idx pathName|
-
- idx := list1 selectionIndex.
- info := allModules at:idx ifAbsent:nil.
-
- list1 selectionIndex:nil.
-
- info isNil ifTrue:[
- "/ selected a method
- "/ idx := idx - allModules size.
- pathName := (handles at:idx) pathName.
-
- ] ifFalse:[
- "/ selected a package
- pathName := info pathName.
- ].
- ObjectFileLoader unloadObjectFile:pathName.
- moduleListUpdater value.
- unloadButton disable.
- ]
- ]
- ].
- moduleListUpdater value.
-
- box addButton:unloadButton.
- box addAbortButtonLabelled:(resources string:'dismiss').
-
- y := box yPosition.
- listView2 topInset:(l preferredExtent y + 5).
- listView2 bottomInset:(box preferredExtent y - y).
-
-"/ box width:(400 min:(box device width * 2 // 3));
-"/ height:(450 min:(box device height - 50));
-"/ sizeFixed:true.
- box open.
-
- box destroy.
-
- "Modified: / 17.9.1995 / 16:47:50 / claus"
- "Modified: / 23.4.1998 / 18:28:42 / cg"
+ ^ Launcher::LauncherDialogs objectModuleDialogFor:self
+
+ "Modified: / 31.7.1998 / 17:33:24 / cg"
!
saveImage
@@ -5570,5 +5262,5 @@
!NewLauncher class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.88 1998-07-31 01:23:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.89 1998-07-31 18:13:25 cg Exp $'
! !