SystemOrganization addCategory: #'OB-Inspector-Browser'! SystemOrganization addCategory: #'OB-Inspector-Parts'! SystemOrganization addCategory: #'OB-Inspector-Nodes'! SystemOrganization addCategory: #'OB-Inspector-Actors'! OBActor subclass: #OBBrowserInspectorActor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Actors'! !OBBrowserInspectorActor methodsFor: 'public' stamp: 'lr 3/4/2006 19:32'! actionsForNode: aNode ^ Array with: (OBAction label: 'browse full' receiver: self selector: #browseFull: arguments: { aNode } keystroke: $b) with: (OBAction label: 'browse hierarchy' receiver: self selector: #browseHierarchy: arguments: { aNode } keystroke: $h)! ! !OBBrowserInspectorActor methodsFor: 'actions' stamp: 'lr 3/4/2006 18:56'! browseFull: aNode OBSystemBrowser openOnClass: aNode value class! ! !OBBrowserInspectorActor methodsFor: 'actions' stamp: 'lr 3/4/2006 19:13'! browseHierarchy: aNode OBHierarchyBrowser openOnClass: aNode value class! ! OBActor subclass: #OBElementInspectorActor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Actors'! !OBElementInspectorActor methodsFor: 'public' stamp: 'lr 3/4/2006 19:31'! actionsForNode: aNode ^ Array with: (OBAction label: 'inspect' receiver: self selector: #inspect: arguments: { aNode } keystroke: $i) with: (OBAction label: 'inspect references' receiver: self selector: #inspectReferences: arguments: { aNode })! ! !OBElementInspectorActor methodsFor: 'actions' stamp: 'lr 3/4/2006 19:35'! inspectReferences: aNode OBInspector openOn: (Utilities pointersTo: aNode value value except: { aNode })! ! !OBElementInspectorActor methodsFor: 'actions' stamp: 'lr 3/4/2006 19:30'! inspect: aNode OBInspector openOn: aNode value! ! !CompiledMethod methodsFor: '*ob-inspector' stamp: 'lr 3/21/2006 00:42'! derivedParts ^ super derivedParts allButLast add: (OBDerivedPart on: self label: 'header' block: [ self headerDescription ]); add: (OBDerivedPart on: self label: 'bytecode' block: [ self symbolic ]); add: (OBDerivedPart on: self label: 'decompiled' block: [ self decompileString ]); add: (OBDerivedPart on: self label: 'source' block: [ self getSource ]); yourself! ! OBNode subclass: #OBInspectorNode instanceVariableNames: 'part' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Nodes'! OBInspectorNode subclass: #OBBasicInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Nodes'! !OBBasicInspectorNode methodsFor: 'accessing' stamp: 'lr 3/20/2006 22:18'! parts ^ Array streamContents: [ :stream | 1 to: self value class instSize do: [ :each | stream nextPut: (OBNamedPart on: self value index: each) ]. 1 to: self value basicSize do: [ :each | stream nextPut: (OBIndexedPart on: self value index: each) ] ]! ! OBInspectorNode subclass: #OBDictionaryInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Nodes'! !OBDictionaryInspectorNode methodsFor: 'accessing' stamp: 'lr 3/21/2006 00:31'! parts ^ Array streamContents: [ :stream | self value keysDo: [ :each | stream nextPut: (OBKeyedPart on: self value key: each) ] ]! ! !OBInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 23:33'! on: aPart ^ self new setPart: aPart; yourself! ! !OBInspectorNode methodsFor: 'drag and drop' stamp: 'lr 3/4/2006 17:43'! asDraggableMorph ^ super asDraggableMorph contents: self text; yourself.! ! !OBInspectorNode methodsFor: 'navigation' stamp: 'lr 3/21/2006 00:25'! children self part isNavigable ifFalse: [ ^ #() ]. ^ (self part value derivedParts , self parts) collect: [ :each | each asInspectorNode ]! ! !OBInspectorNode methodsFor: 'drag and drop' stamp: 'lr 3/20/2006 23:48'! dropOnInspectorNode: aNode aNode part value: self part value! ! !OBInspectorNode methodsFor: 'drag and drop' stamp: 'lr 3/4/2006 17:36'! dropSelector ^ #dropOnInspectorNode:! ! !OBInspectorNode methodsFor: 'delegated' stamp: 'lr 3/20/2006 22:10'! name ^ self part name! ! !OBInspectorNode methodsFor: 'delegated' stamp: 'lr 3/20/2006 22:08'! object ^ self part object! ! !OBInspectorNode methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:56'! part ^ part! ! !OBInspectorNode methodsFor: 'navigation' stamp: 'lr 3/20/2006 21:46'! parts self subclassResponsability! ! !OBInspectorNode methodsFor: 'initialization' stamp: 'lr 3/20/2006 22:05'! setPart: aPart part := aPart! ! !OBInspectorNode methodsFor: 'public' stamp: 'lr 3/21/2006 00:36'! text ^ self value asString! ! !OBInspectorNode methodsFor: 'public' stamp: 'lr 3/20/2006 23:46'! text: aString ^ self part compile: aString in: nil! ! !OBInspectorNode methodsFor: 'delegated' stamp: 'lr 3/20/2006 23:32'! value ^ self part value! ! !OBInspectorNode methodsFor: 'drag and drop' stamp: 'lr 3/20/2006 23:52'! wantsDroppedNode: aNode ^ self ~= aNode and: [ self part isReadOnly not ] and: [ super wantsDroppedNode: aNode ]! ! OBInspectorNode subclass: #OBSequenceInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Nodes'! OBSequenceInspectorNode subclass: #OBArrayInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Nodes'! !OBSequenceInspectorNode methodsFor: 'as yet unclassified' stamp: 'lr 3/20/2006 22:18'! parts ^ Array streamContents: [ :stream | 1 to: self value size do: [ :each | stream nextPut: (OBKeyedPart on: self value key: each) ] ]! ! OBInspectorNode subclass: #OBSetInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Nodes'! !OBSetInspectorNode methodsFor: 'as yet unclassified' stamp: 'lr 3/20/2006 23:55'! parts ^ Array streamContents: [ :stream | self value do: [ :each | stream nextPut: (OBSetPart on: self value element: each) ] ]! ! Object subclass: #OBInspectorPart instanceVariableNames: 'object' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Parts'! OBInspectorPart subclass: #OBDerivedPart instanceVariableNames: 'label block' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Parts'! !OBDerivedPart class methodsFor: 'instance creation' stamp: 'lr 3/21/2006 00:20'! on: anObject label: aString block: aBlock ^ self new setObject: anObject; setLabel: aString; setBlock: aBlock; yourself! ! !OBDerivedPart methodsFor: 'accessing' stamp: 'lr 3/21/2006 00:04'! block ^ block! ! !OBDerivedPart methodsFor: 'testing' stamp: 'lr 3/21/2006 00:18'! isNavigable ^ false! ! !OBDerivedPart methodsFor: 'testing' stamp: 'lr 3/21/2006 00:05'! isReadOnly ^ true! ! !OBDerivedPart methodsFor: 'accessing' stamp: 'lr 3/21/2006 00:04'! label ^ label! ! !OBDerivedPart methodsFor: 'public' stamp: 'lr 3/21/2006 00:23'! name ^ '(' , self label , ')'! ! !OBDerivedPart methodsFor: 'initialization' stamp: 'lr 3/21/2006 00:03'! setBlock: aBlock block := aBlock! ! !OBDerivedPart methodsFor: 'initialization' stamp: 'lr 3/21/2006 00:23'! setLabel: aString label := aString! ! !OBDerivedPart methodsFor: 'public' stamp: 'lr 3/21/2006 00:22'! value ^ self block value! ! OBInspectorPart subclass: #OBIndexedPart instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Parts'! !OBIndexedPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:12'! on: anObject index: anInteger ^ self new setObject: anObject; setIndex: anInteger; yourself! ! !OBIndexedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:12'! index ^ index! ! !OBIndexedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 22:10'! name ^ self index asString! ! !OBIndexedPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:11'! setIndex: anInteger index := anInteger! ! !OBIndexedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:10'! value ^ self object basicAt: self index! ! !OBIndexedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:11'! value: anObject self object basicAt: self index put: anObject! ! !OBInspectorPart methodsFor: 'converting' stamp: 'lr 3/20/2006 22:14'! asInspectorNode ^ self value inspectorClasses first on: self! ! !OBInspectorPart methodsFor: 'public' stamp: 'lr 3/20/2006 23:45'! compile: aString in: aContext self isReadOnly ifTrue: [ ^ false ]. self value: (self object class evaluatorClass new evaluate: aString in: aContext to: self object notifying: nil ifFail: [ ^ false ] logged: false). ^ true! ! !OBInspectorPart methodsFor: 'testing' stamp: 'lr 3/21/2006 00:18'! isNavigable ^ true! ! !OBInspectorPart methodsFor: 'testing' stamp: 'lr 3/20/2006 21:59'! isReadOnly ^ false! ! !OBInspectorPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:09'! object ^ object! ! !OBInspectorPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:00'! setObject: anObject object := anObject! ! !OBInspectorPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:08'! value self subclassResponsability! ! OBInspectorPart subclass: #OBKeyedPart instanceVariableNames: 'key' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Parts'! !OBKeyedPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:14'! on: anObject key: aKey ^ self new setObject: anObject; setKey: aKey; yourself! ! !OBKeyedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:14'! key ^ key! ! !OBKeyedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 22:10'! name ^ self key asString! ! !OBKeyedPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 22:08'! setKey: anObject key := anObject! ! !OBKeyedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:13'! value ^ self object at: self key! ! !OBKeyedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:14'! value: anObject self object at: self key put: anObject! ! OBInspectorPart subclass: #OBNamedPart instanceVariableNames: 'name index' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Parts'! !OBNamedPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:03'! on: anObject index: anInteger ^ self new setObject: anObject; setIndex: anInteger; yourself! ! !OBNamedPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:04'! on: anObject name: aString ^ self new setObject: anObject; setName: aString; yourself! ! !OBNamedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:10'! index ^ index! ! !OBNamedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:10'! name ^ name! ! !OBNamedPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:07'! setIndex: anInteger name := self object class allInstVarNames at: (index := anInteger)! ! !OBNamedPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:07'! setName: aString index := self object class allInstVarNames indexOf: (name := aString)! ! !OBNamedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:10'! value ^ self object instVarAt: self index! ! !OBNamedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:09'! value: anObject self object instVarAt: self index put: anObject! ! OBInspectorPart subclass: #OBRootPart instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Parts'! !OBRootPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 22:03'! on: anObject ^ self new setObject: anObject; yourself! ! !OBRootPart methodsFor: 'testing' stamp: 'lr 3/20/2006 21:58'! isReadOnly ^ true! ! !OBRootPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:58'! value ^ self object! ! OBInspectorPart subclass: #OBSetPart instanceVariableNames: 'element' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Parts'! !OBSetPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:53'! on: anObject element: anotherObject ^ self new setObject: anObject; setElement: anotherObject; yourself! ! !OBSetPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:52'! element ^ element! ! !OBSetPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 23:56'! name ^ self element printString! ! !OBSetPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:52'! setElement: anObject element := anObject! ! !OBSetPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:52'! value ^ self element! ! !OBSetPart methodsFor: 'public' stamp: 'lr 3/20/2006 23:59'! value: anObject self object remove: self element; add: anObject. self setElement: anObject! ! !Object methodsFor: '*ob-inspector' stamp: 'lr 3/21/2006 00:20'! derivedParts ^ OrderedCollection with: (OBDerivedPart on: self label: 'self' block: [ self ])! ! !Object methodsFor: '*ob-inspector' stamp: 'lr 3/20/2006 21:32'! inspectorClasses ^ Array with: OBBasicInspectorNode! ! OBBrowser subclass: #OBInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Inspector-Browser'! !OBInspector class methodsFor: 'configuration' stamp: 'lr 3/20/2006 22:01'! defaultMetaNode | element | element := OBMetaNode named: 'element'. element childAt: #children put: element; addActor: OBBrowserInspectorActor new; addActor: OBElementInspectorActor new. ^ element! ! !OBInspector class methodsFor: 'instance creation' stamp: 'lr 3/20/2006 22:02'! on: anObject ^ super root: (OBRootPart on: anObject) asInspectorNode! ! !OBInspector class methodsFor: 'opening' stamp: 'lr 3/3/2006 23:34'! openOn: anObject ^ (self on: anObject) open! ! !OBInspector class methodsFor: 'configuration' stamp: 'lr 3/4/2006 17:33'! paneCount ^ 2! ! !OBInspector class methodsFor: 'configuration' stamp: 'lr 3/3/2006 23:32'! title ^ 'Inspector'! ! !OBInspector methodsFor: 'morphic' stamp: 'lr 3/4/2006 17:33'! initialExtent ^ 350 @ 350! ! !Fraction methodsFor: '*ob-inspector' stamp: 'lr 3/21/2006 00:15'! derivedParts ^ super derivedParts add: (OBDerivedPart on: self label: 'float' block: [ self asFloat ]); yourself! ! !OrderedCollection methodsFor: '*ob-inspector' stamp: 'lr 3/20/2006 21:32'! inspectorClasses ^ Array with: OBSequenceInspectorNode! ! !Collection methodsFor: '*ob-inspector' stamp: 'lr 3/21/2006 00:20'! derivedParts ^ super derivedParts add: (OBDerivedPart on: self label: 'size' block: [ self size ]); yourself! ! !Integer methodsFor: '*ob-inspector' stamp: 'lr 3/21/2006 00:26'! derivedParts ^ super derivedParts add: (OBDerivedPart on: self label: 'hex' block: [ self printStringRadix: 16 ]); add: (OBDerivedPart on: self label: 'oct' block: [ self printStringRadix: 8 ]); add: (OBDerivedPart on: self label: 'bin' block: [ self printStringRadix: 2 ]); yourself! ! !Set methodsFor: '*ob-inspector' stamp: 'lr 3/20/2006 21:33'! inspectorClasses ^ Array with: OBSetInspectorNode! ! !ArrayedCollection methodsFor: '*ob-inspector' stamp: 'lr 3/20/2006 21:32'! inspectorClasses ^ Array with: OBArrayInspectorNode! ! !Dictionary methodsFor: '*ob-inspector' stamp: 'lr 3/20/2006 21:33'! inspectorClasses ^ Array with: OBDictionaryInspectorNode! !