Smalltalk current createPackage: 'Helios-Debugger'! Object subclass: #HLContextInspectorDecorator instanceVariableNames: 'context' package: 'Helios-Debugger'! !HLContextInspectorDecorator methodsFor: 'accessing'! context ^ context ! ! !HLContextInspectorDecorator methodsFor: 'initialization'! initializeFromContext: aContext context := aContext ! ! !HLContextInspectorDecorator methodsFor: 'inspecting'! inspectOn: anInspector | variables inspectedContext | variables := Dictionary new. inspectedContext := self context. variables addAll: inspectedContext locals. [ inspectedContext notNil and: [ inspectedContext isBlockContext ] ] whileTrue: [ inspectedContext := inspectedContext outerContext. inspectedContext ifNotNil: [ variables addAll: inspectedContext locals ] ]. anInspector setLabel: 'Context'; setVariables: variables ! ! !HLContextInspectorDecorator class methodsFor: 'instance creation'! on: aContext ^ self new initializeFromContext: aContext; yourself ! ! HLFocusableWidget subclass: #HLDebugger instanceVariableNames: 'model stackListWidget codeWidget inspectorWidget' package: 'Helios-Debugger'! !HLDebugger commentStamp! I am the main widget for the Helios debugger.! !HLDebugger methodsFor: 'accessing'! codeWidget ^ codeWidget ifNil: [ codeWidget := HLDebuggerCodeWidget new browserModel: self model; yourself ] ! initializeFromMethodContext: aMethodContext model := HLDebuggerModel on: aMethodContext. self observeModel ! inspectorWidget ^ inspectorWidget ifNil: [ inspectorWidget := HLInspectorWidget new ] ! model ^ model ifNil: [ model := HLDebuggerModel new ] ! stackListWidget ^ stackListWidget ifNil: [ stackListWidget := (HLStackListWidget on: self model) next: self codeWidget; yourself ] ! ! !HLDebugger methodsFor: 'actions'! focus self stackListWidget focus ! observeModel self model announcer on: HLDebuggerContextSelected send: #onContextSelected: to: self ! unregister super unregister. self inspectorWidget unregister ! ! !HLDebugger methodsFor: 'keybindings'! registerBindingsOn: aBindingGroup HLToolCommand registerConcreteClassesOn: aBindingGroup for: self model ! ! !HLDebugger methodsFor: 'reactions'! onContextSelected: anAnnouncement self inspectorWidget inspect: (HLContextInspectorDecorator on: anAnnouncement context) ! ! !HLDebugger methodsFor: 'rendering'! open HLManager current addTab: (HLTab on: self labelled: self class tabLabel) ! renderContentOn: html html with: (HLContainer with: (HLHorizontalSplitter with: self stackListWidget with: (HLVerticalSplitter with: self codeWidget with: self inspectorWidget))) ! ! !HLDebugger class methodsFor: 'accessing'! tabClass ^ 'debugger' ! tabLabel ^ 'Debugger' ! ! !HLDebugger class methodsFor: 'instance creation'! on: aMethodContext ^ self new initializeFromMethodContext: aMethodContext; yourself ! ! HLBrowserCodeWidget subclass: #HLDebuggerCodeWidget instanceVariableNames: 'highlightedNode' package: 'Helios-Debugger'! !HLDebuggerCodeWidget methodsFor: 'accessing'! contents: aString self clearHighlight. super contents: aString ! editorOptions ^ super editorOptions at: 'gutters' put: #('CodeMirror-linenumbers' 'stops'); yourself ! highlightedNode ^ highlightedNode ! highlightedNode: aNode highlightedNode := aNode ! ! !HLDebuggerCodeWidget methodsFor: 'actions'! addStopAt: anInteger editor setGutterMarker: anInteger gutter: 'stops' value: '
' asJQuery toArray first ! clearHighlight editor clearGutter: 'stops'. self highlightedNode ifNotNil: [ :node | editor removeLineClass: node position x - 1 where: 'background' class: 'highlighted' ] ! highlight | anchor head selection | head := #{ 'line' -> (self highlightedNode position x - 1). 'ch' -> (self highlightedNode position y - 1) }. anchor := #{ 'line' -> (self highlightedNode extent x - 1). 'ch' -> (self highlightedNode extent y - 1) }. editor setSelection: head to: anchor ! highlightLine: anInteger editor addLineClass: anInteger where: 'background' class: 'highlighted' ! highlightNode: aNode | line | aNode ifNotNil: [ line := aNode position x - 1. self clearHighlight; addStopAt: line; highlightLine: line; highlightedNode: aNode ] ! observeBrowserModel super observeBrowserModel. self browserModel announcer on: HLDebuggerContextSelected send: #onContextSelected to: self ! ! !HLDebuggerCodeWidget methodsFor: 'reactions'! onContextSelected self highlightNode: self browserModel nextNode ! ! HLToolModel subclass: #HLDebuggerModel instanceVariableNames: 'rootContext currentContext contexts interpreter' package: 'Helios-Debugger'! !HLDebuggerModel commentStamp! I am a model for Helios debugging. My instances hold a reference to an `AIContext` instance, built from a `MethodContext`. The context should be the root of the context stack.! !HLDebuggerModel methodsFor: 'accessing'! contexts ^ contexts ! currentContext currentContext ifNil: [ self currentContext: self rootContext ]. ^ currentContext ! currentContext: aContext self withChangesDo: [ self selectedMethod: aContext method. currentContext := aContext. interpreter := ASTDebugger context: aContext. self announcer announce: (HLDebuggerContextSelected new context: aContext; yourself) ] ! interpreter ^ interpreter ! nextNode ^ self interpreter nextNode ! rootContext ^ rootContext ! ! !HLDebuggerModel methodsFor: 'initialization'! initializeContexts "Flatten the context stack into an OrderedCollection" | context | contexts := OrderedCollection new. context := self rootContext. [ context notNil ] whileTrue: [ contexts add: context. context := context outerContext ] ! initializeFromContext: aMethodContext rootContext := AIContext fromMethodContext: aMethodContext. self initializeContexts ! ! !HLDebuggerModel class methodsFor: 'instance creation'! on: aMethodContext ^ self new initializeFromContext: aMethodContext; yourself ! ! ErrorHandler subclass: #HLErrorHandler instanceVariableNames: '' package: 'Helios-Debugger'! !HLErrorHandler methodsFor: 'error handling'! handleError: anError [ (HLDebugger on: anError context) open ] on: Error do: [ :error | ErrorHandler new handleError: error ] ! ! !HLErrorHandler class methodsFor: 'error handling'! handleError: anError ^ self new handleError: anError ! ! HLToolListWidget subclass: #HLStackListWidget instanceVariableNames: '' package: 'Helios-Debugger'! !HLStackListWidget methodsFor: 'accessing'! items ^ items ifNil: [ items := self model contexts ] ! label ^ 'Call stack' ! ! !HLStackListWidget methodsFor: 'actions'! selectItem: aContext self model currentContext: aContext ! !