"
COPYRIGHT (c) 1993 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' }"
InspectorView subclass:#ContextInspectorView
instanceVariableNames:'inspectedContext names showingTemporaries argsOnly contextSize'
classVariableNames:''
poolDictionaries:''
category:'Interface-Inspector'
!
!ContextInspectorView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1993 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
"
a modified Inspector for Contexts (used in the Debugger)
TODO:
when expressions are evaluated in myself, the inst-var
names are not known by the expression evaluator.
This has to be fixed
(actual work is to be done in the Parser to allow passing of a context ...)
[author:]
Claus Gittinger
[see also:]
Context DebugView
"
! !
!ContextInspectorView methodsFor:'accessing'!
inspect:aContext
"set the context to be inspected"
|homeContext method homeNames rec sel
argNames varNames tmpNames m argsOnly blockNode vars
numVarsInSource numVarsInContext isDoIt
numArgs numVars n tempNames realTempNames src
oldSelection oldSelectedName argAndVarNames|
(aContext == inspectedContext) ifTrue:[
"/ care for contexts which change size
"/ (after the locals & stack-setup)
contextSize == inspectedContext size ifTrue:[
listView selection notNil ifTrue:[
self showSelection:(listView selection).
].
^ self
]
].
hasMore := argsOnly := false.
inspectedObject := object := nil.
inspectedContext := aContext.
contextSize := inspectedContext size.
oldSelection := selectionIndex.
oldSelection notNil ifTrue:[oldSelectedName := listView at:oldSelection].
aContext isNil ifTrue:[
names := nil.
listView list:nil.
^ self
].
"/ realized ifFalse:[^ self].
homeContext := aContext methodHome.
homeContext isNil ifTrue:[
"its a cheap blocks context"
rec := aContext receiver.
sel := aContext selector.
homeNames := OrderedCollection new.
isDoIt := false.
] ifFalse:[
rec := homeContext receiver.
sel := homeContext selector.
"/ #doIt needs special handling below
isDoIt := (sel == #doIt) or:[sel == #doIt:].
method := homeContext method.
"/ implementorClass := homeContext methodClass.
"/ implementorClass notNil ifTrue:[
"/ method := implementorClass compiledMethodAt:sel.
"/ ] ifFalse:[
"/ "/ mhm - an unbound method;
"/ "/ see if it was invoked by a direct call
"/ "/ consider this a kludge
"/
"/ homeContext sender notNil ifTrue:[
"/ (homeContext sender selector startsWith:'valueWithReceiver:') ifTrue:[
"/ method := homeContext sender receiver
"/ ]
"/ ]
"/ ].
(method notNil
and:[method isWrapped]) ifTrue:[
"
in a wrapped context, locals are something different
"
"/ argsOnly := true.
m := method originalMethod.
m notNil ifTrue:[
method := m.
] ifFalse:[
argsOnly := true.
].
].
method notNil ifTrue:[
"/ method source notNil ifTrue:[
argsOnly ifTrue:[
homeNames := method methodArgNames
] ifFalse:[
homeNames := method methodArgAndVarNames.
"/ did it already allocate its locals ?
homeNames size > (homeContext numArgs + homeContext numVars)
ifTrue:[
homeNames := method methodArgNames.
argsOnly := true.
].
].
"/ there is one case, where the above is by purpose:
"/ the #doIt - method, which has been given an invalid
"/ source.
"/ care for this here.
isDoIt ifTrue:[
homeNames := #().
] ifFalse:[
"/ check
numVarsInContext := homeContext argsAndVars size.
numVarsInSource := homeNames size.
numVarsInSource > 0 ifTrue:[
numVarsInContext < numVarsInSource ifTrue:[
"/ the methods source does not correctly reflect
"/ the number of args&vars in the context.
"/ either outDated, or somehow strange.
"/ (happens with wrapped methods, which are not
"/ what they look)
numVarsInSource > numVarsInContext ifTrue:[
homeNames := homeNames copyTo:numVarsInContext.
] ifFalse:[
numVarsInContext >= homeContext numArgs ifTrue:[
homeNames := homeNames copyTo:homeContext numArgs
] ifFalse:[
homeNames := nil
]
]
]
]
]
"/ ]
].
"
create dummy names for method vars (if there is no source available)
"
homeNames isNil ifTrue:[
homeNames := OrderedCollection new.
1 to:homeContext numArgs do:[:index |
homeNames add:('mArg' , index printString)
].
argsOnly ifFalse:[
1 to:homeContext numVars do:[:index |
homeNames add:('mVar' , index printString)
].
"/ showingTemporaries ifTrue:[
"/ 1 to:homeContext numTemps do:[:index |
"/ homeNames add:('mTmp' , index printString)
"/ ]
"/ ]
]
].
showingTemporaries ifTrue:[
1 to:homeContext numTemps do:[:index |
homeNames add:('mTmp' , index printString)
]
].
n := homeNames size.
n < (homeContext numVars + homeContext numArgs) ifTrue:[
"/ its a context which includes locals from
"/ inlined sub-blocks.
"/ First, generate synthetic varNames ...
homeNames := homeNames asOrderedCollection.
tempNames := OrderedCollection new.
n to:(homeContext numVars + homeContext numArgs - 1) do:[:inlinedTempIdx |
tempNames add:('*t' , (inlinedTempIdx - n + 1) printString)
].
"/ now, see if we can find out more
"/ (failes, if source is not available)
method notNil ifTrue:[
(isDoIt and:[tempNames size > 0]) ifTrue:[
"/ special for #doIt
"/ my source is found in the method.
blockNode := Compiler
blockAtLine:(aContext lineNumber)
in:nil
orSource:('[' , method source , '\]') withCRs
numArgs:numArgs
numVars:numVars.
] ifFalse:[
blockNode := Compiler
blockAtLine:(homeContext lineNumber)
in:method
orSource:nil
numArgs:numArgs
numVars:numVars.
].
realTempNames := OrderedCollection new.
[blockNode notNil] whileTrue:[
blockNode variables notNil ifTrue:[
realTempNames := (blockNode variables collect:[:aVar | aVar name]) , realTempNames.
].
blockNode arguments notNil ifTrue:[
realTempNames := (blockNode arguments collect:[:aVar | aVar name]) , realTempNames.
].
"/
"/ hidden temps used for loop.
"/
blockNode invokationSelector == #timesRepeat ifTrue:[
realTempNames asOrderedCollection addFirst:'*loopStop*'
] ifFalse:[
blockNode invokationSelector == #to:do: ifTrue:[
realTempNames asOrderedCollection addFirst:'*loopStop*'
]
].
blockNode := blockNode home.
].
tempNames
replaceFrom:1 to:(tempNames size min:realTempNames size)
with:realTempNames.
].
homeNames := homeNames asOrderedCollection.
homeNames addAll:tempNames.
]
].
"
stupid: should find the block via the contexts
method-home and put real names in here
"
aContext isBlockContext ifTrue:[
numArgs := aContext numArgs.
numVars := aContext numVars.
(numArgs > 0 or:[numVars > 0]) ifTrue:[
argAndVarNames := aContext argAndVarNames.
argAndVarNames notEmptyOrNil ifTrue:[
argNames := argAndVarNames copyTo:numArgs.
varNames := argAndVarNames copyFrom:numArgs+1.
].
"/ method notNil ifTrue:[
"/ isDoIt ifTrue:[
"/ "/ special for #doIt
"/ "/ my source is found in the method.
"/ m := nil.
"/ src := ('[' , method source , '\]') withCRs
"/ ] ifFalse:[
"/ m := method.
"/ src := nil.
"/ ].
"/ blockNode := Compiler
"/ blockAtLine:(aContext lineNumber)
"/ in:m
"/ orSource:src
"/ numArgs:numArgs
"/ numVars:numVars.
"/ blockNode notNil ifTrue:[
"/ numArgs > 0 ifTrue:[
"/ vars := blockNode arguments.
"/ vars size > 0 ifTrue:[
"/ argNames := vars collect:[:var | var name]
"/ ]
"/ ].
"/ numVars > 0 ifTrue:[
"/ vars := blockNode variables.
"/ vars size > 0 ifTrue:[
"/ varNames := vars collect:[:var | var name].
"/ ]
"/ ]
"/ ].
"/ ].
].
names := OrderedCollection new.
argNames isNil ifTrue:[
argNames := (1 to:numArgs) collect:[:i | 'arg' , i printString].
].
names addAll:argNames.
varNames isNil ifTrue:[
varNames := (1 to:numVars) collect:[:i | 'var' , i printString].
] ifFalse:[
varNames size ~~ numVars ifTrue:[
varNames := varNames asOrderedCollection.
varNames size+1 to:aContext numVars do:[:i |
varNames add:('var' , i printString)
]
]
].
names addAll:varNames.
showingTemporaries ifTrue:[
tmpNames := (1 to:(aContext numTemps)) collect:[:i | 'tmp' , i printString].
names addAll:tmpNames.
].
names addAll:homeNames.
] ifFalse:[
names := homeNames.
].
listView list:(self fieldList).
workspace contents:nil.
self setDoitActionIn:workspace for:aContext.
oldSelectedName notNil ifTrue:[
(names includes:oldSelectedName) ifTrue:[
listView selectElement:oldSelectedName.
self showSelection:(listView list indexOf:oldSelectedName).
]
].
"Modified: / 30.7.1998 / 12:51:44 / cg"
!
release
"release inspected object"
inspectedContext := nil.
names := nil.
super release
"Modified: 14.12.1995 / 21:49:43 / cg"
! !
!ContextInspectorView methodsFor:'initialization'!
fieldMenu
"return a popUpMenu for the left (fields) pane"
<resource: #programMenu >
|items m|
showingTemporaries ifFalse:[
items := #(
('Inspect' #doInspect)
('BasicInspect' #doBasicInspect)
('-')
('Browse' #browse)
('Browse blocks home' #browseHome)
('-')
('Show temporaries' #showTemporaries)
)
] ifTrue:[
items := #(
('Inspect' #doInspect)
('BasicInspect' #doBasicInspect)
('-')
('Browse' #browse)
('Browse blocks home' #browseHome)
('-')
('Hide temporaries' #hideTemporaries)
)
].
showHex ifTrue:[
items := items , #(
('-')
('Decimal integers' #toggleHex )
)
] ifFalse:[
items := items , #(
('-')
('Hex integers' #toggleHex )
)
].
m := PopUpMenu
itemList:items
resources:resources.
selectionIndex isNil ifTrue:[
m disableAll:#(doInspect doBasicInspect browse browseHome)
] ifFalse:[
self selection isBlock ifFalse:[
m disable:#browseHome
]
].
^ m
"Modified: / 16.11.2001 / 13:02:35 / cg"
!
initialize
super initialize.
showingTemporaries := false.
! !
!ContextInspectorView methodsFor:'private'!
defaultLabel
^ 'Locals'
"
ContextInspectorView openOn:thisContext sender
"
"Modified: 28.6.1996 / 16:07:49 / cg"
!
displayStringForValue:someValue
"return the values displayString"
|sel|
sel := listView at:selectionIndex.
(sel startsWith:'-all local vars') ifTrue:[
^ self stringWithAllLocalValues
].
^ super displayStringForValue:someValue
!
fieldList
names size == 0 ifTrue:[^ names].
^ #('-all local vars') , names
!
hasSelfEntry
^ false
"Created: 14.12.1995 / 19:29:47 / cg"
!
setDoitActionIn:aWorkspace for:aContext
aWorkspace
doItAction:[:theCode |
Compiler
evaluate:theCode
in:aContext
receiver:nil
notifying:aWorkspace
logged:true
ifFail:nil
]
!
stringWithAllLocalValues
|s maxLen varString|
s := '' writeStream.
maxLen := (names collect:[:eachName | eachName size]) max.
names keysAndValuesDo:[:varIdx :eachLocalName |
s nextPutAll:((eachLocalName , ' ') paddedTo:maxLen+1 with:$.).
s nextPutAll:' : '.
varString := (self valueAtIndex:varIdx) displayString.
(varString includes:Character cr) ifTrue:[
varString := varString copyTo:(varString indexOf:Character cr)-1.
varString := varString , '...'.
].
s nextPutAll:varString.
s cr.
].
^ s contents
!
valueAtIndex:varIdx
"helper - return the value of the selected entry"
|homeContext theContext values|
inspectedContext isNil ifTrue:[^ nil].
argsOnly := false.
theContext := inspectedContext.
homeContext := theContext methodHome.
theContext isBlockContext ifTrue:[
values := Array withAll:(theContext argsAndVars).
(showingTemporaries and:[theContext numTemps ~~ 0]) ifTrue:[
values := values , theContext temporaries
].
homeContext notNil ifTrue:[
values := values , homeContext args.
argsOnly ifFalse:[
values := values , homeContext vars.
(showingTemporaries and:[homeContext numTemps ~~ 0])ifTrue:[
values := values , homeContext temporaries
]
].
].
] ifFalse:[
argsOnly ifTrue:[
values := homeContext args
] ifFalse:[
values := homeContext argsAndVars
].
(showingTemporaries and:[homeContext numTemps ~~ 0])ifTrue:[
values := values , homeContext temporaries
]
].
^ values at:varIdx.
"Modified: / 13.1.1998 / 15:55:16 / cg"
!
valueAtLine:lineNr
"helper - return the value of the selected entry"
|varIdx l|
inspectedContext isNil ifTrue:[^ nil].
varIdx := lineNr.
((l := listView at:lineNr) startsWith:$-) ifTrue:[
(l ~= '-') ifTrue:[
^ self valueForSpecialLine:(listView at:lineNr)
].
].
^ self valueAtIndex:(varIdx - 1). "/ for the special var
!
valueForSpecialLine:line
(line startsWith:'-all local vars') ifTrue:[
^ inspectedObject
].
self error:'unknown special line'.
"Created: / 31.10.2001 / 09:17:45 / cg"
! !
!ContextInspectorView methodsFor:'user actions'!
doAccept:theText
"text in the right pane was accepted - evaluate the contents and
assign to the selected field"
super doAccept:theText.
"/ |newValue|
"/
"/ selectionIndex notNil ifTrue:[
"/ newValue := inspectedObject class evaluatorClass
"/ evaluate:theText
"/ receiver:inspectedObject
"/ notifying:workspace.
"/
"/ "yes, you can do that with a context"
"/ inspectedContext at:selectionIndex put:newValue.
"/ ].
!
hideTemporaries
"do not show contexts temporaries"
showingTemporaries := false.
self inspect:inspectedContext
"Modified: 14.12.1995 / 19:24:44 / cg"
!
showTemporaries
"show contexts temporaries"
showingTemporaries := true.
self inspect:inspectedContext
"Modified: 14.12.1995 / 19:24:49 / cg"
!
valueAtLine:selectionIndex put:newValue
"yes, you can do that with a context"
inspectedContext at:selectionIndex put:newValue.
! !
!ContextInspectorView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/ContextInspectorView.st,v 1.56 2003-09-03 08:05:19 penk Exp $'
! !