Smalltalk 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.
self model announcer
on: HLDebuggerStepped
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'!
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: ''
package: 'Helios-Debugger'!
!HLDebuggerCodeWidget methodsFor: 'accessing'!
contents: aString
self clearHighlight.
super contents: aString
!
editorOptions
^ super editorOptions
at: 'gutters' put: #('CodeMirror-linenumbers' 'stops');
yourself
! !
!HLDebuggerCodeWidget methodsFor: 'actions'!
addStopAt: anInteger
editor
setGutterMarker: anInteger
gutter: 'stops'
value: '
' asJQuery toArray first
!
clearHighlight
self editor clearGutter: 'stops'
!
highlight
self highlightNode: self browserModel nextNode
!
highlightNode: aNode
| token |
aNode ifNotNil: [
token := self editor getTokenAt: #{
'line' -> (aNode position x - 1).
'ch' -> aNode position y
}.
self
clearHighlight;
addStopAt: aNode position x - 1.
self editor
setSelection: #{ 'line' -> (aNode position x - 1). 'ch' -> token start }
to: #{ 'line' -> (aNode position x - 1). 'ch' -> token end } ]
!
observeBrowserModel
super observeBrowserModel.
self browserModel announcer
on: HLDebuggerContextSelected
send: #onContextSelected
to: self.
self browserModel announcer
on: HLDebuggerStepped
send: #onContextSelected
to: self.
self browserModel announcer
on: HLDebuggerWhere
send: #onContextSelected
to: self
! !
!HLDebuggerCodeWidget methodsFor: 'reactions'!
onContextSelected
self highlight
! !
HLToolModel subclass: #HLDebuggerModel
instanceVariableNames: 'rootContext currentContext contexts'
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.
self announcer announce: (HLDebuggerContextSelected new
context: aContext;
yourself) ]
!
interpreter
^ self currentContext interpreter
!
nextNode
^ self interpreter node
!
rootContext
^ rootContext
! !
!HLDebuggerModel methodsFor: 'actions'!
restart
self interpreter restart.
self announcer announce: (HLDebuggerStepped new
context: self currentContext;
yourself)
!
skip
self interpreter skip.
self announcer announce: (HLDebuggerStepped new
context: self currentContext;
yourself)
!
stepOver
self interpreter stepOver.
self announcer announce: (HLDebuggerStepped new
context: self currentContext;
yourself)
!
where
self announcer announce: HLDebuggerWhere new
! !
!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
! !
Object subclass: #HLErrorHandler
instanceVariableNames: ''
package: 'Helios-Debugger'!
!HLErrorHandler methodsFor: 'error handling'!
handleError: anError
self onErrorHandled.
[
(HLDebugger on: anError context) openAsTab
]
on: Error
do: [ :error | ErrorHandler new handleError: error ]
!
onErrorHandled
"when an error is handled, we need to make sure that
any progress bar widget gets removed. Because HLProgressBarWidget is asynchronous,
it has to be done here."
HLProgressWidget default
flush;
remove
! !
HLToolListWidget subclass: #HLStackListWidget
instanceVariableNames: ''
package: 'Helios-Debugger'!
!HLStackListWidget methodsFor: 'accessing'!
items
^ items ifNil: [ items := self model contexts ]
!
label
^ 'Call stack'
! !
!HLStackListWidget methodsFor: 'actions'!
restart
self model restart
!
selectItem: aContext
self model currentContext: aContext
!
skip
self model skip
!
stepOver
self model stepOver
!
where
self model where
! !
!HLStackListWidget methodsFor: 'rendering'!
renderButtonsOn: html
html div
class: 'debugger_bar';
with: [
html button
class: 'btn restart';
with: 'Restart';
onClick: [ self restart ].
html button
class: 'btn where';
with: 'Where';
onClick: [ self where ].
html button
class: 'btn stepOver';
with: 'Step over';
onClick: [ self stepOver ].
html button
class: 'btn skip';
with: 'Skip';
onClick: [ self skip ] ]
! !