InspectorView.st
author Claus Gittinger <cg@exept.de>
Fri, 01 Aug 1997 21:49:58 +0200
changeset 1270 3dc841708edd
parent 1235 13610578a5d2
child 1365 4a98e9a59430
permissions -rw-r--r--
disable accept/doIt, if instances class provides no evaluator

"
 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.
"

SimpleView subclass:#InspectorView
	instanceVariableNames:'listView labelView workspace inspectedObject selectedLine nShown
		hasMore monitorProcess hideReceiver'
	classVariableNames:'DefaultIcon'
	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 an 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).

    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 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'

    [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."

    |topView inspectorView|

    topView := StandardSystemView
                    label:(self labelFor:anObject)
                     icon:self defaultIcon
                minExtent:(100 @ 100).

    topView iconLabel:(self labelNameFor:anObject).
    topView extent:(Screen current extent // 3).

    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 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: 11.12.1996 / 17:07:17 / cg"
! !

!InspectorView class methodsFor:'defaults'!

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 := Image fromFile:nm resolution:100.
            i isNil ifTrue:[
                i := Image fromFile:('bitmaps/' , nm) resolution:100.
                i isNil ifTrue:[
                    i := StandardSystemView defaultIcon
                ]
            ]
        ].
        i notNil ifTrue:[
            DefaultIcon := i := i on:Display
        ]
    ].
    ^ i

    "Modified: 18.4.1997 / 15:16:53 / cg"
!

labelFor:anObject
    "return the windowLabel to use in my topView, when inspecting anObject."

    ^ self classResources 
	string:'Inspector on: %1' with:(self labelNameFor:anObject)
!

labelNameFor:anObject
    "return the iconLabel to use in my topView, when inspecting anObject.
     Simply returns the className or name of anObjects class"

    |nm|

    anObject isClass ifTrue:[
	nm := anObject displayString
    ].
    nm isNil ifTrue:[
	nm := anObject classNameWithArticle
    ].

    ^ nm
! !

!InspectorView methodsFor:'accessing'!

hideReceiver:aBoolean
    hideReceiver := aBoolean

    "Created: 28.6.1996 / 15:08:32 / cg"
!

inspect:anObject
    "define the object to be inspected"

    |aList sameObject|

    sameObject := anObject == inspectedObject.
    inspectedObject := anObject.

    hasMore := false.
    aList := self fieldList.
    hasMore ifTrue:[
	aList add:' ... '
    ].

    sameObject ifTrue:[
	listView setContents:aList.
"/        listView selection:1.
    ] ifFalse:[
	listView contents:aList
    ].

    workspace contents:nil.
    self setDoItAction.

    selectedLine := nil
!

label:aString
    labelView label:aString

    "Created: 28.6.1996 / 15:30:26 / cg"
!

listView
    ^ listView
!

workspace
    ^ workspace
! !

!InspectorView methodsFor:'initialization'!

initialize
    |v panel helpView labelView2|

    super initialize.

    hideReceiver := 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 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 origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
    v topInset:(labelView2 preferredExtent y).
    workspace := v scrolledView.

    workspace acceptAction:[:theText | self doAccept:theText asString].

    nShown := 100.
    hasMore := false.

    "Modified: 28.6.1996 / 16:04:45 / 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 := nil.
        self inspect:o
    ]

    "Created: 30.5.1996 / 09:38:37 / cg"
! !

!InspectorView methodsFor:'menu'!

fieldMenu
    "return the menu for the field-list"

    <resource: #programMenu>

    |labels selectors m|

    hasMore ifTrue:[
        labels := #(
                      'inspect'
                      'basicInspect'
                      '-'
                      'browse'
                      'browse class hierarchy'
                      'browse full class protocol'
                      '-'
                      'trace messages'
                      'trap message'
                      'trap all messages'
                      'untrace/untrap'
                      '-'
                      'show more'
                   ).

        selectors := #(
                      doInspect 
                      doBasicInspect 
                      nil 
                      browse
                      browseClassHierarchy
                      browseFullClassProtocol
                      nil
                      doTrace
                      doTrapAll
                      doTrap
                      doUntrace
                      nil 
                      showMore
                      ).
    ] ifFalse:[
        labels := #(
                      'inspect'
                      'basicInspect'
                      '-'
                      'browse'
                      'browse class hierarchy'
                      'browse full class protocol'
                      '-'
                      'trace messages'
                      'trap message'
                      'trap all messages'
                      'untrace/untrap'
                   ).

        selectors := #(
                      doInspect 
                      doBasicInspect 
                      nil 
                      browse
                      browseClassHierarchy
                      browseFullClassProtocol
                      nil
                      doTrace
                      doTrap
                      doTrapAll
                      doUntrace
                      ).
    ].

    monitorProcess isNil ifTrue:[
        labels := labels , #('-' 'start monitor').
        selectors := selectors , #(nil #doStartMonitor).
    ] ifFalse:[
        labels := labels , #('-' 'stop monitor').
        selectors := selectors , #(nil #doStopMonitor).
    ].

"/    labels := labels , #('-' 'owners').
"/    selectors := selectors , #(nil #inspectOwners).

    m := PopUpMenu
          labels:(resources array:labels)
          selectors:selectors.

    selectedLine isNil ifTrue:[
        m disableAll:#(doInspect doBasicInspect 
                       browse browseClassHierarchy browseFullClassProtocol
                       doStartMonitor)
    ].

    ^ m

    "Modified: 3.7.1997 / 13:54:22 / cg"
! !

!InspectorView methodsFor:'menu actions'!

browse
    |objectToBrowseClass cls|

    selectedLine notNil ifTrue:[
        objectToBrowseClass := self valueAtLine:selectedLine.
    ] ifFalse:[
        objectToBrowseClass := inspectedObject
    ].
    cls := objectToBrowseClass class.
    cls browserClass openInClass:cls selector:nil

    "Created: 14.12.1995 / 19:15:50 / cg"
    "Modified: 3.5.1996 / 12:39:51 / cg"
!

browseClass
    |objectToBrowseClass cls|

    selectedLine notNil ifTrue:[
        objectToBrowseClass := self valueAtLine:selectedLine.
    ] ifFalse:[
        objectToBrowseClass := inspectedObject
    ].
    cls := objectToBrowseClass class.
    cls browserClass browseClass:cls

    "Modified: 3.5.1996 / 12:39:32 / cg"
!

browseClassHierarchy
    |objectToBrowseClass cls|

    selectedLine notNil ifTrue:[
        objectToBrowseClass := self valueAtLine:selectedLine.
    ] ifFalse:[
        objectToBrowseClass := inspectedObject
    ].
    cls := objectToBrowseClass class.
    cls browserClass browseClassHierarchy:cls

    "Modified: 3.5.1996 / 12:40:04 / cg"
!

browseFullClassProtocol
    |objectToBrowseClass cls|

    selectedLine notNil ifTrue:[
        objectToBrowseClass := self valueAtLine:selectedLine.
    ] ifFalse:[
        objectToBrowseClass := inspectedObject
    ].
    cls := objectToBrowseClass class.
    cls browserClass browseFullClassProtocol:cls

    "Modified: 3.5.1996 / 12:40:17 / cg"
!

doBasicInspect
    "user selected inspect-menu entry"

    self doInspect:true 
!

doInspect
    "user selected inspect-menu entry"

    self doInspect:false
!

doStartMonitor
    "start a monitoring process"

    monitorProcess isNil ifTrue:[
        monitorProcess :=
            [
                |sel|

                [true] whileTrue:[
                    (sel := selectedLine) 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
!

doTrace
    "place a trace on all messages sent to the inspected object"

    self topView withWaitCursorDo:[MessageTracer traceAll:inspectedObject]
!

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]
!

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
    ]
! !

!InspectorView methodsFor:'private'!

defaultLabel
    ^ 'instVars'

    "Modified: 28.6.1996 / 16:04:53 / cg"
!

fieldList 
    "return a list of names to show in the selectionList.
     Leave hasMore as true, if a '...' entry should be added."

    |aList n cls s|

    aList := OrderedCollection new.
    hideReceiver ifFalse:[aList add:'self'].
    cls := inspectedObject class.
    cls allInstVarNames do:[:instVarName |
        aList add:instVarName
    ].

    cls isVariable ifTrue:[
        n := inspectedObject basicSize.
        (n > nShown) ifTrue:[
            n := nShown.
            hasMore := true.
        ].
        1 to:n do:[:index |
            aList add:(index printString)
        ].
    ].
    ^ aList

    "Modified: 28.6.1996 / 15:08:51 / cg"
!

hasSelfEntry
    ^ hideReceiver not

    "Created: 14.12.1995 / 19:30:03 / cg"
    "Modified: 28.6.1996 / 15:13:41 / cg"
!

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"
!

showMore
    hasMore ifTrue:[
	nShown := nShown * 2.
	self inspect:inspectedObject
    ]
! !

!InspectorView methodsFor:'release'!

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 := 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:'user interaction'!

destroy
    inspectedObject := nil.
    monitorProcess notNil ifTrue:[
	monitorProcess terminate
    ].
    super destroy
!

doAccept:theText
    |value index|

    value := inspectedObject class evaluatorClass 
		 evaluate:theText
		 receiver:inspectedObject 
		 notifying:workspace.

    selectedLine notNil ifTrue:[
	selectedLine == 1 ifFalse:[
	    index := selectedLine - 1.
	    (inspectedObject class isVariable) ifFalse:[
		inspectedObject instVarAt:index put:value
	    ] ifTrue:[
		index <= (inspectedObject class instSize) ifTrue:[
		    inspectedObject instVarAt:index put:value
		] ifFalse:[
		    index := index - inspectedObject class instSize.
		    inspectedObject basicAt:index put:value
		]
	    ]
	]
    ].
    inspectedObject changed
!

doInspect:basic
    "user selected inspect-menu entry"

    |objectToInspect|

    selectedLine notNil ifTrue:[
	objectToInspect := self valueAtLine:selectedLine.
	basic ifTrue:[
	    objectToInspect basicInspect
	] ifFalse:[
	    objectToInspect inspect
	]
    ]
!

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"

    listView selectElement:anInstVarName.
    self doStartMonitor

    "Created: 1.3.1996 / 19:31:45 / cg"
    "Modified: 11.12.1996 / 17:05:18 / cg"
!

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"
!

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

    hideReceiver ifFalse:[
        (self hasSelfEntry and:[lineNr == 1]) ifTrue:[
            "selecting self also does a re-set, this allows updating the list"
            self inspect:inspectedObject.
        ].
    ].
    val := self valueAtLine:lineNr.
    selectedLine := lineNr.
    self showValue:val.

    "Modified: 21.3.1997 / 15:16:44 / cg"
!

showValue:someValue 
    "user clicked on an entry - show value in workspace"

    self topView withWaitCursorDo:[
	workspace replace:someValue displayString.
    ].
!

update:something with:someArgument from:changedObject
    "handle updates from other inspectors"

    |oldSelection|

    changedObject == inspectedObject ifTrue:[
	oldSelection := listView selection.
	self inspect:inspectedObject.
	oldSelection notNil ifTrue:[
	    self showSelection:oldSelection
	]
    ]
!

valueAtLine:lineNr
    "helper - return the value of the selected entry"

    |index instSize|

    hideReceiver ifFalse:[
        (lineNr isNil or:[lineNr == 1]) ifTrue:[
            ^ inspectedObject
        ].
        index := lineNr - 1.   "/ skip self
    ] ifTrue:[
        index := lineNr
    ].

    instSize := inspectedObject class instSize.

    (inspectedObject class isVariable not
    or:[index <= instSize]) ifTrue:[
        ^ inspectedObject instVarAt:index
    ].
    index := index - instSize.
    ^ inspectedObject basicAt:index

    "Modified: 28.6.1996 / 15:11:27 / cg"
! !

!InspectorView class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.69 1997-08-01 19:49:58 cg Exp $'
! !