1
0

Helios-Debugger.st 7.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403
  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. 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. skip
  208. self interpreter skip.
  209. self announcer announce: (HLDebuggerStepped new
  210. context: self currentContext;
  211. yourself)
  212. !
  213. stepOver
  214. self interpreter stepOver.
  215. self announcer announce: (HLDebuggerStepped new
  216. context: self currentContext;
  217. yourself)
  218. !
  219. where
  220. self announcer announce: HLDebuggerWhere new
  221. ! !
  222. !HLDebuggerModel methodsFor: 'initialization'!
  223. initializeContexts
  224. "Flatten the context stack into an OrderedCollection"
  225. | context |
  226. contexts := OrderedCollection new.
  227. context := self rootContext.
  228. [ context notNil ] whileTrue: [
  229. contexts add: context.
  230. context := context outerContext ]
  231. !
  232. initializeFromContext: aMethodContext
  233. rootContext := AIContext fromMethodContext: aMethodContext.
  234. self initializeContexts
  235. ! !
  236. !HLDebuggerModel class methodsFor: 'instance creation'!
  237. on: aMethodContext
  238. ^ self new
  239. initializeFromContext: aMethodContext;
  240. yourself
  241. ! !
  242. Object subclass: #HLErrorHandler
  243. instanceVariableNames: ''
  244. package: 'Helios-Debugger'!
  245. !HLErrorHandler methodsFor: 'error handling'!
  246. handleError: anError
  247. self onErrorHandled.
  248. [
  249. (HLDebugger on: anError context) openAsTab
  250. ]
  251. on: Error
  252. do: [ :error | ErrorHandler new handleError: error ]
  253. !
  254. onErrorHandled
  255. "when an error is handled, we need to make sure that
  256. any progress bar widget gets removed. Because HLProgressBarWidget is asynchronous,
  257. it has to be done here."
  258. HLProgressWidget default
  259. flush;
  260. remove
  261. ! !
  262. HLToolListWidget subclass: #HLStackListWidget
  263. instanceVariableNames: ''
  264. package: 'Helios-Debugger'!
  265. !HLStackListWidget methodsFor: 'accessing'!
  266. items
  267. ^ items ifNil: [ items := self model contexts ]
  268. !
  269. label
  270. ^ 'Call stack'
  271. ! !
  272. !HLStackListWidget methodsFor: 'actions'!
  273. restart
  274. self model restart
  275. !
  276. selectItem: aContext
  277. self model currentContext: aContext
  278. !
  279. skip
  280. self model skip
  281. !
  282. stepOver
  283. self model stepOver
  284. !
  285. where
  286. self model where
  287. ! !
  288. !HLStackListWidget methodsFor: 'rendering'!
  289. renderButtonsOn: html
  290. html div
  291. class: 'debugger_bar';
  292. with: [
  293. html button
  294. class: 'btn restart';
  295. with: 'Restart';
  296. onClick: [ self restart ].
  297. html button
  298. class: 'btn where';
  299. with: 'Where';
  300. onClick: [ self where ].
  301. html button
  302. class: 'btn stepOver';
  303. with: 'Step over';
  304. onClick: [ self stepOver ].
  305. html button
  306. class: 'btn skip';
  307. with: 'Skip';
  308. onClick: [ self skip ] ]
  309. ! !