SystemOrganization addCategory: #'OB-Tools-String'! SystemOrganization addCategory: #'OB-Tools-Inspector'! SystemOrganization addCategory: #'OB-Tools-Debugger'! SystemOrganization addCategory: #'OB-Tools-Processes'! SystemOrganization addCategory: #'OB-Tools-Filesystem'! SystemOrganization addCategory: #'OB-Tools-Utilities'! OBDefinitionPanel subclass: #OTInspectorDefinitionPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectorDefinitionPanel class methodsFor: 'as yet unclassified' stamp: 'lr 5/29/2008 13:35'! doItReceiver ^ nil! ! !OTInspectorDefinitionPanel methodsFor: 'callbacks' stamp: 'lr 5/29/2008 13:35'! doItReceiver ^ browser navigationPanel root value! ! OBBrowser subclass: #OTDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDebugger class methodsFor: 'configuration' stamp: 'dkh 08/09/2007 09:24'! defaultMetaNode | process context | process := OBMetaNode named: 'process'. context := OBMetaNode named: 'context'. context addFilter: OTBreakpointFilter new. process childAt: #longStack put: context. ^ process! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 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: 'configuration' stamp: 'lr 10/7/2007 12:36'! optionalButtonPanel ^ OBFixedButtonPanel new! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 5/20/2008 16:31'! paneCount ^ 1! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 1/20/2008 12:20'! panels ^ super panels , (Array with: self inspectorPanel)! ! !OTDebugger class methodsFor: 'instance-creation' stamp: 'lr 4/26/2007 09:09'! process: aProcess ^ self process: aProcess context: nil! ! !OTDebugger class methodsFor: 'instance-creation' stamp: 'lr 5/20/2008 13:35'! process: aProcess context: aContext | processNode contextNode | aProcess isSuspended ifFalse: [ self error: 'Unable to debug a running process.' ]. processNode := OTProcessNode on: aProcess. contextNode := processNode nodeAt: (aContext ifNil: [ aProcess suspendedContext ]). ^ self root: processNode selection: contextNode! ! !OTDebugger class methodsFor: 'configuration' stamp: 'lr 4/25/2007 14:16'! title ^ 'Debugger'! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 5/29/2008 14:26'! cmdBrowse ^ OrderedCollection new add: OBCmdBrowse; add: OBCmdBrowseImplementors; add: OBCmdBrowseSenders; yourself! ! !OTDebugger methodsFor: 'commands' stamp: 'lr 5/21/2008 08:55'! cmdDebug ^ OTCmdDebugger allSubclasses! ! !OTDebugger methodsFor: 'building' stamp: 'lr 4/25/2007 14:14'! defaultBackgroundColor ^ Color lightRed! ! !OTDebugger methodsFor: 'building' stamp: 'lr 4/25/2007 18:44'! initialExtent ^ 600 @ 500! ! OBBrowser subclass: #OTFilesystemBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTFilesystemBrowser class methodsFor: 'configuration' stamp: 'lr 12/11/2007 11:08'! defaultMetaNode | directory file | directory := OBMetaNode named: 'directory'. file := OBMetaNode named: 'file'. directory childAt: #directories put: directory. directory childAt: #files put: file. ^ directory! ! !OTFilesystemBrowser class methodsFor: 'configuration' stamp: 'lr 5/15/2008 11:43'! defaultRootNode ^ OTDirectoryNode new setDirectory: FileDirectory root ! ! !OTFilesystemBrowser class methodsFor: 'configuration' stamp: 'lr 1/8/2008 15:45'! optionalButtonPanel ^ nil! ! !OTFilesystemBrowser class methodsFor: 'configuration' stamp: 'lr 12/11/2007 11:27'! title ^ 'File System'! ! !OTFilesystemBrowser methodsFor: 'commands' stamp: 'lr 5/15/2008 11:32'! cmdsCommands ^ OTCmdFilesystem allSubclasses! ! !OTFilesystemBrowser methodsFor: 'building' stamp: 'lr 12/11/2007 11:24'! defaultBackgroundColor ^ Color lightMagenta! ! !OTFilesystemBrowser methodsFor: 'building' stamp: 'lr 5/15/2008 11:59'! defaultLabel ^ String streamContents: [ :stream | stream nextPutAll: super defaultLabel. self currentNode isNil ifFalse: [ stream nextPutAll: ': '. self currentNode path allButFirst do: [ :each | stream nextPut: $/; nextPutAll: each name ] ] ]! ! 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: 'lr 5/21/2008 10:46'! paneCount ^ 1! ! !OTBasicInspector class methodsFor: 'configuration' stamp: 'lr 5/29/2008 13:34'! panels ^ super panels copyWith: OTInspectorWorkspacePanel new! ! !OTBasicInspector methodsFor: 'building' stamp: 'lr 5/29/2008 13:49'! buildOn: aBuilder | window first second | window := aBuilder window: self with: [ aBuilder horizontalGroupWith: [ first := aBuilder root. self panels allButLast do: [ :each | each buildOn: aBuilder ] ]. aBuilder horizontalGroupWith: [ second := aBuilder root. self panels last buildOn: aBuilder ] ]. (window isKindOf: Morph) ifTrue: [ first layoutFrame bottomFraction: 0.75. second layoutFrame topFraction: 0.75 ]. ^ window! ! OTInspector subclass: #OTDebugInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTDebugInspector class methodsFor: 'configuration' stamp: 'lr 5/21/2008 08:50'! paneCount ^ 1! ! !OTDebugInspector methodsFor: 'building' stamp: 'lr 5/21/2008 08:51'! buildGroup: aCollection on: aBuilder ^ aBuilder horizontalGroupWith: [ aCollection do: [ :ea | ea buildOn: aBuilder ] ]! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 6/5/2008 10:22'! defaultMetaNode ^ OBMetaNode new addFilter: OTInspectorFilter new; yourself! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/7/2007 15:54'! defaultRootNode ^ OTRootInspectorNode on: nil! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/29/2008 13:34'! definitionPanel ^ OTInspectorDefinitionPanel new! ! !OTInspector class methodsFor: 'instance-creation' stamp: 'lr 7/15/2007 11:43'! on: anObject | browser | browser := self root: (OTRootInspectorNode on: anObject). browser jumpTo: browser root childNodes first. ^ browser! ! !OTInspector class methodsFor: 'opening' stamp: 'lr 3/3/2006 23:34'! openOn: anObject ^ (self on: anObject) open! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/19/2007 10:44'! optionalButtonPanel ^ nil! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 3/4/2006 17:33'! paneCount ^ 2! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 3/3/2006 23:32'! title ^ 'Inspector'! ! !OTInspector class methodsFor: 'configuration' stamp: 'lr 5/29/2008 13:51'! titleForRoot: aNode ^ aNode object defaultLabelForInspector! ! !OTInspector methodsFor: 'commands' stamp: 'lr 5/29/2008 14:22'! cmdBrowse ^ OrderedCollection new add: OBCmdBrowse; add: OBCmdBrowseImplementors; add: OBCmdBrowseSenders; yourself! ! !OTInspector methodsFor: 'commands' stamp: 'lr 5/21/2008 10:40'! cmdHierarchy ^ OTCmdBrowseHierarchyDebugger! ! !OTInspector methodsFor: 'commands' stamp: 'lr 5/19/2007 10:09'! cmdInspect ^ OTCmdInspectObject! ! !OTInspector methodsFor: 'commands' stamp: 'lr 5/19/2007 10:09'! cmdInspectReferences ^ OTCmdInspectReferences! ! !OTInspector methodsFor: 'morphic' stamp: 'lr 5/29/2008 13:48'! initialExtent ^ 350 @ 300! ! !OTInspector methodsFor: 'initializing' stamp: 'lr 6/5/2008 11:40'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. self navigationPanel selectSubtree: (OBSubtree new instVarAt: 1 put: (Array with: aNode asFan with: 1); yourself)! ! OBBrowser subclass: #OTProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 5/21/2008 10:38'! defaultMetaNode | scheduler process context | scheduler := OBMetaNode named: 'scheduler'. process := OBMetaNode named: 'process'. context := OBMetaNode named: 'context'. scheduler childAt: #processes put: process. process childAt: #shortStack put: context. ^ scheduler! ! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 8/3/2007 19:24'! defaultRootNode ^ OTSchedulerNode new! ! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 1/20/2008 13:45'! optionalButtonPanel ^ nil! ! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 8/3/2007 15:00'! paneCount ^ 2! ! !OTProcessBrowser class methodsFor: 'configuration' stamp: 'lr 8/3/2007 15:01'! title ^ 'Process Browser'! ! !OTProcessBrowser methodsFor: 'commands' stamp: 'lr 5/21/2008 10:38'! cmdsCommands ^ OTCmdProcessBrowser allSubclasses! ! !OTProcessBrowser methodsFor: 'commands' stamp: 'lr 5/21/2008 10:38'! cmdsContextBrowsers ^ OTCmdBrowseDebugger withAllSubclasses! ! !OTProcessBrowser methodsFor: 'commands' stamp: 'lr 5/21/2008 10:38'! cmdsContextInspectors ^ OTCmdInspector allSubclasses! ! !OTProcessBrowser methodsFor: 'morphic' stamp: 'lr 10/7/2007 12:20'! step self announce: (OBChildrenChanged node: self root)! ! !OTProcessBrowser methodsFor: 'morphic' stamp: 'lr 10/7/2007 12:18'! wantsSteps ^ true! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 10:38'! bytecodeInsepectorNode ^ OTDerivedInspectorNode on: self label: 'bytecode' block: [ :obj | obj symbolic ]! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 10:38'! decompiledInspectorNode ^ OTDerivedInspectorNode on: self label: 'decompiled' block: [ :obj | obj decompileString ]! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 10:38'! headerInspectorNode ^ OTDerivedInspectorNode on: self label: 'header' block: [ :obj | obj headerDescription ]! ! !CompiledMethod methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:07'! 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 ]! ! StandardToolSet subclass: #OTToolset instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !OTToolset class methodsFor: 'inspecting' stamp: 'lr 4/26/2007 16:32'! basicInspect: anObject self inspect: anObject! ! !OTToolset class methodsFor: 'debugging' stamp: 'lr 5/23/2007 23:25'! debug: aProcess context: aContext label: aString contents: aContentString fullView: aBool Project spawnNewProcessIfThisIsUI: aProcess. WorldState addDeferredUIMessage: [ aProcess suspend; suspendedContext: aContext. OTDebugger openProcess: aProcess context: aContext ]. aProcess suspend! ! !OTToolset class methodsFor: 'initialization' stamp: 'lr 1/8/2008 15:46'! initialize ToolSet register: self! ! !OTToolset class methodsFor: 'inspecting' stamp: 'lr 5/29/2008 14:28'! 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: 'menu' stamp: 'lr 1/20/2008 16:59'! openProcessBrowser ^ OTProcessBrowser 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! ! 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: 'lr 6/5/2008 11:40'! inspector: anInspector display: anObject anInspector navigationPanel root object: anObject. anInspector signalRefresh! ! !OTDebugInspectorPanel methodsFor: 'events' stamp: 'lr 5/21/2008 09:13'! selectionChanged: anAnnouncement | node | node := anAnnouncement node ifNil: [ ^ self ]. self inspector: receiverInspector display: node doItReceiver. self inspector: contextInspector display: node doItContext! ! !OTDebugInspectorPanel methodsFor: 'updating' stamp: 'lr 5/21/2008 08:42'! subscribe receiverInspector := OTDebugInspector new. contextInspector := OTDebugInspector new. self announcer observe: OBSelectionChanged send: #selectionChanged: to: self! ! Object subclass: #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: '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: 'lr 6/5/2008 11:07'! basicInspectorNodes | nodes | nodes := OrderedCollection new: self class instSize + self basicSize + 5. nodes add: self selfInspectorNode. self class allInstVarNames withIndexDo: [ :name :index | nodes add: (OTNamedVariableNode on: self index: index name: name) ]. 1 to: self basicSize do: [ :index | nodes add: (OTIndexedVariableNode on: self index: index) ]. ^ nodes! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:07'! protocolInspectorNodes ^ self class allSelectors asArray sort collect: [ :each | OTProtocolInspectorNode on: self selector: each ]! ! !Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 09:58'! selfInspectorNode ^ OTDerivedInspectorNode on: self label: 'self' block: [ :obj | obj ]! ! OBModalFilter subclass: #OTInspectorFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !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: 'lr 6/5/2008 09:55'! listForNode: aNode ^ aNode isNil ifTrue: [ Array new ] ifFalse: [ aNode filters collect: [ :each | each key ] ]! ! !OTInspectorFilter methodsFor: 'callbacks' stamp: 'lr 6/5/2008 10:08'! nodesForParent: aNode ^ (aNode filters at: self selection) value! ! !Fraction methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:34'! derivedInspectorNodes ^ super derivedInspectorNodes add: (OTDerivedInspectorNode on: self label: 'float' block: [ :obj | obj asFloat ]); yourself! ! !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! ! !Integer methodsFor: '*ob-tools-inspector' stamp: 'lr 5/19/2007 11:34'! derivedInspectorNodes ^ super derivedInspectorNodes add: (OTDerivedInspectorNode on: self label: 'hex' block: [ :obj | obj printStringRadix: 16 ]); add: (OTDerivedInspectorNode on: self label: 'oct' block: [ :obj | obj printStringRadix: 8 ]); add: (OTDerivedInspectorNode on: self label: 'bin' block: [ :obj | obj printStringRadix: 2 ]); yourself! ! OBFilter subclass: #OTBreakpointFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTBreakpointFilter methodsFor: 'filtering' stamp: 'lr 5/21/2008 08:39'! icon: aSymbol forNode: aNode | method | method := aNode compiledMethod ifNil: [ ^ #blank ]. method literals do: [ :literal | (literal == #halt or: [ literal == #haltIfNil or: [ literal == #haltIf: or: [ literal == #haltOnce ] ] ]) ifTrue: [ ^ #breakpoint ]. (literal == #flag: or: [ literal == #needsWork ]) ifTrue: [ ^ #flag ] ]. ^ #blank! ! !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! ! !Bag methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:08'! elementInspectorNodes ^ super elementInspectorNodes , (contents elementInspectorNodes allButFirst: 2)! ! OBNode subclass: #OTDebugNode instanceVariableNames: 'process' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! OTDebugNode subclass: #OTContextNode instanceVariableNames: 'context parseTree sourceMap selectionInterval' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTContextNode class methodsFor: 'instance-creation' stamp: 'lr 5/20/2008 13:28'! on: aProcess context: aContext ^ (self on: aProcess) setContext: aContext! ! !OTContextNode methodsFor: 'accessing' stamp: 'lr 4/25/2007 19:48'! context ^ context! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 15:04'! homeContext ^ self context finalBlockHome! ! !OTContextNode methodsFor: 'testing' stamp: 'lr 5/20/2008 13:42'! isEditable ^ true! ! !OTContextNode methodsFor: 'accessing' stamp: 'lr 4/26/2007 09:22'! name ^ self context asString! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 14:50'! parseTree "Answer the parse tree representing the source code of the current context." ^ parseTree ifNil: [ parseTree := self context methodNode ]! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 10/7/2007 12:24'! selectionInterval "Answer the interval of the current source code." | index stop | selectionInterval ifNotNil: [ ^ selectionInterval ]. index := self sourceMap indexForInserting: (Association key: (self context previousPc ifNil: [ 0 ]) value: nil). index < 1 ifTrue: [ ^ selectionInterval := 1 to: 0 ]. index > self sourceMap size ifTrue: [ stop := self sourceMap inject: 0 into: [ :prev :this | prev max: this value last ]. ^ selectionInterval := stop + 1 to: stop ]. ^ selectionInterval := (self sourceMap at: index) value! ! !OTContextNode methodsFor: 'initialization' stamp: 'lr 5/20/2008 13:28'! setContext: aContext context := aContext! ! !OTContextNode methodsFor: 'accessing-dynamic' stamp: 'lr 4/26/2007 14:52'! sourceMap "Answer a mapping from byte codes to source code ranges." ^ sourceMap ifNil: [ sourceMap := self parseTree sourceMap ]! ! !OTContextNode methodsFor: 'definition' stamp: 'lr 4/26/2007 15:14'! text | contents | contents := self parseTree sourceText asText. self parseTree isDoIt ifFalse: [ contents := contents makeSelectorBold ]. ^ contents! ! !OTContextNode methodsFor: 'definition' stamp: 'lr 1/20/2008 13:59'! text: aString | class | class := self homeContext receiver class whichClassIncludesSelector: self homeContext selector. (class compile: aString) ifNil: [ ^ false ]. self process popTo: self homeContext; restartTopWith: (class compiledMethodAt: self homeContext selector); stepToSendOrReturn. parseTree := sourceMap := selectionInterval := nil. OBAnnouncer current announce: OBRefreshRequired. ^ true! ! !OTContextNode methodsFor: 'definition' stamp: 'lr 4/26/2007 15:07'! textSelection ^ self selectionInterval! ! !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-dynamic' stamp: 'lr 5/21/2008 08:41'! compiledMethod ^ self theClass ifNotNilDo: [ :class | class lookupSelector: self selector ]! ! !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 5/20/2008 13:30'! methodReference ^ MethodReference class: self theClass selector: self selector! ! !OTDebugNode methodsFor: 'accessing' stamp: 'lr 5/20/2008 13:24'! process ^ process! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 5/20/2008 13:30'! selector ^ self context selector! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 5/29/2008 14:27'! selectorAndMessages ^ Array with: (OBMessageNode fromMethodNode: self)! ! !OTDebugNode methodsFor: 'initialization' stamp: 'lr 5/20/2008 13:27'! setProcess: aProcess process := aProcess! ! !OTDebugNode methodsFor: 'accessing-dynamic' stamp: 'lr 5/20/2008 13:30'! theClass ^ self context receiver class whichClassIncludesSelector: self selector! ! OTDebugNode subclass: #OTProcessNode instanceVariableNames: 'cache' 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 5/20/2008 16:27'! context ^ process suspendedContext! ! !OTProcessNode methodsFor: 'navigation' stamp: 'lr 5/20/2008 13:27'! contextNode ^ self nodeAt: self context! ! !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: '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: '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 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 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 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 1/20/2008 14:25'! text | stream contents | stream := self directory readOnlyFileNamed: self name. contents := [ stream next: 10000 ] ensure: [ stream close ]. 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: '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' 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 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: 'initialization' stamp: 'lr 5/19/2007 11:02'! setKey: anObject key := anObject! ! !OTDictionaryInspectorNode methodsFor: 'accessing' stamp: 'lr 5/21/2008 10:29'! 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: 'initialization' stamp: 'lr 5/19/2007 10:18'! setIndex: anInteger index := anInteger! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 5/21/2008 10:30'! value ^ (self index between: 1 and: self object basicSize) ifTrue: [ self object basicAt: self index ]! ! !OTIndexedVariableNode methodsFor: 'accessing' stamp: 'lr 5/19/2007 10:20'! value: anObject self object basicAt: self index put: anObject! ! !OTInspectorNode class methodsFor: 'instance-creation' stamp: 'lr 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: 'navigation' stamp: 'lr 5/23/2007 23:04'! basicNodes ^ self childrenAt: #basicInspectorNodes! ! !OTInspectorNode methodsFor: 'actions' stamp: 'lr 5/29/2008 14:19'! browse self value browse! ! !OTInspectorNode methodsFor: 'private' stamp: 'lr 6/5/2008 09:32'! childrenAt: aSelector ^ self isLastNode ifTrue: [ Array new ] ifFalse: [ self value perform: aSelector ]! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 5/7/2007 15:47'! dropOnInspectorNode: aNode aNode value: self value! ! !OTInspectorNode methodsFor: 'drag and drop' stamp: 'lr 3/4/2006 17:36'! dropSelector ^ #dropOnInspectorNode:! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'lr 7/14/2007 20:31'! elementNodes ^ self childrenAt: #elementInspectorNodes! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'lr 6/5/2008 10:10'! filters "Answer a colletion of filters (label to elements) for the receiving object." | result items | result := OrderedCollection new. (Pragma allNamed: #inspector:priority: from: self object class to: nil sortedByArgument: 2) do: [ :pragma | items := self object perform: pragma selector. items isEmptyOrNil ifFalse: [ items do: [ :each | each metaNode: metaNode ]. result add: (pragma argumentAt: 1) -> items ] ]. ^ 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: 'printing' stamp: 'lr 7/15/2007 11:29'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' value: '; print: self value! ! !OTInspectorNode methodsFor: 'navigation' stamp: 'lr 5/23/2007 23:04'! protocolNodes ^ self childrenAt: #protocolInspectorNodes! ! !OTInspectorNode methodsFor: 'compatibility' stamp: 'lr 4/26/2007 16:41'! selector ^ nil! ! !OTInspectorNode methodsFor: 'public' stamp: 'lr 6/5/2008 10:39'! text ^ self value printString! ! !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: 'initialization' stamp: 'lr 5/19/2007 10:19'! setIndex: anInteger name: aString index := anInteger. name := aString! ! !OTNamedVariableNode methodsFor: 'accessing' stamp: 'lr 5/21/2008 10:32'! value ^ (self index between: 1 and: self object class instSize) ifTrue: [ 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: 'lr 5/29/2008 14:14'! text ^ self theClass sourceCodeAt: self selector! ! !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: '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: '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: #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 5/20/2008 12:41'! processes | processes | processes := Process allSubInstances reject: [ :each | each isTerminated ]. processes := processes sortBy: [ :a :b | a priority = b priority ifFalse: [ a priority >= b priority ] ifTrue: [ a hash >= b hash ] ]. ^ processes collect: [ :each | OTProcessNode on: each ]! ! !Collection methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 09:44'! derivedInspectorNodes ^ super derivedInspectorNodes add: self sizeInspectorNode; yourself! ! !Collection methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11: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 ]! ! Collection subclass: #PragmaEnumerator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Utilities'! !PragmaEnumerator methodsFor: 'private' stamp: 'lr 6/5/2008 10:55'! classesDo: aBlock Smalltalk allClassesDo: [ :each | aBlock value: each. aBlock value: each class ]! ! !PragmaEnumerator methodsFor: 'enumerating' stamp: 'lr 6/5/2008 10:51'! do: aBlock self pragmasDo: aBlock! ! !PragmaEnumerator methodsFor: 'private' stamp: 'lr 6/5/2008 10:53'! methodsDo: aBlock self classesDo: [ :each | each methodDict do: aBlock ]! ! !PragmaEnumerator methodsFor: 'private' stamp: 'lr 6/5/2008 10:50'! pragmasDo: aBlock self methodsDo: [ :each | each pragmas do: aBlock ]! ! !SequenceableCollection methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:09'! elementInspectorNodes | result | result := super elementInspectorNodes. 1 to: self size do: [ :each | result add: (OTSequenceInspectorNode on: self index: each) ]. ^ result! ! OBTextPanel subclass: #OTStringHolderPanel instanceVariableNames: 'text bindings' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-String'! OTStringHolderPanel subclass: #OTInspectorWorkspacePanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTInspectorWorkspacePanel methodsFor: 'evaluating' stamp: 'lr 5/29/2008 13:22'! doItReceiver ^ browser navigationPanel root value! ! !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: 'initialization' stamp: 'lr 5/29/2008 14:30'! initializeOn: anObject! ! !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: '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: 'as yet unclassified' 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: 'lr 1/20/2008 17:25'! 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: 'lr 1/20/2008 17:31'! update: aSymbol self changed: aSymbol! ! OTStringHolderPanel subclass: #OTWorkspacePanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-String'! !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: 'lr 5/29/2008 13:24'! initializeOn: anObject text := anObject asText. bindings := Dictionary new! ! !OTWorkspacePanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 16:42'! text ^ text! ! !OTWorkspacePanel methodsFor: 'accessing' stamp: 'lr 1/20/2008 17:16'! text: aText text := aText! ! !OTWorkspacePanel methodsFor: 'drag and drop' stamp: 'lr 1/20/2008 17:47'! wantsDroppedMorph: aTransferMorph event: anEvent inMorph: aMorph ^ (aTransferMorph isKindOf: TransferMorph) and: [ aTransferMorph passenger isKindOf: OTInspectorNode ]! ! !OBColumnPanel methodsFor: '*ob-tools' stamp: 'lr 6/5/2008 11:29'! current: aNode current := aNode! ! OBCommand subclass: #OTCmdDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdDebugger methodsFor: 'actions' stamp: 'lr 4/26/2007 09:17'! announce: anAnnouncement requestor announce: anAnnouncement! ! !OTCmdDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! context ^ target context! ! !OTCmdDebugger methodsFor: 'testing' stamp: 'lr 10/7/2007 11:45'! isActive ^ (target isKindOf: OTContextNode) and: [ requestor isSelected: target ]! ! !OTCmdDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 20:41'! process ^ target process! ! !OTCmdDebugger methodsFor: 'actions' stamp: 'lr 10/7/2007 12:08'! update | processNode | processNode := requestor browser root. self announce: (OBChildrenChanged node: processNode). self announce: (OBSelectingNode node: processNode contextNode)! ! OTCmdDebugger subclass: #OTCmdIntoDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdIntoDebugger methodsFor: 'execution' stamp: 'lr 4/26/2007 09:34'! execute target process step: target context; stepToSendOrReturn. self update! ! !OTCmdIntoDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:07'! label ^ 'into'! ! !OTCmdIntoDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdOverDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdOverDebugger methodsFor: 'execution' stamp: 'lr 4/26/2007 15:49'! execute target process completeStep: target context; stepToSendOrReturn. self update! ! !OTCmdOverDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:07'! label ^ 'over'! ! !OTCmdOverDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdProceedDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdProceedDebugger methodsFor: 'execution' stamp: 'lr 5/21/2008 09:07'! execute requestor browser close. target process resume! ! !OTCmdProceedDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:07'! label ^ 'proceed'! ! !OTCmdProceedDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdRestartDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdRestartDebugger methodsFor: 'execution' stamp: 'lr 4/26/2007 09:35'! execute self process popTo: self context; restartTop; stepToSendOrReturn. self update! ! !OTCmdRestartDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:09'! label ^ 'restart'! ! !OTCmdRestartDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdReturnDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdReturnDebugger methodsFor: 'execution' stamp: 'lr 5/21/2008 09:08'! execute | expression value | expression := OBTextRequest prompt: 'Enter expression for return value:' template: 'nil'. value := target theClass compilerClass new evaluate: expression in: target context to: target context receiver. target process popTo: target context sender value: value; stepToSendOrReturn. self update! ! !OTCmdReturnDebugger methodsFor: 'accessing' stamp: 'lr 4/25/2007 18:15'! label ^ 'return'! ! !OTCmdReturnDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:15'! wantsButton ^ true! ! OTCmdDebugger subclass: #OTCmdThroughDebugger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Debugger'! !OTCmdThroughDebugger methodsFor: 'execution' stamp: 'lr 4/26/2007 09:34'! execute target process stepToHome: target context; stepToSendOrReturn. self update! ! !OTCmdThroughDebugger methodsFor: 'accessing' stamp: 'lr 5/31/2007 07:41'! label ^ 'through'! ! !OTCmdThroughDebugger methodsFor: 'testing' stamp: 'lr 4/25/2007 18:10'! wantsButton ^ true! ! OBCommand subclass: #OTCmdFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! OTCmdFilesystem subclass: #OTCmdCompressFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdCompressFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #compression! ! !OTCmdCompressFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:28'! label ^ 'compress'! ! OTCmdFilesystem subclass: #OTCmdCopyFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdCopyFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #editing! ! !OTCmdCopyFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:33'! keystroke ^ $c! ! !OTCmdCopyFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! label ^ 'copy'! ! OTCmdFilesystem subclass: #OTCmdCreateDirectoryFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdCreateDirectoryFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #creational! ! !OTCmdCreateDirectoryFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! label ^ 'new directory'! ! OTCmdFilesystem subclass: #OTCmdCreateFileFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdCreateFileFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #creational! ! !OTCmdCreateFileFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! label ^ 'new file'! ! !OTCmdFilesystem methodsFor: 'as yet unclassified' stamp: 'lr 5/15/2008 11:33'! isActive ^ requestor isSelected: target! ! OTCmdFilesystem subclass: #OTCmdMoveFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdMoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #editing! ! !OTCmdMoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! label ^ 'move'! ! OTCmdFilesystem subclass: #OTCmdRemoveFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdRemoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! group ^ #editing! ! !OTCmdRemoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:33'! keystroke ^ $x! ! !OTCmdRemoveFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:29'! label ^ 'remove'! ! OTCmdFilesystem subclass: #OTCmdRenameFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdRenameFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #editing! ! !OTCmdRenameFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! label ^ 'rename'! ! OTCmdFilesystem subclass: #OTCmdUncompressFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Filesystem'! !OTCmdUncompressFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! group ^ #compression! ! !OTCmdUncompressFilesystem methodsFor: 'accessing' stamp: 'lr 5/15/2008 11:30'! label ^ 'uncompress'! ! OBCommand subclass: #OTCmdInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! OTCmdInspector subclass: #OTCmdInspectObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTCmdInspectObject methodsFor: 'execution' stamp: 'lr 4/26/2007 16:37'! execute target value inspect! ! !OTCmdInspectObject methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:06'! keystroke ^ $i! ! !OTCmdInspectObject methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:05'! label ^ 'inspect'! ! OTCmdInspector subclass: #OTCmdInspectReferences instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Inspector'! !OTCmdInspectReferences methodsFor: 'execution' stamp: 'lr 5/7/2007 16:03'! execute (Utilities pointersTo: target value except: (Array with: target)) inspect! ! !OTCmdInspectReferences methodsFor: 'accessing' stamp: 'dc 3/28/2007 17:07'! label ^ 'inspect references'! ! !OTCmdInspector methodsFor: 'accessing' stamp: 'lr 4/26/2007 16:38'! group ^ #inspection! ! !OTCmdInspector methodsFor: 'testing' stamp: 'lr 4/26/2007 16:38'! isActive ^ requestor isSelected: target! ! OBCommand subclass: #OTCmdProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! OTCmdProcessBrowser subclass: #OTCmdDebugProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdDebugProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 18:59'! execute target process resume; debugWithTitle: 'Interrupted from the Process Browser'! ! !OTCmdDebugProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 16:46'! isEnabled ^ target allowDebug! ! !OTCmdDebugProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $d! ! !OTCmdDebugProcessBrowser methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:13'! label ^ 'debug process'! ! OTCmdProcessBrowser subclass: #OTCmdPriorityProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdPriorityProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 19:00'! execute | priority | priority := (OBTextRequest prompt: 'New priority' template: target process priority asString) ifNil: [ ^ self ]. priority := priority asNumber asInteger. (priority between: Processor lowestPriority and: Processor highestPriority) ifFalse: [ ^ OBInformRequest message: 'Bad priority' ]. target process priority: priority. self update! ! !OTCmdPriorityProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 16:47'! isEnabled ^ target allowDebug! ! !OTCmdPriorityProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:05'! keystroke ^ $p! ! !OTCmdPriorityProcessBrowser methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:11'! label ^ 'change priority'! ! !OTCmdProcessBrowser methodsFor: 'testing' stamp: 'lr 5/21/2008 10:37'! isActive ^ (requestor isSelected: target) and: [ target isKindOf: OTProcessNode ]! ! !OTCmdProcessBrowser methodsFor: 'actions' stamp: 'lr 8/3/2007 16:37'! update requestor announce: OBRefreshRequired! ! OTCmdProcessBrowser subclass: #OTCmdProfileProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdProfileProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 19:09'! execute | seconds | seconds := (OBTextRequest prompt: 'Profile for how many seconds?' template: '4') ifNil: [ ^ self ]. seconds := seconds asNumber asInteger. seconds isZero ifTrue: [ ^ self ]. [ TimeProfileBrowser spyOnProcess: target process forMilliseconds: seconds * 1000 ] forkAt: target process priority + 1! ! !OTCmdProfileProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $m! ! !OTCmdProfileProcessBrowser methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:11'! label ^ 'profile messages'! ! OTCmdProcessBrowser subclass: #OTCmdResumeProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdResumeProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process resume. self update! ! !OTCmdResumeProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTCmdResumeProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 19:02'! isActive ^ super isActive and: [ target process isSuspended ]! ! !OTCmdResumeProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 19:03'! isEnabled ^ target allowStop! ! !OTCmdResumeProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:16'! keystroke ^ $r! ! !OTCmdResumeProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:16'! label ^ 'resume'! ! OTCmdProcessBrowser subclass: #OTCmdSignalProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdSignalProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:41'! execute | semaphore | semaphore := target process suspendingList. (semaphore isKindOf: Semaphore) ifFalse: [ ^ self ]. [ semaphore signal ] forkAndWait. self update! ! !OTCmdSignalProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 16:40'! isEnabled ^ target process suspendingList isKindOf: Semaphore! ! !OTCmdSignalProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:05'! keystroke ^ $S! ! !OTCmdSignalProcessBrowser methodsFor: 'accessing' stamp: 'lr 5/13/2008 12:12'! label ^ 'signal smaphore'! ! OTCmdProcessBrowser subclass: #OTCmdSuspendProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdSuspendProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process suspend. self update! ! !OTCmdSuspendProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTCmdSuspendProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 19:02'! isActive ^ super isActive and: [ target process isSuspended not ]! ! !OTCmdSuspendProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 19:03'! isEnabled ^ target allowStop! ! !OTCmdSuspendProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $s! ! !OTCmdSuspendProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:03'! label ^ 'suspend'! ! OTCmdProcessBrowser subclass: #OTCmdTerminateProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdTerminateProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute target process terminate. self update! ! !OTCmdTerminateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:03'! group ^ #controlling! ! !OTCmdTerminateProcessBrowser methodsFor: 'testing' stamp: 'lr 8/3/2007 16:44'! isEnabled ^ target allowStop! ! !OTCmdTerminateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:04'! keystroke ^ $t! ! !OTCmdTerminateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:03'! label ^ 'terminate'! ! OTCmdProcessBrowser subclass: #OTCmdUpdateProcessBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tools-Processes'! !OTCmdUpdateProcessBrowser methodsFor: 'execution' stamp: 'lr 8/3/2007 16:37'! execute self update! ! !OTCmdUpdateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 19:04'! group ^ #updating! ! !OTCmdUpdateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:25'! keystroke ^ $u! ! !OTCmdUpdateProcessBrowser methodsFor: 'accessing' stamp: 'lr 8/3/2007 16:25'! label ^ 'update'! ! !Morph methodsFor: '*ob-tools' stamp: 'dc 6/1/2007 14:31'! addMorph: aMorph frame: relFrame | frame | frame _ LayoutFrame new. frame leftFraction: relFrame left; rightFraction: relFrame right; topFraction: relFrame top; bottomFraction: relFrame bottom. self addMorph: aMorph fullFrame: frame. ! ! OTToolset initialize!