SystemOrganization addCategory: #'OB-Tools-Debugger'! SystemOrganization addCategory: #'OB-Tools-Inspector'! SystemOrganization addCategory: #'OB-Tools-Utilities'! !Set methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 22:31'! elementsInspectorNode ^ OTSetInspectorNode! ! 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/25/2007 19:13'! context "Answer a suspended 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/25/2007 19:12'! process "Answer the suspended 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: 'part' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTInspectorNode subclass: #OTBasicInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTBasicInspectorNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 16:28'! parts ^ Array streamContents: [ :stream | 1 to: self value class instSize do: [ :each | stream nextPut: (OTNamedPart on: self value index: each) ]. 1 to: self value basicSize do: [ :each | stream nextPut: (OTIndexedPart on: self value index: each) ] ]! ! OTInspectorNode subclass: #OTDictionaryInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTDictionaryInspectorNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 16:29'! parts ^ Array streamContents: [ :stream | self value keysDo: [ :each | stream nextPut: (OTKeyedPart on: self value key: each) ] ]! ! !OTInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 23:33'! on: aPart ^ self new setPart: aPart; yourself! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 4/4/2007 10:10'! asDraggableMorph ^ super asDraggableMorph contents: self title; yourself.! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'lr 3/21/2006 00:25'! children self part isNavigable ifFalse: [ ^ #() ]. ^ (self part value derivedParts , self parts) collect: [ :each | each asInspectorNode ]! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 3/20/2006 23:48'! dropOnInspectorNode: aNode aNode part value: self part value! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 3/4/2006 17:36'! dropSelector ^ #dropOnInspectorNode:! ! !OTInspectorNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 22:15'! name ^ self part name! ! !OTInspectorNode methodsFor: 'delegated' stamp: 'lr 3/20/2006 22:08'! object ^ self part object! ! !OTInspectorNode methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:56'! part ^ part! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'lr 3/20/2006 21:46'! parts self subclassResponsability! ! !OTInspectorNode methodsFor: 'compatibility' stamp: 'lr 4/26/2007 16:41'! selector ^ nil! ! !OTInspectorNode methodsFor: 'initialization' stamp: 'lr 4/26/2007 22:45'! setPart: aPart part := aPart! ! !OTInspectorNode methodsFor: 'public' stamp: 'lr 3/21/2006 00:36'! text ^ self value asString! ! !OTInspectorNode methodsFor: 'public' stamp: 'lr 3/20/2006 23:46'! text: aString ^ self part compile: aString in: nil! ! !OTInspectorNode methodsFor: 'compatibility' stamp: 'lr 4/26/2007 16:41'! theClass ^ self value class! ! !OTInspectorNode methodsFor: 'displaying' stamp: 'dc 3/28/2007 17:36'! title ^ self value defaultLabelForInspector ! ! !OTInspectorNode methodsFor: 'delegated' stamp: 'lr 3/20/2006 23:32'! value ^ self part value! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 4/4/2007 10:09'! wantsDroppedNode: aNode ^ self ~= aNode and: [ self part isReadOnly not and: [ super wantsDroppedNode: aNode ] ]! ! OTInspectorNode subclass: #OTProtocolInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTInspectorNode subclass: #OTSequenceInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTSequenceInspectorNode subclass: #OTArrayInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTSequenceInspectorNode methodsFor: 'navigation' stamp: 'lr 4/26/2007 16:29'! parts ^ Array streamContents: [ :stream | 1 to: self value size do: [ :each | stream nextPut: (OTKeyedPart on: self value key: each) ] ]! ! OTInspectorNode subclass: #OTSetInspectorNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTSetInspectorNode methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 16:22'! parts ^ Array streamContents: [ :stream | self value do: [ :each | stream nextPut: (OTSetPart on: self value element: each) ] ]! ! !Collection methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 16:38'! derivedParts ^ super derivedParts add: (OTDerivedPart on: self label: 'size' block: [ self size ]); yourself! ! !Collection methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 22:30'! elementsInspectorNode ^ nil! ! !ArrayedCollection methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 22:31'! elementsInspectorNode ^ OTArrayInspectorNode! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 16:39'! derivedParts ^ super derivedParts allButLast add: (OTDerivedPart on: self label: 'header' block: [ self headerDescription ]); add: (OTDerivedPart on: self label: 'bytecode' block: [ self symbolic ]); add: (OTDerivedPart on: self label: 'decompiled' block: [ self decompileString ]); add: (OTDerivedPart on: self label: 'source' block: [ self getSource ]); yourself! ! 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 4/26/2007 22:47'! 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! ! 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: '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: '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: 'configuration' stamp: 'lr 4/25/2007 14:16'! title ^ 'Debugger'! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 4/26/2007 16:43'! cmdsCommands ^ OTDebuggerCommand 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 4/26/2007 22:46'! defaultMetaNode | element | element := OBMetaNode named: 'element'. element childAt: #children put: element. " filterClass: OTInspectorFilter; childAt: #children put: element." ^ element! ! !OTInspector class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 16:29'! on: anObject ^ self root: (OTRootPart on: anObject) asInspectorNode! ! !OTInspector class methodsFor: 'opening' stamp: 'lr 3/3/2006 23:34'! openOn: anObject ^ (self on: anObject) open! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 4/26/2007 17:00'! 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 4/26/2007 16:41'! cmdsBrowse ^ { OTBrowseCommand. OTHierarchyCommand}! ! !OTInspector methodsFor: 'commands' stamp: 'lr 4/26/2007 16:37'! cmdsInspect ^ { OTInspectObjectCommand . OTInspectReferencesCommand }! ! !OTInspector methodsFor: 'morphic' stamp: 'lr 3/4/2006 17:33'! initialExtent ^ 350 @ 350! ! !OrderedCollection methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 22:31'! elementsInspectorNode ^ OTSequenceInspectorNode! ! Object subclass: #OTInspectorPart instanceVariableNames: 'object' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTInspectorPart subclass: #OTDerivedPart instanceVariableNames: 'label block' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTDerivedPart 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! ! !OTDerivedPart methodsFor: 'accessing' stamp: 'lr 3/21/2006 00:04'! block ^ block! ! !OTDerivedPart methodsFor: 'testing' stamp: 'lr 3/21/2006 00:18'! isNavigable ^ false! ! !OTDerivedPart methodsFor: 'testing' stamp: 'lr 3/21/2006 00:05'! isReadOnly ^ true! ! !OTDerivedPart methodsFor: 'accessing' stamp: 'lr 3/21/2006 00:04'! label ^ label! ! !OTDerivedPart methodsFor: 'public' stamp: 'lr 3/21/2006 00:23'! name ^ '(' , self label , ')'! ! !OTDerivedPart methodsFor: 'initialization' stamp: 'lr 3/21/2006 00:03'! setBlock: aBlock block := aBlock! ! !OTDerivedPart methodsFor: 'initialization' stamp: 'lr 3/21/2006 00:23'! setLabel: aString label := aString! ! !OTDerivedPart methodsFor: 'public' stamp: 'lr 3/21/2006 00:22'! value ^ self block value! ! OTInspectorPart subclass: #OTIndexedPart instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTIndexedPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:12'! on: anObject index: anInteger ^ self new setObject: anObject; setIndex: anInteger; yourself! ! !OTIndexedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:12'! index ^ index! ! !OTIndexedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 22:10'! name ^ self index asString! ! !OTIndexedPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:11'! setIndex: anInteger index := anInteger! ! !OTIndexedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:10'! value ^ self object basicAt: self index! ! !OTIndexedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:11'! value: anObject self object basicAt: self index put: anObject! ! !OTInspectorPart methodsFor: 'converting' stamp: 'lr 4/26/2007 16:29'! asInspectorNode ^ OTBasicInspectorNode on: self! ! !OTInspectorPart 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! ! !OTInspectorPart methodsFor: 'testing' stamp: 'lr 3/21/2006 00:18'! isNavigable ^ true! ! !OTInspectorPart methodsFor: 'testing' stamp: 'lr 3/20/2006 21:59'! isReadOnly ^ false! ! !OTInspectorPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:09'! object ^ object! ! !OTInspectorPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:00'! setObject: anObject object := anObject! ! !OTInspectorPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:08'! value self subclassResponsability! ! OTInspectorPart subclass: #OTKeyedPart instanceVariableNames: 'key' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTKeyedPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:14'! on: anObject key: aKey ^ self new setObject: anObject; setKey: aKey; yourself! ! !OTKeyedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:14'! key ^ key! ! !OTKeyedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 22:10'! name ^ self key asString! ! !OTKeyedPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 22:08'! setKey: anObject key := anObject! ! !OTKeyedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:13'! value ^ self object at: self key! ! !OTKeyedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:14'! value: anObject self object at: self key put: anObject! ! OTInspectorPart subclass: #OTNamedPart instanceVariableNames: 'name index' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTNamedPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:03'! on: anObject index: anInteger ^ self new setObject: anObject; setIndex: anInteger; yourself! ! !OTNamedPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:04'! on: anObject name: aString ^ self new setObject: anObject; setName: aString; yourself! ! !OTNamedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:10'! index ^ index! ! !OTNamedPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:10'! name ^ name! ! !OTNamedPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:07'! setIndex: anInteger name := self object class allInstVarNames at: (index := anInteger)! ! !OTNamedPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:07'! setName: aString index := self object class allInstVarNames indexOf: (name := aString)! ! !OTNamedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:10'! value ^ self object instVarAt: self index! ! !OTNamedPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:09'! value: anObject self object instVarAt: self index put: anObject! ! OTInspectorPart subclass: #OTRootPart instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTRootPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 22:03'! on: anObject ^ self new setObject: anObject; yourself! ! !OTRootPart methodsFor: 'testing' stamp: 'lr 3/20/2006 21:58'! isReadOnly ^ true! ! !OTRootPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:58'! value ^ self object! ! OTInspectorPart subclass: #OTSetPart instanceVariableNames: 'element' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTSetPart class methodsFor: 'instance-creation' stamp: 'lr 3/20/2006 21:53'! on: anObject element: anotherObject ^ self new setObject: anObject; setElement: anotherObject; yourself! ! !OTSetPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 21:52'! element ^ element! ! !OTSetPart methodsFor: 'accessing' stamp: 'lr 3/20/2006 23:56'! name ^ self element printString! ! !OTSetPart methodsFor: 'initialization' stamp: 'lr 3/20/2006 21:52'! setElement: anObject element := anObject! ! !OTSetPart methodsFor: 'public' stamp: 'lr 3/20/2006 21:52'! value ^ self element! ! !OTSetPart methodsFor: 'public' stamp: 'lr 3/20/2006 23:59'! value: anObject self object remove: self element; add: anObject. self setElement: anObject! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 22:30'! basicInspectorNode ^ OTBasicInspectorNode! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 16:39'! derivedParts ^ OrderedCollection with: (OTDerivedPart on: self label: 'self' block: [ self ])! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 22:30'! protocolInspectorNode ^ OTProtocolInspectorNode! ! OBModalFilter subclass: #OTInspectorFilter instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectorFilter methodsFor: 'callbacks' stamp: 'lr 4/26/2007 22:33'! list ^ self views collect: [ :each | each arguments first ]! ! !OTInspectorFilter methodsFor: 'callbacks' stamp: 'lr 4/26/2007 22:43'! nodesForParent: aNode ^ aNode children! ! !OTInspectorFilter methodsFor: 'callbacks' stamp: 'lr 4/26/2007 22:24'! selectedEdge ^ self views at: self selection! ! !OTInspectorFilter methodsFor: 'accessing' stamp: 'lr 4/26/2007 22:25'! views ^ monitor parent views! ! !Fraction methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 16:39'! derivedParts ^ super derivedParts add: (OTDerivedPart on: self label: 'float' block: [ self asFloat ]); yourself! ! !Dictionary methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 22:31'! elementsInspectorNode ^ OTDictionaryInspectorNode! ! OBCommand subclass: #OTDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! OTDebuggerCommand subclass: #OTBrowseCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTBrowseCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:37'! execute OBSystemBrowser openOnClass: target theClass selector: target selector! ! !OTBrowseCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:41'! group ^ #browse! ! !OTBrowseCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:37'! keystroke ^ $b! ! !OTBrowseCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:35'! label ^ 'browse'! ! OTBrowseCommand subclass: #OTHierarchyCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTHierarchyCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:38'! execute OBHierarchyBrowser openOnClass: target theClass! ! !OTHierarchyCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:43'! keystroke ^ nil! ! !OTHierarchyCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:42'! label ^ 'browse hierarchy'! ! OTBrowseCommand subclass: #OTImplementorsCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTImplementorsCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:46'! execute OBImplementorsBrowser browseRoot: target methodReference asNode! ! !OTImplementorsCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:40'! keystroke ^ $m! ! !OTImplementorsCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:40'! label ^ 'browse implementors'! ! OTBrowseCommand subclass: #OTSendersCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTSendersCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:46'! execute OBSendersBrowser browseRoot: target methodReference asNode! ! !OTSendersCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:43'! keystroke ^ $n! ! !OTSendersCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:39'! label ^ 'browse senders'! ! !OTDebuggerCommand methodsFor: 'actions' stamp: 'lr 4/26/2007 09:17'! announce: anAnnouncement requestor announce: anAnnouncement! ! !OTDebuggerCommand methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! context ^ target context! ! !OTDebuggerCommand methodsFor: 'testing' stamp: 'lr 4/25/2007 19:02'! isActive ^ requestor isSelected: target! ! !OTDebuggerCommand methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! process ^ target process! ! !OTDebuggerCommand methodsFor: 'actions' stamp: 'lr 4/26/2007 09:21'! update self announce: (OBChildrenChanged node: target parent). self announce: (OBSelectingNode node: target parent currentContextNode)! ! OTDebuggerCommand subclass: #OTInspectCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTInspectCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:28'! execute target context inspect! ! !OTInspectCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:47'! group ^ #inspect! ! !OTInspectCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:28'! label ^ 'inspect context'! ! OTInspectCommand subclass: #OTInspectReceiverCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTInspectReceiverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:28'! execute target context receiver inspect! ! !OTInspectReceiverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:28'! label ^ 'inspect receiver'! ! OTDebuggerCommand subclass: #OTIntoCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTIntoCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:34'! execute target process step: target context; stepToSendOrReturn. self update! ! !OTIntoCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:07'! label ^ 'into'! ! !OTIntoCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTOverCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTOverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 15:49'! execute target process completeStep: target context; stepToSendOrReturn. self update! ! !OTOverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:07'! label ^ 'over'! ! !OTOverCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTProceedCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTProceedCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:14'! execute World allMorphs do: [ :each | each model == requestor browser ifTrue: [ each delete ] ]. target process resume! ! !OTProceedCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:20'! icon ^ MenuIcons tryIcons: #(smallForwardIcon)! ! !OTProceedCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:07'! label ^ 'proceed'! ! !OTProceedCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTRestartCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTRestartCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:35'! execute self process popTo: self context; restartTop; stepToSendOrReturn. self update! ! !OTRestartCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:09'! label ^ 'restart'! ! !OTRestartCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTReturnCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTReturnCommand methodsFor: 'as yet unclassified' 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! ! !OTReturnCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:15'! label ^ 'return'! ! !OTReturnCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:15'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTTroughCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTTroughCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/26/2007 09:34'! execute target process stepToHome: target context; stepToSendOrReturn. self update! ! !OTTroughCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:09'! label ^ 'trough'! ! !OTTroughCommand methodsFor: 'as yet unclassified' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OBCommand subclass: #OTInspectorCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTInspectorCommand subclass: #OTInspectObjectCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectObjectCommand methodsFor: 'execution' stamp: 'lr 4/26/2007 16:37'! execute target value inspect! ! !OTInspectObjectCommand methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:06'! keystroke ^ $i! ! !OTInspectObjectCommand methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:05'! label ^ 'inspect'! ! OTInspectorCommand subclass: #OTInspectReferencesCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectReferencesCommand methodsFor: 'execution' stamp: 'lr 4/26/2007 16:38'! execute (Utilities pointersTo: target value value except: (Array with: target)) inspect! ! !OTInspectReferencesCommand methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:07'! label ^ 'inspect references'! ! !OTInspectorCommand methodsFor: 'accessing' stamp: 'lr 4/26/2007 16:38'! group ^ #inspection! ! !OTInspectorCommand methodsFor: 'testing' stamp: 'lr 4/26/2007 16:38'! isActive ^ requestor isSelected: target! ! !Integer methodsFor: '*ob-tools-inspector' stamp: 'lr 4/26/2007 16:39'! derivedParts ^ super derivedParts add: (OTDerivedPart on: self label: 'hex' block: [ self printStringRadix: 16 ]); add: (OTDerivedPart on: self label: 'oct' block: [ self printStringRadix: 8 ]); add: (OTDerivedPart on: self label: 'bin' block: [ self printStringRadix: 2 ]); yourself! ! OTToolset initialize!