SystemOrganization addCategory: #'OB-Tools-Debugger'! SystemOrganization addCategory: #'OB-Tools-Filesystem'! SystemOrganization addCategory: #'OB-Tools-Inspector'! SystemOrganization addCategory: #'OB-Tools-Processes'! SystemOrganization addCategory: #'OB-Tools-String'! SystemOrganization addCategory: #'OB-Tools-Test'! SystemOrganization addCategory: #'OB-Tools-Utilities'! OBDefinitionPanel subclass: #OTDefinitionPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDefinitionPanel methodsFor: 'as yet unclassified' stamp: 'dkh 2/26/2009 10:56'! accept: aText notifying: aController | node | (node := self browser currentNode) isExecutingBlock ifTrue: [ | finalBlockHome | finalBlockHome := node context finalBlockHome. finalBlockHome == nil ifTrue: [ self inform: 'Method not found for block, can''t edit'. ^false]. (self confirm: 'I will have to revert to the method from which this block originated. Is that OK?') ifTrue: [ node := self browser root nodeAt: finalBlockHome. self browser jumpTo: node] ifFalse: [ ^false ]]. self browser root targetContext: nil. ^super accept: aText notifying: aController ! ! !OTDefinitionPanel methodsFor: 'accessing' stamp: 'dkh 1/23/2009 09:36'! definition: aDefinition super definition: aDefinition. self changed: #selection! ! !OTDefinitionPanel methodsFor: 'callbacks' stamp: 'dkh 1/9/2009 10:28'! doItContext ^self browser currentNode doItContext! ! !OTDefinitionPanel methodsFor: 'callbacks' stamp: 'dkh 1/9/2009 10:26'! doItReceiver ^self browser currentNode doItReceiver! ! OBDefinitionPanel subclass: #OTInspectorDefinitionPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectorDefinitionPanel class methodsFor: 'accessing' stamp: 'lr 5/29/2008 13:35'! doItReceiver ^ nil! ! !OTInspectorDefinitionPanel methodsFor: 'callbacks' stamp: 'lr 5/29/2008 13:35'! doItReceiver ^ browser navigationPanel root value! ! OBMetaNode subclass: #OTChasingMetaNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTChasingMetaNode methodsFor: 'as yet unclassified' stamp: 'dkh 3/5/2009 15:42'! childAt: aSelector labeled: aString put: aMetaNode edges add: (OTChasingMetaEdge label: aString selector: aSelector metaNode: aMetaNode)! ! !BlockContext methodsFor: '*ob-tools-inspector' stamp: 'lr 6/16/2008 15:47'! contextInspectorNodes | nodes | nodes := super contextInspectorNodes. self home tempNames keysAndValuesDo: [ :index :name | nodes add: (OTNamedIndexedVariableNode on: self home index: index name: name) ]. 1 to: stackp do: [ :index | nodes add: (OTNamedIndexedVariableNode on: self index: index name: index asString) ]. ^ nodes! ! OBBrowser subclass: #OTDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDebugger class methodsFor: 'configuration' stamp: 'dkh 08/09/2007 09:24'! defaultMetaNode | process context | process := OBMetaNode named: 'process'. context := OBMetaNode named: 'context'. context addFilter: OTBreakpointFilter new. process childAt: #longStack put: context. ^ process! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 6/5/2008 14:29'! defaultProcessNode ^ OTProcessNode! ! !OTDebugger class methodsFor: 'configuration' stamp: 'dkh 1/9/2009 10:22'! definitionPanel ^ OTDefinitionPanel new! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 5/21/2008 08:42'! inspectorPanel ^ OTDebugInspectorPanel 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: 'opening' stamp: 'dkh 1/9/2009 14:31'! openProcess: aProcess context: aContext errorWasInUIProcess: aBool ^ (self process: aProcess context: aContext errorWasInUIProcess: aBool) open! ! !OTDebugger class methodsFor: 'opening' stamp: 'dkh 1/9/2009 15:39'! openProcess: aProcess context: aContext label: aString errorWasInUIProcess: aBool ^ (self process: aProcess context: aContext label: aString errorWasInUIProcess: aBool) open! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 10/7/2007 12:36'! optionalButtonPanel ^ OBFixedButtonPanel new! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 5/20/2008 16:31'! paneCount ^ 1! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 1/20/2008 12:20'! panels ^ super panels , (Array with: self inspectorPanel)! ! !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: 'dkh 1/9/2009 14:30'! process: aProcess context: aContext ^self process: aProcess context: aContext errorWasInUIProcess: false! ! !OTDebugger class methodsFor: 'instance-creation' stamp: 'dkh 2/25/2009 05:32'! process: aProcess context: aContext errorWasInUIProcess: aBool | processNode contextNode | aProcess isSuspended ifFalse: [ self error: 'Unable to debug a running process.' ]. processNode := self defaultProcessNode on: aProcess. processNode errorWasInUIProcess: aBool. contextNode := processNode nodeAt: (aContext ifNil: [ aProcess suspendedContext ]). processNode targetContext: contextNode context. ^ self root: processNode selection: contextNode! ! !OTDebugger class methodsFor: 'instance-creation' stamp: 'dkh 1/9/2009 15:37'! process: aProcess context: aContext label: aString errorWasInUIProcess: aBool | debugger | debugger := self process: aProcess context: aContext errorWasInUIProcess: aBool. debugger root label: aString. ^debugger! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 4/25/2007 14:16'! title ^ 'Debugger'! ! !OTDebugger class methodsFor: 'configuration' stamp: 'dkh 1/9/2009 15:38'! titleForRoot: aNode ^aNode label! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 6/7/2008 20:12'! cmdBrowse ^ OTCmdBrowseDebugger all! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 5/21/2008 08:55'! cmdDebug ^ OTCmdDebugger allSubclasses! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 6/7/2008 20:12'! cmdInspector ^ OTCmdInspector allSubclasses! ! !OTDebugger methodsFor: 'updating' stamp: 'dkh 1/9/2009 14:41'! debuggerIsResuming self root debuggerIsResuming: self. ! ! !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! ! !OTDebugger methodsFor: 'updating' stamp: 'dkh 1/9/2009 14:25'! windowIsClosing self root debuggerIsClosing! ! OBBrowser subclass: #OTFilesystemBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTFilesystemBrowser class methodsFor: 'configuration' stamp: 'lr 12/11/2007 11:08'! defaultMetaNode | directory file | directory := OBMetaNode named: 'directory'. file := OBMetaNode named: 'file'. directory childAt: #directories put: directory. directory childAt: #files put: file. ^ directory! ! !OTFilesystemBrowser class methodsFor: 'configuration' stamp: 'lr 5/15/2008 11:43'! defaultRootNode ^ OTDirectoryNode new setDirectory: FileDirectory root ! ! !OTFilesystemBrowser class methodsFor: 'configuration' stamp: 'lr 1/8/2008 15:45'! optionalButtonPanel ^ nil! ! !OTFilesystemBrowser class methodsFor: 'configuration' stamp: 'lr 12/11/2007 11:27'! title ^ 'File System'! ! !OTFilesystemBrowser methodsFor: 'commands' stamp: 'lr 5/15/2008 11:32'! cmdsCommands ^ OTCmdFilesystem allSubclasses! ! !OTFilesystemBrowser methodsFor: 'building' stamp: 'lr 12/11/2007 11:24'! defaultBackgroundColor ^ Color lightMagenta! ! !OTFilesystemBrowser methodsFor: 'building' stamp: 'lr 8/4/2008 10:47'! defaultLabel ^ String streamContents: [ :stream | stream nextPutAll: super defaultLabel. self currentNode isNil ifFalse: [ stream nextPutAll: ': '; nextPutAll: self currentNode fullName ] ]! ! OBBrowser subclass: #OTInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTInspector subclass: #OTBasicInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTBasicInspector class methodsFor: 'configuration' stamp: 'dkh 3/4/2009 10:30'! paneCount ^ 1! ! !OTBasicInspector class methodsFor: 'configuration' stamp: 'lr 5/29/2008 13:34'! panels ^ super panels copyWith: OTInspectorWorkspacePanel new! ! !OTBasicInspector methodsFor: 'building' stamp: 'dkh 3/4/2009 10:30'! buildOn: aBuilder | first second window | first := second := nil. window := aBuilder window: self with: [ aBuilder horizontalGroupWith: [ first := aBuilder root. self panels allButLast do: [ :each | each buildOn: aBuilder ] ]. aBuilder horizontalGroupWith: [ second := aBuilder root. self panels last buildOn: aBuilder ] ]. (window isKindOf: Morph) ifTrue: [ first layoutFrame bottomFraction: 0.75. second layoutFrame topFraction: 0.75 ]. ^ window! ! OTInspector subclass: #OTChasingInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTChasingInspector class methodsFor: 'configuration' stamp: 'dkh 3/5/2009 15:41'! defaultMetaNodeFor: aNode | element | element := OTChasingMetaNode new addFilter: OTChasingInspectorFilter new; yourself. aNode isLastNode ifTrue: [ ^element ]. aNode filterPragmas do: [:pragma | element childAt: pragma selector labeled: (pragma argumentAt: 1) asString put: element ]. ^element! ! !OTChasingInspector class methodsFor: 'as yet unclassified' stamp: 'dkh 3/4/2009 18:29'! paneCount ^ 4! ! !OTChasingInspector class methodsFor: 'configuration' stamp: 'dkh 3/4/2009 10:28'! panels ^ super panels copyWith: OTInspectorWorkspacePanel new! ! !OTChasingInspector class methodsFor: 'as yet unclassified' stamp: 'dkh 3/4/2009 15:19'! root: rootNode selection: selectedNode ^ self metaNode: (self defaultMetaNodeFor: rootNode) root: rootNode selection: selectedNode panels: self panels! ! !OTChasingInspector methodsFor: 'building' stamp: 'dkh 3/5/2009 11:06'! buildOn: aBuilder | window | window := super buildOn: aBuilder. (window isKindOf: Morph) ifTrue: [ window paneMorphs third layoutFrame bottomFraction: 0.70. window paneMorphs second layoutFrame topFraction: 0.70; bottomFraction: 0.85. window paneMorphs first layoutFrame topFraction: 0.85 ]. ^window! ! !OTChasingInspector methodsFor: 'defaults' stamp: 'dkh 3/5/2009 11:26'! defaultLabel ^self currentOrRootNode object defaultLabelForInspector! ! !OTChasingInspector methodsFor: 'morphic' stamp: 'dkh 3/5/2009 10:26'! initialExtent ^ 500 @ 400! ! !OTChasingInspector methodsFor: 'inspecting' stamp: 'dkh 3/5/2009 11:39'! inspectorDoItReceiver ^self navigationPanel currentNode value! ! OTInspector subclass: #OTDebugInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDebugInspector class methodsFor: 'configuration' stamp: 'lr 5/21/2008 08:50'! paneCount ^ 1! ! !OTDebugInspector methodsFor: 'building' stamp: 'lr 5/21/2008 08:51'! buildGroup: aCollection on: aBuilder ^ aBuilder horizontalGroupWith: [ aCollection do: [ :ea | ea buildOn: aBuilder ] ]! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 6/5/2008 10:22'! defaultMetaNode ^ OBMetaNode new addFilter: OTInspectorFilter new; yourself! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/7/2007 15:54'! defaultRootNode ^ OTRootInspectorNode on: nil! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/29/2008 13:34'! definitionPanel ^ OTInspectorDefinitionPanel new! ! !OTInspector class methodsFor: 'instance-creation' stamp: 'lr 7/15/2007 11:43'! on: anObject | browser | browser := self root: (OTRootInspectorNode on: anObject). browser jumpTo: browser root childNodes first. ^ browser! ! !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 class methodsFor: 'configuration' stamp: 'lr 5/29/2008 13:51'! titleForRoot: aNode ^ aNode object defaultLabelForInspector! ! !OTInspector methodsFor: 'commands' stamp: 'dkh 3/5/2009 12:47'! cmdBrowse ^ OTCmdBrowseInspector all ! ! !OTInspector methodsFor: 'commands' stamp: 'dkh 3/5/2009 10:24'! cmdInspect ^ OTCmdInspector allSubclasses! ! !OTInspector methodsFor: 'morphic' stamp: 'lr 5/29/2008 13:48'! initialExtent ^ 350 @ 300! ! !OTInspector methodsFor: 'inspecting' stamp: 'dkh 3/5/2009 11:38'! inspectorDoItReceiver ^self navigationPanel root value! ! !OTInspector methodsFor: 'initializing' stamp: 'lr 6/5/2008 11:40'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. self navigationPanel selectSubtree: (OBSubtree new instVarAt: 1 put: (Array with: aNode asFan with: 1); yourself)! ! OBBrowser subclass: #OTPreDebug instanceVariableNames: 'root' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTPreDebug class methodsFor: 'configuration' stamp: 'dkh 1/10/2009 17:19'! defaultMetaNode ^OBMetaNode named: 'Predebug'! ! !OTPreDebug class methodsFor: 'configuration' stamp: 'dkh 1/10/2009 17:22'! defaultRootNode ^OTPreDebugNode new! ! !OTPreDebug class methodsFor: 'opening' stamp: 'dkh 1/11/2009 12:22'! openOn: anOTPreDebugNode | panels | panels := (Array with: OBFixedButtonPanel new with: ((OTPreDebugPanel new) initializeOn: anOTPreDebugNode contents; shoutHighlighting: false; yourself)). ^(self metaNode: self defaultMetaNode root: anOTPreDebugNode selection: anOTPreDebugNode panels: panels) open! ! !OTPreDebug class methodsFor: 'configuration' stamp: 'dkh 1/10/2009 17:23'! paneCount ^1! ! !OTPreDebug class methodsFor: 'configuration' stamp: 'dkh 1/10/2009 17:23'! title ^ 'PreDebug'! ! !OTPreDebug methodsFor: 'accessing' stamp: 'dkh 1/11/2009 10:38'! browser ^self! ! !OTPreDebug methodsFor: 'commands' stamp: 'dkh 1/10/2009 17:39'! cmdPreDebug ^OTCmdPreDebug allSubclasses! ! !OTPreDebug methodsFor: 'navigating' stamp: 'dkh 1/10/2009 17:14'! currentColumn ^self! ! !OTPreDebug methodsFor: 'accessing' stamp: 'dkh 1/10/2009 17:15'! currentNode ^root! ! !OTPreDebug methodsFor: 'accessing' stamp: 'dkh 1/10/2009 17:15'! currentOrRootNode ^root! ! !OTPreDebug methodsFor: 'building' stamp: 'dkh 1/10/2009 17:16'! defaultBackgroundColor ^ Color lightRed! ! !OTPreDebug methodsFor: 'user interface' stamp: 'dkh 1/11/2009 09:31'! initialExtent "Answer the desired extent for the receiver when a view on it is first opened on the screen. 5/22/96 sw: in the absence of any override, obtain from RealEstateAgent" ^ 450@150! ! !OTPreDebug methodsFor: 'navigating' stamp: 'dkh 1/10/2009 17:18'! jumpTo: aNode self announcer announce: (OBSelectionChanged column: self). ! ! !OTPreDebug methodsFor: 'callbacks' stamp: 'dkh 1/10/2009 17:20'! labelString ^self root label! ! !OTPreDebug methodsFor: 'accessing' stamp: 'dkh 1/10/2009 17:15'! navigationPanel ^self! ! !OTPreDebug methodsFor: 'opening' stamp: 'dkh 1/10/2009 17:18'! open | res | res := super open. self announcer announce: (OBSelectionChanged column: self). ^res! ! !OTPreDebug methodsFor: 'accessing' stamp: 'dkh 1/10/2009 17:15'! root ^root! ! !OTPreDebug methodsFor: 'initializing' stamp: 'dkh 1/10/2009 17:18'! setMetaNode: aMetaNode node: aNode root := aNode. root metaNode: aMetaNode. self initializeCommands. self signalRefresh! ! !OTPreDebug methodsFor: 'updating' stamp: 'dkh 1/11/2009 10:25'! windowIsClosing root abandon: self! ! OBBrowser subclass: #OTProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 5/21/2008 10:38'! defaultMetaNode | scheduler process context | scheduler := OBMetaNode named: 'scheduler'. process := OBMetaNode named: 'process'. context := OBMetaNode named: 'context'. scheduler childAt: #processes put: process. process childAt: #shortStack put: context. ^ scheduler! ! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 8/3/2007 19:24'! defaultRootNode ^ OTSchedulerNode new! ! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 1/20/2008 13:45'! optionalButtonPanel ^ nil! ! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 8/3/2007 15:00'! paneCount ^ 2! ! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 8/3/2007 15:01'! title ^ 'Process Browser'! ! !OTProcessBrowser methodsFor: 'commands' stamp: 'lr 6/7/2008 20:12'! cmdBrowse ^ OTCmdBrowseDebugger all! ! !OTProcessBrowser methodsFor: 'commands' stamp: 'lr 6/7/2008 20:13'! cmdInspector ^ OTCmdInspector allSubclasses! ! !OTProcessBrowser methodsFor: 'commands' stamp: 'lr 6/7/2008 20:13'! cmdProcess ^ OTCmdProcessBrowser allSubclasses! ! !OTProcessBrowser methodsFor: 'morphic' stamp: 'lr 10/7/2007 12:20'! step self announce: (OBChildrenChanged node: self root)! ! !OTProcessBrowser methodsFor: 'morphic' stamp: 'lr 10/7/2007 12:18'! wantsSteps ^ true! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 10:38'! bytecodeInsepectorNode ^ OTDerivedInspectorNode on: self label: 'bytecode' block: [ :obj | obj symbolic ]! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 10:38'! decompiledInspectorNode ^ OTDerivedInspectorNode on: self label: 'decompiled' block: [ :obj | obj decompileString ]! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 10:38'! headerInspectorNode ^ OTDerivedInspectorNode on: self label: 'header' block: [ :obj | obj headerDescription ]! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'dkh 3/21/2009 12:12'! methodInspectorNodes ^ OrderedCollection new add: self selfInspectorNode; add: self headerInspectorNode; add: self bytecodeInsepectorNode; add: self decompiledInspectorNode; add: self sourceInspectorNode; yourself! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 10:38'! sourceInspectorNode ^ OTDerivedInspectorNode on: self label: 'source' block: [ :obj | obj getSource ]! ! !OBMorphBuilder methodsFor: '*ob-tools' stamp: 'dkh 1/11/2009 13:33'! nonScrollingTextarea: aDefinitionPanel with: aBlock | morph | morph := self textarea: aDefinitionPanel with: aBlock . morph setProperty: #noVScrollBarPlease toValue: true.. ^morph! ! 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: 'dkh 1/23/2009 10:21'! debug: aProcess context: aContext label: aString contents: aContentString fullView: aBool | node process | aBool ifTrue: [ ^self directDebug: aProcess context: aContext label: aString contents: aContentString ]. process := Processor activeProcess. node := OTPreDebugNode debug: process context: aContext contents: aContentString label: aString. aContentString == nil ifTrue: [ node contents: (String streamContents: [:strm | (aContext stackOfSize: 20) do: [:ea | strm nextPutAll: ea printString; cr ]]). node debugOnMouseClick: true ]. node errorWasInUI: (Project spawnNewProcessIfThisIsUI: process). WorldState addDeferredUIMessage: [ OTPreDebug openOn: node ]. process suspend! ! !OTToolset class methodsFor: 'debugging' stamp: 'dkh 1/9/2009 10:01'! debugContext: aContext label: aString contents: aContentString self debug: Processor activeProcess context: aContext label: aString contents: aContentString fullView: false! ! !OTToolset class methodsFor: 'debugging' stamp: 'dkh 2/21/2009 10:43'! debugError: anError | context | context := anError signalerContext. (anError isKindOf: Halt) ifTrue: [ context := context sender ]. self debug: Processor activeProcess context: context label: anError description contents: nil fullView: false! ! !OTToolset class methodsFor: 'debugging' stamp: 'dkh 1/22/2009 18:31'! directDebug: aProcess context: aContext label: aString contents: aContentString Preferences logDebuggerStackToFile ifTrue: [ Smalltalk logError: aString inContext: aContext to: 'debug.log' ]. Project spawnNewProcessIfThisIsUI: aProcess. WorldState addDeferredUIMessage: [ OTDebugger openProcess: aProcess context: aContext ]. aProcess suspend! ! !OTToolset class methodsFor: 'initialization' stamp: 'dc 8/4/2008 10:01'! initialize ToolSet register: self. ToolSet default: self.! ! !OTToolset class methodsFor: 'inspecting' stamp: 'francois.stephany 1/26/2009 16:24'! inspect: anObject ^OTBasicInspector openOn: anObject! ! !OTToolset class methodsFor: 'inspecting' stamp: 'lr 4/26/2007 16:32'! inspect: anObject label: aString self inspect: anObject! ! !OTToolset class methodsFor: 'debugging' stamp: 'lr 6/7/2008 20:35'! interrupt: aProcess label: aString self debug: aProcess context: aProcess suspendedContext label: aString contents: nil fullView: true! ! !OTToolset class methodsFor: 'menu' stamp: 'lr 1/20/2008 16:59'! openProcessBrowser ^ OTProcessBrowser open! ! !OTToolset class methodsFor: 'menu' stamp: 'EL 1/27/2009 13:45'! openTestRunner (Smalltalk classNamed: 'OSTestRunner') ifNil: [ super openTestRunner ] ifNotNilDo: [:tr | tr open ]! ! !OTToolset class methodsFor: 'menu' stamp: 'lr 1/20/2008 17:00'! openTranscript ^ OTTranscript open! ! !OTToolset class methodsFor: 'menu' stamp: 'lr 1/20/2008 16:59'! openWorkspace ^ OTWorkspace open! ! !OTToolset class methodsFor: 'initialization' stamp: 'lr 6/7/2008 19:58'! unload ToolSet unregister: self! ! OBPanel subclass: #OTDebugInspectorPanel instanceVariableNames: 'receiverInspector contextInspector' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDebugInspectorPanel methodsFor: 'building' stamp: 'lr 1/20/2008 14:31'! buildOn: aBuilder ^ aBuilder horizontalGroupWith: [ receiverInspector buildGroup: receiverInspector panels on: aBuilder. contextInspector buildGroup: contextInspector panels on: aBuilder ]! ! !OTDebugInspectorPanel methodsFor: 'updating' stamp: 'dkh 12/19/2008 10:56'! inspector: anInspector display: anObject | col | anInspector navigationPanel root object: anObject. (col := anInspector navigationPanel currentColumn) ~~ nil ifTrue: [ col refreshAndSignal: true ] ifFalse: [ anInspector signalRefresh] ! ! !OTDebugInspectorPanel methodsFor: 'events' stamp: 'lr 5/21/2008 09:13'! selectionChanged: anAnnouncement | node | node := anAnnouncement node ifNil: [ ^ self ]. self inspector: receiverInspector display: node doItReceiver. self inspector: contextInspector display: node doItContext! ! !OTDebugInspectorPanel methodsFor: 'updating' stamp: 'lr 5/21/2008 08:42'! subscribe receiverInspector := OTDebugInspector new. contextInspector := OTDebugInspector new. self announcer observe: OBSelectionChanged send: #selectionChanged: to: self! ! Object subclass: #OTBogusObjectForDebugger instanceVariableNames: 'x y z' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Test'! !OTBogusObjectForDebugger commentStamp: 'dkh 2/22/2009 09:21' prior: 0! OTBogusObjectForDebugger new testDebugger! !OTBogusObjectForDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/22/2009 09:20'! call: aBlock aBlock value! ! !OTBogusObjectForDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/26/2009 10:50'! messageNotUnderstood "self new messageNotUnderstood" ^self foo! ! !OTBogusObjectForDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/26/2009 11:45'! testDebugger "self new testDebugger" self call: [ 3/0 ]! ! !OTBogusObjectForDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/25/2009 05:46'! testError "self new testError" self error: 'error'! ! !OTBogusObjectForDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/24/2009 15:09'! testHalt "self new testHalt" self halt! ! Object subclass: #OTBogusObjectForInspectorDebugger instanceVariableNames: 'generateError x y z' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Test'! !OTBogusObjectForInspectorDebugger commentStamp: 'dkh 2/21/2009 10:25' prior: 0! Inspect me to test handling of printString errors and halts in inspectors: OTBogusObjectForInspectorDebugger new inspect. Debug me to test handling of a printString errros and halts in the debugger: OTBogusObjectForInspectorDebugger new printString. OTBogusObjectForInspectorDebugger generateHalt printString. ! !OTBogusObjectForInspectorDebugger class methodsFor: 'as yet unclassified' stamp: 'dkh 2/21/2009 10:19'! generateHalt ^self new generateError: false! ! !OTBogusObjectForInspectorDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 3/21/2009 12:13'! buggyInspectorNodes | nodes index | nodes := super basicInspectorNodes. index := self class allInstVarNames size. nodes add: (OTNamedVariableNode on: self index: index + 1 name: 'bogus instance variable') . index := self basicSize. nodes add: (OTIndexedVariableNode on: self index: index + 1). nodes add: (OTDictionaryInspectorNode on: self key: 'bogusKey'). index := self basicSize. nodes add: (OTSequenceInspectorNode on: self index: index + 1). nodes add: (OTDerivedInspectorNode on: self label: 'bogus derived (error)' block: [:obj | self error: 'error''']). nodes add: (OTDerivedInspectorNode on: self label: 'bogus derived (halt)' block: [:obj |self halt]). ^ nodes! ! !OTBogusObjectForInspectorDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/21/2009 10:19'! generateError generateError == nil ifTrue: [ generateError := true ]. ^generateError! ! !OTBogusObjectForInspectorDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/21/2009 10:19'! generateError: aBool generateError := aBool! ! !OTBogusObjectForInspectorDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/21/2009 09:04'! initialize ! ! !OTBogusObjectForInspectorDebugger methodsFor: 'as yet unclassified' stamp: 'dkh 2/21/2009 10:44'! printOn: aStream self generateError ifTrue: [ self error: 'error' ] ifFalse: [ self halt]! ! Object subclass: #OTStringHolder instanceVariableNames: 'announcer panel' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-String'! !OTStringHolder class methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:10'! defaultModel self subclassResponsibility! ! !OTStringHolder class methodsFor: 'opening' stamp: 'lr 1/20/2008 17:10'! open ^ self openOn: self defaultModel! ! !OTStringHolder class methodsFor: 'opening' stamp: 'lr 1/20/2008 17:09'! openOn: anObject ^ self new initializeOn: anObject; open! ! !OTStringHolder methodsFor: 'updating' stamp: 'lr 1/20/2008 17:03'! announce: anAnnouncement ^ announcer announce: anAnnouncement! ! !OTStringHolder methodsFor: 'building' stamp: 'lr 1/20/2008 17:02'! buildOn: aBuilder ^ aBuilder window: self with: [ aBuilder verticalGroupWith: [ panel buildOn: aBuilder ] ]! ! !OTStringHolder methodsFor: 'opening' stamp: 'lr 1/20/2008 17:03'! close ^ OBCloseRequest signal: self! ! !OTStringHolder methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:01'! defaultLabel self subclassResponsibility! ! !OTStringHolder methodsFor: 'initialization' stamp: 'lr 1/20/2008 17:11'! initializeOn: anObject announcer := OBAnnouncer new. panel := self panelClass inBrowser: self on: anObject! ! !OTStringHolder methodsFor: 'configuration' stamp: 'lr 8/4/2008 11:30'! labelString ^ self defaultLabel! ! !OTStringHolder methodsFor: 'opening' stamp: 'lr 1/20/2008 17:03'! open ^ OBBrowseRequest signal: self! ! !OTStringHolder methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:04'! panelClass self subclassResponsibility! ! OTStringHolder subclass: #OTTranscript instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-String'! !OTTranscript class methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:11'! defaultModel ^ Transcript! ! !OTTranscript methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:20'! defaultBackgroundColor ^ Color r: 1.0 g: 0.8 b: 0.4! ! !OTTranscript methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:06'! defaultLabel ^ 'Transcript'! ! !OTTranscript methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:07'! panelClass ^ OTTranscriptPanel! ! !OTTranscript methodsFor: 'opening' stamp: 'lr 1/20/2008 17:28'! windowIsClosing panel close! ! OTStringHolder subclass: #OTWorkspace instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-String'! !OTWorkspace class methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:10'! defaultModel ^ String new! ! !OTWorkspace methodsFor: 'configuration' stamp: 'lr 5/29/2008 13:55'! defaultBackgroundColor ^ Color gray veryMuchLighter! ! !OTWorkspace methodsFor: 'configuration' stamp: 'lr 1/20/2008 16:08'! defaultLabel ^ 'Workspace'! ! !OTWorkspace methodsFor: 'configuration' stamp: 'lr 1/20/2008 17:02'! panelClass ^ OTWorkspacePanel! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'dkh 3/21/2009 15:12'! basicInspectorNodes | nodes | nodes := OrderedCollection new: self class instSize + self basicSize + 5. nodes add: self selfInspectorNode. self class allInstVarNames withIndexDo: [ :name :index | nodes add: (OTNamedVariableNode on: self index: index name: name) ]. 1 to: self basicSize do: [ :index | nodes add: (OTIndexedVariableNode on: self index: index) ]. ^ nodes! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'dkh 3/5/2009 10:21'! chasingInspect ^OTChasingInspector openOn: self! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'dkh 3/21/2009 12:14'! protocolInspectorNodes ^ self class allSelectors asArray sort collect: [ :each | OTProtocolInspectorNode on: self selector: each ]! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 09:58'! selfInspectorNode ^ OTDerivedInspectorNode on: self label: 'self' block: [ :obj | obj ]! ! OBModalFilter subclass: #OTChasingInspectorFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTChasingInspectorFilter methodsFor: 'accessing' stamp: 'dkh 3/23/2009 10:32'! buttonBarClass ^OBRadioButtonBar! ! !OTChasingInspectorFilter methodsFor: 'as yet unclassified' stamp: 'dkh 3/23/2009 10:32'! listForNode: aNode ^aNode isNil ifTrue: [ Array new ] ifFalse: [ aNode filterPragmas collect: [ :pragma | (pragma argumentAt: 1) asString ] ]! ! !OTChasingInspectorFilter methodsFor: 'callbacks' stamp: 'dkh 3/23/2009 10:32'! longDescriptionsForNode: aNode ^aNode isNil ifTrue: [ Array new ] ifFalse: [ aNode filterPragmas collect: [ :pragma | (pragma argumentAt: 3) ] ]! ! !OTChasingInspectorFilter methodsFor: 'as yet unclassified' stamp: 'dkh 3/5/2009 12:06'! nodesFrom: aCollection forNode: aNode | tag pragmas | pragmas := aNode childFilterPragmas collect: [:ea | ea argumentAt: 1 ]. pragmas isEmpty ifTrue: [ ^#() ]. tag := (pragmas at: self selection) asString. ^ aCollection select: [:ea | ea tag = tag]! ! OBModalFilter subclass: #OTInspectorFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectorFilter methodsFor: 'accessing' stamp: 'dkh 3/23/2009 10:31'! buttonBarClass ^OBRadioButtonBar! ! !OTInspectorFilter methodsFor: 'callbacks' stamp: 'lr 6/5/2008 10:06'! edgesFrom: aCollection forNode: aNode "Let us play a meta-edge." ^ Array with: self! ! !OTInspectorFilter methodsFor: 'callbacks' stamp: 'dkh 3/21/2009 13:45'! listForNode: aNode ^ aNode isNil ifTrue: [ Array new ] ifFalse: [ aNode filters collect: [ :each | each key ] ]! ! !OTInspectorFilter methodsFor: 'callbacks' stamp: 'dkh 3/23/2009 10:20'! longDescriptionsForNode: aNode ^ aNode isNil ifTrue: [ Array new ] ifFalse: [ aNode filters collect: [ :each | each value value ] ]! ! !OTInspectorFilter methodsFor: 'callbacks' stamp: 'dkh 3/21/2009 12:10'! nodesForParent: aNode ^ ((aNode filters at: self selection) value) key! ! !Dictionary methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:09'! elementInspectorNodes | result | result := super elementInspectorNodes first: 2. self keysDo: [ :each | result add: (OTDictionaryInspectorNode on: self key: each) ]. ^ result! ! !Bag methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:08'! elementInspectorNodes ^ super elementInspectorNodes , (contents elementInspectorNodes allButFirst: 2)! ! OBFilter subclass: #OTBreakpointFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTBreakpointFilter methodsFor: 'filtering' stamp: 'lr 9/1/2008 12:22'! icon: aSymbol forNode: aNode | method | method := aNode method ifNil: [ ^ #blank ]. method literals do: [ :literal | (literal == #halt or: [ literal == #halt: or: [ literal == #haltIfNil or: [ literal == #haltIf: or: [ literal == #haltOnce ] ] ] ]) ifTrue: [ ^ #breakpoint ]. (literal == #flag: or: [ literal == #needsWork or: [ literal == #notYetImplemented ] ]) ifTrue: [ ^ #flag ] ]. ^ #blank! ! !ContextPart methodsFor: '*ob-tools-inspector' stamp: 'dkh 3/21/2009 12:13'! contextInspectorNodes ^ OrderedCollection with: (self selfInspectorNode label: 'thisContext')! ! !Set methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:11'! elementInspectorNodes | result | result := super elementInspectorNodes. self do: [ :each | result add: (OTSetInspectorNode on: self value: each) ]. ^ result! ! OBNode subclass: #OTDebugNode instanceVariableNames: 'process' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! OTDebugNode subclass: #OTContextNode instanceVariableNames: 'context parseTree sourceMap' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTContextNode class methodsFor: 'instance-creation' stamp: 'lr 5/20/2008 13:28'! on: aProcess context: aContext ^ (self on: aProcess) setContext: aContext! ! !OTContextNode methodsFor: 'actions' stamp: 'dkh 2/26/2009 11:43'! compiled: aSelector | method | self selector = aSelector ifFalse: [ ^ self ]. self process popTo: self context. method := self method. self context privRefreshWith: method. method isQuick ifFalse: [self process stepToSendOrReturn]. self flush ! ! !OTContextNode methodsFor: 'accessing' stamp: 'lr 4/25/2007 19:48'! context ^ context! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'dkh 2/26/2009 11:43'! definition ^ (OBMethodDefinition selection: self selection source: self source inClass: self theClass) callback: [ :selector | self compiled: selector ]! ! !OTContextNode methodsFor: 'accessing' stamp: 'dkh 2/22/2009 09:07'! errorReportOn: stream self context errorReportOn: stream ! ! !OTContextNode methodsFor: 'actions' stamp: 'lr 6/7/2008 18:50'! flush parseTree := sourceMap := nil! ! !OTContextNode methodsFor: 'testing' stamp: 'dkh 2/22/2009 09:39'! isExecutingBlock ^self context isExecutingBlock! ! !OTContextNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:22'! name ^ self context asString! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 6/7/2008 18:58'! parseTree ^ parseTree ifNil: [ parseTree := super parseTree ]! ! !OTContextNode methodsFor: 'initialization' stamp: 'lr 5/20/2008 13:28'! setContext: aContext context := aContext! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 6/7/2008 18:59'! sourceMap ^ sourceMap ifNil: [ sourceMap := super sourceMap ]! ! !OTContextNode methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:20'! value ^ self context! ! !OTDebugNode class methodsFor: 'instance-creation' stamp: 'lr 5/20/2008 13:28'! on: aProcess ^ self new setProcess: aProcess! ! !OTDebugNode methodsFor: 'accessing' stamp: 'lr 5/20/2008 16:28'! context self subclassResponsibility! ! !OTDebugNode methodsFor: 'callbacks' stamp: 'lr 5/20/2008 13:22'! doItContext ^ self context! ! !OTDebugNode methodsFor: 'callbacks' stamp: 'lr 5/20/2008 13:22'! doItReceiver ^ self context receiver! ! !OTDebugNode methodsFor: 'testing' stamp: 'lr 5/21/2008 08:55'! hasSelector ^ true! ! !OTDebugNode methodsFor: 'ancestry' stamp: 'lr 5/20/2008 16:26'! isDescendantOf: aNode ^ self = aNode! ! !OTDebugNode methodsFor: 'testing' stamp: 'lr 5/20/2008 13:41'! isEditable ^ false! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 6/7/2008 19:02'! method ^ self theClass ifNotNilDo: [ :class | class lookupSelector: self selector ]! ! !OTDebugNode methodsFor: 'navigation' stamp: 'lr 6/7/2008 19:24'! methodNode ^ OBMethodNode on: self selector inClass: self theClass! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 6/7/2008 19:00'! parseTree ^ self context methodNode! ! !OTDebugNode methodsFor: 'accessing' stamp: 'lr 5/20/2008 13:24'! process ^ process! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'EL 1/27/2009 13:03'! selection "Answer the interval of the current source code." | index stop | index := self sourceMap indexForInserting: (Association key: (self context pc ifNotNilDo: [:pc | pc - ((process suspendedContext = self context) ifTrue: [1] ifFalse: [ 2 ]) ] ifNil: [ 0 ]) value: nil). index < 1 ifTrue: [ ^ 1 to: 0 ]. index > self sourceMap size ifTrue: [ stop := self sourceMap inject: 0 into: [ :prev :this | prev max: this value last ]. ^ stop + 1 to: stop ]. ^(self sourceMap at: index) value! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 5/20/2008 13:30'! selector ^ self context selector! ! !OTDebugNode methodsFor: 'initialization' stamp: 'lr 5/20/2008 13:27'! setProcess: aProcess process := aProcess! ! !OTDebugNode methodsFor: 'testing' stamp: 'lr 12/2/2008 15:07'! shouldBeStyledBy: aShoutMorph aShoutMorph classOrMetaClass: self theClass. ^ true! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 6/7/2008 18:59'! source ^ self parseTree sourceText! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 6/7/2008 18:59'! sourceMap ^ self parseTree sourceMap! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 5/20/2008 13:30'! theClass ^ self context receiver class whichClassIncludesSelector: self selector! ! OTDebugNode subclass: #OTProcessNode instanceVariableNames: 'targetContext cache label errorWasInUIProcess' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTProcessNode methodsFor: 'testing' stamp: 'lr 8/3/2007 19:25'! allowDebug ^ self rules third! ! !OTProcessNode methodsFor: 'testing' stamp: 'lr 8/3/2007 19:25'! allowStop ^ self rules second! ! !OTProcessNode methodsFor: 'accessing' stamp: 'dkh 2/25/2009 05:30'! context ^self targetContext ! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 5/20/2008 13:27'! contextNode ^ self nodeAt: self context! ! !OTProcessNode methodsFor: 'updating' stamp: 'dkh 1/9/2009 14:23'! debuggerIsClosing process == nil ifTrue: [ ^self ]. process terminate. process := nil! ! !OTProcessNode methodsFor: 'updating' stamp: 'dkh 1/9/2009 14:41'! debuggerIsResuming: aBrowser | proc | proc := process. process := nil. self errorWasInUIProcess ifTrue: [ Project resumeProcess: proc ] ifFalse: [ proc resume ]. aBrowser close. self errorWasInUIProcess ifTrue: [ Processor terminateActive ] ! ! !OTProcessNode methodsFor: 'accessing' stamp: 'dkh 1/9/2009 14:27'! errorWasInUIProcess errorWasInUIProcess == nil ifTrue: [ errorWasInUIProcess := false ]. ^errorWasInUIProcess! ! !OTProcessNode methodsFor: 'accessing' stamp: 'dkh 1/9/2009 14:27'! errorWasInUIProcess: aBool errorWasInUIProcess := aBool! ! !OTProcessNode methodsFor: 'testing' stamp: 'lr 8/3/2007 19:18'! hasVersions ^ true! ! !OTProcessNode methodsFor: 'initialization' stamp: 'lr 5/20/2008 13:28'! initialize cache := IdentityDictionary new! ! !OTProcessNode methodsFor: 'testing' stamp: 'lr 8/3/2007 19:26'! isActiveProcess ^ self process isActiveProcess! ! !OTProcessNode methodsFor: 'accessing' stamp: 'dkh 1/9/2009 15:36'! label ^label! ! !OTProcessNode methodsFor: 'accessing' stamp: 'dkh 1/9/2009 15:37'! label: aString label := aString! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 4/25/2007 20:24'! longStack ^ self stackOfSize: 1024! ! !OTProcessNode methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:33'! name ^ self process browserPrintStringWith: self rules first! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 5/20/2008 13:27'! nodeAt: aContext "Answer a cached node of the receiving process." ^ cache at: aContext ifAbsentPut: [ OTContextNode on: process context: aContext ]! ! !OTProcessNode methodsFor: 'private' stamp: 'lr 8/3/2007 19:57'! rules ^ ProcessBrowser nameAndRulesFor: self process! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 4/25/2007 20:25'! shortStack ^ self stackOfSize: 64! ! !OTProcessNode methodsFor: 'testing' stamp: 'dkh 1/9/2009 13:28'! shouldBeStyledBy: aShoutMorph ^false! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 5/20/2008 13:27'! stackOfSize: anInteger | current stack | current := self context. stack := OrderedCollection new: anInteger. [ current notNil and: [ stack size < anInteger ] ] whileTrue: [ stack addLast: (self nodeAt: current). current := current sender ]. ^ stack! ! !OTProcessNode methodsFor: 'accessing' stamp: 'dkh 2/25/2009 05:30'! targetContext targetContext == nil ifTrue: [ ^process suspendedContext ]. ^targetContext! ! !OTProcessNode methodsFor: 'accessing' stamp: 'dkh 2/25/2009 05:29'! targetContext: aContext targetContext := aContext! ! !OTProcessNode methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:19'! value ^ self process! ! OBNode subclass: #OTFilesystemNode instanceVariableNames: 'parent' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! OTFilesystemNode subclass: #OTDirectoryNode instanceVariableNames: 'directory' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTDirectoryNode methodsFor: 'navigation' stamp: 'lr 5/15/2008 11:41'! directories ^ self directory directoryNames collect: [ :each | (OTDirectoryNode on: self) setDirectory: (self directory directoryNamed: each); yourself ]! ! !OTDirectoryNode methodsFor: 'accessing' stamp: 'lr 12/11/2007 11:09'! directory ^ directory! ! !OTDirectoryNode methodsFor: 'navigation' stamp: 'lr 5/15/2008 11:42'! files ^ self directory fileNames collect: [ :each | (OTFileNode on: self) setName: each; yourself ]! ! !OTDirectoryNode methodsFor: 'accessing' stamp: 'lr 8/4/2008 10:47'! fullName ^ self directory fullName! ! !OTDirectoryNode methodsFor: 'accessing' stamp: 'lr 12/11/2007 11:15'! name ^ self directory localName! ! !OTDirectoryNode methodsFor: 'initialization' stamp: 'lr 5/15/2008 11:40'! setDirectory: aDirectory directory := aDirectory! ! OTFilesystemNode subclass: #OTFileNode instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTFileNode methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:42'! directory ^ self parent directory! ! !OTFileNode methodsFor: 'accessing' stamp: 'lr 8/4/2008 10:48'! fullName ^ self directory fullNameFor: self name! ! !OTFileNode methodsFor: 'accessing' stamp: 'lr 12/11/2007 11:13'! name ^ name! ! !OTFileNode methodsFor: 'initialization' stamp: 'lr 5/15/2008 11:40'! setName: aString name := aString! ! !OTFileNode methodsFor: 'accessing' stamp: 'lr 8/4/2008 10:55'! text | stream contents | stream := self directory readOnlyFileNamed: self name. contents := [ [ stream next: 10000 ] ensure: [ stream close ] ] on: Error do: [ :err | err messageText ]. contents size = 10000 ifTrue: [ contents := contents , '...' ]. ^ contents! ! !OTFilesystemNode class methodsFor: 'instance-creation' stamp: 'lr 5/15/2008 11:38'! on: aNode ^ self new initializeOn: aNode! ! !OTFilesystemNode methodsFor: 'navigation' stamp: 'lr 5/15/2008 11:40'! directories ^ #()! ! !OTFilesystemNode methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:36'! directory self subclassResponsibility! ! !OTFilesystemNode methodsFor: 'navigation' stamp: 'lr 5/15/2008 11:41'! files ^ #()! ! !OTFilesystemNode methodsFor: 'accessing' stamp: 'lr 8/4/2008 10:46'! fullName self subclassResponsibility! ! !OTFilesystemNode methodsFor: 'initialization' stamp: 'lr 5/15/2008 11:39'! initializeOn: aNode parent := aNode! ! !OTFilesystemNode methodsFor: 'testing' stamp: 'lr 5/15/2008 11:39'! isRoot ^ parent isNil! ! !OTFilesystemNode methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:38'! parent ^ parent! ! !OTFilesystemNode methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:55'! path ^ self isRoot ifTrue: [ OrderedCollection with: self ] ifFalse: [ self parent path addLast: self; yourself ]! ! OBNode subclass: #OTInspectorNode instanceVariableNames: 'object tag' 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: 'comparing' stamp: 'lr 7/15/2007 11:45'! = aNode ^ super = aNode and: [ self label = aNode label ]! ! !OTDerivedInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:35'! block ^ block! ! !OTDerivedInspectorNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:48'! hash ^ super hash bitXor: self label hash! ! !OTDerivedInspectorNode methodsFor: 'testing' stamp: 'lr 5/23/2007 23:03'! isLastNode ^ true! ! !OTDerivedInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! label ^ label! ! !OTDerivedInspectorNode methodsFor: 'accessing' stamp: 'lr 6/9/2008 16:31'! label: aString label := aString! ! !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: 'comparing' stamp: 'lr 5/29/2008 09:49'! = aNode ^ super = aNode and: [ self key == aNode key ]! ! !OTDictionaryInspectorNode methodsFor: 'comparing' stamp: 'lr 5/29/2008 09:48'! hash ^ super hash bitXor: self key identityHash! ! !OTDictionaryInspectorNode methodsFor: 'testing' stamp: 'lr 5/29/2008 09:50'! isReadOnly ^ false! ! !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: 'private' stamp: 'dkh 2/21/2009 09:40'! printStringErrorText: exception ^ ('<', (self printStringErrorType: exception), ' in printString: evaluate "(self at: ', self key printString, ') printString" to debug>') asText.! ! !OTDictionaryInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 11:02'! setKey: anObject key := anObject! ! !OTDictionaryInspectorNode methodsFor: 'accessing' stamp: 'lr 6/16/2008 15:38'! value ^ self object at: self key ifAbsent: [ nil ]! ! !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 8/3/2007 20:44'! on: anObject index: anInteger ^ (self on: anObject) setIndex: anInteger! ! !OTIndexedVariableNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:46'! = aNode ^ super = aNode and: [ self index = aNode index ]! ! !OTIndexedVariableNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:48'! hash ^ super hash bitXor: self index hash! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:20'! index ^ index! ! !OTIndexedVariableNode methodsFor: 'testing' stamp: 'lr 5/29/2008 09:50'! isReadOnly ^ false! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! name ^ self index printString! ! !OTIndexedVariableNode methodsFor: 'private' stamp: 'dkh 2/21/2009 09:41'! printStringErrorText: exception ^('<', (self printStringErrorType: exception), ' in printString: evaluate "(self basicAt: ', self index printString, ') printString" to debug>') asText.! ! !OTIndexedVariableNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 10:18'! setIndex: anInteger index := anInteger! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'dkh 2/21/2009 10:02'! 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! ! OTIndexedVariableNode subclass: #OTNamedIndexedVariableNode instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTNamedIndexedVariableNode class methodsFor: 'instance-creation' stamp: 'lr 6/16/2008 15:38'! on: anObject index: anInteger name: aString ^ (self on: anObject index: anInteger) setName: aString! ! !OTNamedIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 6/9/2008 16:45'! name ^ name! ! !OTNamedIndexedVariableNode methodsFor: 'initialization' stamp: 'lr 6/16/2008 15:36'! setName: aString name := aString! ! !OTInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 7/15/2007 11:34'! on: anObject ^ self basicNew initializeOn: anObject! ! !OTInspectorNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:44'! = aNode ^ self species = aNode species and: [ self object == aNode object ]! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 5/19/2007 11:41'! asDraggableMorph ^ super asDraggableMorph contents: self label; yourself! ! !OTInspectorNode methodsFor: 'actions' stamp: 'lr 5/29/2008 14:19'! browse self value browse! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'dkh 3/21/2009 12:05'! childFilterPragmas | result | result := OrderedCollection new. [(self pragmasFor: self value class) do: [ :pragma | result add: pragma ]] on: Error, Halt do: [:ex | ^#() ]. ^ result! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'dkh 3/21/2009 12:05'! childInspectorNodes | result items | result := OrderedCollection new. [(self pragmasFor: self value class) do: [ :pragma | items := self value perform: pragma selector. items isEmptyOrNil ifFalse: [ items do: [ :each | each metaNode: metaNode; tag: (pragma argumentAt: 1) asString ]. result addAll: items ] ]] on: Error do: [:ex | ^#()]. ^ result! ! !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: 'dkh 3/21/2009 12:05'! filterPragmas | result | result := OrderedCollection new. (self pragmasFor: self object class) do: [ :pragma | result add: pragma ]. ^ result! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'dkh 3/21/2009 12:10'! filters "Answer a colletion of filters (label to elements) for the receiving object." | result items | result := OrderedCollection new. (self pragmasFor: self object class) do: [ :pragma | items := self object perform: pragma selector. items isEmptyOrNil ifFalse: [ items do: [ :each | each metaNode: metaNode ]. result add: (pragma argumentAt: 1) -> (items -> (pragma argumentAt: 3)) ] ]. ^ result! ! !OTInspectorNode methodsFor: 'testing' stamp: 'lr 5/29/2008 14:17'! hasSelector ^ false! ! !OTInspectorNode methodsFor: 'comparing' stamp: 'lr 6/5/2008 09:53'! hash ^ self species hash bitXor: self object identityHash! ! !OTInspectorNode methodsFor: 'initialization' stamp: 'lr 7/15/2007 11:34'! initializeOn: anObject object := anObject! ! !OTInspectorNode methodsFor: 'testing' stamp: 'lr 5/29/2008 09:50'! isEditable ^ true! ! !OTInspectorNode methodsFor: 'testing' stamp: 'lr 5/23/2007 23:03'! isLastNode ^ false! ! !OTInspectorNode methodsFor: 'testing' stamp: 'lr 5/29/2008 09:50'! isReadOnly ^ true! ! !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: 'dkh 3/21/2009 12:15'! pragmasFor: aClass ^Pragma allNamed: #inspector:priority:toolTip: from: aClass to: nil sortedByArgument: 2! ! !OTInspectorNode methodsFor: 'printing' stamp: 'lr 7/15/2007 11:29'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' value: '; print: self value! ! !OTInspectorNode methodsFor: 'private' stamp: 'dkh 2/21/2009 10:10'! printStringErrorText: exception ^('<', (self printStringErrorType: exception), ' in printstring for class: ', self class name asString, '>') asText! ! !OTInspectorNode methodsFor: 'private' stamp: 'dkh 2/21/2009 09:39'! printStringErrorType: exception ^(exception isKindOf: Halt) ifTrue: [ 'halt' ] ifFalse: [ 'error' ]! ! !OTInspectorNode methodsFor: 'compatibility' stamp: 'lr 4/26/2007 16:41'! selector ^ nil! ! !OTInspectorNode methodsFor: 'accessing' stamp: 'dkh 3/4/2009 14:41'! tag ^ tag! ! !OTInspectorNode methodsFor: 'accessing' stamp: 'dkh 3/4/2009 14:41'! tag: aSymbol tag := aSymbol! ! !OTInspectorNode methodsFor: 'public' stamp: 'dkh 2/21/2009 09:37'! text ^ [self value printString asText] on: Error, Halt do: [:ex | | text | text := self printStringErrorText: ex. text addAttribute: TextColor red from: 1 to: text size. text]! ! !OTInspectorNode methodsFor: 'public' stamp: 'lr 5/29/2008 09:51'! text: aString self isReadOnly ifTrue: [ ^ false ]. self value: (self object class evaluatorClass evaluate: aString for: self object logged: false). ^ true! ! !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/29/2008 13:26'! value: anObject self error: 'Unable to edit ' , self printString! ! !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 8/3/2007 20:44'! on: anObject index: anInteger name: aString ^ (self on: anObject) setIndex: anInteger name: aString! ! !OTNamedVariableNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:46'! = aNode ^ super = aNode and: [ self index = aNode index ]! ! !OTNamedVariableNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:48'! hash ^ super hash bitXor: self index hash! ! !OTNamedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:21'! index ^ index! ! !OTNamedVariableNode methodsFor: 'testing' stamp: 'lr 5/29/2008 09:50'! isReadOnly ^ false! ! !OTNamedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:21'! name ^ name! ! !OTNamedVariableNode methodsFor: 'private' stamp: 'dkh 2/21/2009 09:42'! printStringErrorText: exception ^('<', (self printStringErrorType: exception), ' in printString: evaluate "(self instVarAt: ', self index printString, ') printString" to debug>') asText.! ! !OTNamedVariableNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 10:19'! setIndex: anInteger name: aString index := anInteger. name := aString! ! !OTNamedVariableNode methodsFor: 'accessing' stamp: 'dkh 2/21/2009 10:03'! 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: 'comparing' stamp: 'lr 7/15/2007 11:46'! = aNode ^ super = aNode and: [ self selector = aNode selector ]! ! !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: 'actions' stamp: 'lr 5/29/2008 14:21'! browse OBSystemBrowser openOnClass: self theClass selector: self selector! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/29/2008 14:09'! definition ^ OBMethodDefinition source: self text inClass: self theClass! ! !OTProtocolInspectorNode methodsFor: 'testing' stamp: 'lr 5/29/2008 14:18'! hasSelector ^ true! ! !OTProtocolInspectorNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:48'! hash ^ super hash bitXor: self selector hash! ! !OTProtocolInspectorNode methodsFor: 'testing' stamp: 'lr 5/23/2007 23:03'! isLastNode ^ true! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/29/2008 14:12'! name ^ self selector , ' (' , self theClass name , ')'! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:38'! selector ^ selector! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/29/2008 14:24'! selectorAndMessages ^ Array with: (OBMessageNode fromMethodNode: self)! ! !OTProtocolInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 10:38'! setSelector: aSelector selector := aSelector! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'dkh 2/21/2009 09:17'! text ^ [ (self theClass sourceCodeAt: self selector) asText ] on: Error, Halt do: [:ex | | text | text := '' asText. text addAttribute: TextColor red from: 1 to: text size. text]! ! !OTProtocolInspectorNode methodsFor: 'accessing' stamp: 'lr 5/29/2008 14:11'! theClass ^ super theClass whichClassIncludesSelector: 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: 'private' stamp: 'dkh 2/21/2009 09:42'! printStringErrorText: exception ^('<', (self printStringErrorType: exception), ' in printString: evaluate "self printString" to debug>') asText.! ! !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 class methodsFor: 'instance-creation' stamp: 'lr 8/3/2007 20:44'! on: anObject index: anInteger ^ (self on: anObject) setIndex: anInteger! ! !OTSequenceInspectorNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:47'! = aNode ^ super = aNode and: [ self index = aNode index ]! ! !OTSequenceInspectorNode methodsFor: 'comparing' stamp: 'lr 7/15/2007 11:47'! hash ^ super hash bitXor: self index hash! ! !OTSequenceInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:03'! index ^ index! ! !OTSequenceInspectorNode methodsFor: 'testing' stamp: 'lr 5/29/2008 09:51'! isReadOnly ^ false! ! !OTSequenceInspectorNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 11:36'! name ^ self index printString! ! !OTSequenceInspectorNode methodsFor: 'private' stamp: 'dkh 2/21/2009 09:42'! printStringErrorText: exception ^('<', (self printStringErrorType: exception), ' in printString: evaluate "(self at: ', self index printString, ') printString" to debug>') asText.! ! !OTSequenceInspectorNode methodsFor: 'initialization' stamp: 'lr 5/19/2007 11:03'! setIndex: anInteger index := anInteger! ! !OTSequenceInspectorNode methodsFor: 'accessing' stamp: 'lr 5/21/2008 10:31'! value ^ self object at: self index ifAbsent: [ nil ]! ! !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: 'comparing' stamp: 'lr 7/15/2007 11:47'! = aNode ^ super = aNode and: [ self value == aNode value ]! ! !OTSetInspectorNode methodsFor: 'comparing' stamp: 'lr 5/29/2008 09:48'! hash ^ super hash bitXor: self value identityHash! ! !OTSetInspectorNode methodsFor: 'testing' stamp: 'lr 5/29/2008 09:51'! isReadOnly ^ false! ! !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/21/2008 10:31'! value: anObject self object remove: anObject ifAbsent: [ ]; add: anObject! ! OBNode subclass: #OTPreDebugNode instanceVariableNames: 'errorWasInUI process context label contents debugOnMouseClick' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTPreDebugNode class methodsFor: 'instance creation' stamp: 'dkh 1/11/2009 10:03'! debug: aProcess context: aContext contents: aContentString label: aString ^self new debug: aProcess context: aContext contents: aContentString label: aString! ! !OTPreDebugNode methodsFor: 'actions' stamp: 'dkh 1/11/2009 10:20'! abandon: aRequestor | proc | process == nil ifTrue: [ ^self ]. proc := process. process := nil. aRequestor browser close. proc terminate! ! !OTPreDebugNode methodsFor: 'accessing' stamp: 'dkh 1/11/2009 10:41'! contents contents == nil ifTrue: [ contents := '' ]. ^ contents! ! !OTPreDebugNode methodsFor: 'accessing' stamp: 'dkh 1/11/2009 12:29'! contents: aString contents := aString! ! !OTPreDebugNode methodsFor: 'accessing' stamp: 'dkh 1/20/2009 10:39'! context ^context! ! !OTPreDebugNode methodsFor: 'actions' stamp: 'dkh 2/24/2009 15:13'! debug: aRequestor | proc | process == nil ifTrue: [ ^self ]. proc := process. process := nil. Preferences logDebuggerStackToFile ifTrue: [ [Smalltalk logError: label inContext: context to: 'debug.log'] on: Halt do: [:ex | "don't bother logging if there is a Halt'"]]. WorldState addDeferredUIMessage: [ aRequestor browser close. OTDebugger openProcess: proc context: context label: label errorWasInUIProcess: errorWasInUI ]. ! ! !OTPreDebugNode methodsFor: 'initialization' stamp: 'dkh 1/11/2009 12:32'! debug: aProcess context: aContext contents: aContentString label: aString process := aProcess. context := aContext. label := aString. contents := aContentString. debugOnMouseClick := false.! ! !OTPreDebugNode methodsFor: 'accessing' stamp: 'dkh 1/11/2009 12:32'! debugOnMouseClick: aBool debugOnMouseClick := aBool! ! !OTPreDebugNode methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:53'! errorWasInUI: anObject errorWasInUI := anObject! ! !OTPreDebugNode methodsFor: 'accessing' stamp: 'dkh 1/11/2009 10:14'! label ^ label! ! !OTPreDebugNode methodsFor: 'actions' stamp: 'dkh 1/11/2009 12:32'! notifyMouseEnter: aRequestor debugOnMouseClick ifTrue: [ self debug: aRequestor ].! ! !OTPreDebugNode methodsFor: 'actions' stamp: 'dkh 1/11/2009 10:21'! proceed: aRequestor | proc | process == nil ifTrue: [ ^self ]. proc := process. process := nil. errorWasInUI ifTrue: [ Project resumeProcess: proc. aRequestor browser close. Processor terminateActive ] ifFalse: [ proc resume. aRequestor browser close ]. ! ! !OTPreDebugNode methodsFor: 'accessing' stamp: 'dkh 2/24/2009 15:05'! process ^process! ! !OTPreDebugNode methodsFor: 'actions' stamp: 'dkh 2/24/2009 15:05'! trimTo: aContext self process popTo: aContext; restartTop; stepToSendOrReturn. ! ! OBNode subclass: #OTSchedulerNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTSchedulerNode methodsFor: 'comparing' stamp: 'lr 10/7/2007 12:21'! = anObject ^ self class = anObject class! ! !OTSchedulerNode methodsFor: 'navigation' stamp: 'lr 6/7/2008 20:17'! methodNode ^ nil! ! !OTSchedulerNode methodsFor: 'navigation' stamp: 'lr 5/20/2008 12:41'! processes | processes | processes := Process allSubInstances reject: [ :each | each isTerminated ]. processes := processes sortBy: [ :a :b | a priority = b priority ifFalse: [ a priority >= b priority ] ifTrue: [ a hash >= b hash ] ]. ^ processes collect: [ :each | OTProcessNode on: each ]! ! !Collection methodsFor: '*ob-tools-inspector' stamp: 'dkh 3/21/2009 12:11'! elementInspectorNodes ^ OrderedCollection with: self selfInspectorNode with: self sizeInspectorNode! ! !Collection methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 09:43'! sizeInspectorNode ^ OTDerivedInspectorNode on: self label: 'size' block: [ :obj | obj size ]! ! !SequenceableCollection methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:09'! elementInspectorNodes | result | result := super elementInspectorNodes. 1 to: self size do: [ :each | result add: (OTSequenceInspectorNode on: self index: each) ]. ^ result! ! OBTextPanel subclass: #OTStringHolderPanel instanceVariableNames: 'text bindings shoutHighlighting' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-String'! OTStringHolderPanel subclass: #OTInspectorWorkspacePanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectorWorkspacePanel methodsFor: 'evaluating' stamp: 'dkh 3/5/2009 11:39'! doItReceiver ^ browser inspectorDoItReceiver! ! !OTInspectorWorkspacePanel methodsFor: 'accessing' stamp: 'lr 5/29/2008 13:25'! text ^ text! ! !OTInspectorWorkspacePanel methodsFor: 'accessing' stamp: 'lr 5/29/2008 13:26'! text: aString text := aString! ! !OTStringHolderPanel class methodsFor: 'instance-creation' stamp: 'lr 1/20/2008 17:12'! inBrowser: aBrowser on: anObject ^ (self inBrowser: aBrowser) initializeOn: anObject! ! !OTStringHolderPanel methodsFor: 'evaluating' stamp: 'lr 1/20/2008 17:16'! accept: aText notifying: aController self text: aText. ^ true! ! !OTStringHolderPanel methodsFor: 'building' stamp: 'lr 1/20/2008 17:34'! buildOn: aBuilder ^ aBuilder textarea: self with: [ ]! ! !OTStringHolderPanel methodsFor: 'evaluating' stamp: 'lr 1/20/2008 17:07'! doItContext ^ nil! ! !OTStringHolderPanel methodsFor: 'evaluating' stamp: 'lr 1/20/2008 17:08'! doItReceiver ^ nil! ! !OTStringHolderPanel methodsFor: 'private' stamp: 'dkh 1/23/2009 09:26'! environment ^ Smalltalk! ! !OTStringHolderPanel methodsFor: 'initialization' stamp: 'dkh 1/11/2009 09:37'! initializeOn: anObject shoutHighlighting := false! ! !OTStringHolderPanel methodsFor: 'evaluating' stamp: 'lr 1/20/2008 17:07'! selectedClass ^ nil! ! !OTStringHolderPanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 17:13'! selection ^ 0 to: 1! ! !OTStringHolderPanel methodsFor: 'testing' stamp: 'dkh 1/11/2009 09:38'! shoutAboutToStyle: aPluggableShoutMorph "Turn off shout highlighting ..." ^self shoutHighlighting! ! !OTStringHolderPanel methodsFor: 'accessing' stamp: 'dkh 1/11/2009 12:00'! shoutHighlighting shoutHighlighting == nil ifTrue: [ shoutHighlighting := false ]. ^ shoutHighlighting! ! !OTStringHolderPanel methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:36'! shoutHighlighting: anObject shoutHighlighting := anObject! ! !OTStringHolderPanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 17:06'! text self subclassResponsibility! ! !OTStringHolderPanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 17:14'! text: aString self subclassResponsibility! ! OTStringHolderPanel subclass: #OTTranscriptPanel instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-String'! !OTTranscriptPanel class methodsFor: 'instance-creation' stamp: 'lr 11/21/2007 13:45'! on: aTranscriptStream ^ self new initializeOn: aTranscriptStream! ! !OTTranscriptPanel methodsFor: 'delegating' stamp: 'lr 1/20/2008 17:34'! characterLimit ^ stream characterLimit! ! !OTTranscriptPanel methodsFor: 'actions' stamp: 'lr 1/20/2008 17:25'! close stream removeDependent: self! ! !OTTranscriptPanel methodsFor: 'delegating' stamp: 'lr 1/20/2008 17:35'! contents ^ stream contents! ! !OTTranscriptPanel methodsFor: 'initialization' stamp: 'dkh 1/11/2009 12:01'! initializeOn: aStream super initializeOn: aStream. stream := aStream. stream addDependent: self! ! !OTTranscriptPanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 17:37'! text ^ String new! ! !OTTranscriptPanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 17:37'! text: aString! ! !OTTranscriptPanel methodsFor: 'actions' stamp: 'dkh 1/9/2009 11:05'! update: aSymbol self changed: aSymbol. self changed: #displayWorld! ! OTStringHolderPanel subclass: #OTWorkspacePanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-String'! OTWorkspacePanel subclass: #OTPreDebugPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTPreDebugPanel methodsFor: 'building' stamp: 'dkh 1/11/2009 13:23'! buildOn: aBuilder ^ aBuilder nonScrollingTextarea: self with: [ ]! ! !OTPreDebugPanel methodsFor: 'user interface' stamp: 'dkh 1/11/2009 13:18'! notifyMouseEnter self browser root notifyMouseEnter: self! ! !OTWorkspacePanel methodsFor: 'drag and drop' stamp: 'lr 1/20/2008 17:51'! acceptDroppingMorph: aTransferMorph event: anEvent inMorph: aMorph | node name | node := aTransferMorph passenger. name := OBTextRequest prompt: 'Choose a variable name:' template: node name. name isEmptyOrNil ifTrue: [ ^ false ]. (self bindingOf: name) value: node value. ^ true! ! !OTWorkspacePanel methodsFor: 'evaluating' stamp: 'lr 1/20/2008 16:44'! bindingOf: aString (bindings includesKey: aString) ifFalse: [ bindings at: aString put: nil ]. ^ bindings associationAt: aString! ! !OTWorkspacePanel methodsFor: 'initialization' stamp: 'dkh 1/11/2009 09:39'! initializeOn: anObject text := anObject asText. bindings := Dictionary new. shoutHighlighting := true! ! !OTWorkspacePanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 16:42'! text ^ text! ! !OTWorkspacePanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 17:16'! text: aText text := aText! ! !OTWorkspacePanel methodsFor: 'drag and drop' stamp: 'lr 1/20/2008 17:47'! wantsDroppedMorph: aTransferMorph event: anEvent inMorph: aMorph ^ (aTransferMorph isKindOf: TransferMorph) and: [ aTransferMorph passenger isKindOf: OTInspectorNode ]! ! !OBColumnPanel methodsFor: '*ob-tools' stamp: 'lr 6/5/2008 11:29'! current: aNode current := aNode! ! OBMetaEdge subclass: #OTChasingMetaEdge instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTChasingMetaEdge methodsFor: 'as yet unclassified' stamp: 'dkh 3/21/2009 15:47'! nodesForParent: aNode | newMeta | aNode isLastNode ifTrue: [ ^#() ]. newMeta := OTChasingMetaNode new addFilter: OTChasingInspectorFilter new; yourself. aNode filterPragmas do: [:pragma | newMeta childAt: pragma selector labeled: (pragma argumentAt: 1) asString put: newMeta ]. ^ (aNode childInspectorNodes) do: [:ea | ea metaNode: newMeta. ea navigation: self navigation. ] ! ! !MethodContext methodsFor: '*ob-tools-inspector' stamp: 'lr 6/16/2008 15:45'! contextInspectorNodes | nodes | nodes := super contextInspectorNodes. self tempNames keysAndValuesDo: [ :index :name | nodes add: (OTNamedIndexedVariableNode on: self index: index name: name) ]. method numTemps + 1 to: stackp do: [ :index | nodes add: (OTNamedIndexedVariableNode on: self index: index name: (index - method numTemps) asString) ]. ^ nodes! ! OBCommand subclass: #OTCmdBrowseDebugger instanceVariableNames: 'command' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdBrowseDebugger class methodsFor: 'instance-creation' stamp: 'lr 6/7/2008 20:11'! all ^ OrderedCollection new add: (self with: OBCmdBrowse); add: (self with: OBCmdBrowseHierarchy); add: (self with: OBCmdBrowseSenders); add: (self with: OBCmdBrowseImplementors); add: (self with: OBCmdBrowseInheritance); add: (self with: OBCmdBrowseProtocol); add: (self with: OBCmdBrowseReferences); add: (self with: OBCmdBrowseMethodVersions); add: (self with: OBCmdChaseVariables); add: (self with: OBCmdBrowseHierarchySenders); add: (self with: OBCmdBrowseHierarchyImplementors); add: OBCmdBrowseSendersOfIt; add: OBCmdBrowseMethodsWithIt; add: OBCmdBrowseImplementorsOfIt; yourself! ! !OTCmdBrowseDebugger class methodsFor: 'instance-creation' stamp: 'lr 6/7/2008 19:14'! with: aCommand ^ self new setCommand: aCommand! ! !OTCmdBrowseDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:11'! cluster ^ command cluster! ! !OTCmdBrowseDebugger methodsFor: 'execution' stamp: 'lr 6/7/2008 19:12'! execute command execute! ! !OTCmdBrowseDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:10'! group ^ command group! ! !OTCmdBrowseDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:11'! icon ^ command icon! ! !OTCmdBrowseDebugger methodsFor: 'testing' stamp: 'lr 6/7/2008 20:18'! isActive ^ (requestor isSelected: target) and: [ (target isKindOf: OTContextNode) and: [ target theClass notNil ] ]! ! !OTCmdBrowseDebugger methodsFor: 'testing' stamp: 'lr 6/7/2008 19:32'! isEnabled ^ command isEnabled! ! !OTCmdBrowseDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:10'! keystroke ^ command keystroke! ! !OTCmdBrowseDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:10'! label ^ command label! ! !OTCmdBrowseDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 20:17'! on: aNode for: aRequestor ^ (super on: aNode for: aRequestor) setCommand: (command on: aNode methodNode for: aRequestor)! ! !OTCmdBrowseDebugger methodsFor: 'initialize-release' stamp: 'lr 6/7/2008 19:12'! setCommand: aCommand command := aCommand! ! OTCmdBrowseDebugger subclass: #OTCmdBrowseInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTCmdBrowseInspector class methodsFor: 'instance-creation' stamp: 'dkh 3/5/2009 12:53'! all ^ OrderedCollection new add: (self with: OBCmdBrowse); add: (self with: OBCmdBrowseHierarchy); add: (self with: OBCmdBrowseProtocol); add: (self with: OBCmdBrowseReferences); add: (self with: OBCmdChaseVariables); yourself! ! !OTCmdBrowseInspector methodsFor: 'testing' stamp: 'dkh 3/5/2009 12:50'! isActive ^ (requestor isSelected: target) and: [ (target isKindOf: OTInspectorNode) and: [ target theClass notNil ] ]! ! !OTCmdBrowseInspector methodsFor: 'accessing' stamp: 'dkh 3/5/2009 12:56'! on: aNode for: aRequestor ^ (self class on: aNode for: aRequestor) setCommand: (command on: aNode theClass asNode for: aRequestor)! ! OBCommand subclass: #OTCmdDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !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: 'accessing' stamp: 'lr 6/7/2008 19:22'! group ^ #debug! ! !OTCmdDebugger methodsFor: 'testing' stamp: 'lr 10/7/2007 11:45'! isActive ^ (target isKindOf: OTContextNode) and: [ requestor isSelected: target ]! ! !OTCmdDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! process ^ target process! ! !OTCmdDebugger methodsFor: 'actions' stamp: 'dkh 2/25/2009 05:44'! update | processNode | processNode := requestor browser root. processNode targetContext: nil. self announce: (OBChildrenChanged node: processNode). self announce: (OBSelectingNode node: processNode contextNode)! ! OTCmdDebugger subclass: #OTCmdErrorReport instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdErrorReport methodsFor: 'execution' stamp: 'dkh 2/22/2009 09:13'! execute | str | str := WriteStream on: String new. target errorReportOn: str. str contents inspect! ! !OTCmdErrorReport methodsFor: 'accessing' stamp: 'dkh 2/22/2009 09:14'! group ^ #stack! ! !OTCmdErrorReport methodsFor: 'accessing' stamp: 'dkh 2/22/2009 09:13'! label ^ 'error report'! ! OTCmdDebugger subclass: #OTCmdIntoDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdIntoDebugger methodsFor: 'execution' stamp: 'lr 6/7/2008 15:11'! execute self process step: self context; stepToSendOrReturn. self update! ! !OTCmdIntoDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:46'! keystroke ^ $s! ! !OTCmdIntoDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:44'! label ^ 'into'! ! !OTCmdIntoDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdOutDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdOutDebugger methodsFor: 'execution' stamp: 'lr 6/7/2008 17:02'! execute | current | current := self context. [ current == self context ] whileTrue: [ current := self process completeStep: current ]. current stepToSendOrReturn. self update! ! !OTCmdOutDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:44'! label ^ 'out'! ! !OTCmdOutDebugger methodsFor: 'testing' stamp: 'lr 6/7/2008 17:00'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdOverDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdOverDebugger methodsFor: 'execution' stamp: 'lr 6/7/2008 15:11'! execute self process completeStep: self context; stepToSendOrReturn. self update! ! !OTCmdOverDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:47'! keystroke ^ $o! ! !OTCmdOverDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:44'! label ^ 'over'! ! !OTCmdOverDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdProceedDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdProceedDebugger methodsFor: 'execution' stamp: 'dkh 1/9/2009 14:34'! execute requestor browser debuggerIsResuming. ! ! !OTCmdProceedDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:46'! keystroke ^ $p! ! !OTCmdProceedDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:45'! label ^ 'proceed'! ! !OTCmdProceedDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdRestartDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdRestartDebugger methodsFor: 'execution' stamp: 'lr 4/26/2007 09:35'! execute self process popTo: self context; restartTop; stepToSendOrReturn. self update! ! !OTCmdRestartDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:46'! keystroke ^ $r! ! !OTCmdRestartDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:45'! label ^ 'restart'! ! !OTCmdRestartDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdReturnDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdReturnDebugger methodsFor: 'execution' stamp: 'lr 6/7/2008 15:12'! execute | expression value | expression := OBTextRequest prompt: 'Enter expression for return value:' template: 'nil'. value := target theClass compilerClass new evaluate: expression in: self context to: self context receiver. self process popTo: self context sender value: value; stepToSendOrReturn. self update! ! !OTCmdReturnDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:45'! label ^ 'return'! ! !OTCmdReturnDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:15'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdRunToDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdRunToDebugger class methodsFor: 'testing' stamp: 'lr 6/7/2008 15:38'! takesNodes ^ false! ! !OTCmdRunToDebugger class methodsFor: 'testing' stamp: 'lr 6/7/2008 15:38'! takesText ^ true! ! !OTCmdRunToDebugger methodsFor: 'execution' stamp: 'lr 6/7/2008 19:40'! execute | selection contextNode current | selection := target instVarNamed: 'selection'. contextNode := requestor browser currentNode. current := contextNode context. [ current == contextNode context and: [ contextNode selection first < selection first ] ] whileTrue: [ current := contextNode process completeStep: current ]. current stepToSendOrReturn. self update! ! !OTCmdRunToDebugger methodsFor: 'testing' stamp: 'lr 6/7/2008 15:56'! isActive ^ true! ! !OTCmdRunToDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 15:41'! label ^ 'run to cursor'! ! OTCmdDebugger subclass: #OTCmdTerminateDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdTerminateDebugger methodsFor: 'execution' stamp: 'lr 6/7/2008 19:44'! execute requestor browser close. self process terminate! ! !OTCmdTerminateDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:45'! label ^ 'terminate'! ! !OTCmdTerminateDebugger methodsFor: 'testing' stamp: 'lr 6/7/2008 19:43'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdThroughDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdThroughDebugger methodsFor: 'execution' stamp: 'lr 6/7/2008 15:12'! execute self process stepToHome: self context; stepToSendOrReturn. self update! ! !OTCmdThroughDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:46'! keystroke ^ $t! ! !OTCmdThroughDebugger methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:45'! label ^ 'through'! ! !OTCmdThroughDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OBCommand subclass: #OTCmdFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! OTCmdFilesystem subclass: #OTCmdCompressFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdCompressFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #compression! ! !OTCmdCompressFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:28'! label ^ 'compress'! ! OTCmdFilesystem subclass: #OTCmdCopyFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdCopyFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #editing! ! !OTCmdCopyFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:33'! keystroke ^ $c! ! !OTCmdCopyFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! label ^ 'copy'! ! OTCmdFilesystem subclass: #OTCmdCreateDirectoryFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdCreateDirectoryFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #creational! ! !OTCmdCreateDirectoryFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! label ^ 'new directory'! ! OTCmdFilesystem subclass: #OTCmdCreateFileFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdCreateFileFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #creational! ! !OTCmdCreateFileFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! label ^ 'new file'! ! !OTCmdFilesystem methodsFor: 'testing' stamp: 'lr 5/15/2008 11:33'! isActive ^ requestor isSelected: target! ! OTCmdFilesystem subclass: #OTCmdMoveFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdMoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #editing! ! !OTCmdMoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! label ^ 'move'! ! OTCmdFilesystem subclass: #OTCmdRemoveFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdRemoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #editing! ! !OTCmdRemoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:33'! keystroke ^ $x! ! !OTCmdRemoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! label ^ 'remove'! ! OTCmdFilesystem subclass: #OTCmdRenameFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdRenameFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #editing! ! !OTCmdRenameFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! label ^ 'rename'! ! OTCmdFilesystem subclass: #OTCmdUncompressFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdUncompressFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #compression! ! !OTCmdUncompressFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! label ^ 'uncompress'! ! OBCommand subclass: #OTCmdInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTCmdInspector subclass: #OTCmdChasingInspectObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTCmdChasingInspectObject methodsFor: 'execution' stamp: 'dkh 3/5/2009 10:22'! execute target value chasingInspect! ! !OTCmdChasingInspectObject methodsFor: 'accessing' stamp: 'dkh 3/5/2009 10:22'! label ^ 'chase'! ! OTCmdInspector subclass: #OTCmdExploreObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTCmdExploreObject methodsFor: 'execution' stamp: 'dkh 3/5/2009 10:23'! execute target value explore! ! !OTCmdExploreObject methodsFor: 'accessing' stamp: 'dkh 3/5/2009 10:23'! keystroke ^ $I! ! !OTCmdExploreObject methodsFor: 'accessing' stamp: 'dkh 3/5/2009 10:23'! label ^ 'explore'! ! 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! ! OBCommand subclass: #OTCmdPreDebug instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTCmdPreDebug methodsFor: 'testing' stamp: 'dkh 1/11/2009 09:56'! isActive ^true! ! !OTCmdPreDebug methodsFor: 'testing' stamp: 'dkh 1/11/2009 09:32'! wantsButton ^true! ! OTCmdPreDebug subclass: #OTCmdPreDebugAbandon instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTCmdPreDebugAbandon methodsFor: 'execution' stamp: 'dkh 1/11/2009 10:19'! execute target abandon: requestor! ! !OTCmdPreDebugAbandon methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:43'! label ^'Abandon'! ! !OTCmdPreDebugAbandon methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:44'! longDescription ^'Terminate execution'! ! !OTCmdPreDebugAbandon methodsFor: 'as yet unclassified' stamp: 'dkh 1/11/2009 12:18'! order ^5! ! OTCmdPreDebug subclass: #OTCmdPreDebugCreateMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTCmdPreDebugCreateMethod methodsFor: 'private' stamp: 'dkh 1/20/2009 10:59'! askForCategoryIn: aClass default: aString | categories newLabel category | newLabel := 'new ...'. categories := OrderedCollection with: newLabel. categories addAll: (aClass allMethodCategoriesIntegratedThrough: Object). category := OBChoiceRequest prompt: 'Add Category' labels: categories values: categories. category == nil ifTrue: [ ^aString ]. category = newLabel ifTrue: [ ^OBTextRequest prompt: 'Please type new category name' template: aString ]. ^category! ! !OTCmdPreDebugCreateMethod methodsFor: 'private' stamp: 'dkh 1/20/2009 10:47'! askForSuperclassOf: aClass toImplement: aSelector | classes | classes := aClass withAllSuperclasses. ^OBChoiceRequest prompt: 'Define #', aSelector, ' in which class?' labels: (classes collect: [:c | c name]) values: classes! ! !OTCmdPreDebugCreateMethod methodsFor: 'execution' stamp: 'dkh 2/24/2009 15:13'! execute "Create a stub for the method that was missing and proceed into it." | msg chosenClass | msg := target context tempAt: 1. chosenClass := self askForSuperclassOf: target context receiver class toImplement: msg selector. chosenClass == nil ifTrue: [^self]. self implement: msg inClass: chosenClass. target trimTo: target context. target debug: requestor! ! !OTCmdPreDebugCreateMethod methodsFor: 'private' stamp: 'dkh 2/24/2009 15:08'! implement: aMessage inClass: aClass | category | category := self askForCategoryIn: aClass default: 'as yet unclassified'. aClass compile: aMessage createStubMethod classified: category. target context privRefreshWith: (aClass lookupSelector: aMessage selector). aMessage arguments doWithIndex: [:arg :i | target context at: i put: arg. ]. ! ! !OTCmdPreDebugCreateMethod methodsFor: 'testing' stamp: 'dkh 1/20/2009 10:40'! isActive ^(target context selector == #doesNotUnderstand:)! ! !OTCmdPreDebugCreateMethod methodsFor: 'accessing' stamp: 'dkh 1/20/2009 10:34'! label ^'Create Method'! ! !OTCmdPreDebugCreateMethod methodsFor: 'accessing' stamp: 'dkh 1/20/2009 10:34'! longDescription ^'Create the missing method and step into it.'! ! !OTCmdPreDebugCreateMethod methodsFor: 'user interface' stamp: 'dkh 1/20/2009 10:34'! order ^15! ! !OTCmdPreDebugCreateMethod methodsFor: 'testing' stamp: 'dkh 1/20/2009 10:40'! wantsButton ^self isActive! ! OTCmdPreDebug subclass: #OTCmdPreDebugDebug instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTCmdPreDebugDebug methodsFor: 'execution' stamp: 'dkh 1/11/2009 10:19'! execute target debug: requestor! ! !OTCmdPreDebugDebug methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:44'! label ^'Debug'! ! !OTCmdPreDebugDebug methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:44'! longDescription ^'Debug process'! ! !OTCmdPreDebugDebug methodsFor: 'user interface' stamp: 'dkh 1/11/2009 12:15'! order ^10! ! OTCmdPreDebug subclass: #OTCmdPreDebugProceed instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTCmdPreDebugProceed methodsFor: 'execution' stamp: 'dkh 1/11/2009 10:19'! execute target proceed: requestor! ! !OTCmdPreDebugProceed methodsFor: 'accessing' stamp: 'dkh 1/10/2009 17:36'! label ^'Proceed'! ! !OTCmdPreDebugProceed methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:44'! longDescription ^'Proceed with execution'! ! !OTCmdPreDebugProceed methodsFor: 'user interface' stamp: 'dkh 1/11/2009 12:15'! order ^1! ! OBCommand subclass: #OTCmdProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! OTCmdProcessBrowser subclass: #OTCmdDebugProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdDebugProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 18:59'! execute target process resume; debugWithTitle: 'Interrupted from the Process Browser'! ! !OTCmdDebugProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 16:46'! isEnabled ^ target allowDebug! ! !OTCmdDebugProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $d! ! !OTCmdDebugProcessBrowser methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:13'! label ^ 'debug process'! ! OTCmdProcessBrowser subclass: #OTCmdPriorityProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdPriorityProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 19:00'! execute | priority | priority := (OBTextRequest prompt: 'New priority' template: target process priority asString) ifNil: [ ^ self ]. priority := priority asNumber asInteger. (priority between: Processor lowestPriority and: Processor highestPriority) ifFalse: [ ^ OBInformRequest message: 'Bad priority' ]. target process priority: priority. self update! ! !OTCmdPriorityProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 16:47'! isEnabled ^ target allowDebug! ! !OTCmdPriorityProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:05'! keystroke ^ $p! ! !OTCmdPriorityProcessBrowser methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:11'! label ^ 'change priority'! ! !OTCmdProcessBrowser methodsFor: 'testing' stamp: 'lr 5/21/2008 10:37'! isActive ^ (requestor isSelected: target) and: [ target isKindOf: OTProcessNode ]! ! !OTCmdProcessBrowser methodsFor: 'actions' stamp: 'lr 8/3/2007 16:37'! update requestor announce: OBRefreshRequired! ! OTCmdProcessBrowser subclass: #OTCmdProfileProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdProfileProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 19:09'! execute | seconds | seconds := (OBTextRequest prompt: 'Profile for how many seconds?' template: '4') ifNil: [ ^ self ]. seconds := seconds asNumber asInteger. seconds isZero ifTrue: [ ^ self ]. [ TimeProfileBrowser spyOnProcess: target process forMilliseconds: seconds * 1000 ] forkAt: target process priority + 1! ! !OTCmdProfileProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $m! ! !OTCmdProfileProcessBrowser methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:11'! label ^ 'profile messages'! ! OTCmdProcessBrowser subclass: #OTCmdResumeProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdResumeProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process resume. self update! ! !OTCmdResumeProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTCmdResumeProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 19:02'! isActive ^ super isActive and: [ target process isSuspended ]! ! !OTCmdResumeProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 19:03'! isEnabled ^ target allowStop! ! !OTCmdResumeProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:16'! keystroke ^ $r! ! !OTCmdResumeProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:16'! label ^ 'resume'! ! OTCmdProcessBrowser subclass: #OTCmdSignalProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdSignalProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:41'! execute | semaphore | semaphore := target process suspendingList. (semaphore isKindOf: Semaphore) ifFalse: [ ^ self ]. [ semaphore signal ] forkAndWait. self update! ! !OTCmdSignalProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 16:40'! isEnabled ^ target process suspendingList isKindOf: Semaphore! ! !OTCmdSignalProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:05'! keystroke ^ $S! ! !OTCmdSignalProcessBrowser methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:12'! label ^ 'signal smaphore'! ! OTCmdProcessBrowser subclass: #OTCmdSuspendProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdSuspendProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process suspend. self update! ! !OTCmdSuspendProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTCmdSuspendProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 19:02'! isActive ^ super isActive and: [ target process isSuspended not ]! ! !OTCmdSuspendProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 19:03'! isEnabled ^ target allowStop! ! !OTCmdSuspendProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $s! ! !OTCmdSuspendProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:03'! label ^ 'suspend'! ! OTCmdProcessBrowser subclass: #OTCmdTerminateProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdTerminateProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process terminate. self update! ! !OTCmdTerminateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTCmdTerminateProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 16:44'! isEnabled ^ target allowStop! ! !OTCmdTerminateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $t! ! !OTCmdTerminateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:03'! label ^ 'terminate'! ! OTCmdProcessBrowser subclass: #OTCmdUpdateProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdUpdateProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute self update! ! !OTCmdUpdateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:04'! group ^ #updating! ! !OTCmdUpdateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:25'! keystroke ^ $u! ! !OTCmdUpdateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:25'! label ^ 'update'! ! !Morph methodsFor: '*ob-tools' stamp: 'dc 6/1/2007 14:31'! addMorph: aMorph frame: relFrame | frame | frame _ LayoutFrame new. frame leftFraction: relFrame left; rightFraction: relFrame right; topFraction: relFrame top; bottomFraction: relFrame bottom. self addMorph: aMorph fullFrame: frame. ! ! OTToolset initialize!