Breakpoints in debugger

src/NewTools-Debugger/DebugPoint.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : 'DebugPoint' }
+
+{ #category : '*NewTools-Debugger' }
+DebugPoint class >> allInstalledInMethod: aCompiledMethod [
+	"We don't expect this code to be slow: there are rarely thousands of breakpoints installed in a running system. Therefore the enumerating of all links of all breakpoints should be quick because few breakpoints are involved. Future work could store install-time metadata in debug points to simplify this."
+	^ self all select: [ :dp |
+		  dp link nodes anySatisfy: [ :n |
+			  n methodNode compiledMethod == aCompiledMethod method ] ]
+]

src/NewTools-Debugger/DebugPointIconStyler.extension.st

@@ -0,0 +1,16 @@
+Extension { #name : 'DebugPointIconStyler' }
+
+{ #category : '*NewTools-Debugger' }
+DebugPointIconStyler >> buildIconStyleFor: dp to: aNode [
+	"there probably is a better way that just adding a second row but i couldn't figure out rubric"
+
+	| r |
+	r := self segmentMorphClass from: aNode start to: aNode stop + 1.
+
+	r label: (self iconLabelBlock: dp).
+	r icon: (self iconFor: dp).
+	r iconBlock: (self iconBlock: dp).
+	r color: self highlightColor.
+	r borderColor: self borderColor.
+	^ r
+]

src/NewTools-Debugger/StDebugger.class.st

@@ -528,6 +528,30 @@ StDebugger >> debuggerInspectorModelClass [
 	^ StDebuggerInspectorModel
 ]
 
+{ #category : 'updating - presenters' }
+StDebugger >> decorateCodeForBreakpointsInContext: aContext [
+
+	| debugPoints decorators |
+	debugPoints := DebugPoint allInstalledInMethod: aContext method.
+	decorators := debugPoints collect: [ :dp |
+		              dp link nodes collect: [ :n |
+			              dp name
+			              ->
+			              (DebugPointIconStyler new buildIconStyleFor: dp to: n) ] ].
+
+	decorators flattened do: [ :d |
+		| styler |
+		styler := d value.
+		self code addTextSegmentDecoration:
+			(SpTextPresenterDecorator forHighlight
+				 interval: styler interval;
+				 icon: styler icon;
+				 iconBlock: styler iconBlock;
+				 highlightColor: styler color;
+				 title: d key asString;
+				 yourself) ]
+]
+
 { #category : 'layout' }
 StDebugger >> defaultLayout [
 	^ SpPanedLayout newTopToBottom
@@ -1359,24 +1383,16 @@ StDebugger >> updateCodeFromContext: aContext [
 { #category : 'updating - presenters' }
 StDebugger >> updateCodeTextSegmentDecoratorsIn: aContext forInterval: selectionInterval [
 
+
+
 	self code removeAllTextSegmentDecorations.
+	self decorateCodeForBreakpointsInContext: aContext.
 
-	"This decorates the receiver and the next node with an underline"
-	"self code
-		addTextSegmentDecoration:
-			(SpTextPresenterDecorator new
-				underlineColor: Color orange;
-				interval: (aContext currentNode start to: aContext currentNode stop + 1);
-				yourself)."
-
 	"This decorates the next executing node"
 	self code addTextSegmentDecoration: (SpTextPresenterDecorator forHighlight
 		interval: (selectionInterval first to: selectionInterval last + 1);
 		yourself)
-
-	"	icon: (self iconNamed: #warning);
-		iconBlock: [ :n | n inspect ];
-		title: 'Click me!';"
+
 ]
 
 { #category : 'updating' }

src/NewTools-SpTextPresenterDecorators/SpMorphicBaseTextAdapter.extension.st

@@ -4,7 +4,8 @@ Extension { #name : 'SpMorphicBaseTextAdapter' }
 SpMorphicBaseTextAdapter >> addTextSegmentDecoration: aDecorationSegment [
 
 	self widgetDo: [ :w | 
-		w addSegment: (RubUnderlinedSegmentMorph on: aDecorationSegment) ]
+		w addSegment: (RubUnderlinedSegmentMorph on: aDecorationSegment).
+		w withTextSegmentIcons ] 
 ]
 
 { #category : '*NewTools-SpTextPresenterDecorators' }