{ import: Object }
{ import: TextController }
{ import: Scroll }
{ import: Utility }

"----------------------------------------------------------------"
Object dump
[
    | slots value |
    StdErr nextPutAll: '=========='; cr.
    StdErr nextPutAll: self debugName; cr.
    StdErr nextPutAll: '----------'; cr.
    slots := self slots.
    slots keys do: [:key |
        StdErr nextPutAll: key, ' : '.
        value := self _oopAt: (slots at: key) key / 4.
        StdErr nextPutAll: value printString; cr].
]

"----------------------------------------------------------------"

Window openWorkspace
[
    | box frame |
    box := TextView new.
    box extent:     640,480.

    frame := FrameBox with: box addScrollPane title: 'Workspace'.
    self addFront: frame.
    ^ frame
]

Object inspect [ Window default inspect: self ] 
Object browse  [ Window default browse: self ] 
Window openDefaultBrowser [ Window default openBrowser ]

Window addFrame: aBox title: aString
[
    | pane |
    pane := ScrollPane new.
    pane background: ButtonOffColor;
	add: aBox;
	extent: 200, 150.
    self addFront: ((FrameBox with: pane title: aString) position: hand position)

]

Window openBrowser
[
    | menu button types |
    menu := Box new.

    Object allTypes do: [ :each |
	button := Box newButton: each debugName action: [:anEvent | self browse: each ].
	menu add: button; beMenu.
    ].
    self addFrame: menu title: 'All Types'.
]

Window inspect: anObject
[
    | slots menu button |
    menu := Box new.
    menu extent: 160,10;
	background: ButtonOffColor.
    anObject slotValues do: [:each |
	button := Box newButton: each key, ' : ', each value inspectString action: [:anEvent | self inspect: each value].
	menu add: button; beMenu.
    ].
    self addFrame: menu title: anObject inspectString.
]

Window browse: anObject
[
    | box frame |
    box := Box new.
    anObject _vtable selectors
	do: [:selector |
	    box add: (Box newButton: selector printString
			  action: [:ev | self openSourceType: anObject selector: selector ])].
    box beMenu.
    self addFrame: box title: anObject debugName.
]

Window openSourceType: anObject selector: aSymbol
[
    | info file source lines aStream frame |
    info := Object findMethodType: anObject debugName name: aSymbol asString.
    info ifNil: [ ^self ].
    file := File openIfPresent: info file.
    source := file readStream contents.
    lines := (source split: $\n) copyFrom: info sourceStart - 1 to: info sourceEnd - 2.
    aStream := WriteStream on: (String new: 8).
    lines do: [ :line | aStream nextPutAll: line ].
    file close.

    ((frame := self propertyAt: #defaultWorkspace) and: [self contents includes: frame])
	ifNil: [
	    frame := self openWorkspace.
	    frame position: hand position.
	    frame extent: 400, 300.
	    frame titleString: info file inspectString.
	    self propertyAt: #defaultWorkspace put: frame].
    frame content content propertyAt: #font put: Font default.
    frame content content textContents: aStream contents.
]


Object findMethodType: type name: name
[
    | _type _name _found |
    _type := type _stringValue.
    _name := name _stringValue.
    {
      struct __methodinfo *info= _libid->infoList();
      while (info) {
	if ((!strcmp((char*) v__type, info->type)) && (!strcmp((char*) v__name, info->name))) {
	  v__found= (oop) info;
	  break;
	}
	info= info->next;
      }
    }.
    ^ MethodInfo new: _found.
]

MethodInfo : Object (name type file sourceStart sourceEnd)

MethodInfo name [ ^name ]
MethodInfo type [ ^type ]
MethodInfo file [ ^file ]
MethodInfo sourceStart [ ^sourceStart ]
MethodInfo sourceEnd [ ^sourceEnd ]

MethodInfo new: _methodInfo
[
    | _n _f _t |
    self := super new.
    {
      struct __methodinfo* info= (struct __methodinfo*) v__methodInfo;
      if (v__methodInfo == 0) { _return(0); }
      v__n= (oop) info->name;
      v__t= (oop) info->type;
      v__f= (oop) info->file;
      self->v_sourceStart= (oop) ((int) info->sourceStart << 1 | 1);
      self->v_sourceEnd= (oop) ((int) info->sourceEnd << 1 | 1);
      
    }.
    name := String value_: _n.
    type := String value_: _t.
    file := String value_: _f.
]

Object allTypes
[
    | aCollection types |
    aCollection := IdentitySet new.
    {
      struct __methodinfo *info= _libid->infoList();
      while (info) {
        char head= info->type[0];

        if ((('a' <= head) && (head <= 'z')) ||
	    (('A' <= head) && (head <= 'Z'))) {
	  oop typeName= _libid->intern(info->type);
	  _sendv(s_add_, 2, v_aCollection, typeName);
	}
	info= info->next;
      }
    }.

    types := IdentitySet new.
    aCollection do: [ :aSymbol | | _type type |
	_type := aSymbol _stringValue.
	{ v_type= _libid->import((char *) v__type); }.
	types add: type.
    ].
    ^ types
]


"----------------"

Object inspectString
[
    | aString |
    aString := self printString.
    ^ aString size > 50 ifTrue: [ (aString copyFrom: 0 to: 49), '...' ] ifFalse: [ aString ]
]

Object slotValues
[
    "Answer a collection of key -> value pair describing this object"
    | slots result |
    result := OrderedCollection new.
    (self _vtable lookup: #_slots) ifFalse: [ ^#() ].
    slots := self slots.
    slots keys do: [:key |
	result add: key asString -> (key asString first = $_
				ifTrue: [ #native ]
				ifFalse: [ self _oopAt: (slots at: key) key / 4 ])].
    ^ result
]

IdentityDictionary slotValues
[
    | result |
    result := OrderedCollection new.
    self keys do: [:key | result add: key printString -> (self at: key)].
    ^ result
]

SequenceableCollection slotValues
[
    | result i |
    result := OrderedCollection new.
    i := 0.
    self do: [:each | result add: i printString -> each. i := i + 1 ].
    ^ result
]