"

 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"

    |methodHomeContext method homeNames rec sel 

     numVarsInSource numVarsInContext isDoIt

    (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].

    methodHomeContext := aContext methodHome.

    methodHomeContext isNil ifTrue:[

        "its a cheap blocks context"

        rec := aContext receiver.

        sel := aContext selector.

        homeNames := OrderedCollection new.

        isDoIt := false.

    ] ifFalse:[

        rec := methodHomeContext receiver.

        sel := methodHomeContext selector.

        "/ #doIt needs special handling below

        isDoIt := (sel == #doIt) or:[sel == #doIt:].

        method := methodHomeContext method.

"/        implementorClass := methodHomeContext 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

"/

"/            methodHomeContext sender notNil ifTrue:[

"/                (methodHomeContext sender selector startsWith:'valueWithReceiver:') ifTrue:[

"/                    method := methodHomeContext 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 > (methodHomeContext numArgs + methodHomeContext 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 := methodHomeContext 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 >= methodHomeContext numArgs ifTrue:[

                                    homeNames := homeNames copyTo:methodHomeContext numArgs

                                ] ifFalse:[

                                    homeNames := nil

                                ]    

                            ]

                        ]

                    ]

                ]

            "/ ]

        ].

        "

         create dummy names for method vars (if there is no source available)

        "

        homeNames isNil ifTrue:[

            homeNames := OrderedCollection new.

            1 to:methodHomeContext numArgs do:[:index |

                homeNames add:('mArg' , index printString)

            ].

            argsOnly ifFalse:[

                1 to:methodHomeContext numVars do:[:index |

                    homeNames add:('mVar' , index printString)

                ].

"/                showingTemporaries ifTrue:[

"/                    1 to:methodHomeContext numTemps do:[:index |

"/                        homeNames add:('mTmp' , index printString)

"/                    ]

"/                ]

            ]

        ].

        showingTemporaries ifTrue:[

            1 to:methodHomeContext numTemps do:[:index |

                homeNames add:('mTmp' , index printString)

            ]

        ].

        n := homeNames size.

        n < (methodHomeContext numVars + methodHomeContext numArgs) ifTrue:[

            "/ its a context which includes locals from

            "/ inlined sub-blocks.

            "/ First, generate synthetic varNames ...

            homeNames := homeNames asOrderedCollection.

            tempNames := OrderedCollection new.

            n to:(methodHomeContext numVars + methodHomeContext 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

                                    in:nil

                                    orSource:('[' , method source , '\]') withCRs

                                    numArgs:numArgs 

                                    numVars:numVars.

                ] ifFalse:[

                    blockNode := Compiler 

                                    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:[

        names := self namesOfBlockContext:aContext.

        hCon := aContext home.

        [hCon == methodHomeContext] whileFalse:[

            names addAll:(self namesOfBlockContext:hCon).

            hCon := hCon home.

        ].

        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"

!

namesOfBlockContext:aContext

    |numArgs numVars argAndVarNames argNames varNames tmpNames names|

    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.

        ].

    ].

    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

!

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:[