"
 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 workspace inspectedObject selectedLine nShown hasMore
		monitorProcess'
	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).

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

    |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 open.
    inspectorView inspect:anObject.
    ^ inspectorView

    "
     InspectorView openOn:(5 @ 7)
     InspectorView openOn:(Array new:400)
     DictionaryInspectorView openOn:(IdentityDictionary new)
    "
! !

!InspectorView class methodsFor:'defaults'!

defaultIcon
    DefaultIcon isNil ifTrue:[
	DefaultIcon := Form fromFile:'Inspector.xbm' resolution:100
    ].
    ^ DefaultIcon
!

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

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
!

listView
    ^ listView
! !

!InspectorView methodsFor:'initialization'!

initialize
    |v panel|

    super initialize.

    panel := VariableHorizontalPanel 
		origin:(0.0 @ 0.0)
		corner:(1.0 @ 1.0)
		in:self.

    v := HVScrollableView 
		for:SelectionInListView 
		miniScrollerH:true
		miniScrollerV:false
		in:panel.
    v origin:(0.0 @ 0.0) corner:(0.3 @ 1.0).

    listView := v scrolledView.
    listView action:[:lineNr | self showSelection:lineNr].
    listView doubleClickAction:[:lineNr | self doInspect].
    listView ignoreReselect:false.
    listView menuHolder:self; menuPerformer:self; menuMessage:#fieldMenu.

    v := HVScrollableView 
		for:CodeView 
		miniScrollerH:true
		miniScrollerV:false
		in:panel.
    v origin:(0.3 @ 0.0) corner:(1.0 @ 1.0).
    workspace := v scrolledView.

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

    nShown := 100.
    hasMore := false.
!

mapped
    "delayed setup of lists till map-time - 
     this makes startup of inspectors a bit faster"

    |o|

    super mapped.
    "
     kludge to trick inspect:, which ignores setting the
     same object again ...
    "
    o := inspectedObject.
    inspectedObject := nil.
    self inspect:o
! !

!InspectorView methodsFor:'menu'!

fieldMenu
    |labels selectors|

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

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

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

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

    ^ PopUpMenu
          labels:(resources array:labels)
          selectors:selectors

    "Modified: 14.12.1995 / 19:15:27 / cg"
! !

!InspectorView methodsFor:'private'!

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.
    aList add:'self'.
    cls := inspectedObject class.
    cls isClass ifTrue:[
	cls allInstVarNames do:[:instVarName |
	    aList add:instVarName
	]
    ] ifFalse:[
	1 to:cls instSize do:[:index |
	    aList add:('instvar' , index printString)
	]
    ].
    cls isVariable ifTrue:[
	n := inspectedObject basicSize.
	(n > nShown) ifTrue:[
	    n := nShown.
	    hasMore := true.
	].
	(inspectedObject respondsTo:#keys) ifTrue:[
	    s := ReadStream on:(inspectedObject keys).
	    1 to:n do:[:index |
		aList add:(s next printString)
	    ]
	] ifFalse:[
	    1 to:n do:[:index |
		aList add:(index printString)
	    ]
	].
    ].
    ^ aList
!

hasSelfEntry
    ^ true

    "Created: 14.12.1995 / 19:30:03 / cg"
!

setDoItAction
    workspace doItAction:[:theCode |
	(inspectedObject class evaluatorClass) 
	    evaluate:theCode 
	    in:nil 
	    receiver:inspectedObject 
	    notifying:workspace 
	    logged:true 
	    ifFail:nil 
    ].

!

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

!InspectorView methodsFor:'user interaction'!

browse
    |objectToBrowseClass|

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

    "Created: 14.12.1995 / 19:15:50 / cg"
!

browseClass
    |objectToBrowseClass|

    selectedLine notNil ifTrue:[
	objectToBrowseClass := self valueAtLine:selectedLine.
    ] ifFalse:[
	objectToBrowseClass := inspectedObject
    ].
    SystemBrowser browseClass:objectToBrowseClass class
!

browseClassHierarchy
    |objectToBrowseClass|

    selectedLine notNil ifTrue:[
	objectToBrowseClass := self valueAtLine:selectedLine.
    ] ifFalse:[
	objectToBrowseClass := inspectedObject
    ].
    SystemBrowser browseClassHierarchy:objectToBrowseClass class
!

browseFullClassProtocol
    |objectToBrowseClass|

    selectedLine notNil ifTrue:[
	objectToBrowseClass := self valueAtLine:selectedLine.
    ] ifFalse:[
	objectToBrowseClass := inspectedObject
    ].
    SystemBrowser browseFullClassProtocol:objectToBrowseClass class
!

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
!

doBasicInspect
    "user selected inspect-menu entry"

    self doInspect:true 
!

doInspect
    "user selected inspect-menu entry"

    self doInspect:false
!

doInspect:basic
    "user selected inspect-menu entry"

    |objectToInspect|

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

doStartMonitor
    "start a monitoring process"

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

		[true] whileTrue:[
		    (sel := listView selection) notNil ifTrue:[
			self showSelection:sel 
		    ].
		    (Delay forSeconds:0.5) wait
		]
	    ] forkAt:Processor userBackgroundPriority
    ]
!

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:'.
    string notEmpty ifTrue:[
	selector := string asSymbolIfInterned.
    ].
    selector isNil ifTrue:[
	self warn:'no such selector'
    ] ifFalse:[
	self topView withWaitCursorDo:[MessageTracer trap:inspectedObject 
						     selector:selector]
    ]
!

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

keyPress:aKey x:x y:y
    "all my input is passed on to the workspace-field"

    workspace keyPress:aKey x:0 y:0
!

showSelection:lineNr
    "user clicked on an instvar - show value in workspace"

    |val string|

    (hasMore and:[lineNr == listView list size]) ifTrue:[
        "clicked on the '...' entry"
        self showMore.
        listView selection:lineNr.
    ].

    (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.
    self showValue:val.
    selectedLine := lineNr.

    "Modified: 14.12.1995 / 19:29:56 / 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|

    lineNr == 1 ifTrue:[
	^ inspectedObject
    ].
    index := lineNr - 1.   "/ skip self
    instSize := inspectedObject class instSize.

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

!InspectorView class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.35 1995-12-14 20:21:30 cg Exp $'
! !