diff --git a/src/NewTools-Debugger/DebugPoint.extension.st b/src/NewTools-Debugger/DebugPoint.extension.st new file mode 100644 index 000000000..0d4207b87 --- /dev/null +++ b/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 ] ] +] diff --git a/src/NewTools-Debugger/DebugPointIconStyler.extension.st b/src/NewTools-Debugger/DebugPointIconStyler.extension.st new file mode 100644 index 000000000..6d932f188 --- /dev/null +++ b/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 +] diff --git a/src/NewTools-Debugger/StDebugger.class.st b/src/NewTools-Debugger/StDebugger.class.st index 43ea5f85e..986131dfc 100644 --- a/src/NewTools-Debugger/StDebugger.class.st +++ b/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' } diff --git a/src/NewTools-SpTextPresenterDecorators/SpMorphicBaseTextAdapter.extension.st b/src/NewTools-SpTextPresenterDecorators/SpMorphicBaseTextAdapter.extension.st index 1eaacb5e1..2ef65ae5a 100644 --- a/src/NewTools-SpTextPresenterDecorators/SpMorphicBaseTextAdapter.extension.st +++ b/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' }