2
0

Helios-Debugger.st 8.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463
  1. Smalltalk 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. model: (HLDebuggerCodeModel new
  42. debuggerModel: self model;
  43. yourself);
  44. browserModel: self model;
  45. yourself ]
  46. !
  47. initializeFromMethodContext: aMethodContext
  48. model := HLDebuggerModel on: aMethodContext.
  49. self observeModel
  50. !
  51. inspectorWidget
  52. ^ inspectorWidget ifNil: [
  53. inspectorWidget := HLInspectorWidget new ]
  54. !
  55. model
  56. ^ model ifNil: [ model := HLDebuggerModel new ]
  57. !
  58. stackListWidget
  59. ^ stackListWidget ifNil: [
  60. stackListWidget := (HLStackListWidget on: self model)
  61. next: self codeWidget;
  62. yourself ]
  63. ! !
  64. !HLDebugger methodsFor: 'actions'!
  65. focus
  66. self stackListWidget focus
  67. !
  68. observeModel
  69. self model announcer
  70. on: HLDebuggerContextSelected
  71. send: #onContextSelected:
  72. to: self.
  73. self model announcer
  74. on: HLDebuggerStepped
  75. send: #onContextSelected:
  76. to: self
  77. !
  78. unregister
  79. super unregister.
  80. self inspectorWidget unregister
  81. ! !
  82. !HLDebugger methodsFor: 'keybindings'!
  83. registerBindingsOn: aBindingGroup
  84. HLToolCommand
  85. registerConcreteClassesOn: aBindingGroup
  86. for: self model
  87. ! !
  88. !HLDebugger methodsFor: 'reactions'!
  89. onContextSelected: anAnnouncement
  90. self inspectorWidget inspect: (HLContextInspectorDecorator on: anAnnouncement context)
  91. ! !
  92. !HLDebugger methodsFor: 'rendering'!
  93. renderContentOn: html
  94. html with: (HLContainer with: (HLHorizontalSplitter
  95. with: self stackListWidget
  96. with: (HLVerticalSplitter
  97. with: self codeWidget
  98. with: self inspectorWidget)))
  99. ! !
  100. !HLDebugger class methodsFor: 'accessing'!
  101. tabClass
  102. ^ 'debugger'
  103. !
  104. tabLabel
  105. ^ 'Debugger'
  106. ! !
  107. !HLDebugger class methodsFor: 'instance creation'!
  108. on: aMethodContext
  109. ^ self new
  110. initializeFromMethodContext: aMethodContext;
  111. yourself
  112. ! !
  113. HLCodeModel subclass: #HLDebuggerCodeModel
  114. instanceVariableNames: 'debuggerModel'
  115. package: 'Helios-Debugger'!
  116. !HLDebuggerCodeModel methodsFor: 'accessing'!
  117. debuggerModel
  118. ^ debuggerModel
  119. !
  120. debuggerModel: anObject
  121. debuggerModel := anObject
  122. ! !
  123. !HLDebuggerCodeModel methodsFor: 'actions'!
  124. doIt: aString
  125. ^ self debuggerModel evaluate: aString
  126. ! !
  127. HLBrowserCodeWidget subclass: #HLDebuggerCodeWidget
  128. instanceVariableNames: ''
  129. package: 'Helios-Debugger'!
  130. !HLDebuggerCodeWidget methodsFor: 'accessing'!
  131. contents: aString
  132. self clearHighlight.
  133. super contents: aString
  134. !
  135. editorOptions
  136. ^ super editorOptions
  137. at: 'gutters' put: #('CodeMirror-linenumbers' 'stops');
  138. yourself
  139. ! !
  140. !HLDebuggerCodeWidget methodsFor: 'actions'!
  141. addStopAt: anInteger
  142. editor
  143. setGutterMarker: anInteger
  144. gutter: 'stops'
  145. value: '<div class="stop"></stop>' asJQuery toArray first
  146. !
  147. clearHighlight
  148. self editor clearGutter: 'stops'
  149. !
  150. highlight
  151. self highlightNode: self browserModel nextNode
  152. !
  153. highlightNode: aNode
  154. | token |
  155. aNode ifNotNil: [
  156. self
  157. clearHighlight;
  158. addStopAt: aNode positionStart x - 1.
  159. self editor
  160. setSelection: #{ 'line' -> (aNode positionStart x - 1). 'ch' -> (aNode positionStart y - 1) }
  161. to: #{ 'line' -> (aNode positionEnd x - 1). 'ch' -> (aNode positionEnd y) } ]
  162. !
  163. observeBrowserModel
  164. super observeBrowserModel.
  165. self browserModel announcer
  166. on: HLDebuggerContextSelected
  167. send: #onContextSelected
  168. to: self.
  169. self browserModel announcer
  170. on: HLDebuggerStepped
  171. send: #onContextSelected
  172. to: self.
  173. self browserModel announcer
  174. on: HLDebuggerWhere
  175. send: #onContextSelected
  176. to: self
  177. ! !
  178. !HLDebuggerCodeWidget methodsFor: 'reactions'!
  179. onContextSelected
  180. self highlight
  181. ! !
  182. HLToolModel subclass: #HLDebuggerModel
  183. instanceVariableNames: 'rootContext currentContext contexts'
  184. package: 'Helios-Debugger'!
  185. !HLDebuggerModel commentStamp!
  186. I am a model for debugging Amber code in Helios.
  187. My instances hold a reference to an `AIContext` instance, built from a `MethodContext`. The context should be the root of the context stack.!
  188. !HLDebuggerModel methodsFor: 'accessing'!
  189. contexts
  190. ^ contexts
  191. !
  192. currentContext
  193. currentContext ifNil: [ self currentContext: self rootContext ].
  194. ^ currentContext
  195. !
  196. currentContext: aContext
  197. self withChangesDo: [
  198. self selectedMethod: aContext method.
  199. currentContext := aContext.
  200. self announcer announce: (HLDebuggerContextSelected new
  201. context: aContext;
  202. yourself) ]
  203. !
  204. interpreter
  205. ^ self currentContext interpreter
  206. !
  207. nextNode
  208. ^ self interpreter node
  209. !
  210. rootContext
  211. ^ rootContext
  212. ! !
  213. !HLDebuggerModel methodsFor: 'actions'!
  214. restart
  215. self interpreter restart.
  216. self flushInnerContexts.
  217. self announcer announce: (HLDebuggerStepped new
  218. context: self currentContext;
  219. yourself)
  220. !
  221. skip
  222. self interpreter skip.
  223. self flushInnerContexts.
  224. self announcer announce: (HLDebuggerStepped new
  225. context: self currentContext;
  226. yourself)
  227. !
  228. stepOver
  229. self interpreter stepOver.
  230. self flushInnerContexts.
  231. self announcer announce: (HLDebuggerStepped new
  232. context: self currentContext;
  233. yourself)
  234. !
  235. where
  236. self announcer announce: HLDebuggerWhere new
  237. ! !
  238. !HLDebuggerModel methodsFor: 'evaluating'!
  239. evaluate: aString
  240. ^ self environment
  241. interpret: aString
  242. inContext: self currentContext
  243. ! !
  244. !HLDebuggerModel methodsFor: 'initialization'!
  245. initializeContexts
  246. "Flatten the context stack into an OrderedCollection"
  247. | context |
  248. contexts := OrderedCollection new.
  249. context := self rootContext.
  250. [ context notNil ] whileTrue: [
  251. contexts add: context.
  252. context := context outerContext ]
  253. !
  254. initializeFromContext: aMethodContext
  255. rootContext := (AIContext fromMethodContext: aMethodContext).
  256. self initializeContexts
  257. ! !
  258. !HLDebuggerModel methodsFor: 'private'!
  259. flushInnerContexts
  260. "When stepping, the inner contexts are not relevent anymore,
  261. and can be flushed"
  262. self currentContext innerContext: nil.
  263. rootContext := self currentContext.
  264. self initializeContexts
  265. ! !
  266. !HLDebuggerModel class methodsFor: 'instance creation'!
  267. on: aMethodContext
  268. ^ self new
  269. initializeFromContext: aMethodContext;
  270. yourself
  271. ! !
  272. Object subclass: #HLErrorHandler
  273. instanceVariableNames: ''
  274. package: 'Helios-Debugger'!
  275. !HLErrorHandler methodsFor: 'error handling'!
  276. handleError: anError
  277. self onErrorHandled.
  278. [
  279. (HLDebugger on: anError context) openAsTab
  280. ]
  281. on: Error
  282. do: [ :error | ErrorHandler new handleError: error ]
  283. !
  284. onErrorHandled
  285. "when an error is handled, we need to make sure that
  286. any progress bar widget gets removed. Because HLProgressBarWidget is asynchronous,
  287. it has to be done here."
  288. HLProgressWidget default
  289. flush;
  290. remove
  291. ! !
  292. HLToolListWidget subclass: #HLStackListWidget
  293. instanceVariableNames: ''
  294. package: 'Helios-Debugger'!
  295. !HLStackListWidget methodsFor: 'accessing'!
  296. items
  297. ^ items ifNil: [ items := self model contexts ]
  298. !
  299. label
  300. ^ 'Call stack'
  301. ! !
  302. !HLStackListWidget methodsFor: 'actions'!
  303. observeModel
  304. super observeModel.
  305. self model announcer
  306. on: HLDebuggerStepped
  307. send: #onDebuggerStepped:
  308. to: self
  309. !
  310. restart
  311. self model restart
  312. !
  313. selectItem: aContext
  314. self model currentContext: aContext.
  315. super selectItem: aContext
  316. !
  317. skip
  318. self model skip
  319. !
  320. stepOver
  321. self model stepOver
  322. !
  323. where
  324. self model where
  325. ! !
  326. !HLStackListWidget methodsFor: 'reactions'!
  327. onDebuggerStepped: anAnnouncement
  328. items := nil.
  329. self refresh
  330. ! !
  331. !HLStackListWidget methodsFor: 'rendering'!
  332. renderButtonsOn: html
  333. html div
  334. class: 'debugger_bar';
  335. with: [
  336. html button
  337. class: 'btn restart';
  338. with: 'Restart';
  339. onClick: [ self restart ].
  340. html button
  341. class: 'btn where';
  342. with: 'Where';
  343. onClick: [ self where ].
  344. html button
  345. class: 'btn stepOver';
  346. with: 'Step over';
  347. onClick: [ self stepOver ].
  348. html button
  349. class: 'btn skip';
  350. with: 'Skip';
  351. onClick: [ self skip ] ]
  352. ! !