SystemOrganization addCategory: #'OB-Tools-Debugger'! SystemOrganization addCategory: #'OB-Tools-Inspector'! SystemOrganization addCategory: #'OB-Tools-Utilities'! !Bag methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:28'! elementInspectorNodes ^ contents elementInspectorNodes! ! !Set methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:33'! elementInspectorNodes ^ Array streamContents: [ :stream | self do: [ :each | stream nextPut: (OTSetInspectorNode on: self value: each) ] ]! ! OBNode subclass: #OTDebugNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! OTDebugNode subclass: #OTContextNode instanceVariableNames: 'parent context parseTree sourceMap selectionInterval' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTContextNode class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 09:05'! parent: aProcessNode context: aContext ^ self basicNew initializeParent: aProcessNode context: aContext! ! !OTContextNode methodsFor: 'comparing' stamp: 'lr 4/26/2007 14:52'! = anObject ^ self class = anObject class and: [ self context = anObject context ]! ! !OTContextNode methodsFor: 'accessing' stamp: 'lr 4/25/2007 19:48'! context ^ context! ! !OTContextNode methodsFor: 'callbacks' stamp: 'lr 4/26/2007 15:07'! doItContext ^ self context! ! !OTContextNode methodsFor: 'callbacks' stamp: 'lr 4/26/2007 15:07'! doItReceiver ^ self context receiver! ! !OTContextNode methodsFor: 'comparing' stamp: 'lr 4/25/2007 19:56'! hash ^ self context hash! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:04'! homeContext ^ self context finalBlockHome! ! !OTContextNode methodsFor: 'initialization' stamp: 'lr 4/26/2007 14:49'! initializeParent: aProcessNode context: aContext parent := aProcessNode. context := aContext! ! !OTContextNode methodsFor: 'displaying' stamp: 'lr 4/26/2007 09:22'! name ^ self context asString! ! !OTContextNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:17'! parent ^ parent! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 14:50'! parseTree "Answer the parse tree representing the source code of the current context." ^ parseTree ifNil: [ parseTree := self context methodNode ]! ! !OTContextNode methodsFor: 'accessing' stamp: 'lr 4/25/2007 19:48'! process ^ parent process! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:20'! selectionInterval "Answer the interval of the current source code." | index stop | selectionInterval ifNotNil: [ ^ selectionInterval ]. index := self sourceMap indexForInserting: (Association key: self context previousPc value: nil). index < 1 ifTrue: [ ^ selectionInterval := 0 to: 1 ]. index > self sourceMap size ifTrue: [ stop := self sourceMap detectMax: [ :each | each value last ]. ^ selectionInterval := stop + 1 to: stop ]. ^ selectionInterval := (self sourceMap at: index) value! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 14:52'! sourceMap "Answer a mapping from byte codes to source code ranges." ^ sourceMap ifNil: [ sourceMap := self parseTree sourceMap ]! ! !OTContextNode methodsFor: 'definition' stamp: 'lr 4/26/2007 15:14'! text | contents | contents := self parseTree sourceText asText. self parseTree isDoIt ifFalse: [ contents := contents makeSelectorBold ]. ^ contents! ! !OTContextNode methodsFor: 'definition' stamp: 'lr 4/26/2007 15:06'! text: aString | class | class := self homeContext receiver class whichClassIncludesSelector: self homeContext selector. (class compile: aString) ifNil: [ ^ false ]. self process popTo: self homeContext; restartTopWith: (class compiledMethodAt: self homeContext selector); stepToSendOrReturn. OBAnnouncer current announce: (OBChildrenChanged node: self parent); announce: (OBSelectingNode node: self parent currentContextNode). ^ true! ! !OTContextNode methodsFor: 'definition' stamp: 'lr 4/26/2007 15:07'! textSelection ^ self selectionInterval! ! !OTDebugNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 22:48'! context self subclassResponsibility! ! !OTDebugNode methodsFor: 'testing' stamp: 'lr 4/26/2007 15:33'! hasSelector ^ true! ! !OTDebugNode methodsFor: 'testing' stamp: 'lr 4/26/2007 15:33'! hasVersions ^ true! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:46'! methodReference ^ MethodReference class: self theClass selector: self selector! ! !OTDebugNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 22:48'! process self subclassResponsibility! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:36'! selector ^ self context selector! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:36'! theClass ^ self context receiver class whichClassIncludesSelector: self selector! ! OTDebugNode subclass: #OTProcessNode instanceVariableNames: 'process' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTProcessNode class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 09:06'! process: aProcess ^ self basicNew initializeProcess: aProcess! ! !OTProcessNode methodsFor: 'comparing' stamp: 'lr 4/26/2007 14:52'! = anObject ^ self class = anObject class and: [ self process = anObject process ]! ! !OTProcessNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:11'! context ^ process suspendedContext! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 4/26/2007 16:39'! currentContextNode ^ OTContextNode parent: self context: self context! ! !OTProcessNode methodsFor: 'comparing' stamp: 'lr 4/25/2007 19:48'! hash ^ self process hash! ! !OTProcessNode methodsFor: 'initialization' stamp: 'lr 4/26/2007 09:11'! initializeProcess: aProcess process := aProcess! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 4/25/2007 20:24'! longStack ^ self stackOfSize: 1024! ! !OTProcessNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:22'! name ^ self process asString! ! !OTProcessNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:11'! process ^ process! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 4/25/2007 20:25'! shortStack ^ self stackOfSize: 64! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 4/26/2007 16:16'! stackOfSize: anInteger "Answer a stack of contexts of the given size." | current stack | current := self context. stack := OrderedCollection new: anInteger. [ current notNil and: [ stack size < anInteger ] ] whileTrue: [ stack addLast: (OTContextNode parent: self context: current). current := current sender ]. ^ stack! ! OBNode subclass: #OTInspectorNode instanceVariableNames: 'object' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTInspectorNode subclass: #OTDerivedInspectorNode instanceVariableNames: 'label block' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTDerivedInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 10:15'! on: anObject label: aString block: aBlock ^ (self on: anObject) setLabel: aString block: aBlock! ! !OTDerivedInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:35'! block ^ block! ! !OTDerivedInspectorNode methodsFor: 'testing' stamp: 'lr 5/23/2007 23:03'! isLastNode ^ true! ! !OTDerivedInspectorNode methodsFor: 'testing' stamp: 'lr 5/19/2007 10:15'! isReadOnly ^ true! ! !OTDerivedInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! label ^ label! ! !OTDerivedInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! name ^ '(' , self label , ')'! ! !OTDerivedInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 10:15'! setLabel: aString block: aBlock label := aString. block := aBlock! ! !OTDerivedInspectorNode methodsFor: 'accessing' stamp: 'lr 5/7/2007 16:05'! value ^ self block value: self object! ! OTInspectorNode subclass: #OTDictionaryInspectorNode instanceVariableNames: 'key' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTDictionaryInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 11:02'! on: anObject key: aKey ^ (self on: anObject) setKey: aKey! ! !OTDictionaryInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:01'! key ^ key! ! !OTDictionaryInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! name ^ self key! ! !OTDictionaryInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 11:01'! setIndex: anInteger index := anInteger! ! !OTDictionaryInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 11:02'! setKey: anObject key := anObject! ! !OTDictionaryInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:02'! value ^ self object at: self key! ! !OTDictionaryInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:02'! value: anObject self object at: self key put: anObject! ! OTInspectorNode subclass: #OTIndexedVariableNode instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTIndexedVariableNode class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 10:17'! on: anObject index: anInteger ^ (super on: anObject) setIndex: anInteger! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:20'! index ^ index! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! name ^ self index printString! ! !OTIndexedVariableNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 10:18'! setIndex: anInteger index := anInteger! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:19'! value ^ self object basicAt: self index! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:20'! value: anObject self object basicAt: self index put: anObject! ! !OTInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 10:23'! on: anObject ^ self basicNew initializeOn: anObject! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 5/19/2007 11:41'! asDraggableMorph ^ super asDraggableMorph contents: self label; yourself! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'lr 5/23/2007 23:04'! basicNodes ^ self childrenAt: #basicInspectorNodes! ! !OTInspectorNode methodsFor: 'private' stamp: 'lr 5/23/2007 23:09'! childrenAt: aSelector self isLastNode ifTrue: [ ^ #() ]. ^ self value perform: aSelector! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 5/7/2007 15:47'! dropOnInspectorNode: aNode aNode value: self value! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 3/4/2006 17:36'! dropSelector ^ #dropOnInspectorNode:! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'lr 5/23/2007 23:04'! elementNodes ^ self childrenAt: #elementInspectorNodes! ! !OTInspectorNode methodsFor: 'initialization' stamp: 'lr 5/7/2007 16:05'! initializeOn: anObject object := anObject! ! !OTInspectorNode methodsFor: 'testing' stamp: 'lr 5/23/2007 23:03'! isLastNode ^ false! ! !OTInspectorNode methodsFor: 'testing' stamp: 'lr 5/7/2007 15:48'! isReadOnly ^ false! ! !OTInspectorNode methodsFor: 'displaying' stamp: 'lr 5/7/2007 16:00'! label ^ self value defaultLabelForInspector! ! !OTInspectorNode methodsFor: 'displaying' stamp: 'lr 5/7/2007 15:49'! name ^ self value name! ! !OTInspectorNode methodsFor: 'accessing' stamp: 'lr 5/7/2007 15:45'! object ^ object! ! !OTInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 08:54'! object: anObject object := anObject! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'lr 5/23/2007 23:04'! protocolNodes ^ self childrenAt: #protocolInspectorNodes! ! !OTInspectorNode methodsFor: 'compatibility' stamp: 'lr 4/26/2007 16:41'! selector ^ nil! ! !OTInspectorNode methodsFor: 'public' stamp: 'lr 3/21/2006 00:36'! text ^ self value asString! ! !OTInspectorNode methodsFor: 'public' stamp: 'lr 5/19/2007 10:45'! text: aString ^ self value: (self object class evaluatorClass evaluate: aString for: self object logged: false)! ! !OTInspectorNode methodsFor: 'compatibility' stamp: 'lr 4/26/2007 16:41'! theClass ^ self value class! ! !OTInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:14'! value ^ nil! ! !OTInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:14'! value: anObject! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 5/7/2007 15:47'! wantsDroppedNode: aNode ^ (super wantsDroppedNode: aNode) and: [ self isReadOnly not ]! ! OTInspectorNode subclass: #OTNamedVariableNode instanceVariableNames: 'index name' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTNamedVariableNode class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 10:19'! on: anObject index: anInteger name: aString ^ (super on: anObject) setIndex: anInteger name: aString! ! !OTNamedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:21'! index ^ index! ! !OTNamedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:21'! name ^ name! ! !OTNamedVariableNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 10:19'! setIndex: anInteger name: aString index := anInteger. name := aString! ! !OTNamedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:20'! value ^ self object instVarAt: self index! ! !OTNamedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:20'! value: anObject self object instVarAt: self index put: anObject! ! OTInspectorNode subclass: #OTProtocolInspectorNode instanceVariableNames: 'selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTProtocolInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 10:37'! on: anObject selector: aSelector ^ (self on: anObject) setSelector: aSelector! ! !OTProtocolInspectorNode methodsFor: 'drag and drop' stamp: 'lr 5/19/2007 11:50'! acceptDroppedNode: aNode (self value perform: self selector withArguments: (Array with: aNode value)) inspect! ! !OTProtocolInspectorNode methodsFor: 'testing' stamp: 'lr 5/23/2007 23:03'! isLastNode ^ true! ! !OTProtocolInspectorNode methodsFor: 'testing' stamp: 'lr 5/19/2007 10:38'! isReadOnly ^ true! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! name ^ '#' , self selector! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:38'! selector ^ selector! ! !OTProtocolInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 10:38'! setSelector: aSelector selector := aSelector! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:49'! text | class | class := self theClass whichClassIncludesSelector: self selector. ^ class sourceCodeAt: self selector! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:49'! value ^ self object! ! !OTProtocolInspectorNode methodsFor: 'drag and drop' stamp: 'lr 5/19/2007 11:18'! wantsDroppedNode: aNode ^ self selector numArgs = 1! ! OTInspectorNode subclass: #OTRootInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTRootInspectorNode methodsFor: 'testing' stamp: 'lr 5/7/2007 15:52'! isReadOnly ^ true! ! !OTRootInspectorNode methodsFor: 'accessing' stamp: 'lr 5/7/2007 15:53'! value ^ self object! ! OTInspectorNode subclass: #OTSequenceInspectorNode instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTSequenceInspectorNode subclass: #OTArrayInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTSequenceInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 11:03'! on: anObject index: anInteger ^ (super on: anObject) setIndex: anInteger! ! !OTSequenceInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:03'! index ^ index! ! !OTSequenceInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! name ^ self index printString! ! !OTSequenceInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 11:03'! setIndex: anInteger index := anInteger! ! !OTSequenceInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:03'! value ^ self object at: self index! ! !OTSequenceInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:03'! value: anObject self object at: self index put: anObject! ! OTInspectorNode subclass: #OTSetInspectorNode instanceVariableNames: 'value' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTSetInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 11:06'! on: anObject value: aValue ^ (self on: anObject) setValue: aValue! ! !OTSetInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 11:06'! setValue: anObject value := anObject! ! !OTSetInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:04'! value ^ value! ! !OTSetInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:05'! value: anObject self object remove: anObject ifAbsent: []; add: anObject! ! !Collection methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:34'! derivedInspectorNodes ^ super derivedInspectorNodes add: (OTDerivedInspectorNode on: self label: 'size' block: [ :obj | obj size ]); yourself! ! OBBrowser subclass: #OTDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 4/25/2007 19:59'! defaultMetaNode | process context | process := OBMetaNode named: 'process'. context := OBMetaNode named: 'context'. process childAt: #shortStack put: context. ^ process! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 5/7/2007 15:35'! inspectorPanel ^ OTInspectorPanel new! ! !OTDebugger class methodsFor: 'opening' stamp: 'lr 4/26/2007 09:07'! openProcess: aProcess ^ (self process: aProcess) open! ! !OTDebugger class methodsFor: 'opening' stamp: 'lr 4/26/2007 09:07'! openProcess: aProcess context: aContext ^ (self process: aProcess context: aContext) open! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 4/25/2007 14:16'! paneCount ^ 1! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 5/23/2007 23:24'! panels ^ super panels " , { self inspectorPanels } "! ! !OTDebugger class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 09:09'! process: aProcess ^ self process: aProcess context: nil! ! !OTDebugger class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 16:16'! process: aProcess context: aContext | processNode contextNode | aProcess isSuspended ifFalse: [ self error: 'Unable to debug a running process.' ]. processNode := OTProcessNode process: aProcess. contextNode := OTContextNode parent: processNode context: (aContext ifNil: [ aProcess suspendedContext ]). ^ self root: processNode selection: contextNode! ! !OTDebugger class methodsFor: 'debugging' stamp: 'dc 6/1/2007 12:01'! raiseExceptionAndOpenThisDebugger |var1 var2 var3| var2 := 3/4. var3 := OrderedCollection withAll: #(1 false #(a b c)). var1 := Dictionary new at: #x put: 'This is a string' copy; at: 123 put: #'a new number is born'; at: $a put: var2; at: #() put: var3. var3 add: var1. OTToolset debug: Processor activeProcess context: thisContext label: 'Label' contents: nil fullView: true! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 4/25/2007 14:16'! title ^ 'Debugger'! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 5/19/2007 10:06'! cmdsCommands ^ OTCmdDebugger allSubclasses! ! !OTDebugger methodsFor: 'building' stamp: 'lr 4/25/2007 14:14'! defaultBackgroundColor ^ Color lightRed! ! !OTDebugger methodsFor: 'building' stamp: 'lr 4/25/2007 18:44'! initialExtent ^ 600 @ 500 ! ! OBBrowser subclass: #OTInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/23/2007 23:50'! defaultMetaNode | element | element := OBMetaNode named: 'element'. element childAt: #basicNodes labeled: 'basic' put: element; childAt: #elementNodes labeled: 'elements' put: element; childAt: #protocolNodes labeled: 'prototcol' put: element. element addFilter: OBModalFilter new. ^ element! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/7/2007 15:54'! defaultRootNode ^ OTRootInspectorNode on: nil! ! !OTInspector class methodsFor: 'instance-creation' stamp: 'lr 5/19/2007 10:23'! on: anObject ^ self root: (OTRootInspectorNode on: anObject)! ! !OTInspector class methodsFor: 'opening' stamp: 'lr 3/3/2006 23:34'! openOn: anObject ^ (self on: anObject) open! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/19/2007 10:44'! optionalButtonPanel ^ nil! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 3/4/2006 17:33'! paneCount ^ 2! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 3/3/2006 23:32'! title ^ 'Inspector'! ! !OTInspector methodsFor: 'commands' stamp: 'lr 5/19/2007 10:07'! cmdBrowse ^ OTCmdBrowse! ! !OTInspector methodsFor: 'commands' stamp: 'lr 5/19/2007 10:07'! cmdHierarchy ^ OTCmdHierarchy! ! !OTInspector methodsFor: 'commands' stamp: 'lr 5/19/2007 10:09'! cmdInspect ^ OTCmdInspectObject! ! !OTInspector methodsFor: 'commands' stamp: 'lr 5/19/2007 10:09'! cmdInspectReferences ^ OTCmdInspectReferences! ! !OTInspector methodsFor: 'morphic' stamp: 'lr 3/4/2006 17:33'! initialExtent ^ 350 @ 350! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:34'! derivedInspectorNodes ^ super derivedInspectorNodes allButLast add: (OTDerivedInspectorNode on: self label: 'header' block: [ :obj | obj headerDescription ]); add: (OTDerivedInspectorNode on: self label: 'bytecode' block: [ :obj | obj symbolic ]); add: (OTDerivedInspectorNode on: self label: 'decompiled' block: [ :obj | obj decompileString ]); add: (OTDerivedInspectorNode on: self label: 'source' block: [ :obj | obj getSource ]); yourself! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:45'! elementInspectorNodes ^ #()! ! !ArrayedCollection methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:28'! elementInspectorNodes ^ (1 to: self size) collect: [ :each | OTArrayInspectorNode on: self index: each ]! ! StandardToolSet subclass: #OTToolset instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTToolset class methodsFor: 'inspecting' stamp: 'lr 4/26/2007 16:32'! basicInspect: anObject self inspect: anObject! ! !OTToolset class methodsFor: 'debugging' stamp: 'lr 5/23/2007 23:25'! debug: aProcess context: aContext label: aString contents: aContentString fullView: aBool Project spawnNewProcessIfThisIsUI: aProcess. WorldState addDeferredUIMessage: [ aProcess suspend; suspendedContext: aContext. OTDebugger openProcess: aProcess context: aContext ]. aProcess suspend! ! !OTToolset class methodsFor: 'initialization' stamp: 'lr 4/26/2007 15:57'! initialize ToolSet register: self! ! !OTToolset class methodsFor: 'inspecting' stamp: 'lr 4/26/2007 16:32'! inspect: anObject OTInspector openOn: anObject! ! !OTToolset class methodsFor: 'inspecting' stamp: 'lr 4/26/2007 16:32'! inspect: anObject label: aString self inspect: anObject! ! OBPanel subclass: #OTInspectorPanel instanceVariableNames: 'receiver context' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !SequenceableCollection methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:28'! elementInspectorNodes ^ (1 to: self size) collect: [ :each | OTSequenceInspectorNode on: self index: each ]! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:34'! basicInspectorNodes ^ Array streamContents: [ :stream | stream nextPutAll: self derivedInspectorNodes. self class allInstVarNames withIndexDo: [ :name :index | stream nextPut: (OTNamedVariableNode on: self index: index name: name) ]. 1 to: self basicSize do: [ :index | stream nextPut: (OTIndexedVariableNode on: self index: index) ] ]! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 10:24'! derivedInspectorNodes ^ OrderedCollection with: (OTDerivedInspectorNode on: self label: 'self' block: [ :obj | obj ])! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:30'! elementInspectorNodes ^ #()! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:23'! protocolInspectorNodes ^ self class allSelectors asArray sort collect: [ :each | OTProtocolInspectorNode on: self selector: each ]! ! !Dictionary methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:32'! elementInspectorNodes ^ Array streamContents: [ :stream | self keysDo: [ :each | stream nextPut: (OTDictionaryInspectorNode on: self key: each) ] ]! ! !Fraction methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:34'! derivedInspectorNodes ^ super derivedInspectorNodes add: (OTDerivedInspectorNode on: self label: 'float' block: [ :obj | obj asFloat ]); yourself! ! OBCommand subclass: #OTCmdDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! OTCmdDebugger subclass: #OTCmdBrowse instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdBrowse methodsFor: 'execution' stamp: 'lr 4/26/2007 15:37'! execute OBSystemBrowser openOnClass: target theClass selector: target selector! ! !OTCmdBrowse methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:41'! group ^ #browse! ! !OTCmdBrowse methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:37'! keystroke ^ $b! ! !OTCmdBrowse methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:35'! label ^ 'browse'! ! OTCmdBrowse subclass: #OTCmdHierarchy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdHierarchy methodsFor: 'execution' stamp: 'lr 4/26/2007 15:38'! execute OBHierarchyBrowser openOnClass: target theClass! ! !OTCmdHierarchy methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:43'! keystroke ^ nil! ! !OTCmdHierarchy methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:42'! label ^ 'browse hierarchy'! ! OTCmdBrowse subclass: #OTCmdImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdImplementors methodsFor: 'execution' stamp: 'lr 4/26/2007 15:46'! execute OBImplementorsBrowser browseRoot: target methodReference asNode! ! !OTCmdImplementors methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:40'! keystroke ^ $m! ! !OTCmdImplementors methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:40'! label ^ 'browse implementors'! ! OTCmdBrowse subclass: #OTCmdSenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdSenders methodsFor: 'execution' stamp: 'lr 4/26/2007 15:46'! execute OBSendersBrowser browseRoot: target methodReference asNode! ! !OTCmdSenders methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:43'! keystroke ^ $n! ! !OTCmdSenders methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:39'! label ^ 'browse senders'! ! !OTCmdDebugger methodsFor: 'actions' stamp: 'lr 4/26/2007 09:17'! announce: anAnnouncement requestor announce: anAnnouncement! ! !OTCmdDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! context ^ target context! ! !OTCmdDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 19:02'! isActive ^ requestor isSelected: target! ! !OTCmdDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! process ^ target process! ! !OTCmdDebugger methodsFor: 'actions' stamp: 'lr 4/26/2007 09:21'! update self announce: (OBChildrenChanged node: target parent). self announce: (OBSelectingNode node: target parent currentContextNode)! ! OTCmdDebugger subclass: #OTCmdInspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdInspect methodsFor: 'execution' stamp: 'lr 4/26/2007 15:28'! execute target context inspect! ! !OTCmdInspect methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:47'! group ^ #inspect! ! !OTCmdInspect methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:28'! label ^ 'inspect context'! ! OTCmdInspect subclass: #OTCmdInspectReceiver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdInspectReceiver methodsFor: 'execution' stamp: 'lr 4/26/2007 15:28'! execute target context receiver inspect! ! !OTCmdInspectReceiver methodsFor: 'accessing' stamp: 'lr 4/26/2007 15:28'! label ^ 'inspect receiver'! ! OTCmdDebugger subclass: #OTCmdInto instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdInto methodsFor: 'execution' stamp: 'lr 4/26/2007 09:34'! execute target process step: target context; stepToSendOrReturn. self update! ! !OTCmdInto methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:07'! label ^ 'into'! ! !OTCmdInto methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdOver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdOver methodsFor: 'execution' stamp: 'lr 4/26/2007 15:49'! execute target process completeStep: target context; stepToSendOrReturn. self update! ! !OTCmdOver methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:07'! label ^ 'over'! ! !OTCmdOver methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdProceed instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdProceed methodsFor: 'execution' stamp: 'lr 4/26/2007 09:14'! execute World allMorphs do: [ :each | each model == requestor browser ifTrue: [ each delete ] ]. target process resume! ! !OTCmdProceed methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:20'! icon ^ MenuIcons tryIcons: #(smallForwardIcon)! ! !OTCmdProceed methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:07'! label ^ 'proceed'! ! !OTCmdProceed methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdRestart instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdRestart methodsFor: 'execution' stamp: 'lr 4/26/2007 09:35'! execute self process popTo: self context; restartTop; stepToSendOrReturn. self update! ! !OTCmdRestart methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:09'! label ^ 'restart'! ! !OTCmdRestart methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdReturn instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdReturn methodsFor: 'execution' stamp: 'lr 4/26/2007 09:39'! execute | expression value | expression := OBTextRequest prompt: 'Enter expression for return value:' template: 'nil'. value := Compiler new evaluate: expression in: target context to: target context receiver. target process popTo: target context sender value: value; stepToSendOrReturn. self update! ! !OTCmdReturn methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:15'! label ^ 'return'! ! !OTCmdReturn methodsFor: 'testing' stamp: 'lr 4/25/2007 18:15'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdThrough instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdThrough methodsFor: 'execution' stamp: 'lr 4/26/2007 09:34'! execute target process stepToHome: target context; stepToSendOrReturn. self update! ! !OTCmdThrough methodsFor: 'accessing' stamp: 'lr 5/31/2007 07:41'! label ^ 'through'! ! !OTCmdThrough methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OBCommand subclass: #OTCmdInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTCmdInspector subclass: #OTCmdInspectObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTCmdInspectObject methodsFor: 'execution' stamp: 'lr 4/26/2007 16:37'! execute target value inspect! ! !OTCmdInspectObject methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:06'! keystroke ^ $i! ! !OTCmdInspectObject methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:05'! label ^ 'inspect'! ! OTCmdInspector subclass: #OTCmdInspectReferences instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTCmdInspectReferences methodsFor: 'execution' stamp: 'lr 5/7/2007 16:03'! execute (Utilities pointersTo: target value except: (Array with: target)) inspect! ! !OTCmdInspectReferences methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:07'! label ^ 'inspect references'! ! !OTCmdInspector methodsFor: 'accessing' stamp: 'lr 4/26/2007 16:38'! group ^ #inspection! ! !OTCmdInspector methodsFor: 'testing' stamp: 'lr 4/26/2007 16:38'! isActive ^ requestor isSelected: target! ! !Integer methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:34'! derivedInspectorNodes ^ super derivedInspectorNodes add: (OTDerivedInspectorNode on: self label: 'hex' block: [ :obj | obj printStringRadix: 16 ]); add: (OTDerivedInspectorNode on: self label: 'oct' block: [ :obj | obj printStringRadix: 8 ]); add: (OTDerivedInspectorNode on: self label: 'bin' block: [ :obj | obj printStringRadix: 2 ]); yourself! ! OTToolset initialize!