1
0

Helios-Debugger.st 6.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354
  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. !
  71. unregister
  72. super unregister.
  73. self inspectorWidget unregister
  74. ! !
  75. !HLDebugger methodsFor: 'keybindings'!
  76. registerBindingsOn: aBindingGroup
  77. HLToolCommand
  78. registerConcreteClassesOn: aBindingGroup
  79. for: self model
  80. ! !
  81. !HLDebugger methodsFor: 'reactions'!
  82. onContextSelected: anAnnouncement
  83. self inspectorWidget inspect: (HLContextInspectorDecorator on: anAnnouncement context)
  84. ! !
  85. !HLDebugger methodsFor: 'rendering'!
  86. renderContentOn: html
  87. html with: (HLContainer with: (HLHorizontalSplitter
  88. with: self stackListWidget
  89. with: (HLVerticalSplitter
  90. with: self codeWidget
  91. with: self inspectorWidget)))
  92. ! !
  93. !HLDebugger class methodsFor: 'accessing'!
  94. tabClass
  95. ^ 'debugger'
  96. !
  97. tabLabel
  98. ^ 'Debugger'
  99. ! !
  100. !HLDebugger class methodsFor: 'instance creation'!
  101. on: aMethodContext
  102. ^ self new
  103. initializeFromMethodContext: aMethodContext;
  104. yourself
  105. ! !
  106. HLBrowserCodeWidget subclass: #HLDebuggerCodeWidget
  107. instanceVariableNames: 'highlightedNode'
  108. package: 'Helios-Debugger'!
  109. !HLDebuggerCodeWidget methodsFor: 'accessing'!
  110. contents: aString
  111. self clearHighlight.
  112. super contents: aString
  113. !
  114. editorOptions
  115. ^ super editorOptions
  116. at: 'gutters' put: #('CodeMirror-linenumbers' 'stops');
  117. yourself
  118. !
  119. highlightedNode
  120. ^ highlightedNode
  121. !
  122. highlightedNode: aNode
  123. highlightedNode := aNode
  124. ! !
  125. !HLDebuggerCodeWidget methodsFor: 'actions'!
  126. addStopAt: anInteger
  127. editor
  128. setGutterMarker: anInteger
  129. gutter: 'stops'
  130. value: '<div class="stop"></stop>' asJQuery toArray first
  131. !
  132. clearHighlight
  133. editor clearGutter: 'stops'.
  134. self highlightedNode ifNotNil: [ :node |
  135. editor
  136. removeLineClass: node position x - 1
  137. where: 'background'
  138. class: 'highlighted' ]
  139. !
  140. highlight
  141. | anchor head selection |
  142. head := #{
  143. 'line' -> (self highlightedNode position x - 1).
  144. 'ch' -> (self highlightedNode position y - 1)
  145. }.
  146. anchor := #{
  147. 'line' -> (self highlightedNode extent x - 1).
  148. 'ch' -> (self highlightedNode extent y - 1)
  149. }.
  150. editor setSelection: head to: anchor
  151. !
  152. highlightLine: anInteger
  153. editor
  154. addLineClass: anInteger
  155. where: 'background'
  156. class: 'highlighted'
  157. !
  158. highlightNode: aNode
  159. | line |
  160. aNode ifNotNil: [
  161. line := aNode position x - 1.
  162. self
  163. clearHighlight;
  164. addStopAt: line;
  165. highlightLine: line;
  166. highlightedNode: aNode
  167. ]
  168. !
  169. observeBrowserModel
  170. super observeBrowserModel.
  171. self browserModel announcer
  172. on: HLDebuggerContextSelected
  173. send: #onContextSelected
  174. to: self
  175. ! !
  176. !HLDebuggerCodeWidget methodsFor: 'reactions'!
  177. onContextSelected
  178. self highlightNode: self browserModel nextNode
  179. ! !
  180. HLToolModel subclass: #HLDebuggerModel
  181. instanceVariableNames: 'rootContext currentContext contexts interpreter'
  182. package: 'Helios-Debugger'!
  183. !HLDebuggerModel commentStamp!
  184. I am a model for Helios debugging.
  185. My instances hold a reference to an `AIContext` instance, built from a `MethodContext`. The context should be the root of the context stack.!
  186. !HLDebuggerModel methodsFor: 'accessing'!
  187. contexts
  188. ^ contexts
  189. !
  190. currentContext
  191. currentContext ifNil: [ self currentContext: self rootContext ].
  192. ^ currentContext
  193. !
  194. currentContext: aContext
  195. self withChangesDo: [
  196. self selectedMethod: aContext method.
  197. currentContext := aContext.
  198. interpreter := ASTDebugger context: aContext.
  199. self announcer announce: (HLDebuggerContextSelected new
  200. context: aContext;
  201. yourself) ]
  202. !
  203. interpreter
  204. ^ interpreter
  205. !
  206. nextNode
  207. ^ self interpreter nextNode
  208. !
  209. rootContext
  210. ^ rootContext
  211. ! !
  212. !HLDebuggerModel methodsFor: 'initialization'!
  213. initializeContexts
  214. "Flatten the context stack into an OrderedCollection"
  215. | context |
  216. contexts := OrderedCollection new.
  217. context := self rootContext.
  218. [ context notNil ] whileTrue: [
  219. contexts add: context.
  220. context := context outerContext ]
  221. !
  222. initializeFromContext: aMethodContext
  223. rootContext := AIContext fromMethodContext: aMethodContext.
  224. self initializeContexts
  225. ! !
  226. !HLDebuggerModel class methodsFor: 'instance creation'!
  227. on: aMethodContext
  228. ^ self new
  229. initializeFromContext: aMethodContext;
  230. yourself
  231. ! !
  232. ErrorHandler subclass: #HLErrorHandler
  233. instanceVariableNames: ''
  234. package: 'Helios-Debugger'!
  235. !HLErrorHandler methodsFor: 'error handling'!
  236. handleError: anError
  237. self onErrorHandled.
  238. [
  239. (HLDebugger on: anError context) openAsTab
  240. ]
  241. on: Error
  242. do: [ :error | ErrorHandler new handleError: error ]
  243. !
  244. onErrorHandled
  245. "when an error is handled, we need to make sure that
  246. any progress bar widget gets removed. Because HLProgressBarWidget is asynchronous,
  247. it has to be done here."
  248. HLProgressWidget default
  249. flush;
  250. remove
  251. ! !
  252. !HLErrorHandler class methodsFor: 'error handling'!
  253. handleError: anError
  254. ^ self new handleError: anError
  255. ! !
  256. HLToolListWidget subclass: #HLStackListWidget
  257. instanceVariableNames: ''
  258. package: 'Helios-Debugger'!
  259. !HLStackListWidget methodsFor: 'accessing'!
  260. items
  261. ^ items ifNil: [ items := self model contexts ]
  262. !
  263. label
  264. ^ 'Call stack'
  265. ! !
  266. !HLStackListWidget methodsFor: 'actions'!
  267. selectItem: aContext
  268. self model currentContext: aContext
  269. ! !