diff --git a/docs/debug-points-browser.md b/docs/debug-points-browser.md new file mode 100644 index 000000000..7ddee6ac3 --- /dev/null +++ b/docs/debug-points-browser.md @@ -0,0 +1,48 @@ +# Debug Points Browser + +The debug points browser is a new tool to visualize and configure existing debug points. +Full details on the new debug points model are [described here](https://github.com/pharo-project/pharo/blob/Pharo12/doc/DebugPoints/debug-points.md) + +The tool can be opened via the `Debug > Debug Point Browser` world menu and looks like that: + +![Opening Debug Point Browser via the World menu](https://github.com/pharo-spec/NewTools/assets/97704417/1cacd05d-f459-4a5c-bd9e-6587a89d6a95) + +On the top-left, a table allows to visualize all debug points (breakpoints/watchpoints/basic debug points/etc.) +Each debug point has a name, which we could assimilate to a tag, that can be edited directly in this table. +The "enabled" state of the debug point is also displayed via a checkbox, as well as the scope of the debug point (class or object). + +All behaviors of the selected can be configured via the right pane of debug point browser + +When a debug point is selected, according to the target of the debug point, different information are displayed. +If the target is an AST node, the code of the concerned method is displayed (as in the screenshot above), while highlighting the corresponding code +If the target is an instance variable, all concerned methods are listed and selecting a method displays the corresponding code and highlights the correct variable accesses: + +![image](https://github.com/pharo-spec/NewTools/assets/97704417/4c746e55-c50b-4a0f-97a6-9812acb5ca57) + +Also, if the target is an instance variable, it is possible to configure the accesss strategy on which the debug point should be hit. + +It is possible to filter the displayed debug points by name, thanks to an input field at the top. Validating the input field will filter so that all the remaining debug points contain the entered sequence of characters in their name: + +![image](https://github.com/pharo-spec/NewTools/assets/97704417/c42d125e-bb45-4836-a524-b00f3364c6e5) + +## Object-centric debug points + +To set object-centric debug points, the second button in the inspector toolbar, with the `objects` icon, allows to do the same thing in the same way as former object-centric breakpoints So, this is possible to set object-centric breakpoints and watchpoints on all variables of a target for this object: + +![image](https://github.com/adri09070/NewTools/assets/97704417/295fd03f-3591-47b1-b808-67d21d45a678) + +Just as it was possible before debug points existed, it is still possible to set debug points on only some instance variables of the objects. +To do that, from the raw view in the inspector, select the variables you want to watch/break on and right-click to open a context menu to install breakpoints/watchpoints on them: + +![image](https://github.com/adri09070/NewTools/assets/97704417/41f65031-36be-4659-9d71-87c43ab6284a) + +Moreover, you can set object-centric breakpoints from the meta view in the inspector. Right-click on the method on which you want to break and select **Break on call** or **Break once on call**: + +![image](https://github.com/adri09070/NewTools/assets/97704417/32dbf212-5eef-410e-b60d-331c0e2de31e) + +Last but not least, it is also possible to change the scope of an existing debug point to an object, which was not possible before. +The third button in the inspector toolbar, with the `debug` icon, allows to do that and opens a modal to choose a debug point whose scope should be changed to the inspected object: + +![image](https://github.com/pharo-spec/NewTools/assets/97704417/1d254ee1-704d-4501-878d-176a2b2e71af) + + diff --git a/src/BaselineOfNewTools/BaselineOfNewTools.class.st b/src/BaselineOfNewTools/BaselineOfNewTools.class.st index ca6ec0d71..686d133eb 100644 --- a/src/BaselineOfNewTools/BaselineOfNewTools.class.st +++ b/src/BaselineOfNewTools/BaselineOfNewTools.class.st @@ -61,6 +61,9 @@ BaselineOfNewTools >> baseline: spec [ package: 'NewTools-FontChooser-Tests' with: [ spec requires: #( 'NewTools-FontChooser' ) ]; package: 'NewTools-SpTextPresenterDecorators'; package: 'NewTools-Debugger-Breakpoints-Tools' with: [ spec requires: #( 'NewTools-Inspector' ) ]; + "Debug points" + package: 'NewTools-DebugPointsBrowser' with: [spec requires: #( 'NewTools-SpTextPresenterDecorators' )]; + package: 'NewTools-ObjectCentricDebugPoints' with: [spec requires: #( 'NewTools-DebugPointsBrowser' 'NewTools-Inspector' 'NewTools-Debugger' )]; package: 'NewTools-ProjectLoader'; package: 'NewTools-ProjectLoader-Microdown'; "Object-centric breakpoints" @@ -111,17 +114,19 @@ BaselineOfNewTools >> baseline: spec [ 'Core' 'Inspector' 'NewTools-Debugger-Commands' - 'NewTools-Debugger-Extensions' + 'NewTools-Debugger-Extensions' 'NewTools-Debugger' - 'NewTools-ObjectCentricBreakpoints' - 'NewTools-Sindarin-Tools' + 'NewTools-ObjectCentricBreakpoints' + 'NewTools-Sindarin-Tools' 'NewTools-Sindarin-Commands' - 'NewTools-Sindarin-Commands-Tests' - 'NewTools-Debugger-Breakpoints-Tools' - 'NewTools-Debugger-Tests' + 'NewTools-Sindarin-Commands-Tests' + 'NewTools-Debugger-Breakpoints-Tools' + 'NewTools-Debugger-Tests' 'NewTools-Debugger-Fuel' - 'NewTools-Debugger-Fuel-Tests' - 'NewTools-Fuel' ); + 'NewTools-Debugger-Fuel-Tests' + 'NewTools-Fuel' + 'NewTools-DebugPointsBrowser' + 'NewTools-ObjectCentricDebugPoints' ); group: 'Spotter' with: #( 'NewTools-Morphic-Spotter' 'NewTools-Spotter-Processors' diff --git a/src/NewTools-DebugPointsBrowser/BreakDebugPoint.extension.st b/src/NewTools-DebugPointsBrowser/BreakDebugPoint.extension.st new file mode 100644 index 000000000..7bfc510e6 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/BreakDebugPoint.extension.st @@ -0,0 +1,6 @@ +Extension { #name : 'BreakDebugPoint' } + +{ #category : '*NewTools-DebugPointsBrowser' } +BreakDebugPoint >> uiElement [ + ^BreakPresenter new debugPoint: self. +] diff --git a/src/NewTools-DebugPointsBrowser/BreakPresenter.class.st b/src/NewTools-DebugPointsBrowser/BreakPresenter.class.st new file mode 100644 index 000000000..23423c860 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/BreakPresenter.class.st @@ -0,0 +1,19 @@ +" +I am the breakpoint-specific UI element. +" +Class { + #name : 'BreakPresenter', + #superclass : 'DebugPointPresenter', + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'layout' } +BreakPresenter >> defaultLayout [ + + ^SpBoxLayout newTopToBottom + add: (self newLabel label: 'Break') expand: false ; + yourself. + + +] diff --git a/src/NewTools-DebugPointsBrowser/ChainBehavior.extension.st b/src/NewTools-DebugPointsBrowser/ChainBehavior.extension.st new file mode 100644 index 000000000..ac0d0b32e --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/ChainBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'ChainBehavior' } + +{ #category : '*NewTools-DebugPointsBrowser' } +ChainBehavior class >> uiElement [ + + ^ ChainLinkPresenter +] diff --git a/src/NewTools-DebugPointsBrowser/ChainLinkPresenter.class.st b/src/NewTools-DebugPointsBrowser/ChainLinkPresenter.class.st new file mode 100644 index 000000000..fc0f0a56b --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/ChainLinkPresenter.class.st @@ -0,0 +1,85 @@ +" +I am the UI element for the ChainLinkBehavior of DebugPoints and am added to the DebugPointEditor. +" +Class { + #name : 'ChainLinkPresenter', + #superclass : 'DebugPointBehaviorPresenter', + #instVars : [ + 'chain' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'accessing' } +ChainLinkPresenter >> debugPoint: aDebugPoint [ + + super debugPoint: aDebugPoint. + behavior := self debugPoint getBehavior: ChainBehavior. + checkBox state: behavior isNotNil. + behavior ifNotNil: [ + chain roots: + { (ChainBehavior rootFor: aDebugPoint) } asOrderedCollection. + chain children: [ :dp | + (ChainBehavior childFor: dp) + ifNil: [ OrderedCollection new ] + ifNotNil: [ :dp2 | { dp2 } ] ]. + "chain expandAll." + "since selectItem does not work after expanding this requires a different solution to clarify which chainlink is currently selected" + chain selectItem: aDebugPoint ] +] + +{ #category : 'layout' } +ChainLinkPresenter >> defaultLayout [ + | newLayout | + + newLayout := SpBoxLayout newTopToBottom + + add: checkBox expand: false; + yourself. + + self behavior ifNotNil: [ + newLayout add: ( SpBoxLayout newTopToBottom borderWidth: 5; + add: (self newButton label: 'Reset Chain State'; action: [self resetChain.]) expand: false; + add: chain "height: 100" ; + yourself) expand: true; + + yourself]. + + ^newLayout + + + + +] + +{ #category : 'expanding-collapsing' } +ChainLinkPresenter >> expand [ + ^true +] + +{ #category : 'initialization' } +ChainLinkPresenter >> initializePresenters [ + + chain := self newTreeTable beResizable. + chain + addColumn: + (SpStringTableColumn title: 'Type' evaluated: [ :item | item name ]) + yourself; + addColumn: (SpStringTableColumn + title: 'Target' + evaluated: [ :item | item targetString ]) yourself. + checkBox := self newCheckBox label: + 'Chain: Each debug point is hit once in sequential order'. + checkBox whenActivatedDo: [ + self behavior ifNil: [ debugPoint addBehavior: ChainBehavior new ] ]. + checkBox whenDeactivatedDo: [ + self debugPoint removeBehavior: ChainBehavior. + self behavior: nil ] +] + +{ #category : 'API' } +ChainLinkPresenter >> resetChain [ + + self behavior resetChain. +] diff --git a/src/NewTools-DebugPointsBrowser/ClyAddAndConfigureBreakPointCommand.class.st b/src/NewTools-DebugPointsBrowser/ClyAddAndConfigureBreakPointCommand.class.st new file mode 100644 index 000000000..4b6659290 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/ClyAddAndConfigureBreakPointCommand.class.st @@ -0,0 +1,30 @@ +" +I define a command to add a breakpoint on the AST node corresponding to the selected code and I open a debug point browser on the created breakpoint to configure it +" +Class { + #name : 'ClyAddAndConfigureBreakPointCommand', + #superclass : 'ClyDebuggingPointsCommand', + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'accessing' } +ClyAddAndConfigureBreakPointCommand >> defaultMenuIconName [ + + ^ #smallConfiguration +] + +{ #category : 'accessing' } +ClyAddAndConfigureBreakPointCommand >> defaultMenuItemName [ + + ^ ' Add Breakpoint to: ' , sourceNode displaySourceCode + , 'and configure it' +] + +{ #category : 'execution' } +ClyAddAndConfigureBreakPointCommand >> execute [ + + | dp | + dp := DebugPointManager installNew: BreakDebugPoint on: sourceNode. + DebugPointBrowserPresenter openOn: dp +] diff --git a/src/NewTools-DebugPointsBrowser/ConditionBehavior.extension.st b/src/NewTools-DebugPointsBrowser/ConditionBehavior.extension.st new file mode 100644 index 000000000..032512510 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/ConditionBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'ConditionBehavior' } + +{ #category : '*NewTools-DebugPointsBrowser' } +ConditionBehavior class >> uiElement [ + + ^ConditionPresenter +] diff --git a/src/NewTools-DebugPointsBrowser/ConditionPresenter.class.st b/src/NewTools-DebugPointsBrowser/ConditionPresenter.class.st new file mode 100644 index 000000000..bca3e3761 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/ConditionPresenter.class.st @@ -0,0 +1,69 @@ +" +I am the UI element for the ConditionBehavior of DebugPoints and am added to the DebugPointEditor. +" +Class { + #name : 'ConditionPresenter', + #superclass : 'DebugPointBehaviorPresenter', + #instVars : [ + 'codeInput' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'model updates' } +ConditionPresenter >> activate [ + | bh | + self behavior ifNotNil: [ ^self ]. + bh := (ConditionBehavior new condition: (self debugPoint properties at: #Condition ifAbsent: '')). + self debugPoint addBehavior: bh. + self behavior: bh +] + +{ #category : 'model updates' } +ConditionPresenter >> deactivate [ + self debugPoint removeBehavior: ConditionBehavior. + self behavior: nil. +] + +{ #category : 'accessing' } +ConditionPresenter >> debugPoint: aDebugPoint [ + super debugPoint: aDebugPoint. + + behavior := self debugPoint getBehavior: ConditionBehavior. + checkBox state: self behavior isNotNil. + codeInput enabled: checkBox state. + (self behavior ifNotNil: [:bh | codeInput text: bh condition]). + +] + +{ #category : 'layout' } +ConditionPresenter >> defaultLayout [ + | newLayout | + + newLayout := SpBoxLayout newTopToBottom + add: checkBox expand: false; + yourself. + + self behavior ifNotNil: [ + newLayout add: ( SpBoxLayout newLeftToRight borderWidth: 5; + add: codeInput expand: true ; + yourself) height: 60; + yourself]. + + ^newLayout + +] + +{ #category : 'initialization' } +ConditionPresenter >> initializePresenters [ + + codeInput := self newCode. + codeInput beForScripting. + codeInput whenTextChangedDo: [ self behavior ifNotNil: [behavior condition: codeInput text ]]. + checkBox := self newCheckBox label: 'Condition: Hit when the condition evaluates to true'. + checkBox whenActivatedDo: [ self activate ]. + checkBox whenDeactivatedDo: [ self deactivate ]. + + +] diff --git a/src/NewTools-DebugPointsBrowser/CountBehavior.extension.st b/src/NewTools-DebugPointsBrowser/CountBehavior.extension.st new file mode 100644 index 000000000..b8a3b5c7c --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/CountBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'CountBehavior' } + +{ #category : '*NewTools-DebugPointsBrowser' } +CountBehavior class >> uiElement [ + + ^ CountPresenter +] diff --git a/src/NewTools-DebugPointsBrowser/CountPresenter.class.st b/src/NewTools-DebugPointsBrowser/CountPresenter.class.st new file mode 100644 index 000000000..e75d0039e --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/CountPresenter.class.st @@ -0,0 +1,59 @@ +" +I am the UI element for the CountBehavior of DebugPoints and am added to the DebugPointEditor. +" +Class { + #name : 'CountPresenter', + #superclass : 'DebugPointBehaviorPresenter', + #instVars : [ + 'textInput' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'accessing' } +CountPresenter >> debugPoint: aDebugPoint [ + super debugPoint: aDebugPoint. + behavior := self debugPoint getBehavior: CountBehavior. + checkBox state: (self debugPoint getBehavior: CountBehavior) isNotNil. + behavior ifNotNil: [ + textInput text: behavior count asString ]. +] + +{ #category : 'layout' } +CountPresenter >> defaultLayout [ + | newLayout | + newLayout := SpBoxLayout newTopToBottom + add: checkBox expand: false; + yourself. + + self behavior ifNotNil: [ + newLayout add: self expandedLayout expand: false; + yourself]. + + ^newLayout + +] + +{ #category : 'layout' } +CountPresenter >> expandedLayout [ + ^( SpBoxLayout newLeftToRight borderWidth: 5; + add: (self newLabel label: 'Current Count:') expand: false ; + add: textInput expand: true ; + yourself) +] + +{ #category : 'initialization' } +CountPresenter >> initializePresenters [ + + textInput := self newTextInput beNotEditable . + + checkBox := self newCheckBox label: 'Counter: Tracks how many times the debug point was reached'. + checkBox whenActivatedDo: [ + self behavior ifNil: [ + debugPoint addBehavior: CountBehavior new ] ]. + checkBox whenDeactivatedDo: [ + + self debugPoint removeBehavior: CountBehavior. + self behavior: nil. ]. +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPoint.extension.st b/src/NewTools-DebugPointsBrowser/DebugPoint.extension.st new file mode 100644 index 000000000..bb2af4037 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPoint.extension.st @@ -0,0 +1,13 @@ +Extension { #name : 'DebugPoint' } + +{ #category : '*NewTools-DebugPointsBrowser' } +DebugPoint >> uiElement [ + ^nil + +] + +{ #category : '*NewTools-DebugPointsBrowser' } +DebugPoint >> updateDebugPointUIManager: aDebugPointUIManager [ + + self target updateDebugPointUIManager: aDebugPointUIManager +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointBehavior.extension.st b/src/NewTools-DebugPointsBrowser/DebugPointBehavior.extension.st new file mode 100644 index 000000000..4b22e5775 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'DebugPointBehavior' } + +{ #category : '*NewTools-DebugPointsBrowser' } +DebugPointBehavior class >> uiElement [ + + ^ self subclassResponsibility +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointBehaviorPresenter.class.st b/src/NewTools-DebugPointsBrowser/DebugPointBehaviorPresenter.class.st new file mode 100644 index 000000000..2dba4afca --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointBehaviorPresenter.class.st @@ -0,0 +1,41 @@ +" +I am the superclass of UI elements of debug point behaviors. + +By setting the expand property a subclass can decide if the element should be expanding automatically when it is used in the DebugPointEditor. +" +Class { + #name : 'DebugPointBehaviorPresenter', + #superclass : 'SpPresenter', + #instVars : [ + 'behavior', + 'debugPoint', + 'checkBox' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'accessing' } +DebugPointBehaviorPresenter >> behavior [ + ^behavior +] + +{ #category : 'accessing' } +DebugPointBehaviorPresenter >> behavior: aBehavior [ + behavior := aBehavior +] + +{ #category : 'accessing' } +DebugPointBehaviorPresenter >> debugPoint [ + ^debugPoint +] + +{ #category : 'accessing' } +DebugPointBehaviorPresenter >> debugPoint: aDebugPoint [ + debugPoint := aDebugPoint +] + +{ #category : 'expanding-collapsing' } +DebugPointBehaviorPresenter >> expand [ + ^false +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointBrowserPresenter.class.st b/src/NewTools-DebugPointsBrowser/DebugPointBrowserPresenter.class.st new file mode 100644 index 000000000..db142b7a8 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointBrowserPresenter.class.st @@ -0,0 +1,212 @@ +" +I am the UI for the complete DebugPoint Browser, used to visualize and configure debug points and their behaviors. +" +Class { + #name : 'DebugPointBrowserPresenter', + #superclass : 'SpPresenter', + #instVars : [ + 'dpTable', + 'dpEditor', + 'dpCode', + 'inputFilter', + 'selectAllCheckbox', + 'variableTargetPresenter', + 'targetContainer' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'world menu' } +DebugPointBrowserPresenter class >> menuCommandOn: aBuilder [ + + (aBuilder item: #'Debug Point Browser') + parent: #Debug; + action: [ self new open ]; + order: -3; + help: 'opens a browser to visualize and configure debug points'; + icon: (self iconNamed: #glamorousBug). + aBuilder withSeparatorAfter +] + +{ #category : 'instance creation' } +DebugPointBrowserPresenter class >> openOn: aDebugPoint [ + + self new + select: aDebugPoint; + open +] + +{ #category : 'action handling' } +DebugPointBrowserPresenter >> activateAllDebugPoints [ + + dpTable items do: [ :debugPoint | + self activateDebugPoint: debugPoint ] +] + +{ #category : 'action handling' } +DebugPointBrowserPresenter >> activateDebugPoint: debugPoint [ + + (debugPoint getBehavior: ChainBehavior) + ifNil: [ debugPoint enabled: true ] + ifNotNil: [ debugPoint resetChain ] +] + +{ #category : 'initialization' } +DebugPointBrowserPresenter >> connectPresenters [ + + inputFilter whenSubmitDo: [ :text | + self items: DebugPoint all asOrderedCollection ]. + selectAllCheckbox + whenActivatedDo: [ self activateAllDebugPoints ]; + whenDeactivatedDo: [ self deactivateAllDebugPoints ] +] + +{ #category : 'action handling' } +DebugPointBrowserPresenter >> deactivateAllDebugPoints [ + + dpTable items do: [ :debugPoint | + self deactivateDebugPoint: debugPoint ] +] + +{ #category : 'action handling' } +DebugPointBrowserPresenter >> deactivateDebugPoint: debugPoint [ + + debugPoint enabled: false +] + +{ #category : 'layout' } +DebugPointBrowserPresenter >> defaultLayout [ + + ^ SpBoxLayout newTopToBottom + add: (SpBoxLayout newLeftToRight + add: selectAllCheckbox expand: false; + add: inputFilter; + yourself) + expand: false; + add: (SpPanedLayout newLeftToRight + add: targetContainer; + add: dpEditor; + positionOfSlider: 50 percent; + yourself); + yourself +] + +{ #category : 'initialization' } +DebugPointBrowserPresenter >> initialize [ + + super initialize. + SystemAnnouncer uniqueInstance weak when: DebugPointAdded send: #updateTable to: self. + SystemAnnouncer uniqueInstance weak when: DebugPointRemoved send: #updateTable to: self. + SystemAnnouncer uniqueInstance weak when: DebugPointChanged send: #updateEditor to: self. + + +] + +{ #category : 'initialization' } +DebugPointBrowserPresenter >> initializePresenters [ + + self initializeTable. + dpEditor := DebugPointEditorPresenter new. + dpCode := DebugPointCodePresenter new editable: false. + + inputFilter := self newSearchInput + placeholder: 'Search by name'; + yourself. + selectAllCheckbox := self newCheckBox + label: '(De)activate all'; + yourself. + self initializeVariableTargetPresenter. + + targetContainer := SpPanedLayout newTopToBottom + add: dpTable; + add: dpCode; + positionOfSlider: 40 percent; + yourself +] + +{ #category : 'presenter building' } +DebugPointBrowserPresenter >> initializeTable [ + + dpTable := DebugPointTablePresenter new. + + dpTable whenSelectionChangedDo: [ :sel | + dpEditor debugPoint: dpTable selectedItem. + dpTable selectedItem ifNotNil: [ :dp | + dp updateDebugPointUIManager: self ] ] +] + +{ #category : 'presenter building' } +DebugPointBrowserPresenter >> initializeVariableTargetPresenter [ + + variableTargetPresenter := DebugPointVariableTargetPresenter new +] + +{ #category : 'initialization' } +DebugPointBrowserPresenter >> initializeWindow: aWindowPresenter [ + + aWindowPresenter + title: 'Debug Point Browser'; + windowIcon: (self application iconNamed: #glamorousBug); + initialExtent: 800@550 +] + +{ #category : 'api' } +DebugPointBrowserPresenter >> items: aDebugPointCollection [ + + dpTable items: (aDebugPointCollection select: [ :db | + db name beginsWith: inputFilter text ]) +] + +{ #category : 'enumerating' } +DebugPointBrowserPresenter >> select: aDebugPoint [ + dpTable selectItem: aDebugPoint +] + +{ #category : 'layout' } +DebugPointBrowserPresenter >> switchToNodeTargetView [ + + self switchToTargetView: dpCode +] + +{ #category : 'private - layout' } +DebugPointBrowserPresenter >> switchToTargetView: aDebugPointTargetPresenter [ + + targetContainer replaceSecond: aDebugPointTargetPresenter +] + +{ #category : 'layout' } +DebugPointBrowserPresenter >> switchToVariableTargetView [ + + self switchToTargetView: variableTargetPresenter +] + +{ #category : 'updating - presenters' } +DebugPointBrowserPresenter >> updateCode: aDebugPointTarget [ + + dpCode updateCode: aDebugPointTarget +] + +{ #category : 'updating - presenters' } +DebugPointBrowserPresenter >> updateEditor [ + dpTable refresh. + dpEditor updateAll . + + +] + +{ #category : 'updating - presenters' } +DebugPointBrowserPresenter >> updateTable [ + | prevSel | + prevSel := dpTable selectedItem. + dpTable items: DebugPoint all asOrderedCollection . + dpTable selectItem: prevSel. + + +] + +{ #category : 'updating - presenters' } +DebugPointBrowserPresenter >> updateVariableTargetPresenterFrom: aDebugPointTarget [ + + variableTargetPresenter target: aDebugPointTarget +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointCodePresenter.class.st b/src/NewTools-DebugPointsBrowser/DebugPointCodePresenter.class.st new file mode 100644 index 000000000..6c8bab247 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointCodePresenter.class.st @@ -0,0 +1,21 @@ +" +I am a code presenter that highlights the code of an AST node to which a DebugPoint is attached. +" +Class { + #name : 'DebugPointCodePresenter', + #superclass : 'SpCodePresenter', + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'updating - presenters' } +DebugPointCodePresenter >> updateCode: aDebugPointNodeTarget [ + "updates the code window with the code of the selected debug point" + aDebugPointNodeTarget ifNil:[self text: ''.^self]. + self text: aDebugPointNodeTarget sourceCode; + beForMethod: aDebugPointNodeTarget method; + addTextSegmentDecoration: + (SpTextPresenterDecorator forHighlight + interval: (aDebugPointNodeTarget node start to: ((aDebugPointNodeTarget node stop) +1)); + yourself) . +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointEditorPresenter.class.st b/src/NewTools-DebugPointsBrowser/DebugPointEditorPresenter.class.st new file mode 100644 index 000000000..df687a341 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointEditorPresenter.class.st @@ -0,0 +1,99 @@ +" +I create a vertical list of UI elements, based on the behaviors and class of a DebugPoint. +" +Class { + #name : 'DebugPointEditorPresenter', + #superclass : 'SpPresenter', + #instVars : [ + 'debugPoint', + 'isActiveCheckBox', + 'actionBar' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'action handling' } +DebugPointEditorPresenter >> changeDebugPointState: newState [ + self debugPoint enabled: newState. + DebugPointManager notifyDebugPointChanged: self debugPoint . +] + +{ #category : 'layout' } +DebugPointEditorPresenter >> createLayout [ + + self debugPoint ifNil: [ ^ self layout: self defaultLayout ]. + self layout: SpBoxLayout newTopToBottom. + self layout add: actionBar expand: false. + self layout add: self newActiveCheckBox expand: false. + DebugPointBehavior allSubclasses + reject: [ :behaviorClass | behaviorClass isAbstract ] + thenDo: [ :behavior | + | behaviorUI | + behaviorUI := behavior uiElement new debugPoint: self debugPoint. + self layout + add: behaviorUI + expand: ((self debugPoint getBehavior: behavior) + ifNotNil: [ behaviorUI expand ] + ifNil: [ false ]) ]. + debugPoint uiElement ifNotNil: [ :ui | self layout add: ui ] + "self layout add: debugPoint uiElement." +] + +{ #category : 'accessing' } +DebugPointEditorPresenter >> debugPoint [ + ^debugPoint + + + +] + +{ #category : 'accessing' } +DebugPointEditorPresenter >> debugPoint: aDebugPoint [ + debugPoint := aDebugPoint . + + self updateAll. + +] + +{ #category : 'layout' } +DebugPointEditorPresenter >> defaultLayout [ + ^SpBoxLayout new hAlignCenter; vAlignCenter; + add: (SpLabelPresenter new label: 'Select a Debug Point'); + yourself. +] + +{ #category : 'initialization' } +DebugPointEditorPresenter >> initializePresenters [ + + actionBar := self newToolbar + add: (self newToolbarButton + label: 'Refresh'; + icon: (self iconNamed: #smallUpdate); + help: 'refresh page'; + action: [ self updateAll ]; + yourself); + add: (self newToolbarButton + label: 'Remove'; + icon: (self iconNamed: #smallCancel); + help: 'Remove this point'; + action: [ debugPoint remove ]; + yourself); + yourself +] + +{ #category : 'presenter building' } +DebugPointEditorPresenter >> newActiveCheckBox [ + isActiveCheckBox := self newCheckBox label: 'enabled: (de)activates debug point'. + isActiveCheckBox state: self debugPoint enabled. + isActiveCheckBox whenActivatedDo: [ self changeDebugPointState: true ]. + isActiveCheckBox whenDeactivatedDo: [ self changeDebugPointState: false ]. + ^isActiveCheckBox +] + +{ #category : 'updating - presenters' } +DebugPointEditorPresenter >> updateAll [ + + self createLayout. + "self layout children do: [ :c | c update]" +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointIconStyler.extension.st b/src/NewTools-DebugPointsBrowser/DebugPointIconStyler.extension.st new file mode 100644 index 000000000..151e0780f --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointIconStyler.extension.st @@ -0,0 +1,8 @@ +Extension { #name : 'DebugPointIconStyler' } + +{ #category : '*NewTools-DebugPointsBrowser' } +DebugPointIconStyler >> iconBlock: dp [ + + ^[ :seg | DebugPointBrowserPresenter new open; select: dp. ] + +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointInstanceVariableTarget.extension.st b/src/NewTools-DebugPointsBrowser/DebugPointInstanceVariableTarget.extension.st new file mode 100644 index 000000000..d5fc91e0f --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointInstanceVariableTarget.extension.st @@ -0,0 +1,8 @@ +Extension { #name : 'DebugPointInstanceVariableTarget' } + +{ #category : '*NewTools-DebugPointsBrowser' } +DebugPointInstanceVariableTarget >> updateDebugPointUIManager: aDebugPointUIManager [ + + aDebugPointUIManager updateVariableTargetPresenterFrom: self. + aDebugPointUIManager switchToVariableTargetView +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointNodeTarget.extension.st b/src/NewTools-DebugPointsBrowser/DebugPointNodeTarget.extension.st new file mode 100644 index 000000000..92cb2b671 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointNodeTarget.extension.st @@ -0,0 +1,8 @@ +Extension { #name : 'DebugPointNodeTarget' } + +{ #category : '*NewTools-DebugPointsBrowser' } +DebugPointNodeTarget >> updateDebugPointUIManager: aDebugPointUIManager [ + + aDebugPointUIManager updateCode: self. + aDebugPointUIManager switchToNodeTargetView +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointObjectTarget.extension.st b/src/NewTools-DebugPointsBrowser/DebugPointObjectTarget.extension.st new file mode 100644 index 000000000..9e4e4d722 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointObjectTarget.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'DebugPointObjectTarget' } + +{ #category : '*NewTools-DebugPointsBrowser' } +DebugPointObjectTarget >> updateDebugPointUIManager: aDebugPointUIManager [ + + ^ self subTarget updateDebugPointUIManager: aDebugPointUIManager +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointPresenter.class.st b/src/NewTools-DebugPointsBrowser/DebugPointPresenter.class.st new file mode 100644 index 000000000..e4bea6367 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointPresenter.class.st @@ -0,0 +1,22 @@ +" +I am the superclass for UI elements for subclasses of DebugPoint. +" +Class { + #name : 'DebugPointPresenter', + #superclass : 'SpPresenter', + #instVars : [ + 'debugPoint' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'accessing' } +DebugPointPresenter >> debugPoint [ + ^debugPoint +] + +{ #category : 'accessing' } +DebugPointPresenter >> debugPoint: aDebugPoint [ + debugPoint := aDebugPoint +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointSelectDialogPresenter.class.st b/src/NewTools-DebugPointsBrowser/DebugPointSelectDialogPresenter.class.st new file mode 100644 index 000000000..fa77f4b22 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointSelectDialogPresenter.class.st @@ -0,0 +1,118 @@ +" +I am a select dialog to display DebugPoints so that the scope of a DebugPoint can be set to a specific object. +" +Class { + #name : 'DebugPointSelectDialogPresenter', + #superclass : 'SpSelectDialog', + #instVars : [ + 'code', + 'scope', + 'variableTargetPresenter' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'layout' } +DebugPointSelectDialogPresenter >> defaultLayout [ + + ^ SpBoxLayout newTopToBottom + borderWidth: 5; + spacing: 5; + add: label expand: false; + add: (SpPanedLayout newTopToBottom + add: list; + add: code; + yourself); + yourself +] + +{ #category : 'initialization' } +DebugPointSelectDialogPresenter >> initializePresenters [ + + label := self newLabel. + + list := DebugPointTablePresenter new. + code := DebugPointCodePresenter new + beForScripting; + editable: false. + + self initializeVariableTargetPresenter. + + list transmitDo: [ :dp | + dp ifNotNil: [ dp updateDebugPointUIManager: self ] ] +] + +{ #category : 'presenter building' } +DebugPointSelectDialogPresenter >> initializeVariableTargetPresenter [ + + variableTargetPresenter := DebugPointVariableTargetPresenter new. + variableTargetPresenter layout: variableTargetPresenter dialogLayout +] + +{ #category : 'initialization' } +DebugPointSelectDialogPresenter >> initializeWindow: aWindowPresenter [ + + aWindowPresenter + title: 'Debug Points'; + windowIcon: (self application iconNamed: #glamorousBug); + initialExtent: 800@400 + +] + +{ #category : 'api' } +DebugPointSelectDialogPresenter >> items: items [ + "filter debug points such that only those that are attached to the class of the inspected object are displayed" + + list items: (items select: [ :db | db targetClass = self scope ]) +] + +{ #category : 'accessing' } +DebugPointSelectDialogPresenter >> scope [ + ^scope +] + +{ #category : 'accessing' } +DebugPointSelectDialogPresenter >> scope: anObject [ +"see items: method" + scope := anObject class +] + +{ #category : 'layout' } +DebugPointSelectDialogPresenter >> switchToNodeTargetView [ + + self layout: self defaultLayout +] + +{ #category : 'layout' } +DebugPointSelectDialogPresenter >> switchToVariableTargetView [ + + self layout: self variableTargetLayout +] + +{ #category : 'updating - presenters' } +DebugPointSelectDialogPresenter >> updateCode: aDebugPointTarget [ + + code updateCode: aDebugPointTarget +] + +{ #category : 'updating - presenters' } +DebugPointSelectDialogPresenter >> updateVariableTargetPresenterFrom: aDebugPointTarget [ + + variableTargetPresenter target: aDebugPointTarget +] + +{ #category : 'layout' } +DebugPointSelectDialogPresenter >> variableTargetLayout [ + + ^ SpBoxLayout newTopToBottom + borderWidth: 5; + spacing: 5; + add: label expand: false; + add: (SpPanedLayout newTopToBottom + add: list; + add: variableTargetPresenter; + positionOfSlider: 30 percent; + yourself); + yourself +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointTablePresenter.class.st b/src/NewTools-DebugPointsBrowser/DebugPointTablePresenter.class.st new file mode 100644 index 000000000..134357953 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointTablePresenter.class.st @@ -0,0 +1,111 @@ +" +I am a table presenter for debug points with a custom context menu to perform several actions (browse, inspect, ...). +" +Class { + #name : 'DebugPointTablePresenter', + #superclass : 'SpTablePresenter', + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'context menu' } +DebugPointTablePresenter >> debugPointContextMenu [ + + ^ self newMenu + addGroup: [ :aGroup | + aGroup + addItem: [ :anItem | + anItem + name: 'Inspect'; + description: 'inspect this debug point'; + enabled: [ self selectedItem isNotNil ]; + action: [ self selectedItem inspect ] ]; + addItem: [ :anItem | + anItem + name: 'Browse Target'; + description: 'browse target of the selected debug point'; + enabled: [ self selectedItem isNotNil ]; + action: [ self selectedItem browse ] ]; + addItem: [ :anItem | + anItem + name: 'Inspect Current Scope'; + description: + 'inspect the current scope of the selected debug point'; + enabled: [ self selectedItem isNotNil ]; + action: [ self selectedItem scope inspect ] ]; + addItem: [ :anItem | + anItem + name: 'Reset Current Scope'; + description: + 'resetting the current scope of the selected debug point'; + enabled: [ self selectedItem isNotNil ]; + action: [ self selectedItem resetObjectScope ] ]; + addItem: [ :anItem | + anItem + name: 'Remove'; + description: 'removes the selected debug point'; + enabled: [ self selectedItem isNotNil ]; + action: [ + self selectedItem remove. + self refresh ] ] ]; + addGroup: [ :aGroup | + aGroup addItem: [ :anItem | + anItem + name: 'Refresh'; + description: 'refresh this window'; + action: [ self refresh ] ] ] +] + +{ #category : 'initialization' } +DebugPointTablePresenter >> initialize [ + super initialize. + self initializeDebugPointTable +] + +{ #category : 'presenter building' } +DebugPointTablePresenter >> initializeDebugPointTable [ + + self beResizable. + self + addColumn: + ((SpCheckBoxTableColumn + title: ' ' + evaluated: [ :item | item enabled ]) + onActivation: [ :item | item enabled: true ]; + onDeactivation: [ :item | item enabled: false ]; + width: 20; + yourself); + addColumn: + ((SpStringTableColumn + title: 'Type' + evaluated: [ :item | item type ]) + width: 80; + yourself); + addColumn: ((SpStringTableColumn + title: 'Target' + evaluated: [ :item | item targetString ]) + width: 180; + yourself); + addColumn: + ((SpStringTableColumn + title: 'Name' + evaluated: [ :item | item name ]) + beEditable; + onAcceptEdition: [ :item :newName | item name: newName asSymbol ]); + addColumn: (SpStringTableColumn + title: 'Scope' + evaluated: [ :item | item scopeString ]); + contextMenu: self debugPointContextMenu. + self items: DebugPoint all asOrderedCollection. + + + self dropEnabled: true. + self dragEnabled: true. + self wantsDrop: [ :item | + item row ~= 0 and: [ item passenger first isKindOf: DebugPoint ] ]. + self acceptDrop: [ :item | + item passenger first addBehavior: ChainBehavior new. + (self itemAt: item row) addBehavior: ChainBehavior new. + ((self itemAt: item row) getBehavior: ChainBehavior) putChild: + item passenger first ] +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointTarget.extension.st b/src/NewTools-DebugPointsBrowser/DebugPointTarget.extension.st new file mode 100644 index 000000000..c325dca34 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointTarget.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'DebugPointTarget' } + +{ #category : '*NewTools-DebugPointsBrowser' } +DebugPointTarget >> updateDebugPointUIManager: aDebugPointUIManager [ + + ^ self subclassResponsibility +] diff --git a/src/NewTools-DebugPointsBrowser/DebugPointVariableTargetPresenter.class.st b/src/NewTools-DebugPointsBrowser/DebugPointVariableTargetPresenter.class.st new file mode 100644 index 000000000..798615e80 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/DebugPointVariableTargetPresenter.class.st @@ -0,0 +1,212 @@ +" +I am a UI element to display all methods, and their source code, affected by a selected debug point which targets a variable +" +Class { + #name : 'DebugPointVariableTargetPresenter', + #superclass : 'SpPresenter', + #instVars : [ + 'target', + 'impactedNodesCache', + 'readCheckbox', + 'writeCheckbox', + 'readWriteCheckbox', + 'toolbar', + 'impactedMethodList', + 'codePresenter' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'initialization' } +DebugPointVariableTargetPresenter >> connectPresenters [ + + impactedMethodList transmitDo: [ :methodOrBlock | + methodOrBlock ifNotNil: [ self updateCodeFromMethod: methodOrBlock ] ]. + + "implement radio button activation" + self setupRadioButtonActivationListeners +] + +{ #category : 'layout' } +DebugPointVariableTargetPresenter >> defaultLayout [ + + ^ self newBoxLayoutTopToBottom + add: (self newBoxLayoutLeftToRight + add: readCheckbox expand: false; + add: writeCheckbox expand: false) + expand: false; + add: (self newBoxLayoutLeftToRight + add: readWriteCheckbox expand: false; + add: toolbar expand: false; + yourself) + expand: false; + add: (self newPanedLayoutTopToBottom + add: impactedMethodList; + add: codePresenter; + positionOfSlider: 30 percent; + yourself); + yourself +] + +{ #category : 'layout' } +DebugPointVariableTargetPresenter >> dialogLayout [ + + ^ self newBoxLayoutTopToBottom + add: (self newBoxLayoutLeftToRight + add: readCheckbox expand: false; + add: writeCheckbox expand: false; + add: readWriteCheckbox expand: false; + add: toolbar expand: false; + yourself) + expand: false; + add: (self newPanedLayoutLeftToRight + add: impactedMethodList; + add: codePresenter; + yourself); + yourself +] + +{ #category : 'presenter building' } +DebugPointVariableTargetPresenter >> initializeCode [ + + codePresenter := self newCode + beNotEditable; + yourself +] + +{ #category : 'presenter building' } +DebugPointVariableTargetPresenter >> initializeMethodList [ + + impactedMethodList := self newFilteringList + items: { }; + sortingBlock: [ :m1 :m2 | + m1 methodClass name < m2 methodClass name + and: [ m1 method name < m2 method name ] ]; + yourself +] + +{ #category : 'initialization' } +DebugPointVariableTargetPresenter >> initializePresenters [ + + self initializeRadioButtons. + self initializeMethodList. + self initializeCode. + self initializeToolbar +] + +{ #category : 'presenter building' } +DebugPointVariableTargetPresenter >> initializeRadioButtons [ + + self initializeReadRadioButton. + self initializeWriteRadioButton. + self initializeReadWriteRadioButton. + readCheckbox associatedRadioButtons: { + writeCheckbox. + readWriteCheckbox } +] + +{ #category : 'presenter building' } +DebugPointVariableTargetPresenter >> initializeReadRadioButton [ + + readCheckbox := self newRadioButton + label: 'read only'; + yourself +] + +{ #category : 'presenter building' } +DebugPointVariableTargetPresenter >> initializeReadWriteRadioButton [ + + readWriteCheckbox := self newRadioButton + label: 'read / write'; + yourself +] + +{ #category : 'presenter building' } +DebugPointVariableTargetPresenter >> initializeToolbar [ + + toolbar := self newToolbar + add: (self newToolbarButton + label: 'Refresh'; + icon: (self iconNamed: #smallUpdate); + help: 'Update method list and code'; + action: [ self updateMethodList ]; + yourself); + yourself +] + +{ #category : 'presenter building' } +DebugPointVariableTargetPresenter >> initializeWriteRadioButton [ + + writeCheckbox := self newRadioButton + label: 'write only'; + yourself +] + +{ #category : 'presenter building' } +DebugPointVariableTargetPresenter >> setupRadioButtonActivationListeners [ + + readCheckbox whenActivatedDo: [ self target accessStrategy: #read ]. + writeCheckbox whenActivatedDo: [ self target accessStrategy: #write ]. + readWriteCheckbox whenActivatedDo: [ + self target accessStrategy: #all ] +] + +{ #category : 'accessing' } +DebugPointVariableTargetPresenter >> target [ + + ^ target +] + +{ #category : 'accessing' } +DebugPointVariableTargetPresenter >> target: aDebugPointInstanceVariableTarget [ + + target := aDebugPointInstanceVariableTarget. + self updatePresenter +] + +{ #category : 'updating - presenters' } +DebugPointVariableTargetPresenter >> updateCodeFromMethod: method [ + + codePresenter + text: method sourceCode; + beForMethod: method. + impactedNodesCache + select: [ :node | node methodNode == method ast ] + thenDo: [ :node | + codePresenter addTextSegmentDecoration: + (SpTextPresenterDecorator forHighlight + interval: (node start to: node stop + 1); + yourself) ] +] + +{ #category : 'model updates' } +DebugPointVariableTargetPresenter >> updateImpactedNodesCache [ + + impactedNodesCache := self target impactedNodes +] + +{ #category : 'updating - presenters' } +DebugPointVariableTargetPresenter >> updateMethodList [ + + self updateImpactedNodesCache. + impactedMethodList items: + (impactedNodesCache collect: [ :node | + node methodNode compiledMethod ]) asIdentitySet +] + +{ #category : 'initialization' } +DebugPointVariableTargetPresenter >> updatePresenter [ + + self target ifNil: [ ^ self ]. + self updateMethodList. + self updateRadioButtonsState +] + +{ #category : 'updating - presenters' } +DebugPointVariableTargetPresenter >> updateRadioButtonsState [ + + readCheckbox state: self target isReadOnly. + writeCheckbox state: self target isWriteOnly. + readWriteCheckbox state: self target isReadWrite +] diff --git a/src/NewTools-DebugPointsBrowser/OnceBehavior.extension.st b/src/NewTools-DebugPointsBrowser/OnceBehavior.extension.st new file mode 100644 index 000000000..7f239684d --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/OnceBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'OnceBehavior' } + +{ #category : '*NewTools-DebugPointsBrowser' } +OnceBehavior class >> uiElement [ + + ^OncePresenter +] diff --git a/src/NewTools-DebugPointsBrowser/OncePresenter.class.st b/src/NewTools-DebugPointsBrowser/OncePresenter.class.st new file mode 100644 index 000000000..8845a9188 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/OncePresenter.class.st @@ -0,0 +1,35 @@ +" +I am the UI element for the OnceBehavior of DebugPoints and am added to the DebugPointEditor. +" +Class { + #name : 'OncePresenter', + #superclass : 'DebugPointBehaviorPresenter', + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'accessing' } +OncePresenter >> debugPoint: aDebugPoint [ + super debugPoint: aDebugPoint. + behavior := self debugPoint getBehavior: OnceBehavior. + checkBox state: (self debugPoint getBehavior: OnceBehavior) isNotNil. + +] + +{ #category : 'layout' } +OncePresenter >> defaultLayout [ + + ^SpBoxLayout newTopToBottom + add: checkBox expand: false; + yourself. +] + +{ #category : 'initialization' } +OncePresenter >> initializePresenters [ + + checkBox := self newCheckBox label: 'Once: Deactivates debug point after one hit'. + checkBox whenActivatedDo: [ self behavior ifNil: [ debugPoint addBehavior: OnceBehavior new ] ]. + checkBox whenDeactivatedDo: [ + self debugPoint removeBehavior: OnceBehavior. + self behavior: nil. ]. +] diff --git a/src/NewTools-DebugPointsBrowser/ScriptBehavior.extension.st b/src/NewTools-DebugPointsBrowser/ScriptBehavior.extension.st new file mode 100644 index 000000000..b354d6e7a --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/ScriptBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'ScriptBehavior' } + +{ #category : '*NewTools-DebugPointsBrowser' } +ScriptBehavior class >> uiElement [ + + ^ScriptPresenter +] diff --git a/src/NewTools-DebugPointsBrowser/ScriptPresenter.class.st b/src/NewTools-DebugPointsBrowser/ScriptPresenter.class.st new file mode 100644 index 000000000..cb8f72da4 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/ScriptPresenter.class.st @@ -0,0 +1,70 @@ +" +I am the UI element for the ScriptBehavior of DebugPoints and am added to the DebugPointEditor. +" +Class { + #name : 'ScriptPresenter', + #superclass : 'DebugPointBehaviorPresenter', + #instVars : [ + 'codeInput' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'action handling' } +ScriptPresenter >> activate [ + | bh | + self behavior ifNotNil: [ ^self ]. + bh := (ScriptBehavior new script: (self debugPoint properties at: #Script ifAbsent: '')). + self debugPoint addBehavior: bh. + self behavior: bh +] + +{ #category : 'action handling' } +ScriptPresenter >> deactivate [ + self debugPoint removeBehavior: ScriptBehavior. + self behavior: nil. +] + +{ #category : 'accessing' } +ScriptPresenter >> debugPoint: aDebugPoint [ + super debugPoint: aDebugPoint. + behavior := self debugPoint getBehavior: ScriptBehavior. + checkBox state: self behavior isNotNil. + + (self behavior ifNotNil: [:bh | codeInput text: bh script]). +] + +{ #category : 'layout' } +ScriptPresenter >> defaultLayout [ + | newLayout | + newLayout := SpBoxLayout newTopToBottom + add: checkBox expand: false; + yourself. + + self behavior ifNotNil: [ + newLayout add: ( SpBoxLayout newLeftToRight borderWidth: 5; + add: codeInput expand: true ; + yourself) expand: true; + yourself]. + + ^newLayout + +] + +{ #category : 'expanding-collapsing' } +ScriptPresenter >> expand [ + ^true +] + +{ #category : 'initialization' } +ScriptPresenter >> initializePresenters [ + + checkBox := self newCheckBox label: 'Script: Executes a script at each hit'. + checkBox whenActivatedDo: [ self activate ]. + checkBox whenDeactivatedDo: [ self deactivate ]. + + codeInput := self newCode. + codeInput beForScripting. + codeInput whenTextChangedDo: [ self behavior ifNotNil: [behavior script: codeInput text ]]. +] diff --git a/src/NewTools-DebugPointsBrowser/TestEnvironmentBehavior.extension.st b/src/NewTools-DebugPointsBrowser/TestEnvironmentBehavior.extension.st new file mode 100644 index 000000000..f5ecf7346 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/TestEnvironmentBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'TestEnvironmentBehavior' } + +{ #category : '*NewTools-DebugPointsBrowser' } +TestEnvironmentBehavior class >> uiElement [ + + ^TestEnvironmentPresenter +] diff --git a/src/NewTools-DebugPointsBrowser/TestEnvironmentPresenter.class.st b/src/NewTools-DebugPointsBrowser/TestEnvironmentPresenter.class.st new file mode 100644 index 000000000..32047f574 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/TestEnvironmentPresenter.class.st @@ -0,0 +1,35 @@ +" +I am the UI element for the TestEnvironmentBehavior of DebugPoints and am added to the DebugPointEditor. +" +Class { + #name : 'TestEnvironmentPresenter', + #superclass : 'DebugPointBehaviorPresenter', + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'accessing' } +TestEnvironmentPresenter >> debugPoint: aDebugPoint [ + super debugPoint: aDebugPoint. + behavior := self debugPoint getBehavior: TestEnvironmentBehavior . + checkBox state: (self debugPoint getBehavior: TestEnvironmentBehavior) isNotNil. + +] + +{ #category : 'layout' } +TestEnvironmentPresenter >> defaultLayout [ + + ^SpBoxLayout newTopToBottom + add: checkBox expand: false; + yourself. +] + +{ #category : 'initialization' } +TestEnvironmentPresenter >> initializePresenters [ + + checkBox := self newCheckBox label: 'Test Environment Only: Hits only when executing tests'. + checkBox whenActivatedDo: [ self behavior ifNil: [ debugPoint addBehavior: TestEnvironmentBehavior new ] ]. + checkBox whenDeactivatedDo: [ + self debugPoint removeBehavior: TestEnvironmentBehavior. + self behavior: nil. ]. +] diff --git a/src/NewTools-DebugPointsBrowser/TranscriptBehavior.extension.st b/src/NewTools-DebugPointsBrowser/TranscriptBehavior.extension.st new file mode 100644 index 000000000..f5e4bf887 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/TranscriptBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'TranscriptBehavior' } + +{ #category : '*NewTools-DebugPointsBrowser' } +TranscriptBehavior class >> uiElement [ + + ^TranscriptPresenter +] diff --git a/src/NewTools-DebugPointsBrowser/TranscriptPresenter.class.st b/src/NewTools-DebugPointsBrowser/TranscriptPresenter.class.st new file mode 100644 index 000000000..61d649f8b --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/TranscriptPresenter.class.st @@ -0,0 +1,68 @@ +" +I am the UI element for the TranscriptBehavior of DebugPoints and am added to the DebugPointEditor. +" +Class { + #name : 'TranscriptPresenter', + #superclass : 'DebugPointBehaviorPresenter', + #instVars : [ + 'textInput' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'action handling' } +TranscriptPresenter >> activate [ + | bh | + self behavior ifNotNil: [ ^self ]. + bh := (TranscriptBehavior new text: (self debugPoint properties at: #TranscriptText ifAbsent: '')). + self debugPoint addBehavior: bh. + self behavior: bh +] + +{ #category : 'action handling' } +TranscriptPresenter >> deactivate [ + self debugPoint removeBehavior: TranscriptBehavior. + self behavior: nil. +] + +{ #category : 'accessing' } +TranscriptPresenter >> debugPoint: aDebugPoint [ + super debugPoint: aDebugPoint. + + behavior := self debugPoint getBehavior: TranscriptBehavior. + checkBox state: self behavior isNotNil. + textInput enabled: checkBox state. + (self behavior ifNotNil: [:bh | textInput text: bh text]). + +] + +{ #category : 'layout' } +TranscriptPresenter >> defaultLayout [ + | newLayout | + + newLayout := SpBoxLayout newTopToBottom + add: checkBox expand: false; + yourself. + + self behavior ifNotNil: [ + newLayout add: ( SpBoxLayout newLeftToRight borderWidth: 5; + add: textInput expand: true ; + yourself) height: 60; + yourself]. + + ^newLayout + +] + +{ #category : 'initialization' } +TranscriptPresenter >> initializePresenters [ + + textInput := self newText. + textInput whenTextChangedDo: [ self behavior ifNotNil: [behavior text: textInput text ]]. + checkBox := self newCheckBox label: 'Transcript: Logs to transcript at each hit'. + checkBox whenActivatedDo: [ self activate ]. + checkBox whenDeactivatedDo: [ self deactivate ]. + + +] diff --git a/src/NewTools-DebugPointsBrowser/WatchDebugPoint.extension.st b/src/NewTools-DebugPointsBrowser/WatchDebugPoint.extension.st new file mode 100644 index 000000000..e7a800e53 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/WatchDebugPoint.extension.st @@ -0,0 +1,6 @@ +Extension { #name : 'WatchDebugPoint' } + +{ #category : '*NewTools-DebugPointsBrowser' } +WatchDebugPoint >> uiElement [ + ^WatchPresenter new debugPoint: self. +] diff --git a/src/NewTools-DebugPointsBrowser/WatchPresenter.class.st b/src/NewTools-DebugPointsBrowser/WatchPresenter.class.st new file mode 100644 index 000000000..a29279e33 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/WatchPresenter.class.st @@ -0,0 +1,49 @@ +" +I a the watchpoint-specific UI element. +" +Class { + #name : 'WatchPresenter', + #superclass : 'DebugPointPresenter', + #instVars : [ + 'historyList', + 'textInput' + ], + #category : 'NewTools-DebugPointsBrowser', + #package : 'NewTools-DebugPointsBrowser' +} + +{ #category : 'accessing' } +WatchPresenter >> debugPoint: aDebugPoint [ + super debugPoint: aDebugPoint. + + textInput number: (self debugPoint limit ifNil:[''] ifNotNil: [:s|s]). + historyList items: self debugPoint history. +] + +{ #category : 'layout' } +WatchPresenter >> defaultLayout [ + + ^SpBoxLayout newTopToBottom + add: (self newLabel label: 'Watch') expand: false ; + add: ( SpBoxLayout newTopToBottom borderWidth: 5; + add: ( SpBoxLayout newLeftToRight + add: (self newLabel label: 'History:') expand: true; + add: (self newLabel label: 'Limit: ' ) expand: false; + add: textInput width: 50; + yourself) expand: false ; + add: historyList expand: true fill: true padding: 1; + yourself) expand: true; + yourself. + + +] + +{ #category : 'initialization' } +WatchPresenter >> initializePresenters [ + + historyList := self newList + activateOnDoubleClick; + whenActivatedDo: [ :selection | selection selectedItem inspect ]. + textInput := self newNumberInput beInteger; minimum: 0. + textInput whenNumberChangedDo: [ :a | self debugPoint limit: (textInput number ). ]. +] diff --git a/src/NewTools-DebugPointsBrowser/package.st b/src/NewTools-DebugPointsBrowser/package.st new file mode 100644 index 000000000..06d593a15 --- /dev/null +++ b/src/NewTools-DebugPointsBrowser/package.st @@ -0,0 +1 @@ +Package { #name : 'NewTools-DebugPointsBrowser' } diff --git a/src/NewTools-ObjectCentricDebugPoints/StBreakOnAccessCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StBreakOnAccessCommand.class.st new file mode 100644 index 000000000..be2390a6d --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StBreakOnAccessCommand.class.st @@ -0,0 +1,33 @@ +" +I am the base class for commands to install from the inspector object-centric breakpoints on a variable's readings and writings +" +Class { + #name : 'StBreakOnAccessCommand', + #superclass : 'StDebugPointSlotTargetCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StBreakOnAccessCommand class >> defaultDescription [ + + ^ 'Breaks when the selected or any variable is read or written' +] + +{ #category : 'default' } +StBreakOnAccessCommand class >> defaultIconName [ + + ^ #smallObjects +] + +{ #category : 'default' } +StBreakOnAccessCommand class >> defaultName [ + + ^ 'Break on state access' +] + +{ #category : 'executing' } +StBreakOnAccessCommand >> execute [ + + ^ context breakInspectedObjectOnAccess +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StBreakOnCallCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StBreakOnCallCommand.class.st new file mode 100644 index 000000000..97d3748ff --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StBreakOnCallCommand.class.st @@ -0,0 +1,33 @@ +" +I am a command to install from the inspector object-centric breakpoints on a method call, for a specific object. +" +Class { + #name : 'StBreakOnCallCommand', + #superclass : 'StDebugPointNodeTargetCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StBreakOnCallCommand class >> defaultDescription [ + + ^ 'Halts when this method is called' +] + +{ #category : 'default' } +StBreakOnCallCommand class >> defaultIconName [ + + ^ #smallDebug +] + +{ #category : 'default' } +StBreakOnCallCommand class >> defaultName [ + + ^ 'Break on call' +] + +{ #category : 'executing' } +StBreakOnCallCommand >> execute [ + + ^ context breakOnCallToSelectedMethod +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StBreakOnCallOnceCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StBreakOnCallOnceCommand.class.st new file mode 100644 index 000000000..43cea3309 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StBreakOnCallOnceCommand.class.st @@ -0,0 +1,33 @@ +" +I am the base class for commands to install from the inspector object-centric breakpoints on a method call, for a specific object. These object-centric breakpoints will only break once +" +Class { + #name : 'StBreakOnCallOnceCommand', + #superclass : 'StDebugPointNodeTargetCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StBreakOnCallOnceCommand class >> defaultDescription [ + + ^ 'Breaks once when this method is called' +] + +{ #category : 'default' } +StBreakOnCallOnceCommand class >> defaultIconName [ + + ^ #smallDebug +] + +{ #category : 'default' } +StBreakOnCallOnceCommand class >> defaultName [ + + ^ 'Break once on call' +] + +{ #category : 'executing' } +StBreakOnCallOnceCommand >> execute [ + + ^ context breakOnceOnCallToSelectedMethod +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StBreakOnReadCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StBreakOnReadCommand.class.st new file mode 100644 index 000000000..73f06d199 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StBreakOnReadCommand.class.st @@ -0,0 +1,33 @@ +" +I am the base class for commands to install from the inspector object-centric breakpoints on a variable's readings +" +Class { + #name : 'StBreakOnReadCommand', + #superclass : 'StDebugPointSlotTargetCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StBreakOnReadCommand class >> defaultDescription [ + + ^ 'Breaks when the selected or any variable is read' +] + +{ #category : 'default' } +StBreakOnReadCommand class >> defaultIconName [ + + ^ #smallObjects +] + +{ #category : 'default' } +StBreakOnReadCommand class >> defaultName [ + + ^ 'Break on read' +] + +{ #category : 'executing' } +StBreakOnReadCommand >> execute [ + + ^ context breakInspectedObjectOnRead +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StBreakOnWriteCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StBreakOnWriteCommand.class.st new file mode 100644 index 000000000..94132c5f5 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StBreakOnWriteCommand.class.st @@ -0,0 +1,33 @@ +" +I am the base class for commands to install from the inspector object-centric breakpoints on a variable's writings +" +Class { + #name : 'StBreakOnWriteCommand', + #superclass : 'StDebugPointSlotTargetCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StBreakOnWriteCommand class >> defaultDescription [ + + ^ 'Breaks when the selected or any variable is written' +] + +{ #category : 'default' } +StBreakOnWriteCommand class >> defaultIconName [ + + ^ #smallObjects +] + +{ #category : 'default' } +StBreakOnWriteCommand class >> defaultName [ + + ^ 'Break on write' +] + +{ #category : 'executing' } +StBreakOnWriteCommand >> execute [ + + ^ context breakInspectedObjectOnWrite +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StDebugPointCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StDebugPointCommand.class.st new file mode 100644 index 000000000..f682a6d23 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StDebugPointCommand.class.st @@ -0,0 +1,33 @@ +" +I am the base class for commands to install from the inspector object-centric debug points +" +Class { + #name : 'StDebugPointCommand', + #superclass : 'CmCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'testing' } +StDebugPointCommand >> appliesTo: aTool [ + ^ [ aTool owner class ~= StDebuggerRawObjectInspector ] + on: Error + do: [ false ] +] + +{ #category : 'converting' } +StDebugPointCommand >> asSpecCommand [ + + | command | + command := super asSpecCommand. + self class defaultIconName ifNotNil: [ :iconName | + command iconName: iconName ]. + + ^ command +] + +{ #category : 'testing' } +StDebugPointCommand >> canBeExecuted [ + + ^ true +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StDebugPointNodeTargetCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StDebugPointNodeTargetCommand.class.st new file mode 100644 index 000000000..ad7b5bfe2 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StDebugPointNodeTargetCommand.class.st @@ -0,0 +1,15 @@ +" +I am the base class for commands to install from the inspector object-centric debug points on an AST node +" +Class { + #name : 'StDebugPointNodeTargetCommand', + #superclass : 'StDebugPointCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'testing' } +StDebugPointNodeTargetCommand >> canBeExecuted [ + + ^ self appliesTo: context +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StDebugPointSlotTargetCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StDebugPointSlotTargetCommand.class.st new file mode 100644 index 000000000..a0c10d116 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StDebugPointSlotTargetCommand.class.st @@ -0,0 +1,15 @@ +" +I am the base class for commands to install from the inspector object-centric debug points on a variable +" +Class { + #name : 'StDebugPointSlotTargetCommand', + #superclass : 'StDebugPointCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'testing' } +StDebugPointSlotTargetCommand >> canBeExecuted [ + + ^ context enableSlotMenuEntries +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StInspectorSetScopeCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StInspectorSetScopeCommand.class.st new file mode 100644 index 000000000..7457ad5e4 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StInspectorSetScopeCommand.class.st @@ -0,0 +1,47 @@ +" +I am an inspector command allowing to set the scope of a debug point to the inspected object. +" +Class { + #name : 'StInspectorSetScopeCommand', + #superclass : 'StInspectorCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StInspectorSetScopeCommand class >> defaultDescription [ + ^'Change the scope of a debug point to this object' +] + +{ #category : 'initialization' } +StInspectorSetScopeCommand class >> defaultIconName [ + ^#smallDebug +] + +{ #category : 'default' } +StInspectorSetScopeCommand class >> defaultName [ + + + ^'Set Scope' +] + +{ #category : 'documentation' } +StInspectorSetScopeCommand class >> documentContextRequiredSelectors [ + ^super documentContextRequiredSelectors, #(selectedObject) +] + +{ #category : 'executing' } +StInspectorSetScopeCommand >> execute [ + + | debugPoint | + debugPoint := DebugPointSelectDialogPresenter new + scope: self interestingObject; + items: DebugPoint all asOrderedCollection; + label: + 'The scope of the selected debug point will be set to the inspected object'; + title: 'Select Debug Point'; + openModal. + + debugPoint ifNotNil: [ :dp | + dp targetInstance: self interestingObject ] +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StMetaBrowserPresenter.extension.st b/src/NewTools-ObjectCentricDebugPoints/StMetaBrowserPresenter.extension.st new file mode 100644 index 000000000..9d8f07fa8 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StMetaBrowserPresenter.extension.st @@ -0,0 +1,27 @@ +Extension { #name : 'StMetaBrowserPresenter' } + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StMetaBrowserPresenter >> breakOnCallToSelectedMethod [ + + | method | + method := self selectedMethod ifNil: [ ^ self ]. + self model breakOnCallTo: method selector +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StMetaBrowserPresenter >> breakOnceOnCallToSelectedMethod [ + + | method | + method := self selectedMethod ifNil: [ ^ self ]. + self model breakOnceOnCallTo: method selector +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StMetaBrowserPresenter class >> objectCentricDebugPointCommandsWith: presenter forRootGroup: aRootCmCommandsGroup [ + + + | methodsCommandGroup | + methodsCommandGroup := aRootCmCommandsGroup / 'methods'. + StDebugPointNodeTargetCommand allSubclassesDo: [ :commandClass | + methodsCommandGroup register: commandClass forSpec ] +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StObjectInspectorPresenter.extension.st b/src/NewTools-ObjectCentricDebugPoints/StObjectInspectorPresenter.extension.st new file mode 100644 index 000000000..f1f103d75 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StObjectInspectorPresenter.extension.st @@ -0,0 +1,54 @@ +Extension { #name : 'StObjectInspectorPresenter' } + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StObjectInspectorPresenter >> breakInspectedObjectOnAccess [ + + ^ self inspectedObject breakOnReadWrite +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StObjectInspectorPresenter >> breakInspectedObjectOnRead [ + + ^ self inspectedObject breakOnRead +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StObjectInspectorPresenter >> breakInspectedObjectOnWrite [ + + ^ self inspectedObject breakOnWrite +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StObjectInspectorPresenter class >> objectCentricDebugPointCommandsWith: aPresenter forRootGroup: aRootCommandsGroup [ + + + | objCentricGroup | + objCentricGroup := CmCommandGroup forSpec + beToolbarPopoverButton; + name: 'Debug'; + icon: + (aPresenter application iconNamed: #smallObjects); + yourself. + StDebugPointSlotTargetCommand allSubclasses do: [ :aCommandClass | + objCentricGroup register: aCommandClass forSpec ]. + + aRootCommandsGroup register: objCentricGroup +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StObjectInspectorPresenter >> watchInspectedObjectAccess [ + + ^ self inspectedObject watchOnReadWrite +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StObjectInspectorPresenter >> watchInspectedObjectRead [ + + ^ self inspectedObject watchOnRead +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StObjectInspectorPresenter >> watchInspectedObjectWrite [ + + ^ self inspectedObject watchOnWrite +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StRawInspectionPresenter.extension.st b/src/NewTools-ObjectCentricDebugPoints/StRawInspectionPresenter.extension.st new file mode 100644 index 000000000..b64a3d4b3 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StRawInspectionPresenter.extension.st @@ -0,0 +1,76 @@ +Extension { #name : 'StRawInspectionPresenter' } + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter >> breakInspectedObjectOnAccess [ + + ^ self breakInspectedObjectOnAccess: #all +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter >> breakInspectedObjectOnAccess: access [ + | selectedItem | + selectedItem := self selectedItem. + selectedItem ifNil:[ + "No selection: halt on all accesses" + ^ self model breakOnAccess: access ]. + selectedItem key asSymbol == #self + ifTrue:[ + "Self is selected: halt on all accesses" + ^ self model breakOnAccess: access]. + ^ self model breakOnAccess: access toSlotNamed: selectedItem key +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter >> breakInspectedObjectOnRead [ + + ^ self breakInspectedObjectOnAccess: #read +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter >> breakInspectedObjectOnWrite [ + + ^ self breakInspectedObjectOnAccess: #write +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter class >> objectCentricDebugPointCommandsWith: presenter forRootGroup: aRootCmCommandsGroup [ + + + (StDebugPointSlotTargetCommand allSubclasses + collect: [ :aCommandClass | aCommandClass forSpec ] + thenSelect: [ :spCommand | + spCommand decoratedCommand appliesTo: presenter ]) do: [ :spCommand | + aRootCmCommandsGroup register: spCommand ] +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter >> watchInspectedObjectAccess [ + + ^ self watchInspectedObjectOnAccess: #all +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter >> watchInspectedObjectOnAccess: access [ + | selectedItem | + selectedItem := self selectedItem. + selectedItem ifNil:[ + "No selection: halt on all accesses" + ^ self model watchOnAccess: access ]. + selectedItem key asSymbol == #self + ifTrue:[ + "Self is selected: halt on all accesses" + ^ self model watchOnAccess: access]. + ^ self model watchOnAccess: access toSlotNamed: selectedItem key +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter >> watchInspectedObjectRead [ + + ^ self watchInspectedObjectOnAccess: #read +] + +{ #category : '*NewTools-ObjectCentricDebugPoints' } +StRawInspectionPresenter >> watchInspectedObjectWrite [ + + ^ self watchInspectedObjectOnAccess: #write +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StWatchOnAccessCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StWatchOnAccessCommand.class.st new file mode 100644 index 000000000..4dd851186 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StWatchOnAccessCommand.class.st @@ -0,0 +1,33 @@ +" +I am the base class for commands to install from the inspector object-centric watchpoints on a variable's readings and writings +" +Class { + #name : 'StWatchOnAccessCommand', + #superclass : 'StDebugPointSlotTargetCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StWatchOnAccessCommand class >> defaultDescription [ + + ^ 'Saves values read or written for the selected or any variable' +] + +{ #category : 'default' } +StWatchOnAccessCommand class >> defaultIconName [ + + ^ #smallObjects +] + +{ #category : 'default' } +StWatchOnAccessCommand class >> defaultName [ + + ^ 'Watch state access' +] + +{ #category : 'executing' } +StWatchOnAccessCommand >> execute [ + + ^ context watchInspectedObjectAccess +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StWatchOnReadCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StWatchOnReadCommand.class.st new file mode 100644 index 000000000..e874ca0e8 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StWatchOnReadCommand.class.st @@ -0,0 +1,33 @@ +" +I am the base class for commands to install from the inspector object-centric watchpoints on a variable's readings +" +Class { + #name : 'StWatchOnReadCommand', + #superclass : 'StDebugPointSlotTargetCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StWatchOnReadCommand class >> defaultDescription [ + + ^ 'Saves values read for the selected or any variable' +] + +{ #category : 'default' } +StWatchOnReadCommand class >> defaultIconName [ + + ^ #smallObjects +] + +{ #category : 'default' } +StWatchOnReadCommand class >> defaultName [ + + ^ 'Watch read' +] + +{ #category : 'executing' } +StWatchOnReadCommand >> execute [ + + ^ context watchInspectedObjectRead +] diff --git a/src/NewTools-ObjectCentricDebugPoints/StWatchOnWriteCommand.class.st b/src/NewTools-ObjectCentricDebugPoints/StWatchOnWriteCommand.class.st new file mode 100644 index 000000000..fa8dacb66 --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/StWatchOnWriteCommand.class.st @@ -0,0 +1,33 @@ +" +I am the base class for commands to install from the inspector object-centric breakpoints on a variable's writings +" +Class { + #name : 'StWatchOnWriteCommand', + #superclass : 'StDebugPointSlotTargetCommand', + #category : 'NewTools-ObjectCentricDebugPoints', + #package : 'NewTools-ObjectCentricDebugPoints' +} + +{ #category : 'default' } +StWatchOnWriteCommand class >> defaultDescription [ + + ^ 'Saves values written for the selected or any variable' +] + +{ #category : 'default' } +StWatchOnWriteCommand class >> defaultIconName [ + + ^ #smallObjects +] + +{ #category : 'default' } +StWatchOnWriteCommand class >> defaultName [ + + ^ 'Watch write' +] + +{ #category : 'executing' } +StWatchOnWriteCommand >> execute [ + + ^ context watchInspectedObjectWrite +] diff --git a/src/NewTools-ObjectCentricDebugPoints/package.st b/src/NewTools-ObjectCentricDebugPoints/package.st new file mode 100644 index 000000000..e24400cee --- /dev/null +++ b/src/NewTools-ObjectCentricDebugPoints/package.st @@ -0,0 +1 @@ +Package { #name : 'NewTools-ObjectCentricDebugPoints' }