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'! 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: 'damiencassou 7/3/2009 14:58'! basicInspectorNodes | nodes | nodes := SortedCollection new: self class instSize + self basicSize + 5. nodes sortBlock: [:node1 :node2| node1 name < node2 name]. 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 ]! ! !Bag methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:08'! elementInspectorNodes ^ super elementInspectorNodes , (contents elementInspectorNodes allButFirst: 2)! ! 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 ]! ! 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)! ! !Morph methodsFor: '*ob-tools' stamp: 'lr 7/4/2009 10:42'! 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! ! !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! ! !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 ]! ! OBDefinitionPanel subclass: #OTDefinitionPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDefinitionPanel methodsFor: 'as yet unclassified' stamp: 'dkh 4/25/2009 13:51'! accept: aText notifying: aController | node | (node := self browser currentNode) isExecutingBlock ifTrue: [ | context finalBlockHome | finalBlockHome := ((context := node context) respondsTo: #finalBlockHome) ifTrue: [ "Squeak" context finalBlockHome ] ifFalse: [ "Pharo" context activeHome ]. 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! ! 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. ] ! ! !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! ! 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! ! 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! ! 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 subclass: #OTClosureContextNode instanceVariableNames: 'debuggerMap' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTClosureContextNode methodsFor: 'actions' stamp: 'dkh 4/6/2009 11:59'! flush super flush. debuggerMap := nil! ! !OTClosureContextNode methodsFor: 'accessing-dynamic' stamp: 'Hernan Wilkinson 6/22/2009 18:27'! selection "Answer the indices in the source code for the method corresponding to the selected context's program counter value." self context isDead ifTrue: [^1 to: 0]. debuggerMap ifNil: [ | method | method := self method. method ifNil: [ ^1 to: 0 ]. debuggerMap := method debuggerMap]. ^debuggerMap rangeForPC: self context pc contextIsActiveContext: (process suspendedContext = self context)! ! !OTClosureContextNode methodsFor: 'accessing-dynamic' stamp: 'dkh 4/6/2009 12:04'! sourceMap "use debuggerMap instead" ^ self shouldNotImplement! ! !OTContextNode class methodsFor: 'instance-creation' stamp: 'dkh 4/6/2009 12:02'! on: aProcess context: aContext | contextClass | contextClass := self. Smalltalk at: #DebuggerMethodMap ifPresent: [:cl | contextClass := OTClosureContextNode]. ^ (contextClass 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 6/12/2010 14:51'! icon ^ #folder! ! !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: 'accessing' stamp: 'lr 6/12/2010 15:00'! icon ^ #blank! ! !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 ]! ! 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! ! !ContextPart methodsFor: '*ob-tools-inspector' stamp: 'dkh 3/21/2009 12:13'! contextInspectorNodes ^ OrderedCollection with: (self selfInspectorNode label: 'thisContext')! ! !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! ! !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! ! 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! ! !OBMorphicIcons methodsFor: '*ob-tools' stamp: 'lr 6/12/2010 15:00'! folder ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #(1701143909 1701143909 1701143909 471335169 204034915 1667453203 1532439627 1614492002 1650611246 1024266254 1063196513 106906917 1379078430 1310793755 759641685 1560876121 302014720 576675897 610285327 1631209987 1008681558 140122410 942021980 1480599369 1275409412 838994526 1293568011 355418416 1127567367 1146037054 672556132 1684300900 1684293163 1701143909 1701143909 1701143909) offset: 0@0) colorsFromArray: #(#(0.996 0.988 0.9490000000000001) #(0.891 0.768 0.388) #(0.965 0.871 0.462) #(0.969 0.891 0.522) #(0.973 0.902 0.585) #(0.992 0.98 0.9490000000000001) #(0.996 0.988 0.9450000000000001) #(0.9490000000000001 0.8270000000000001 0.47400000000000003) #(0.859 0.639 0.232) #(0.984 0.965 0.91) #(0.961 0.859 0.396) #(0.859 0.608 0.232) #(0.891 0.768 0.384) #(0.996 0.988 0.969) #(0.961 0.879 0.624) #(1.0 0.988 0.961) #(0.961 0.871 0.5690000000000001) #(0.9570000000000001 0.863 0.577) #(0.965 0.914 0.788) #(0.996 0.996 0.988) #(0.934 0.807 0.534) #(0.851 0.561 0.20400000000000001) #(0.851 0.545 0.2) #(0.996 0.992 0.9570000000000001) #(0.883 0.761 0.369) #(0.984 0.937 0.725) #(0.9490000000000001 0.8190000000000001 0.232) #(0.937 0.8230000000000001 0.502) #(0.879 0.761 0.34900000000000003) #(0.965 0.879 0.486) #(0.9490000000000001 0.836 0.506) #(0.961 0.859 0.40800000000000003) #(0.937 0.8270000000000001 0.522) #(0.918 0.796 0.423) #(0.996 0.988 0.9410000000000001) #(0.973 0.918 0.761) #(0.859 0.659 0.232) #(0.879 0.737 0.34500000000000003) #(0.969 0.891 0.545) #(0.988 0.9530000000000001 0.8150000000000001) #(0.934 0.792 0.635) #(0.879 0.753 0.337) #(0.98 0.926 0.674) #(0.914 0.725 0.522) #(1.0 0.996 0.996) #(0.937 0.8150000000000001 0.47800000000000004) #(0.9490000000000001 0.898 0.729) #(0.98 0.937 0.851) #(0.9530000000000001 0.855 0.588) #(0.898 0.784 0.431) #(0.969 0.887 0.522) #(0.992 0.98 0.9450000000000001) #(0.977 0.914 0.643) #(0.9530000000000001 0.844 0.526) #(0.984 0.969 0.914) #(1.0 0.992 0.965) #(0.977 0.91 0.612) #(0.859 0.682 0.23600000000000002) #(0.988 0.965 0.848) #(0.984 0.969 0.918) #(0.965 0.875 0.462) #(0.863 0.706 0.255) #(0.851 0.557 0.2) #(0.965 0.883 0.674) #(0.9570000000000001 0.84 0.31) #(0.9570000000000001 0.859 0.62) #(0.988 0.9570000000000001 0.844) #(0.9530000000000001 0.848 0.557) #(0.9450000000000001 0.8230000000000001 0.447) #(1.0 0.992 0.98) #(0.848 0.534 0.177) #(0.934 0.811 0.462) #(0.984 0.9490000000000001 0.8) #(0.859 0.635 0.232) #(0.973 0.902 0.581) #(1.0 0.996 0.992) #(0.859 0.616 0.23600000000000002) #(0.9530000000000001 0.8310000000000001 0.28600000000000003) #(0.93 0.792 0.41500000000000004) #(0.9450000000000001 0.8150000000000001 0.423) #(0.9490000000000001 0.8310000000000001 0.498) #(0.984 0.965 0.906) #(0.863 0.682 0.251) #(0.988 0.973 0.93) #(0.898 0.792 0.462) #(0.863 0.6980000000000001 0.243) #(0.859 0.655 0.232) #(0.996 0.996 0.992) #(0.961 0.851 0.365) #(0.914 0.757 0.451) #(0.996 0.988 0.965) #(0.859 0.71 0.23600000000000002) #(0.965 0.863 0.423) #(0.859 0.678 0.224) #(0.9570000000000001 0.844 0.341) #(0.996 0.984 0.937) #(1.0 1.0 0.996) #(0.996 0.988 0.9530000000000001) #(0.894 0.788 0.435) #(0.992 0.98 0.9530000000000001) #(0.851 0.549 0.20400000000000001) #( ) ))! ! !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! ! 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)! ! !OTInspector methodsFor: 'as yet unclassified' stamp: 'damiencassou 7/3/2009 15:21'! step self announce: (OBChildrenChanged node: self root)! ! !OTInspector methodsFor: 'as yet unclassified' stamp: 'damiencassou 7/3/2009 15:21'! wantsSteps ^ true! ! 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! ! !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! ! 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'! ! !OBColumnPanel methodsFor: '*ob-tools' stamp: 'lr 6/5/2008 11:29'! current: aNode current := aNode! ! OTToolset initialize!