Helios-Debugger.st 9.4 KB

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