1
0

Helios-Debugger.st 6.7 KB

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