2
0

Helios-Debugger.st 7.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394
  1. Smalltalk current createPackage: 'Helios-Debugger'!
  2. Object subclass: #HLContextInspectorDecorator
  3. instanceVariableNames: 'context'
  4. package: 'Helios-Debugger'!
  5. !HLContextInspectorDecorator methodsFor: 'accessing'!
  6. context
  7. ^ context
  8. ! !
  9. !HLContextInspectorDecorator methodsFor: 'initialization'!
  10. initializeFromContext: aContext
  11. context := aContext
  12. ! !
  13. !HLContextInspectorDecorator methodsFor: 'inspecting'!
  14. inspectOn: anInspector
  15. | variables inspectedContext |
  16. variables := Dictionary new.
  17. inspectedContext := self context.
  18. variables addAll: inspectedContext locals.
  19. [ inspectedContext notNil and: [ inspectedContext isBlockContext ] ] whileTrue: [
  20. inspectedContext := inspectedContext outerContext.
  21. inspectedContext ifNotNil: [
  22. variables addAll: inspectedContext locals ] ].
  23. anInspector
  24. setLabel: 'Context';
  25. setVariables: variables
  26. ! !
  27. !HLContextInspectorDecorator class methodsFor: 'instance creation'!
  28. on: aContext
  29. ^ self new
  30. initializeFromContext: aContext;
  31. yourself
  32. ! !
  33. HLFocusableWidget subclass: #HLDebugger
  34. instanceVariableNames: 'model stackListWidget codeWidget inspectorWidget'
  35. package: 'Helios-Debugger'!
  36. !HLDebugger commentStamp!
  37. I am the main widget for the Helios debugger.!
  38. !HLDebugger methodsFor: 'accessing'!
  39. codeWidget
  40. ^ codeWidget ifNil: [ codeWidget := HLDebuggerCodeWidget new
  41. browserModel: self model;
  42. yourself ]
  43. !
  44. initializeFromMethodContext: aMethodContext
  45. model := HLDebuggerModel on: aMethodContext.
  46. self observeModel
  47. !
  48. inspectorWidget
  49. ^ inspectorWidget ifNil: [
  50. inspectorWidget := HLInspectorWidget new ]
  51. !
  52. model
  53. ^ model ifNil: [ model := HLDebuggerModel new ]
  54. !
  55. stackListWidget
  56. ^ stackListWidget ifNil: [
  57. stackListWidget := (HLStackListWidget on: self model)
  58. next: self codeWidget;
  59. yourself ]
  60. ! !
  61. !HLDebugger methodsFor: 'actions'!
  62. focus
  63. self stackListWidget focus
  64. !
  65. observeModel
  66. self model announcer
  67. on: HLDebuggerContextSelected
  68. send: #onContextSelected:
  69. to: self.
  70. self model announcer
  71. on: HLDebuggerStepped
  72. send: #onContextSelected:
  73. to: self
  74. !
  75. unregister
  76. super unregister.
  77. self inspectorWidget unregister
  78. ! !
  79. !HLDebugger methodsFor: 'keybindings'!
  80. registerBindingsOn: aBindingGroup
  81. HLToolCommand
  82. registerConcreteClassesOn: aBindingGroup
  83. for: self model
  84. ! !
  85. !HLDebugger methodsFor: 'reactions'!
  86. onContextSelected: anAnnouncement
  87. self inspectorWidget inspect: (HLContextInspectorDecorator on: anAnnouncement context)
  88. ! !
  89. !HLDebugger methodsFor: 'rendering'!
  90. renderContentOn: html
  91. html with: (HLContainer with: (HLHorizontalSplitter
  92. with: self stackListWidget
  93. with: (HLVerticalSplitter
  94. with: self codeWidget
  95. with: self inspectorWidget)))
  96. ! !
  97. !HLDebugger class methodsFor: 'accessing'!
  98. tabClass
  99. ^ 'debugger'
  100. !
  101. tabLabel
  102. ^ 'Debugger'
  103. ! !
  104. !HLDebugger class methodsFor: 'instance creation'!
  105. on: aMethodContext
  106. ^ self new
  107. initializeFromMethodContext: aMethodContext;
  108. yourself
  109. ! !
  110. HLBrowserCodeWidget subclass: #HLDebuggerCodeWidget
  111. instanceVariableNames: ''
  112. package: 'Helios-Debugger'!
  113. !HLDebuggerCodeWidget methodsFor: 'accessing'!
  114. contents: aString
  115. self clearHighlight.
  116. super contents: aString
  117. !
  118. editorOptions
  119. ^ super editorOptions
  120. at: 'gutters' put: #('CodeMirror-linenumbers' 'stops');
  121. yourself
  122. ! !
  123. !HLDebuggerCodeWidget methodsFor: 'actions'!
  124. addStopAt: anInteger
  125. editor
  126. setGutterMarker: anInteger
  127. gutter: 'stops'
  128. value: '<div class="stop"></stop>' asJQuery toArray first
  129. !
  130. clearHighlight
  131. self editor clearGutter: 'stops'
  132. !
  133. highlight
  134. self highlightNode: self browserModel nextNode
  135. !
  136. highlightNode: aNode
  137. | token |
  138. aNode ifNotNil: [
  139. token := self editor getTokenAt: #{
  140. 'line' -> (aNode position x - 1).
  141. 'ch' -> aNode position y
  142. }.
  143. self
  144. clearHighlight;
  145. addStopAt: aNode position x - 1.
  146. self editor
  147. setSelection: #{ 'line' -> (aNode position x - 1). 'ch' -> token start }
  148. to: #{ 'line' -> (aNode position x - 1). 'ch' -> token end } ]
  149. !
  150. observeBrowserModel
  151. super observeBrowserModel.
  152. self browserModel announcer
  153. on: HLDebuggerContextSelected
  154. send: #onContextSelected
  155. to: self.
  156. self browserModel announcer
  157. on: HLDebuggerStepped
  158. send: #onContextSelected
  159. to: self.
  160. self browserModel announcer
  161. on: HLDebuggerWhere
  162. send: #onContextSelected
  163. to: self
  164. ! !
  165. !HLDebuggerCodeWidget methodsFor: 'reactions'!
  166. onContextSelected
  167. self highlight
  168. ! !
  169. HLToolModel subclass: #HLDebuggerModel
  170. instanceVariableNames: 'rootContext currentContext contexts'
  171. package: 'Helios-Debugger'!
  172. !HLDebuggerModel commentStamp!
  173. I am a model for Helios debugging.
  174. My instances hold a reference to an `AIContext` instance, built from a `MethodContext`. The context should be the root of the context stack.!
  175. !HLDebuggerModel methodsFor: 'accessing'!
  176. contexts
  177. ^ contexts
  178. !
  179. currentContext
  180. currentContext ifNil: [ self currentContext: self rootContext ].
  181. ^ currentContext
  182. !
  183. currentContext: aContext
  184. self withChangesDo: [
  185. self selectedMethod: aContext method.
  186. currentContext := aContext.
  187. self announcer announce: (HLDebuggerContextSelected new
  188. context: aContext;
  189. yourself) ]
  190. !
  191. interpreter
  192. ^ self currentContext interpreter
  193. !
  194. nextNode
  195. ^ self interpreter node
  196. !
  197. rootContext
  198. ^ rootContext
  199. ! !
  200. !HLDebuggerModel methodsFor: 'actions'!
  201. restart
  202. self interpreter restart.
  203. self announcer announce: (HLDebuggerStepped new
  204. context: self currentContext;
  205. yourself)
  206. !
  207. stepOver
  208. self interpreter stepOver.
  209. self announcer announce: (HLDebuggerStepped new
  210. context: self currentContext;
  211. yourself)
  212. !
  213. where
  214. self announcer announce: HLDebuggerWhere new
  215. ! !
  216. !HLDebuggerModel methodsFor: 'initialization'!
  217. initializeContexts
  218. "Flatten the context stack into an OrderedCollection"
  219. | context |
  220. contexts := OrderedCollection new.
  221. context := self rootContext.
  222. [ context notNil ] whileTrue: [
  223. contexts add: context.
  224. context := context outerContext ]
  225. !
  226. initializeFromContext: aMethodContext
  227. rootContext := AIContext fromMethodContext: aMethodContext.
  228. self initializeContexts
  229. ! !
  230. !HLDebuggerModel class methodsFor: 'instance creation'!
  231. on: aMethodContext
  232. ^ self new
  233. initializeFromContext: aMethodContext;
  234. yourself
  235. ! !
  236. ErrorHandler subclass: #HLErrorHandler
  237. instanceVariableNames: ''
  238. package: 'Helios-Debugger'!
  239. !HLErrorHandler methodsFor: 'error handling'!
  240. handleError: anError
  241. self onErrorHandled.
  242. [
  243. (HLDebugger on: anError context) openAsTab
  244. ]
  245. on: Error
  246. do: [ :error | ErrorHandler new handleError: error ]
  247. !
  248. onErrorHandled
  249. "when an error is handled, we need to make sure that
  250. any progress bar widget gets removed. Because HLProgressBarWidget is asynchronous,
  251. it has to be done here."
  252. HLProgressWidget default
  253. flush;
  254. remove
  255. ! !
  256. !HLErrorHandler class methodsFor: 'error handling'!
  257. handleError: anError
  258. ^ self new handleError: anError
  259. ! !
  260. HLToolListWidget subclass: #HLStackListWidget
  261. instanceVariableNames: ''
  262. package: 'Helios-Debugger'!
  263. !HLStackListWidget methodsFor: 'accessing'!
  264. items
  265. ^ items ifNil: [ items := self model contexts ]
  266. !
  267. label
  268. ^ 'Call stack'
  269. ! !
  270. !HLStackListWidget methodsFor: 'actions'!
  271. restart
  272. self model restart
  273. !
  274. selectItem: aContext
  275. self model currentContext: aContext
  276. !
  277. stepOver
  278. self model stepOver
  279. !
  280. where
  281. self model where
  282. ! !
  283. !HLStackListWidget methodsFor: 'rendering'!
  284. renderButtonsOn: html
  285. html div
  286. class: 'debugger_bar';
  287. with: [
  288. html button
  289. class: 'btn restart';
  290. with: 'Restart';
  291. onClick: [ self restart ].
  292. html button
  293. class: 'btn where';
  294. with: 'Where';
  295. onClick: [ self where ].
  296. html button
  297. class: 'btn stepOver';
  298. with: 'Step over';
  299. onClick: [ self stepOver ] ]
  300. ! !