"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libtool' }"
SimpleView subclass:#InspectorView
instanceVariableNames:'listView labelView workspace inspectedObject selectedLine nShown
hasMore monitorProcess hideReceiver showHex inspectHistory
allowFollow isStandaloneInspector selectionIndex object
inspectedObjectHolder displayStringMessage suppressPseudoSlots
dereferenceValueHolders'
classVariableNames:'DefaultIcon IdDictionary NextSequentialID'
poolDictionaries:''
category:'Interface-Inspector'
!
!InspectorView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
This class implements a graphical inspector.
Inspecting can be done on an object -
(where its instvarnames/values are inspected)
or a list of objects (where a nameArray/valuesArray is inspected).
The later is used by the debugger to inspect method variables/args.
The system calls the inspector through the global variable 'Inspector'
which is bound to this class (but could be redefined - it actually is
set to MiniInspector in a smalltalk without graphical user interface,
or to NewInspector if that is wanted).
Also notice, that there are two methods to inspect an object:
sending #basicInspect to any object, will open this kind of inspector on
it (showing instance variables which are physically present).
Sending it #inspect, will - depending on the object - sometimes invoke a
specialized inspector.
(see OrderedCollectionInspectorView, ImageInspectorView,
ColorInspectorView etc. as examples).
You can also open a monitoring inspector, which displays some instance
variable in regular intervals. See #openOn:monitor:.
examples:
#(1 2 3 4) asOrderedCollection inspect
#(1 2 3 4) asOrderedCollection basicInspect
(Array new:10000) inspect
(Image fromFile:'bitmaps/claus.gif') inspect
(Image fromFile:'bitmaps/claus.gif') basicInspect
(Image fromFile:'bitmaps/SBrowser.xbm') inspect
(Image fromFile:'bitmaps/SBrowser.xbm') basicInspect
InspectorView openOn:Display
InspectorView openOn:Display monitor:'shiftDown'
The InspectorView can also be used as a subComponent within another view.
In this case, the isStandAlone flag should be cleared, to prevent the
inspector from changing the topViews window label.
Notice:
the instvars 'inspectedObject' and 'selectedLine' have been
renamed to 'object' and 'selectionIndex' for squeak compatibility;
however, the old vars are kept (in sync) for a while, to allow for
smooth migration.
[author:]
Claus Gittinger
"
! !
!InspectorView class methodsFor:'instance creation'!
for:anObject
"create and launch a new inspector for anObject.
This protocol is a historic leftover - this method will vanish."
^ self openOn:anObject
!
inspect:anObject
"create and launch a new inspector for anObject.
This protocol is a historic leftover - this method will vanish."
^ self openOn:anObject
!
openOn:anObject
"create and launch a new inspector for anObject"
^ self openOn:anObject monitor:nil
"
InspectorView openOn:(5 @ 7)
InspectorView openOn:(Array new:400)
DictionaryInspectorView openOn:(IdentityDictionary new)
"
"Modified: 1.3.1996 / 19:31:03 / cg"
!
openOn:anObject monitor:anInstVarName
"create and launch a new inspector for anObject.
If anInstVarName is nonNil, let the inspector monitor it
(use an integer-printString as name, for indexed instVars)."
|topView inspectorView|
topView := StandardSystemView new.
topView icon:self defaultIcon.
"/ topView minExtent:(100 @ 100).
topView label:'Inspector'.
topView iconLabel:'Inspector'.
topView extent:(self defaultExtent).
inspectorView := self origin:(0.0 @ 0.0)
corner:(1.0 @ 1.0)
in:topView.
"kludge: must realize first, to be able to set menu again"
topView openAndWait.
topView windowGroup
focusSequence:(Array
with:inspectorView listView
with:inspectorView workspace).
inspectorView allowFollow:true.
inspectorView isStandaloneInspector:true.
inspectorView inspect:anObject.
anInstVarName notNil ifTrue:[
inspectorView monitor:anInstVarName
].
^ inspectorView
"
|m|
m := 1 asValue.
InspectorView openOn:m monitor:'value'.
2 to:10 do:[:i |
Delay waitForSeconds:1.
m value:i
]
"
"
|o|
o := Array with:1 with:2 with:3.
InspectorView openOn:o monitor:'2'.
Delay waitForSeconds:1.
o at:2 put:20
"
"Created: / 1.3.1996 / 19:30:50 / cg"
"Modified: / 12.2.1999 / 16:04:42 / cg"
!
openOn:anObject withEvalPane:withEvalPane
^ self openOn:anObject
!
openOn:anObject withEvalPane:withEvalPane withLabel:aLabel
^ self openOn:anObject
! !
!InspectorView class methodsFor:'defaults'!
defaultExtent
^ (Screen current extent // 3)
"Created: / 7.9.1998 / 13:47:45 / cg"
"Modified: / 7.9.1998 / 14:15:38 / cg"
!
defaultIcon
"return the browsers default window icon"
<resource: #style (#ICON #ICON_FILE)>
|nm i|
(i := DefaultIcon) isNil ifTrue:[
i := self classResources at:'ICON' default:nil.
i isNil ifTrue:[
nm := ClassResources at:'ICON_FILE' default:'Inspector.xbm'.
i := Smalltalk imageFromFileNamed:nm forClass:self.
i isNil ifTrue:[
i := StandardSystemView defaultIcon
]
].
i notNil ifTrue:[
DefaultIcon := i := i onDevice:Display
]
].
^ i
"Modified: 18.4.1997 / 15:16:53 / cg"
! !
!InspectorView class methodsFor:'queries-plugin'!
aspectSelectors
^ #( inspectedObjectHolder )
"Modified: / 10.2.2000 / 12:25:28 / cg"
! !
!InspectorView methodsFor:'accessing'!
allowFollow:aBoolean
"enable/disable the follow menu item;
This is disabled for inspectors which are embedded in the debugger"
allowFollow := aBoolean
!
dereferenceValueHolders:aBoolean
dereferenceValueHolders := aBoolean
!
fieldListLabel:aString
labelView label:aString
"Created: 28.6.1996 / 15:30:26 / cg"
!
hideReceiver:aBoolean
"hide/show the self-entry for the inspected object;
This is hidden for context inspectors in the debugger"
hideReceiver := aBoolean
"Created: 28.6.1996 / 15:08:32 / cg"
!
inspect:anObject
"define the object to be inspected"
|aList sameObject|
sameObject := anObject == inspectedObject and:[inspectedObject notNil].
inspectedObject := object := anObject.
sameObject ifFalse:[
hasMore := false.
aList := self fieldList.
hasMore ifTrue:[
aList add:' ... '
].
].
sameObject ifTrue:[
"/ listView setContents:aList.
] ifFalse:[
listView contents:aList.
workspace contents:nil.
self setDoItAction.
].
selectionIndex := selectedLine := nil.
isStandaloneInspector == true ifTrue:[
self topView
label:(self labelFor:anObject);
iconLabel:(self labelNameFor:anObject).
]
"Modified: / 12.2.1999 / 16:03:27 / cg"
!
isStandaloneInspector:aBoolean
"obsolete now"
isStandaloneInspector := aBoolean
"Modified: / 12.2.1999 / 16:01:44 / cg"
!
label:aString
"set the fieldListLabel - obsolete; collides with inherited label-functionality"
<resource:#obsolete>
self obsoleteMethodWarning:'use fieldListLabel:'.
self fieldListLabel:aString.
super label:aString.
"Created: 28.6.1996 / 15:30:26 / cg"
!
listView
^ listView
!
reinspect
"update display for a changed inspectedObject"
|aList|
hasMore := false.
aList := self fieldList.
hasMore ifTrue:[
aList add:' ... '
].
listView contents:aList.
"/ workspace contents:nil.
self setDoItAction.
selectionIndex := selectedLine := nil
!
suppressPseudoSlots:aBoolean
suppressPseudoSlots := aBoolean
!
workspace
^ workspace
! !
!InspectorView methodsFor:'accessing-channels'!
inspectedObjectHolder
inspectedObjectHolder isNil ifTrue:[
inspectedObjectHolder := ValueHolder new.
inspectedObjectHolder addDependent:self.
].
^ inspectedObjectHolder
"Created: / 10.2.2000 / 13:33:16 / cg"
"Modified: / 10.2.2000 / 13:34:23 / cg"
!
inspectedObjectHolder:aValueHolder
inspectedObjectHolder notNil ifTrue:[
inspectedObjectHolder removeDependent:self.
].
inspectedObjectHolder := aValueHolder.
inspectedObjectHolder notNil ifTrue:[
inspectedObjectHolder addDependent:self.
].
"Created: / 10.2.2000 / 13:34:53 / cg"
! !
!InspectorView methodsFor:'change & update'!
update:something with:aParameter from:changedObject
"Invoked when one of my dependees sends a change notification."
|oldSelection|
changedObject == inspectedObject ifTrue:[
oldSelection := listView selection.
self inspect:inspectedObject.
oldSelection notNil ifTrue:[
self showSelection:oldSelection
]
].
changedObject == inspectedObjectHolder ifTrue:[
self inspect:(inspectedObjectHolder value)
].
super update:something with:aParameter from:changedObject
"Created: / 10.2.2000 / 13:46:38 / cg"
"Modified: / 10.2.2000 / 13:48:18 / cg"
! !
!InspectorView methodsFor:'initialization & release'!
destroy
inspectedObject := object := nil.
monitorProcess notNil ifTrue:[
monitorProcess terminate
].
super destroy
!
initialize
|v panel helpView labelView2|
super initialize.
displayStringMessage := #displayString.
hideReceiver := false.
showHex := false.
allowFollow := false.
isStandaloneInspector := false.
panel := VariableHorizontalPanel
origin:(0.0 @ 0.0)
corner:(1.0 @ 1.0)
in:self.
helpView := View origin:(0.0 @ 0.0) corner:(0.3 @ 1.0) in:panel.
helpView level:0; borderWidth:0.
labelView := Label origin:0.0@0.0 corner:1.0@0.0 in:helpView.
labelView label:(self defaultLabel).
labelView bottomInset:(labelView preferredExtent y negated).
v := HVScrollableView
for:SelectionInListView
miniScrollerH:true
miniScrollerV:false
in:helpView.
"/ v autoHideScrollBars:true.
v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
v topInset:(labelView preferredExtent y).
listView := v scrolledView.
listView action:[:lineNr | self showSelection:lineNr].
listView doubleClickAction:[:lineNr | self doInspect].
listView ignoreReselect:false.
listView menuHolder:self; menuPerformer:self; menuMessage:#fieldMenu.
helpView := View origin:(0.3 @ 0.0) corner:(1.0 @ 1.0) in:panel.
helpView level:0; borderWidth:0.
labelView2 := Label origin:0.0@0.0 corner:1.0@0.0 in:helpView.
labelView2 label:''.
labelView2 bottomInset:(labelView preferredExtent y negated).
v := HVScrollableView
for:CodeView
miniScrollerH:true
miniScrollerV:false
in:helpView.
"/ v autoHideScrollBars:true.
v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
v topInset:(labelView2 preferredExtent y).
workspace := v scrolledView.
self setAcceptAction.
nShown := 100.
hasMore := false.
"Modified: / 12.2.1999 / 16:03:19 / cg"
!
realize
"delayed setup of lists till first map-time -
this makes startup of inspectors a bit faster"
|o|
super realize.
inspectedObject notNil ifTrue:[
"
kludge to trick inspect:, which ignores setting the
same object again ...
"
o := inspectedObject.
inspectedObject := object := nil.
self inspect:o
]
"Created: 30.5.1996 / 09:38:37 / cg"
!
release
"release inpected object. This is normally not needed,
since the garbage collector will find this memory alone.
However, if some applications keeps invisible inspectors around
(for example, the debugger does this), the inspected object
would be kept from being freed or freed very late."
"
inspectedObject notNil ifTrue:[
inspectedObject removeDependent:self
].
"
inspectedObject := object := nil.
self setDoItAction. "/ to release ref to inspectedObject in doItBlock
workspace contents:nil.
listView contents:nil.
super release.
"Modified: 11.6.1997 / 13:20:39 / cg"
! !
!InspectorView methodsFor:'menu'!
fieldMenu
"return the menu for the field-list"
<resource: #programMenu>
|items m sel|
items := #(
('Copy Name or Key' #doCopyKey )
('-')
('Inspect' #doInspect )
('BasicInspect' #doBasicInspect )
('Inspect Hierarchical' #doNewInspect )
('-')
('Ref Chains' #showReferences )
('-')
('Browse' #browse )
"/ ('Browse class hierarchy' #browseClassHierarchy )
"/ ('Browse full class protocol' #browseFullClassProtocol)
).
sel := self selection.
(sel isBlock or:[sel isContext]) ifTrue:[
items := items , #(
('Browse Blocks Home' #browseHome)
).
].
(inspectedObject isMethod or:[sel isMethod]) ifTrue:[
items := items , #(
('Browse Methods Class' #browseMethodsClass)
).
].
(sel isStream and:[self isExternalStream not]) ifTrue:[
items := items , #(
('-')
('Show Stream Contents' #showStreamContents)
).
].
items := items , #(
('-')
('Trap Message...' #doTrap )
('Trap all Messages' #doTrapAll )
('Trace all Messages' #doTraceAll )
('Untrace/Untrap' #doUntrace )
"/ ('-')
"/ ('Trap change to instVar' #doTrapInstVarChange )
"/ ('Trap change to any instVar' #doTrapAnyInstVarChange )
).
allowFollow ifTrue:[
items := #(
('Follow' #doFollow )
('Back' #doBack )
('-')
)
,
items.
].
hasMore ifTrue:[
items := items , #(
('-')
('Show More' #showMore )
)
].
monitorProcess isNil ifTrue:[
items := items , #(
('-')
('Start Monitor' #doStartMonitor )
).
] ifFalse:[
items := items , #(
('-')
('Stop Monitor' #doStopMonitor )
).
].
showHex ifTrue:[
items := items , #(
('-')
('Decimal Integers' #toggleHex )
)
] ifFalse:[
items := items , #(
('-')
('Hex Integers' #toggleHex )
)
].
m := PopUpMenu
itemList:items
resources:resources.
selectionIndex isNil ifTrue:[
m disableAll:#(doFollow doInspect doBasicInspect doNewInspect
browse browseClassHierarchy browseFullClassProtocol
doStartMonitor doCopyKey doCopyKey)
].
(selectionIndex == 1) ifTrue:[
m disableAll:#(doFollow doCopyKey)
].
inspectHistory size == 0 ifTrue:[
m disable:#doBack
].
self selection class hasImmediateInstances ifTrue:[
m disableAll:#(showReferences doNewInspect)
].
sel inspectorClass == self class ifFalse:[
m disable:#doFollow
].
sel isMethod ifFalse:[
m disable:#browseMethodsClass
].
^ m
"Modified: / 6.2.2000 / 13:48:09 / cg"
! !
!InspectorView methodsFor:'menu actions'!
browse
|cls|
cls := self selection class.
cls browserClass openInClass:cls selector:nil
"Created: / 14.12.1995 / 19:15:50 / cg"
"Modified: / 14.10.1998 / 15:32:10 / cg"
!
browseClass
|cls|
cls := self selection class.
cls browserClass browseClass:cls
"Modified: 3.5.1996 / 12:39:32 / cg"
!
browseClassHierarchy
|cls|
cls := self selection class.
cls browserClass browseClassHierarchy:cls
"Modified: 3.5.1996 / 12:40:04 / cg"
!
browseFullClassProtocol
|cls|
cls := self selection class.
cls browserClass browseFullClassProtocol:cls
"Modified: 3.5.1996 / 12:40:17 / cg"
!
browseHome
|sel mthd|
sel := self selection.
sel isBlock ifTrue:[
mthd := sel homeMethod
] ifFalse:[
sel isContext ifTrue:[
mthd := sel method.
]
].
mthd isNil ifTrue:[
^ self warn:'Sorry - cannot figure out home method.'
].
mthd class browserClass
openInClass:mthd mclass selector:mthd selector
!
browseMethodsClass
|mthd|
mthd := self selection.
mthd mclass browserClass
openInClass:mthd mclass selector:mthd selector
!
doBack
"user selected back-menu entry"
|objectToInspect|
inspectHistory size > 0 ifTrue:[
objectToInspect := inspectHistory removeLast.
inspectHistory size == 0 ifTrue:[
inspectHistory := nil
].
self inspect:objectToInspect.
]
"Created: / 22.9.1998 / 18:22:01 / cg"
"Modified: / 22.9.1998 / 18:22:28 / cg"
!
doBasicInspect
"user selected inspect-menu entry"
self doInspect:true
!
doFollow
"user selected follow-menu entry"
|objectToInspect|
selectionIndex notNil ifTrue:[
objectToInspect := self selection.
inspectHistory isNil ifTrue:[
inspectHistory := OrderedCollection new
].
inspectHistory addLast:inspectedObject.
self inspect:objectToInspect.
]
"Created: / 22.9.1998 / 18:21:08 / cg"
"Modified: / 22.9.1998 / 18:22:23 / cg"
!
doInspect
"user selected inspect-menu entry"
self doInspect:false
!
doNewInspect
self doInspect:#new
"Created: / 31.10.1997 / 12:45:38 / cg"
"Modified: / 31.10.1997 / 12:47:11 / cg"
!
doStartMonitor
"start a monitoring process"
monitorProcess isNil ifTrue:[
monitorProcess :=
[
|sel|
[true] whileTrue:[
(sel := selectionIndex) notNil ifTrue:[
self showSelection:sel
].
(Delay forSeconds:0.5) wait
]
] forkAt:Processor userBackgroundPriority
]
"Modified: 12.4.1996 / 14:20:06 / cg"
!
doStopMonitor
"stop the monitor"
monitorProcess terminate.
monitorProcess := nil
!
doTraceAll
"place a trace on all messages sent to the inspected object"
self topView withWaitCursorDo:[MessageTracer traceAll:inspectedObject on:Transcript]
!
doTrap
"place a trap on a message sent to the inspected object"
|string selector|
string := Dialog request:'Selector to trap on:' onCancel:nil.
string notNil ifTrue:[
selector := string asSymbolIfInterned.
selector isNil ifTrue:[
self warn:'no such selector'
] ifFalse:[
self topView withWaitCursorDo:[MessageTracer trap:inspectedObject
selector:selector]
]
]
"Modified: 12.4.1996 / 14:07:01 / cg"
!
doTrapAll
"place a trap on all messages sent to the inspected object"
self topView withWaitCursorDo:[MessageTracer trapAll:inspectedObject]
!
doTrapAnyInstVarChange
"place a trap which is triggered if any instVar of the inspected object is changed"
self topView withWaitCursorDo:[
MessageTracer trapModificationsIn:inspectedObject
]
!
doTrapInstVarChange
"place a trap which is triggered if the selected instVar of the inspected object is changed"
self topView withWaitCursorDo:[
|idx|
"/ a named instVar ?
idx := self instVarIndexForLine:selectionIndex.
idx isNil ifTrue:[
self warn:'select an instance variable first.'.
^ self.
].
MessageTracer
trapModificationsOf:(inspectedObject class allInstVarNames at:idx)
in:inspectedObject
]
!
doUntrace
"remove traps/traces"
MessageTracer untrace:inspectedObject
!
inspectOwners
"open an inspector on owners of the inspectedObject.
(this is a secret function)"
self withCursor:(Cursor questionMark) do:[
|owners dict|
owners := (ObjectMemory whoReferences:inspectedObject) asOrderedCollection.
owners size > 500 ifTrue:[
(self confirm:'there are ' , owners size printString , ' owners.\\Do you really want to see them all ?' withCRs)
ifFalse:[^ self]
].
dict := IdentityDictionary new.
owners do:[:owner |
|set names oClass|
owner ~~ self ifTrue:[
set := Set new.
names := owner class allInstVarNames.
oClass := owner class.
1 to:oClass instSize do:[:i |
(owner instVarAt:i) == inspectedObject ifTrue:[
set add:(names at:i).
].
].
oClass isVariable ifTrue:[
oClass isPointers ifTrue:[
1 to:owner basicSize do:[:i |
(owner basicAt:i) == inspectedObject ifTrue:[
set add:i
]
]
]
].
dict at:owner put:set
].
].
dict inspect
]
!
showStreamContents
|sel|
sel := self selection.
(sel isStream and:[sel isExternalStream not]) ifTrue:[
workspace replace:(sel contents printString)
].
"Created: / 6.2.2000 / 13:46:37 / cg"
"Modified: / 6.2.2000 / 13:47:37 / cg"
! !
!InspectorView methodsFor:'private'!
baseInspectedObjectClass
^ Object
!
basicDisplayStringForValue:someValue
"return the values displayString"
|s sel|
sel := listView at:selectionIndex.
Error handle:[:ex |
s := someValue classNameWithArticle.
displayStringMessage == #displayString ifTrue:[
s := s , ' "error in displayString: ' , ex description , '"'
] ifFalse:[
s := s , ' "error in displayString (' , displayStringMessage , '): ' , ex description , '"'
]
] do:[
showHex ifTrue:[
someValue isInteger ifTrue:[
^ '16r' , someValue hexPrintString
].
(someValue isMemberOf:ByteArray) ifTrue:[
^ String streamContents:[:s | inspectedObject asByteArray printOn:s base:16 showRadix:true]
"/ s := '' writeStream.
"/ s nextPutAll:'#['.
"/ someValue keysAndValuesDo:[:i :byte |
"/ i ~~ 1 ifTrue:[
"/ s space
"/ ].
"/ s nextPutAll:'16r'.
"/ s nextPutAll:(byte hexPrintString leftPaddedTo:2 with:$0).
"/ ].
"/ s nextPutAll:']'.
"/ s := s contents
]
].
"/ displayStringMessage := #classNameWithArticle
"/ displayStringMessage := #displayString
"/ displayStringMessage := #printString
s := someValue perform:displayStringMessage.
].
^ s.
"Modified: / 31.10.2001 / 10:44:16 / cg"
!
defaultLabel
^ 'InstVars'
"Modified: 28.6.1996 / 16:04:53 / cg"
!
displayStringForValue:someValue
"return the values displayString"
|sel radix|
sel := listView at:selectionIndex.
inspectedObject isNumber ifTrue:[
(sel startsWith:$-) ifTrue:[
(sel startsWith:'-hex') ifTrue:[
radix := 16.
].
(sel startsWith:'-oct') ifTrue:[
radix := 8.
].
(sel startsWith:'-bin') ifTrue:[
radix := 2.
].
radix notNil ifTrue:[
^ inspectedObject radixPrintStringRadix:radix
]
]
].
(inspectedObject isKindOf:Method) ifTrue:[
(sel startsWith:'-code') ifTrue:[
^ String streamContents:[:s | inspectedObject decompileTo:s]
].
].
(inspectedObject isKindOf:Text) ifTrue:[
(sel startsWith:'-text') ifTrue:[
^ inspectedObject
].
].
(inspectedObject isKindOf:ByteArray) ifTrue:[
(sel startsWith:'-hex') ifTrue:[
^ String streamContents:
[:s |
inspectedObject class isWords ifTrue:[
inspectedObject asWordArray printOn:s base:16 showRadix:true
] ifFalse:[
inspectedObject class isLongs ifTrue:[
inspectedObject asLongIntegerArray printOn:s base:16 showRadix:true
] ifFalse:[
inspectedObject asByteArray printOn:s base:16 showRadix:true
]
]
]
].
].
(sel startsWith:'-all inst vars') ifTrue:[
^ self stringWithAllInstVarValues
].
(sel startsWith:'-all indexed vars') ifTrue:[
^ self stringWithAllIndexedVarValues
].
^ self basicDisplayStringForValue:someValue
!
fieldList
"return a list of names to show in the selectionList.
Leave hasMore as true, if a '...' entry should be added."
|aList cls indexedList|
inspectedObject isNil ifTrue:[
^ self hasSelfEntry ifFalse:[ #() ] ifTrue:[ #('-self') ]
].
cls := inspectedObject class.
self topView withWaitCursorDo:[
aList := self namedFieldList.
indexedList := self indexedFieldList.
self hasSelfEntry ifTrue:[
self suppressPseudoSlots ifFalse:[
(indexedList notNil and:[self showAllIndexedVarsInFieldList]) ifTrue:[
aList addFirst:'-all indexed vars'.
].
cls instSize > 0 ifTrue:[
aList addFirst:'-all inst vars'.
].
cls hasImmediateInstances ifFalse:[
aList addFirst:'-dependents'.
].
aList addFirst:'-identityHash'.
aList addFirst:'-hash'.
aList addFirst:'-self'.
].
].
indexedList notNil ifTrue:[aList addAll:indexedList].
].
^ aList
"Modified: / 31.10.2001 / 09:14:10 / cg"
!
hasSelfEntry
^ hideReceiver not and:[self suppressPseudoSlots not]
"Created: 14.12.1995 / 19:30:03 / cg"
"Modified: 28.6.1996 / 15:13:41 / cg"
!
indexList
"return a list of indexes to show in the selectionList.
Set hasMore to true, if a '...' entry should be added."
| n cls|
cls := inspectedObject class.
cls isVariable ifFalse:[^ nil ].
n := inspectedObject basicSize.
(n > nShown) ifTrue:[
n := nShown.
hasMore := true.
].
^ (1 to:n)
!
indexedFieldList
"return a list of indexed-variable names to show in the selectionList.
Set hasMore to true, if a '...' entry should be added."
|l|
l := self indexList.
l isNil ifTrue:[^ nil ].
^ l collect:[:i | i printString].
!
indexedValueAtIndex:idx
^ inspectedObject basicAt:idx
!
indexedValueAtIndex:idx put:newValue
inspectedObject basicAt:idx put:newValue
!
indexedValueAtKey:key
"/ kludge
inspectedObject isLimitedPrecisionReal ifTrue:[
^ inspectedObject basicAt:key
].
^ inspectedObject at:key
!
instVarIndexForLine:lineNr
"helper - return the index for a named instVar;
nil, if self or a keyed instvar is selected."
|idx nNamedInstvarsShown cls baseCls firstRealIndex line|
lineNr isNil ifTrue:[^ nil].
firstRealIndex := 1.
idx := lineNr.
self hasSelfEntry ifTrue:[
(lineNr == 1 or:[lineNr isNil]) ifTrue:[
^ nil "/ self selected
].
idx := idx - 1.
firstRealIndex := 2.
].
[line := listView at:firstRealIndex.
(line startsWith:'-') and:[line size < 2 or:[line second isDigit not]]] whileTrue:[
firstRealIndex := firstRealIndex + 1.
idx := idx - 1.
].
cls := inspectedObject class.
baseCls := self baseInspectedObjectClass.
nNamedInstvarsShown := cls instSize.
"/ only the namedInstvars below baseInspectedObjectClass
"/ are shown ...
(cls == baseCls or:[cls isSubclassOf:baseCls]) ifTrue:[
nNamedInstvarsShown := nNamedInstvarsShown - baseCls instSize.
].
idx <= nNamedInstvarsShown ifTrue:[
^ idx + self baseInspectedObjectClass instSize.
].
^ nil "/ indexed instvar or other selected
"Modified: / 31.10.2001 / 09:20:20 / cg"
!
keyIndexForLine:lineNr
"helper - return the index of the key-list;
nil, if self or a namedInstVar is selected."
|idx nNamedInstvarsShown cls baseCls firstRealIndex line|
lineNr isNil ifTrue:[^ nil].
firstRealIndex := 1.
idx := lineNr.
self hasSelfEntry ifTrue:[
(lineNr == 1 or:[lineNr isNil]) ifTrue:[
^ nil "/ self selected
].
idx := idx - 1.
firstRealIndex := firstRealIndex + 1.
].
[line := listView at:firstRealIndex.
line notNil
and:[(line startsWith:'-') and:[line size < 2 or:[line second isDigit not]]]
] whileTrue:[
firstRealIndex := firstRealIndex + 1.
idx := idx - 1.
].
cls := inspectedObject class.
baseCls := self baseInspectedObjectClass.
nNamedInstvarsShown := cls instSize.
"/ only the namedInstvars below baseInspectedObjectClass
"/ are shown ...
(cls == baseCls or:[cls isSubclassOf:baseCls]) ifTrue:[
nNamedInstvarsShown := nNamedInstvarsShown - baseCls instSize.
].
idx <= nNamedInstvarsShown ifTrue:[
^ nil "/ named instVar selected.
].
^ idx - nNamedInstvarsShown.
"Modified: / 31.10.2001 / 09:21:13 / cg"
!
namedFieldList
"return a list of instVar names to show in the selectionList."
|aList cls baseCls|
cls := inspectedObject class.
baseCls := self baseInspectedObjectClass.
aList := OrderedCollection new.
inspectedObject isInteger ifTrue:[
aList addLast:'-hexadecimal'.
aList addLast:'-octal'.
aList addLast:'-binary'.
].
(inspectedObject isKindOf:Text) ifTrue:[
aList addLast:'-text'.
].
(inspectedObject isKindOf:ByteArray) ifTrue:[
aList addLast:'-hexadecimal'.
].
(inspectedObject isKindOf:Method) ifTrue:[
aList addLast:'-source'.
aList addLast:'-code'.
].
aList addAll:(cls allInstVarNames).
(cls == baseCls or:[cls isSubclassOf:baseCls]) ifTrue:[
"/ hide some stuff
aList := aList copyFrom:(self baseInspectedObjectClass instSize + 1).
].
^ aList
"Modified: / 31.10.2001 / 10:44:29 / cg"
!
setAcceptAction
"set the codeViews accept action"
|acceptAction sel|
acceptAction := [:theText | self doAccept:theText asString].
(selectionIndex isNil
or:[ inspectedObject class hasImmediateInstances])
ifTrue:[
acceptAction := nil.
] ifFalse:[
sel := listView at:selectionIndex.
(sel startsWith:'-all') ifTrue:[
acceptAction := nil.
].
(sel startsWith:'-hash') ifTrue:[
acceptAction := nil.
].
(sel startsWith:'-identityHash') ifTrue:[
acceptAction := nil.
].
(sel startsWith:'-dependents') ifTrue:[
acceptAction := nil.
].
(sel startsWith:'-source') ifTrue:[
acceptAction := nil.
].
].
workspace acceptAction:acceptAction.
!
setDoItAction
"set the codeViews doit action"
workspace
doItAction:[:theCode |
|evaluator|
(evaluator := inspectedObject class evaluatorClass)
notNil ifTrue:[
evaluator
evaluate:theCode
in:nil
receiver:inspectedObject
notifying:workspace
logged:true
ifFail:nil
] ifFalse:[
'objects class provides no evaluator'
]
].
inspectedObject class evaluatorClass isNil ifTrue:[
workspace doItAction:nil.
workspace acceptAction:nil.
]
"Modified: 1.8.1997 / 21:47:09 / cg"
!
showAllIndexedVarsInFieldList
^ true
!
showMore
|o|
hasMore ifTrue:[
nShown := nShown * 2.
"/ force update (which is otherwise ignored)
o := inspectedObject.
inspectedObject := object := nil.
self inspect:o
]
"Modified: / 26.8.1998 / 19:05:25 / cg"
!
showSelection:lineNr
"user clicked on an instvar - show value in workspace"
|val|
(hasMore and:[lineNr == listView list size]) ifTrue:[
"clicked on the '...' entry"
self showMore.
listView setSelection:lineNr.
].
self hasSelfEntry ifTrue:[
(self hasSelfEntry and:[lineNr == 1]) ifTrue:[
"selecting self also does a re-set, this allows updating the list"
self reinspect.
].
].
selectionIndex := selectedLine := lineNr.
val := self selection.
self dereferenceValueHolders ifTrue:[
val := val value
].
self showValue:val.
self setAcceptAction.
"Modified: / 30.7.1998 / 13:36:33 / cg"
!
showValue:someValue
"user clicked on an entry - show value in workspace"
|s|
self topView withWaitCursorDo:[
s := self displayStringForValue:someValue.
workspace replace:s.
].
!
stringWithAllIndexedVarValues
|nIdx s names maxLen varString padLeft|
nIdx := inspectedObject size.
s := '' writeStream.
names := self indexList.
names size > 0 ifTrue:[
maxLen := (names collect:[:eachName | eachName printString size]) max.
padLeft := names conform:[:eachIdx | eachIdx isInteger].
names do:[:eachIdx |
|val|
padLeft ifTrue:[
s nextPutAll:(eachIdx printStringLeftPaddedTo:maxLen).
] ifFalse:[
s nextPutAll:((eachIdx printString , ' ') paddedTo:maxLen+1 with:$.).
].
s nextPutAll:' : '.
val := self indexedValueAtKey:eachIdx.
varString := self basicDisplayStringForValue:val.
(varString includes:Character cr) ifTrue:[
varString := varString copyTo:(varString indexOf:Character cr)-1.
varString := varString , '...'.
].
s nextPutLine:varString.
].
].
nShown < nIdx ifTrue:[
s nextPutLine:' ...'.
].
^ s contents
!
stringWithAllInstVarValues
|s names maxLen varString|
s := WriteStream on:Unicode32String new.
names := inspectedObject class allInstVarNames.
maxLen := (names collect:[:eachName | eachName size]) max.
names keysAndValuesDo:[:eachInstVarIndex :eachInstVarName |
s nextPutAll:((eachInstVarName , ' ') paddedTo:maxLen+1 with:$.).
s nextPutAll:' : '.
varString := self basicDisplayStringForValue:(inspectedObject instVarAt:eachInstVarIndex).
(varString includes:Character cr) ifTrue:[
varString := varString copyTo:(varString indexOf:Character cr)-1.
varString := varString , '...'.
].
s nextPutAll:varString.
s cr.
].
^ s contents asSingleByteStringIfPossible
!
valueAtLine:lineNr
"helper - return the value of the selected entry"
|idx l|
(self hasSelfEntry
and:[lineNr == 1 or:[lineNr isNil]]) ifTrue:[
^ inspectedObject
].
((l := listView at:lineNr) startsWith:$-) ifTrue:[
(l ~= '-' and:[(l at:2) isDigit not "negative number"]) ifTrue:[
^ self valueForSpecialLine:(listView at:lineNr)
].
].
"/ a named instVar ?
idx := self instVarIndexForLine:lineNr.
idx notNil ifTrue:[
BreakPointInterrupt catch:[
^ inspectedObject instVarAt:idx
]
].
"/ an indexed instVar ?
idx := self keyIndexForLine:lineNr.
idx notNil ifTrue:[
BreakPointInterrupt catch:[
^ self indexedValueAtIndex:idx.
]
].
"/ nope
^ nil
"Modified: / 16.11.2001 / 16:19:04 / cg"
!
valueAtLine:lineNr put:newValue
|idx|
idx := self instVarIndexForLine:selectionIndex.
idx notNil ifTrue:[
inspectedObject instVarAt:idx put:newValue.
] ifFalse:[
idx := self keyIndexForLine:selectionIndex.
idx notNil ifTrue:[
self indexedValueAtIndex:idx put:newValue.
] ifFalse:[
^ self "/ self selected - dont store
]
].
!
valueForSpecialLine:line
(line startsWith:'-self') ifTrue:[
^ inspectedObject
].
(line startsWith:'-hash') ifTrue:[
^ inspectedObject hash
].
(line startsWith:'-identityHash') ifTrue:[
^ inspectedObject identityHash
].
(line startsWith:'-dependents') ifTrue:[
^ inspectedObject dependents
].
(line startsWith:'-source') ifTrue:[
^ inspectedObject source
].
(line startsWith:'-text') ifTrue:[
^ inspectedObject
].
(line startsWith:'-hex') ifTrue:[
^ inspectedObject
].
(line startsWith:'-octal') ifTrue:[
^ inspectedObject
].
(line startsWith:'-binary') ifTrue:[
^ inspectedObject
].
(line startsWith:'-code') ifTrue:[
^ inspectedObject
].
(line startsWith:'-all') ifTrue:[
^ inspectedObject
].
self error:'unknown special line'.
"Created: / 31.10.2001 / 09:17:45 / cg"
! !
!InspectorView methodsFor:'queries'!
canInspect:anObject
^ anObject inspectorClass == self class
!
compilerClass
^ inspectedObject class compilerClass
!
dereferenceValueHolders
^ dereferenceValueHolders ? false
!
labelFor:anObject
"return the windowLabel to use in my topView, when inspecting anObject."
|lbl id|
(self class == InspectorView
and:[anObject inspectorClass ~~ InspectorView]) ifTrue:[
lbl := 'BasicInspector on: '
] ifFalse:[
lbl := 'Inspector on: '
].
(anObject isImmediate
or:[anObject isBoolean]) ifFalse:[
lbl := lbl , '<%2> '
].
lbl := lbl , '%1'.
IdDictionary isNil ifTrue:[
IdDictionary := WeakIdentityDictionary new.
].
[
id := IdDictionary
at:anObject
ifAbsentPut:[
|nextID|
nextID := NextSequentialID ? 0.
NextSequentialID := nextID + 1.
nextID
].
] valueUninterruptably.
^ self class classResources
string:lbl
with:(self labelNameFor:anObject)
with:id
!
labelNameFor:anObject
"return the iconLabel to use in my topView, when inspecting anObject.
Simply returns the className or name of anObjects class"
|s|
anObject isClass ifTrue:[
s := anObject displayString
] ifFalse:[
((anObject class == SmallInteger)
or:[anObject isBoolean]) ifTrue:[
s := anObject printString , ', ' , anObject classNameWithArticle
] ifFalse:[
s := anObject classNameWithArticle
].
].
s isNil ifTrue:[
anObject isBehavior ifTrue:[
^ 'someBehavior'
].
^ 'something'
].
^ s
"
1234 inspect
true inspect
$a inspect
"
!
selectedKeyName
selectionIndex notNil ifTrue:[
^ listView listAt:selectionIndex.
].
^ nil
!
suppressPseudoSlots
^ suppressPseudoSlots ? false
! !
!InspectorView methodsFor:'user interaction'!
doAccept:theText
|sel newValue|
sel := listView at:selectionIndex.
(sel startsWith:'-all') ifTrue:[
workspace flash.
^ self.
].
Error handle:[:ex |
workspace flash
] do:[
newValue := inspectedObject class evaluatorClass
evaluate:theText
receiver:inspectedObject
notifying:workspace.
self dereferenceValueHolders ifTrue:[
(self valueAtLine:selectionIndex) value:newValue
] ifFalse:[
self valueAtLine:selectionIndex put:newValue.
]
]
!
doCopyKey
"put the instVar-name into the text-copy-buffer"
|nm|
selectionIndex notNil ifTrue:[
nm := listView listAt:selectionIndex.
nm notNil ifTrue:[
self setClipboardText:(nm asString)
]
]
!
doInspect:basic
"user selected inspect-menu entry"
|objectToInspect|
selectionIndex notNil ifTrue:[
objectToInspect := self selection.
basic == #new ifTrue:[
NewInspector::NewInspectorView inspect:objectToInspect
] ifFalse:[
basic ifTrue:[
objectToInspect basicInspect
] ifFalse:[
objectToInspect inspect
]
]
]
"Modified: / 31.10.1997 / 12:46:53 / cg"
!
doUpdate
self reinspect
!
keyPress:aKey x:x y:y
"all my input is passed on to the workspace-field"
x notNil ifTrue:[
"/ not already delegated
workspace keyPress:aKey x:-1 y:-1
].
"Modified: 4.3.1996 / 22:21:37 / cg"
!
monitor:anInstVarName
"start a monitoring process, showing the given instVar
in regular intervals."
|ivName|
(ivName := anInstVarName) isInteger ifTrue:[
ivName := anInstVarName printString
].
listView selectElement:ivName.
self doStartMonitor
"Created: / 1.3.1996 / 19:31:45 / cg"
"Modified: / 12.2.1999 / 16:05:47 / cg"
!
selection
"helper - return the value of the selected entry"
^ self valueAtLine:selectionIndex
!
showLast
"user clicked on an instvar - show value in workspace"
|lastIdx|
lastIdx := listView list size.
lastIdx ~~ 0 ifTrue:[
self showSelection:lastIdx.
listView selection:lastIdx.
]
"Created: 28.6.1996 / 15:06:38 / cg"
"Modified: 18.3.1997 / 18:22:54 / cg"
!
showReferences
"user selected references-menu entry"
self selection class hasImmediateInstances ifTrue:[
^ self warn:'Sorry - cannot show references to immediate objects'
].
ObjectMemory displayRefChainTo:(self selection)
"Modified: / 30.7.1998 / 14:03:16 / cg"
!
toggleHex
|sel|
showHex := showHex not.
sel := listView selection.
sel notNil ifTrue:[
self showSelection:sel
]
"Created: / 7.5.1998 / 01:54:52 / cg"
"Modified: / 7.5.1998 / 02:00:10 / cg"
!
tryToSelectKeyNamed:aString
|list idx|
list := listView list.
list notNil ifTrue:[
(idx := list indexOf:aString) ~= 0 ifTrue:[
listView selection:idx
].
].
"Created: / 16.11.2001 / 13:48:51 / cg"
! !
!InspectorView methodsFor:'workspace protocol'!
modified:aBoolean
^ workspace modified:aBoolean
!
saveAs:file doAppend:doAppend
workspace saveAs:file doAppend:doAppend
! !
!InspectorView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.157 2004-11-11 09:51:15 cg Exp $'
! !