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'! !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: 'lr 6/12/2010 15:08'! shoutAboutToStyle: aPluggableShoutMorph ^ self shoutHighlighting! ! !OTStringHolderPanel methodsFor: 'accessing' stamp: 'lr 6/12/2010 15:07'! shoutHighlighting ^ shoutHighlighting ifNil: [ shoutHighlighting := false ]! ! !OTStringHolderPanel methodsFor: 'accessing' stamp: 'lr 6/12/2010 15:07'! shoutHighlighting: aBoolean shoutHighlighting := aBoolean! ! !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! ! !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 ]! ! !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! ! 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. ] ! ! OBDefinitionPanel subclass: #OTDebugDefinitionPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDebugDefinitionPanel methodsFor: 'visiting' 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 ! ! !OTDebugDefinitionPanel methodsFor: 'accessing' stamp: 'dkh 1/23/2009 09:36'! definition: aDefinition super definition: aDefinition. self changed: #selection! ! !OTDebugDefinitionPanel methodsFor: 'callbacks' stamp: 'dkh 1/9/2009 10:28'! doItContext ^self browser currentNode doItContext! ! !OTDebugDefinitionPanel 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! ! !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 11/12/2010 19:26'! subscribe super 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 11/12/2010 19:16'! icon: aSymbol forNode: aNode | method | method := aNode method ifNil: [ ^ #blank ]. method literalsDo: [ :literal | (literal == #halt or: [ literal == #halt: or: [ literal == #haltIfNil or: [ literal == #haltIf: or: [ literal == #haltOnce or: [ literal == #haltOnce: or: [ literal == #haltOnCount: or: [ literal == #halt:onCount: ] ] ] ] ] ] ]) ifTrue: [ ^ #breakpoint ]. (literal == #flag: or: [ literal == #needsWork or: [ literal == #notYetImplemented or: [ literal == #isThisEverCalled ] ] ]) 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 11/12/2010 19:02'! 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: 'lr 11/12/2010 19:03'! 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: 'lr 11/12/2010 18:56'! 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: 'lr 11/12/2010 19:03'! targetContext ^ targetContext ifNil: [ process suspendedContext ]! ! !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: 'lr 11/12/2010 18:50'! buttonPanel ^ OBFixedButtonPanel new! ! !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: 'lr 11/12/2010 19:26'! definitionPanel ^ OTDebugDefinitionPanel 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 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: 'lr 11/12/2010 19:24'! 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: 'lr 11/12/2010 19:24'! 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: 'lr 11/12/2010 19:09'! titleForRoot: aNode ^ aNode label! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 11/12/2010 19:05'! cmdBrowse ^ OTBrowseDebuggerCommand all! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 11/12/2010 19:05'! cmdDebug ^ OTDebuggerCommand allSubclasses! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 11/12/2010 19:05'! cmdInspector ^ OTInspectorCommand 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 11/12/2010 18:49'! buttonPanel ^ nil! ! !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 12/11/2007 11:27'! title ^ 'File System'! ! !OTFilesystemBrowser methodsFor: 'commands' stamp: 'lr 11/12/2010 19:05'! cmdsCommands ^ OTFilesystemCommand 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: 'lr 6/12/2010 15:04'! buildOn: aBuilder | window first second | window := aBuilder window: self with: [ first := aBuilder horizontalGroupWith: [ self panels allButLast do: [ :each | each buildOn: aBuilder ] ]. second := aBuilder horizontalGroupWith: [ 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 11/12/2010 18:48'! buttonPanel ^ nil! ! !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: 'lr 11/12/2010 19:05'! cmdBrowse ^ OTBrowseInspectorCommand all! ! !OTInspector methodsFor: 'commands' stamp: 'lr 11/12/2010 19:05'! cmdInspect ^ OTInspectorCommand 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: 'lr 11/12/2010 19:05'! cmdPreDebug ^ OTPreDebugCommand 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 11/12/2010 18:50'! buttonPanel ^ nil! ! !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 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 11/12/2010 19:05'! cmdBrowse ^ OTBrowseDebuggerCommand all! ! !OTProcessBrowser methodsFor: 'commands' stamp: 'lr 11/12/2010 19:05'! cmdInspector ^ OTInspectorCommand allSubclasses! ! !OTProcessBrowser methodsFor: 'commands' stamp: 'lr 11/12/2010 19:05'! cmdProcess ^ OTProcessBrowserCommand 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: 'lr 11/12/2010 19:20'! nonScrollingTextarea: aDefinitionPanel with: aBlock | morph | morph := self textarea: aDefinitionPanel with: aBlock. morph setProperty: #noVScrollBarPlease toValue: true. ^ morph! ! OBCommand subclass: #OTBrowseDebuggerCommand instanceVariableNames: 'command' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTBrowseDebuggerCommand class methodsFor: 'instance-creation' stamp: 'lr 11/12/2010 18:51'! 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: OBCmdBrowseReferences); add: (self with: OBCmdBrowseMethodVersions); add: (self with: OBCmdChaseVariables); add: (self with: OBCmdBrowseHierarchySenders); add: (self with: OBCmdBrowseHierarchyImplementors); add: OBCmdBrowseSendersOfIt; add: OBCmdBrowseImplementorsOfIt; yourself! ! !OTBrowseDebuggerCommand class methodsFor: 'instance-creation' stamp: 'lr 6/7/2008 19:14'! with: aCommand ^ self new setCommand: aCommand! ! !OTBrowseDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:11'! cluster ^ command cluster! ! !OTBrowseDebuggerCommand methodsFor: 'execution' stamp: 'lr 6/7/2008 19:12'! execute command execute! ! !OTBrowseDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:10'! group ^ command group! ! !OTBrowseDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:11'! icon ^ command icon! ! !OTBrowseDebuggerCommand methodsFor: 'testing' stamp: 'lr 6/7/2008 20:18'! isActive ^ (requestor isSelected: target) and: [ (target isKindOf: OTContextNode) and: [ target theClass notNil ] ]! ! !OTBrowseDebuggerCommand methodsFor: 'testing' stamp: 'lr 6/7/2008 19:32'! isEnabled ^ command isEnabled! ! !OTBrowseDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:10'! keystroke ^ command keystroke! ! !OTBrowseDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:10'! label ^ command label! ! !OTBrowseDebuggerCommand 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)! ! !OTBrowseDebuggerCommand methodsFor: 'initialize-release' stamp: 'lr 6/7/2008 19:12'! setCommand: aCommand command := aCommand! ! OTBrowseDebuggerCommand subclass: #OTBrowseInspectorCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTBrowseInspectorCommand class methodsFor: 'instance-creation' stamp: 'lr 11/12/2010 18:45'! all ^ OrderedCollection new add: (self with: OBCmdBrowse); add: (self with: OBCmdBrowseHierarchy); add: (self with: OBCmdBrowseReferences); add: (self with: OBCmdChaseVariables); yourself! ! !OTBrowseInspectorCommand methodsFor: 'testing' stamp: 'dkh 3/5/2009 12:50'! isActive ^ (requestor isSelected: target) and: [ (target isKindOf: OTInspectorNode) and: [ target theClass notNil ] ]! ! !OTBrowseInspectorCommand 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: #OTDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDebuggerCommand methodsFor: 'actions' stamp: 'lr 4/26/2007 09:17'! announce: anAnnouncement requestor announce: anAnnouncement! ! !OTDebuggerCommand methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! context ^ target context! ! !OTDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:22'! group ^ #debug! ! !OTDebuggerCommand methodsFor: 'testing' stamp: 'lr 10/7/2007 11:45'! isActive ^ (target isKindOf: OTContextNode) and: [ requestor isSelected: target ]! ! !OTDebuggerCommand methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! process ^ target process! ! !OTDebuggerCommand 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)! ! OTDebuggerCommand subclass: #OTErrorReportCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTErrorReportCommand methodsFor: 'execution' stamp: 'dkh 2/22/2009 09:13'! execute | str | str := WriteStream on: String new. target errorReportOn: str. str contents inspect! ! !OTErrorReportCommand methodsFor: 'accessing' stamp: 'dkh 2/22/2009 09:14'! group ^ #stack! ! !OTErrorReportCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Error report'! ! OTDebuggerCommand subclass: #OTIntoDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTIntoDebuggerCommand methodsFor: 'execution' stamp: 'lr 6/7/2008 15:11'! execute self process step: self context; stepToSendOrReturn. self update! ! !OTIntoDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:46'! keystroke ^ $s! ! !OTIntoDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Into'! ! !OTIntoDebuggerCommand methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTOutDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTOutDebuggerCommand 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! ! !OTOutDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Out'! ! !OTOutDebuggerCommand methodsFor: 'testing' stamp: 'lr 6/7/2008 17:00'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTOverDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTOverDebuggerCommand methodsFor: 'execution' stamp: 'lr 6/7/2008 15:11'! execute self process completeStep: self context; stepToSendOrReturn. self update! ! !OTOverDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:47'! keystroke ^ $o! ! !OTOverDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Over'! ! !OTOverDebuggerCommand methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTProceedDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTProceedDebuggerCommand methodsFor: 'execution' stamp: 'dkh 1/9/2009 14:34'! execute requestor browser debuggerIsResuming. ! ! !OTProceedDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:46'! keystroke ^ $p! ! !OTProceedDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Proceed'! ! !OTProceedDebuggerCommand methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTRestartDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTRestartDebuggerCommand methodsFor: 'execution' stamp: 'lr 4/26/2007 09:35'! execute self process popTo: self context; restartTop; stepToSendOrReturn. self update! ! !OTRestartDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:46'! keystroke ^ $r! ! !OTRestartDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Restart'! ! !OTRestartDebuggerCommand methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTReturnDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTReturnDebuggerCommand 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! ! !OTReturnDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Return'! ! !OTReturnDebuggerCommand methodsFor: 'testing' stamp: 'lr 4/25/2007 18:15'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTRunToDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTRunToDebuggerCommand class methodsFor: 'testing' stamp: 'lr 6/7/2008 15:38'! takesNodes ^ false! ! !OTRunToDebuggerCommand class methodsFor: 'testing' stamp: 'lr 6/7/2008 15:38'! takesText ^ true! ! !OTRunToDebuggerCommand 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! ! !OTRunToDebuggerCommand methodsFor: 'testing' stamp: 'lr 6/7/2008 15:56'! isActive ^ true! ! !OTRunToDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Run to cursor'! ! OTDebuggerCommand subclass: #OTTerminateDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTTerminateDebuggerCommand methodsFor: 'execution' stamp: 'lr 6/7/2008 19:44'! execute requestor browser close. self process terminate! ! !OTTerminateDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Terminate'! ! !OTTerminateDebuggerCommand methodsFor: 'testing' stamp: 'lr 6/7/2008 19:43'! wantsButton ^ true! ! OTDebuggerCommand subclass: #OTThroughDebuggerCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTThroughDebuggerCommand methodsFor: 'execution' stamp: 'lr 6/7/2008 15:12'! execute self process stepToHome: self context; stepToSendOrReturn. self update! ! !OTThroughDebuggerCommand methodsFor: 'accessing' stamp: 'lr 6/7/2008 19:46'! keystroke ^ $t! ! !OTThroughDebuggerCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:56'! label ^ 'Through'! ! !OTThroughDebuggerCommand methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OBCommand subclass: #OTFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! OTFilesystemCommand subclass: #OTCompressFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCompressFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #compression! ! !OTCompressFilesystemCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:53'! label ^ 'Compress'! ! OTFilesystemCommand subclass: #OTCopyFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCopyFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #editing! ! !OTCopyFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:33'! keystroke ^ $c! ! !OTCopyFilesystemCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:53'! label ^ 'Copy'! ! OTFilesystemCommand subclass: #OTCreateDirectoryFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCreateDirectoryFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #creational! ! !OTCreateDirectoryFilesystemCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'New directory'! ! OTFilesystemCommand subclass: #OTCreateFileFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCreateFileFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #creational! ! !OTCreateFileFilesystemCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'New file'! ! !OTFilesystemCommand methodsFor: 'testing' stamp: 'lr 5/15/2008 11:33'! isActive ^ requestor isSelected: target! ! OTFilesystemCommand subclass: #OTMoveFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTMoveFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #editing! ! !OTMoveFilesystemCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Move'! ! OTFilesystemCommand subclass: #OTRemoveFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTRemoveFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #editing! ! !OTRemoveFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:33'! keystroke ^ $x! ! !OTRemoveFilesystemCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Remove'! ! OTFilesystemCommand subclass: #OTRenameFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTRenameFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #editing! ! !OTRenameFilesystemCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Rename'! ! OTFilesystemCommand subclass: #OTUncompressFilesystemCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTUncompressFilesystemCommand methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #compression! ! !OTUncompressFilesystemCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:56'! label ^ 'Uncompress'! ! OBCommand subclass: #OTInspectorCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTInspectorCommand subclass: #OTChasingInspectObjectCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTChasingInspectObjectCommand methodsFor: 'execution' stamp: 'dkh 3/5/2009 10:22'! execute target value chasingInspect! ! !OTChasingInspectObjectCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:53'! label ^ 'Chase'! ! OTInspectorCommand subclass: #OTExploreObjectCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTExploreObjectCommand methodsFor: 'execution' stamp: 'dkh 3/5/2009 10:23'! execute target value explore! ! !OTExploreObjectCommand methodsFor: 'accessing' stamp: 'dkh 3/5/2009 10:23'! keystroke ^ $I! ! !OTExploreObjectCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Explore'! ! OTInspectorCommand subclass: #OTInspectObjectCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectObjectCommand methodsFor: 'execution' stamp: 'lr 4/26/2007 16:37'! execute target value inspect! ! !OTInspectObjectCommand methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:06'! keystroke ^ $i! ! !OTInspectObjectCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Inspect'! ! OTInspectorCommand subclass: #OTInspectReferencesCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectReferencesCommand methodsFor: 'execution' stamp: 'lr 5/7/2007 16:03'! execute (Utilities pointersTo: target value except: (Array with: target)) inspect! ! !OTInspectReferencesCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Inspect references'! ! !OTInspectorCommand methodsFor: 'accessing' stamp: 'lr 4/26/2007 16:38'! group ^ #inspection! ! !OTInspectorCommand methodsFor: 'testing' stamp: 'lr 4/26/2007 16:38'! isActive ^ requestor isSelected: target! ! OBCommand subclass: #OTPreDebugCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! OTPreDebugCommand subclass: #OTPreDebugAbandonCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTPreDebugAbandonCommand methodsFor: 'execution' stamp: 'dkh 1/11/2009 10:19'! execute target abandon: requestor! ! !OTPreDebugAbandonCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Abandon'! ! !OTPreDebugAbandonCommand methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:44'! longDescription ^'Terminate execution'! ! !OTPreDebugAbandonCommand methodsFor: 'as yet unclassified' stamp: 'dkh 1/11/2009 12:18'! order ^5! ! !OTPreDebugCommand methodsFor: 'testing' stamp: 'dkh 1/11/2009 09:56'! isActive ^true! ! !OTPreDebugCommand methodsFor: 'testing' stamp: 'dkh 1/11/2009 09:32'! wantsButton ^true! ! OTPreDebugCommand subclass: #OTPreDebugCreateMethodCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTPreDebugCreateMethodCommand 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! ! !OTPreDebugCreateMethodCommand 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! ! !OTPreDebugCreateMethodCommand 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! ! !OTPreDebugCreateMethodCommand 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. ]. ! ! !OTPreDebugCreateMethodCommand methodsFor: 'testing' stamp: 'dkh 1/20/2009 10:40'! isActive ^(target context selector == #doesNotUnderstand:)! ! !OTPreDebugCreateMethodCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Create method'! ! !OTPreDebugCreateMethodCommand methodsFor: 'accessing' stamp: 'dkh 1/20/2009 10:34'! longDescription ^'Create the missing method and step into it.'! ! !OTPreDebugCreateMethodCommand methodsFor: 'user interface' stamp: 'dkh 1/20/2009 10:34'! order ^15! ! !OTPreDebugCreateMethodCommand methodsFor: 'testing' stamp: 'dkh 1/20/2009 10:40'! wantsButton ^self isActive! ! OTPreDebugCommand subclass: #OTPreDebugDebugCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTPreDebugDebugCommand methodsFor: 'execution' stamp: 'dkh 1/11/2009 10:19'! execute target debug: requestor! ! !OTPreDebugDebugCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Debug'! ! !OTPreDebugDebugCommand methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:44'! longDescription ^'Debug process'! ! !OTPreDebugDebugCommand methodsFor: 'user interface' stamp: 'dkh 1/11/2009 12:15'! order ^10! ! OTPreDebugCommand subclass: #OTPreDebugProceedCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTPreDebugProceedCommand methodsFor: 'execution' stamp: 'dkh 1/11/2009 10:19'! execute target proceed: requestor! ! !OTPreDebugProceedCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Proceed'! ! !OTPreDebugProceedCommand methodsFor: 'accessing' stamp: 'dkh 1/11/2009 09:44'! longDescription ^'Proceed with execution'! ! !OTPreDebugProceedCommand methodsFor: 'user interface' stamp: 'dkh 1/11/2009 12:15'! order ^1! ! OBCommand subclass: #OTProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! OTProcessBrowserCommand subclass: #OTDebugProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTDebugProcessBrowserCommand methodsFor: 'execution' stamp: 'lr 8/3/2007 18:59'! execute target process resume; debugWithTitle: 'Interrupted from the Process Browser'! ! !OTDebugProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 8/3/2007 16:46'! isEnabled ^ target allowDebug! ! !OTDebugProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $d! ! !OTDebugProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:54'! label ^ 'Debug process'! ! OTProcessBrowserCommand subclass: #OTPriorityProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTPriorityProcessBrowserCommand 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! ! !OTPriorityProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 8/3/2007 16:47'! isEnabled ^ target allowDebug! ! !OTPriorityProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:05'! keystroke ^ $p! ! !OTPriorityProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Change priority'! ! !OTProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 5/21/2008 10:37'! isActive ^ (requestor isSelected: target) and: [ target isKindOf: OTProcessNode ]! ! !OTProcessBrowserCommand methodsFor: 'actions' stamp: 'lr 8/3/2007 16:37'! update requestor announce: OBRefreshRequired! ! OTProcessBrowserCommand subclass: #OTProfileProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTProfileProcessBrowserCommand 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! ! !OTProfileProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $m! ! !OTProfileProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Profile messages'! ! OTProcessBrowserCommand subclass: #OTResumeProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTResumeProcessBrowserCommand methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process resume. self update! ! !OTResumeProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTResumeProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 8/3/2007 19:02'! isActive ^ super isActive and: [ target process isSuspended ]! ! !OTResumeProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 8/3/2007 19:03'! isEnabled ^ target allowStop! ! !OTResumeProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:16'! keystroke ^ $r! ! !OTResumeProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Resume'! ! OTProcessBrowserCommand subclass: #OTSignalProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTSignalProcessBrowserCommand 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! ! !OTSignalProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 8/3/2007 16:40'! isEnabled ^ target process suspendingList isKindOf: Semaphore! ! !OTSignalProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:05'! keystroke ^ $S! ! !OTSignalProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Signal smaphore'! ! OTProcessBrowserCommand subclass: #OTSuspendProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTSuspendProcessBrowserCommand methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process suspend. self update! ! !OTSuspendProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTSuspendProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 8/3/2007 19:02'! isActive ^ super isActive and: [ target process isSuspended not ]! ! !OTSuspendProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 8/3/2007 19:03'! isEnabled ^ target allowStop! ! !OTSuspendProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $s! ! !OTSuspendProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Suspend'! ! OTProcessBrowserCommand subclass: #OTTerminateProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTTerminateProcessBrowserCommand methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process terminate. self update! ! !OTTerminateProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTTerminateProcessBrowserCommand methodsFor: 'testing' stamp: 'lr 8/3/2007 16:44'! isEnabled ^ target allowStop! ! !OTTerminateProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $t! ! !OTTerminateProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:55'! label ^ 'Terminate'! ! OTProcessBrowserCommand subclass: #OTUpdateProcessBrowserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTUpdateProcessBrowserCommand methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute self update! ! !OTUpdateProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:04'! group ^ #updating! ! !OTUpdateProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:25'! keystroke ^ $u! ! !OTUpdateProcessBrowserCommand methodsFor: 'accessing' stamp: 'lr 11/12/2010 18:56'! label ^ 'Update'! ! !OBColumnPanel methodsFor: '*ob-tools' stamp: 'lr 6/5/2008 11:29'! current: aNode current := aNode! ! 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 ]! ! OTToolset initialize!