diff --git a/src/Athens-Cairo/AthensCairoSurface.class.st b/src/Athens-Cairo/AthensCairoSurface.class.st index 4ad3fbdb4e2..03828615dcb 100644 --- a/src/Athens-Cairo/AthensCairoSurface.class.st +++ b/src/Athens-Cairo/AthensCairoSurface.class.st @@ -342,9 +342,12 @@ AthensCairoSurface class >> primImage: aFormat width: aWidth height: aHeight [ { #category : #private } AthensCairoSurface class >> primImageFromData: data width: width height: height pitch: stride [ + + "CAIRO_FORMAT_ARGB32 -> 0" + ^ self ffiCall: #(AthensCairoSurface cairo_image_surface_create_for_data ( void *data, - CAIRO_FORMAT_ARGB32, + 0, int width, int height, int stride) ) diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser-Tests/ClyInstallMetaLinkPresenterTest.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser-Tests/ClyInstallMetaLinkPresenterTest.class.st new file mode 100644 index 00000000000..3b462b37d68 --- /dev/null +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser-Tests/ClyInstallMetaLinkPresenterTest.class.st @@ -0,0 +1,142 @@ +Class { + #name : #ClyInstallMetaLinkPresenterTest, + #superclass : #TestCase, + #instVars : [ + 'node', + 'metalink', + 'metalink2', + 'breakpoint', + 'executionCounter', + 'watchpoint' + ], + #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Tests-Metalinks' +} + +{ #category : #'helper methods' } +ClyInstallMetaLinkPresenterTest >> dummyMethod [ + self +] + +{ #category : #'helper methods' } +ClyInstallMetaLinkPresenterTest >> nodeInRealMethod [ + ^(self class >> #dummyMethod) ast statements first +] + +{ #category : #running } +ClyInstallMetaLinkPresenterTest >> presenterForMetalinkInstallation [ + ^ClyMetaLinkInstallationPresenter onNode: node forInstallation: true +] + +{ #category : #running } +ClyInstallMetaLinkPresenterTest >> presenterForMetalinkUninstallation [ + ^ ClyMetaLinkInstallationPresenter onNode: node forInstallation: false +] + +{ #category : #running } +ClyInstallMetaLinkPresenterTest >> setUp [ + super setUp. + MetaLink uninstallAll. + node := RBTemporaryNode named: 'test'. + metalink := MetaLink new. + metalink2 := MetaLink new. + breakpoint := MetaLink new metaObject: Break; yourself. + executionCounter := MetaLink new metaObject: ExecutionCounter new; yourself. + watchpoint := MetaLink new metaObject: Watchpoint new; yourself. + node propertyAt: #links put: {metalink. breakpoint. executionCounter. watchpoint} asOrderedCollection + +] + +{ #category : #running } +ClyInstallMetaLinkPresenterTest >> tearDown [ + metalink uninstall. + metalink2 uninstall. + super tearDown +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testInstallSelectedMetalink [ + |presenter list| + presenter := ClyMetaLinkInstallationPresenter onNode: self nodeInRealMethod forInstallation: true. + list := presenter metalinkListPresenter. + list clickItem: 1. + self deny: self nodeInRealMethod hasLinks. + presenter installSelectedMetalink. + self assert: self nodeInRealMethod hasLinks. + self assert: self nodeInRealMethod links asArray first identicalTo: list items first +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testInstallSelectedMetalinkActionButton [ + |presenter list| + presenter := ClyMetaLinkInstallationPresenter onNode: self nodeInRealMethod forInstallation: true. + list := presenter metalinkListPresenter. + list clickItem: 1. + self deny: self nodeInRealMethod hasLinks. + presenter toolbarButtons first execute. + self assert: self nodeInRealMethod hasLinks. + self assert: self nodeInRealMethod links asArray first identicalTo: list items first +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testRelevantMetalinksForInstallation [ + |links| + links := self presenterForMetalinkInstallation allRelevantMetaLinks. + self assert: links size >= 2. + self assertCollection: links includesAll: { metalink. metalink2 }. + self denyCollection: links includesAll: { breakpoint. watchpoint. executionCounter }. + +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testRelevantMetalinksForUninstallation [ + | links | + links := self presenterForMetalinkUninstallation allRelevantMetaLinks. + self assert: links size equals: 1. + self assertCollection: links hasSameElements: { metalink } +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testToolbarButtonsCollectionSize [ + self assert: self presenterForMetalinkInstallation toolbarButtons size equals: 2. + self assert: self presenterForMetalinkUninstallation toolbarButtons size equals: 2. +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testToolbarButtonsForMetalinkInstallation [ + |toolbarButtons| + toolbarButtons := self presenterForMetalinkInstallation toolbarButtons. + self assert: toolbarButtons first label equals: 'Install'. + self assert: toolbarButtons last label equals: 'Cancel'. +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testToolbarButtonsForMetalinkUninstallation [ + |toolbarButtons| + toolbarButtons := self presenterForMetalinkUninstallation toolbarButtons. + self assert: toolbarButtons first label equals: 'Uninstall'. + self assert: toolbarButtons last label equals: 'Cancel'. +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testUninstallSelectedMetalink [ + |presenter list| + self nodeInRealMethod link: metalink. + presenter := ClyMetaLinkInstallationPresenter onNode: self nodeInRealMethod forInstallation: false. + list := presenter metalinkListPresenter. + list clickItem: 1. + self assert: self nodeInRealMethod hasLinks. + presenter uninstallSelectedMetalink. + self deny: self nodeInRealMethod hasLinks +] + +{ #category : #tests } +ClyInstallMetaLinkPresenterTest >> testUninstallSelectedMetalinkActionButton [ + |presenter list| + self nodeInRealMethod link: metalink. + presenter := ClyMetaLinkInstallationPresenter onNode: self nodeInRealMethod forInstallation: false. + list := presenter metalinkListPresenter. + list clickItem: 1. + self assert: self nodeInRealMethod hasLinks. + presenter toolbarButtons first execute. + self deny: self nodeInRealMethod hasLinks +] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddBreakpointCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddBreakpointCommand.class.st index a58dc59d0a7..f76b9e5a4c1 100644 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddBreakpointCommand.class.st +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddBreakpointCommand.class.st @@ -7,7 +7,7 @@ My subclasses should implement single method: " Class { #name : #ClyAddBreakpointCommand, - #superclass : #ClyMetalinkCommand, + #superclass : #ClyDebuggingCommand, #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Breakpoints' } diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddExecutionCounterCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddExecutionCounterCommand.class.st index 707f89962b9..920d0b19f97 100644 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddExecutionCounterCommand.class.st +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddExecutionCounterCommand.class.st @@ -3,7 +3,7 @@ I am a command to install execution counter into given method or source node " Class { #name : #ClyAddExecutionCounterCommand, - #superclass : #ClyMetalinkCommand, + #superclass : #ClyDebuggingCommand, #category : #'Calypso-SystemPlugins-Reflectivity-Browser-ExecutionCounters' } diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddWatchpointCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddWatchpointCommand.class.st index 360864d3b9d..8ca02205cc7 100644 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddWatchpointCommand.class.st +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyAddWatchpointCommand.class.st @@ -3,7 +3,7 @@ I am a command to install watchpoint into the given method or source node " Class { #name : #ClyAddWatchpointCommand, - #superclass : #ClyMetalinkCommand, + #superclass : #ClyDebuggingCommand, #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Watchpoints' } diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyDebuggingCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyDebuggingCommand.class.st new file mode 100644 index 00000000000..24038c47224 --- /dev/null +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyDebuggingCommand.class.st @@ -0,0 +1,43 @@ +" +I am a base class for commands which add/remove metalinks into given method or source node +" +Class { + #name : #ClyDebuggingCommand, + #superclass : #SycSourceCodeCommand, + #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Commands' +} + +{ #category : #activation } +ClyDebuggingCommand class >> contextMenuOrder [ + + self subclassResponsibility +] + +{ #category : #testing } +ClyDebuggingCommand class >> isAbstract [ + ^self = ClyDebuggingCommand +] + +{ #category : #activation } +ClyDebuggingCommand class >> methodContextMenuActivation [ + + + ^CmdContextMenuActivation + byItemOf: ClyDebuggingMenuGroup order: self contextMenuOrder for: ClyMethod asCalypsoItemContext +] + +{ #category : #activation } +ClyDebuggingCommand class >> methodEditorLeftBarMenuActivation [ + + + ^CmdTextLeftBarMenuActivation + byItemOf: ClyDebuggingMenuGroup order: self contextMenuOrder for: ClyMethodSourceCodeContext +] + +{ #category : #activation } +ClyDebuggingCommand class >> sourceCodeMenuActivation [ + + + ^SycDebuggingMenuActivation + byItemOf: ClyDebuggingMenuGroup order: self contextMenuOrder for: ClyMethodSourceCodeContext +] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetalinkMenuGroup.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyDebuggingMenuGroup.class.st similarity index 73% rename from src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetalinkMenuGroup.class.st rename to src/Calypso-SystemPlugins-Reflectivity-Browser/ClyDebuggingMenuGroup.class.st index db51940bbc5..2519d9d31c1 100644 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetalinkMenuGroup.class.st +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyDebuggingMenuGroup.class.st @@ -2,17 +2,17 @@ I am menu group to arrange together all metalink related commands (breakpoints, counters, watchpoints) " Class { - #name : #ClyMetalinkMenuGroup, + #name : #ClyDebuggingMenuGroup, #superclass : #CmdMenuGroup, #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Commands' } { #category : #testing } -ClyMetalinkMenuGroup >> isInlined [ +ClyDebuggingMenuGroup >> isInlined [ ^true ] { #category : #accessing } -ClyMetalinkMenuGroup >> order [ +ClyDebuggingMenuGroup >> order [ ^1.5 ] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyInstallMetaLinkCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyInstallMetaLinkCommand.class.st new file mode 100644 index 00000000000..cb64a82fb51 --- /dev/null +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyInstallMetaLinkCommand.class.st @@ -0,0 +1,29 @@ +" +I am a command to install metalinks on the selected method or one of its ast nodes. +I open a small browser to choose which metalink to install among existing metalink instances. +" +Class { + #name : #ClyInstallMetaLinkCommand, + #superclass : #ClyDebuggingCommand, + #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Metalinks' +} + +{ #category : #activation } +ClyInstallMetaLinkCommand class >> contextMenuOrder [ + ^100 +] + +{ #category : #accessing } +ClyInstallMetaLinkCommand >> defaultMenuIconName [ + ^#smallObjects +] + +{ #category : #accessing } +ClyInstallMetaLinkCommand >> defaultMenuItemName [ + ^'Install MetaLink...' +] + +{ #category : #execution } +ClyInstallMetaLinkCommand >> execute [ + ClyMetaLinkInstallationPresenter openInstallerOnNode: sourceNode +] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetaLinkInstallationPresenter.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetaLinkInstallationPresenter.class.st new file mode 100644 index 00000000000..f9a396731a6 --- /dev/null +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetaLinkInstallationPresenter.class.st @@ -0,0 +1,142 @@ +" +I present a list of available metalink for a given ast node to be installed or uninstalled. +The presenter can be in install mode or uninstall mode, see class methods. +The list of links for a node is either all the instances of metalinks from the system when in install mode or all node currently installed on that node. +" +Class { + #name : #ClyMetaLinkInstallationPresenter, + #superclass : #SpPresenter, + #instVars : [ + 'sourceNode', + 'toolBar', + 'isForMetaLinkInstallation', + 'metalinkListPresenter' + ], + #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Metalinks' +} + +{ #category : #specs } +ClyMetaLinkInstallationPresenter class >> defaultSpec [ + ^ SpBoxLayout newVertical + add: #toolBar + expand: false + fill: false + padding: 0; + add: #metalinkListPresenter; + yourself +] + +{ #category : #'instance creation' } +ClyMetaLinkInstallationPresenter class >> onNode: aSourceNode forInstallation: forInstallation [ + ^ self basicNew + sourceNode: aSourceNode; + isForMetaLinkInstallation: forInstallation; + initialize +] + +{ #category : #opening } +ClyMetaLinkInstallationPresenter class >> openInstallerOnNode: aSourceNode [ + (self onNode: aSourceNode forInstallation: true) openWithSpec +] + +{ #category : #opening } +ClyMetaLinkInstallationPresenter class >> openUninstallerOnNode: aSourceNode [ + (self onNode: aSourceNode forInstallation: false) openWithSpec +] + +{ #category : #accessing } +ClyMetaLinkInstallationPresenter >> allRelevantMetaLinks [ + | baseLinks | + baseLinks := self isForMetaLinkInstallation + ifTrue: [ "This is temporary, I should have put a comment. +The idea would be to add an explicit option at the metalink level, so that only the ones that are ''installable through the menu'' would appear. +But we need to think about how to do that exactly." + MetaLink allInstances ] + ifFalse: [ sourceNode links ]. + ^ baseLinks reject: [ :link | + link metaObject == Break or: [ + { + Watchpoint. + ExecutionCounter } includes: link metaObject class ] ] +] + +{ #category : #initialization } +ClyMetaLinkInstallationPresenter >> close [ + self withWindowDo: #close +] + +{ #category : #initialization } +ClyMetaLinkInstallationPresenter >> initializePresenter [ + metalinkListPresenter := self newList. + metalinkListPresenter items: self allRelevantMetaLinks. + toolBar := self newToolBar. + self toolbarButtons do: [ :button | toolBar addItem: button ] +] + +{ #category : #initialization } +ClyMetaLinkInstallationPresenter >> initializeWindow: aWindowPresenter [ + super initializeWindow: aWindowPresenter. + aWindowPresenter title: sourceNode printString +] + +{ #category : #installation } +ClyMetaLinkInstallationPresenter >> installSelectedMetalink [ + metalinkListPresenter selection selectedItem ifNotNil: [ :metalink | + sourceNode link: metalink ]. + self close +] + +{ #category : #testing } +ClyMetaLinkInstallationPresenter >> isForMetaLinkInstallation [ + ^isForMetaLinkInstallation ifNil:[isForMetaLinkInstallation := true] +] + +{ #category : #accessing } +ClyMetaLinkInstallationPresenter >> isForMetaLinkInstallation: anObject [ + isForMetaLinkInstallation := anObject +] + +{ #category : #accessing } +ClyMetaLinkInstallationPresenter >> metalinkListPresenter [ + ^ metalinkListPresenter +] + +{ #category : #accessing } +ClyMetaLinkInstallationPresenter >> sourceNode: anObject [ + sourceNode := anObject +] + +{ #category : #accessing } +ClyMetaLinkInstallationPresenter >> toolbarButtons [ + | buttons | + buttons := OrderedCollection new. + buttons add: (self isForMetaLinkInstallation + ifTrue: [ + SpToolBarButton new + label: 'Install'; + icon: (self iconNamed: #smallOk); + help: 'Install the selected metalink'; + action: [ self installSelectedMetalink ]; + yourself ] + ifFalse: [ + SpToolBarButton new + label: 'Uninstall'; + icon: (self iconNamed: #smallOk); + help: 'Uninstall the selected metalink'; + action: [ self uninstallSelectedMetalink ]; + yourself ]). + buttons add: (SpToolBarButton new + label: 'Cancel'; + icon: (self iconNamed: #smallCancel); + help: 'Cancel'; + action: [ self close ]; + yourself). + ^ buttons +] + +{ #category : #installation } +ClyMetaLinkInstallationPresenter >> uninstallSelectedMetalink [ + metalinkListPresenter selection selectedItem ifNotNil: [ :metalink | + sourceNode removeLink: metalink ]. + self close +] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetalinkCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetalinkCommand.class.st deleted file mode 100644 index ea0cb50e0e5..00000000000 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyMetalinkCommand.class.st +++ /dev/null @@ -1,43 +0,0 @@ -" -I am a base class for commands which add/remove metalinks into given method or source node -" -Class { - #name : #ClyMetalinkCommand, - #superclass : #SycSourceCodeCommand, - #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Commands' -} - -{ #category : #activation } -ClyMetalinkCommand class >> contextMenuOrder [ - - self subclassResponsibility -] - -{ #category : #testing } -ClyMetalinkCommand class >> isAbstract [ - ^self = ClyMetalinkCommand -] - -{ #category : #activation } -ClyMetalinkCommand class >> methodContextMenuActivation [ - - - ^CmdContextMenuActivation - byItemOf: ClyMetalinkMenuGroup order: self contextMenuOrder for: ClyMethod asCalypsoItemContext -] - -{ #category : #activation } -ClyMetalinkCommand class >> methodEditorLeftBarMenuActivation [ - - - ^CmdTextLeftBarMenuActivation - byItemOf: ClyMetalinkMenuGroup order: self contextMenuOrder for: ClyMethodSourceCodeContext -] - -{ #category : #activation } -ClyMetalinkCommand class >> sourceCodeMenuActivation [ - - - ^SycSourceCodeMenuActivation - byItemOf: ClyMetalinkMenuGroup order: self contextMenuOrder for: ClyMethodSourceCodeContext -] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveBreakpointCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveBreakpointCommand.class.st index 9e7c4a13daa..d9ec4255be2 100644 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveBreakpointCommand.class.st +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveBreakpointCommand.class.st @@ -3,7 +3,7 @@ I am a command to remove all breakpoints from given method or source node " Class { #name : #ClyRemoveBreakpointCommand, - #superclass : #ClyRemoveMetalinkCommand, + #superclass : #ClyRemoveDebuggingCommand, #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Breakpoints' } @@ -19,7 +19,7 @@ ClyRemoveBreakpointCommand class >> contextMenuOrder [ ] { #category : #execution } -ClyRemoveBreakpointCommand >> metalinkManagerClass [ +ClyRemoveBreakpointCommand >> debuggingToolClass [ ^Breakpoint ] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveMetalinkCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveDebuggingCommand.class.st similarity index 60% rename from src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveMetalinkCommand.class.st rename to src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveDebuggingCommand.class.st index d607f5a7bcd..d5499e8ec31 100644 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveMetalinkCommand.class.st +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveDebuggingCommand.class.st @@ -9,41 +9,41 @@ It is a class which manages target type of metalinks. For example Breakpoint or It should return order in context menu " Class { - #name : #ClyRemoveMetalinkCommand, - #superclass : #ClyMetalinkCommand, + #name : #ClyRemoveDebuggingCommand, + #superclass : #ClyDebuggingCommand, #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Commands' } { #category : #testing } -ClyRemoveMetalinkCommand class >> isAbstract [ - ^self = ClyRemoveMetalinkCommand +ClyRemoveDebuggingCommand class >> isAbstract [ + ^self = ClyRemoveDebuggingCommand ] { #category : #activation } -ClyRemoveMetalinkCommand class >> methodBrowserTableIconActivation [ +ClyRemoveDebuggingCommand class >> methodBrowserTableIconActivation [ ^ClyTableIconCommandActivation priority: 900 for: ClyMethod asCalypsoItemContext ] +{ #category : #execution } +ClyRemoveDebuggingCommand >> debuggingToolClass [ + self subclassResponsibility +] + { #category : #accessing } -ClyRemoveMetalinkCommand >> defaultMenuIconName [ +ClyRemoveDebuggingCommand >> defaultMenuIconName [ ^#smallCancel ] { #category : #accessing } -ClyRemoveMetalinkCommand >> defaultMenuItemName [ - ^'Remove ', self metalinkManagerClass name asLowercase +ClyRemoveDebuggingCommand >> defaultMenuItemName [ + ^'Remove ', self debuggingToolClass name asLowercase ] { #category : #execution } -ClyRemoveMetalinkCommand >> execute [ +ClyRemoveDebuggingCommand >> execute [ sourceNode nodesWithLinks do: [:each | - self metalinkManagerClass removeFrom: each] -] - -{ #category : #execution } -ClyRemoveMetalinkCommand >> metalinkManagerClass [ - self subclassResponsibility + self debuggingToolClass removeFrom: each] ] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveExecutionCounterCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveExecutionCounterCommand.class.st index 631765d9951..eaa6c2c776e 100644 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveExecutionCounterCommand.class.st +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveExecutionCounterCommand.class.st @@ -3,7 +3,7 @@ I am a command to remove execution counters from given method of node " Class { #name : #ClyRemoveExecutionCounterCommand, - #superclass : #ClyRemoveMetalinkCommand, + #superclass : #ClyRemoveDebuggingCommand, #category : #'Calypso-SystemPlugins-Reflectivity-Browser-ExecutionCounters' } @@ -33,6 +33,11 @@ ClyRemoveExecutionCounterCommand >> currentCallsCount [ ^sourceNode counter count ] +{ #category : #execution } +ClyRemoveExecutionCounterCommand >> debuggingToolClass [ + ^ExecutionCounter +] + { #category : #accessing } ClyRemoveExecutionCounterCommand >> defaultMenuItemName [ @@ -41,11 +46,6 @@ ClyRemoveExecutionCounterCommand >> defaultMenuItemName [ ifFalse: [ 'Remove counter' ] ] -{ #category : #execution } -ClyRemoveExecutionCounterCommand >> metalinkManagerClass [ - ^ExecutionCounter -] - { #category : #'table decoration' } ClyRemoveExecutionCounterCommand >> tableCellIcon [ ^Smalltalk ui iconNamed: #classIcon diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveWatchpointCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveWatchpointCommand.class.st index 5dd34ccfdc1..10e28183208 100644 --- a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveWatchpointCommand.class.st +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyRemoveWatchpointCommand.class.st @@ -3,7 +3,7 @@ I am a command to remove all watchpoints from given method or source node " Class { #name : #ClyRemoveWatchpointCommand, - #superclass : #ClyRemoveMetalinkCommand, + #superclass : #ClyRemoveDebuggingCommand, #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Watchpoints' } @@ -19,7 +19,7 @@ ClyRemoveWatchpointCommand class >> contextMenuOrder [ ] { #category : #execution } -ClyRemoveWatchpointCommand >> metalinkManagerClass [ +ClyRemoveWatchpointCommand >> debuggingToolClass [ ^Watchpoint ] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyUninstallMetaLinkCommand.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyUninstallMetaLinkCommand.class.st new file mode 100644 index 00000000000..db486b118c4 --- /dev/null +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ClyUninstallMetaLinkCommand.class.st @@ -0,0 +1,31 @@ +" +I am a copy of class ClyInstallMetaLinkCommand. This comment is copied from there, and might not be entirely accurate + +I am a command to install metalinks on the selected method or one of its ast nodes. +I open a small browser to choose which metalink to install among existing metalink instances. +" +Class { + #name : #ClyUninstallMetaLinkCommand, + #superclass : #ClyDebuggingCommand, + #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Metalinks' +} + +{ #category : #activation } +ClyUninstallMetaLinkCommand class >> contextMenuOrder [ + ^101 +] + +{ #category : #accessing } +ClyUninstallMetaLinkCommand >> defaultMenuIconName [ + ^#smallObjects +] + +{ #category : #accessing } +ClyUninstallMetaLinkCommand >> defaultMenuItemName [ + ^'Uninstall MetaLink...' +] + +{ #category : #execution } +ClyUninstallMetaLinkCommand >> execute [ + ClyMetaLinkInstallationPresenter openUninstallerOnNode: sourceNode +] diff --git a/src/Calypso-SystemPlugins-Reflectivity-Browser/ManifestCalypsoSystemPluginsReflectivityBrowser.class.st b/src/Calypso-SystemPlugins-Reflectivity-Browser/ManifestCalypsoSystemPluginsReflectivityBrowser.class.st new file mode 100644 index 00000000000..d1992a27ca2 --- /dev/null +++ b/src/Calypso-SystemPlugins-Reflectivity-Browser/ManifestCalypsoSystemPluginsReflectivityBrowser.class.st @@ -0,0 +1,5 @@ +Class { + #name : #ManifestCalypsoSystemPluginsReflectivityBrowser, + #superclass : #PackageManifest, + #category : #'Calypso-SystemPlugins-Reflectivity-Browser-Manifest' +} diff --git a/src/Calypso-SystemTools-Core/SycOpenDebuggingMenuCommand.extension.st b/src/Calypso-SystemTools-Core/SycOpenDebuggingMenuCommand.extension.st new file mode 100644 index 00000000000..701be9a80b1 --- /dev/null +++ b/src/Calypso-SystemTools-Core/SycOpenDebuggingMenuCommand.extension.st @@ -0,0 +1,15 @@ +Extension { #name : #SycOpenDebuggingMenuCommand } + +{ #category : #'*Calypso-SystemTools-Core' } +SycOpenDebuggingMenuCommand class >> methodEditorShortcutActivation [ + + + ^CmdShortcutActivation by: $d meta for: ClySourceCodeContext +] + +{ #category : #'*Calypso-SystemTools-Core' } +SycOpenDebuggingMenuCommand class >> sourceCodeMenuActivation [ + + + ^CmdContextMenuActivation byRootGroupItemOrder: -1 for: ClySourceCodeContext +] diff --git a/src/ClassAnnotation-Tests/ActiveClassAnnotationsTest.class.st b/src/ClassAnnotation-Tests/ActiveClassAnnotationsTest.class.st index d2c6736a18d..08e5c1754cd 100644 --- a/src/ClassAnnotation-Tests/ActiveClassAnnotationsTest.class.st +++ b/src/ClassAnnotation-Tests/ActiveClassAnnotationsTest.class.st @@ -1,7 +1,7 @@ Class { #name : #ActiveClassAnnotationsTest, #superclass : #ClassAnnotationTestCase, - #category : #'ClassAnnotation-Tests' + #category : #'ClassAnnotation-Tests-Base' } { #category : #tests } diff --git a/src/ClassAnnotation-Tests/ClassAnnotationTest.class.st b/src/ClassAnnotation-Tests/ClassAnnotationTest.class.st index 80e535ae9ab..71e41c505da 100644 --- a/src/ClassAnnotation-Tests/ClassAnnotationTest.class.st +++ b/src/ClassAnnotation-Tests/ClassAnnotationTest.class.st @@ -1,7 +1,7 @@ Class { #name : #ClassAnnotationTest, #superclass : #ClassAnnotationTestCase, - #category : #'ClassAnnotation-Tests' + #category : #'ClassAnnotation-Tests-Base' } { #category : #running } diff --git a/src/ClassAnnotation-Tests/ClassAnnotationTestCase.class.st b/src/ClassAnnotation-Tests/ClassAnnotationTestCase.class.st index 9450ced935c..1b204dc4671 100644 --- a/src/ClassAnnotation-Tests/ClassAnnotationTestCase.class.st +++ b/src/ClassAnnotation-Tests/ClassAnnotationTestCase.class.st @@ -1,7 +1,7 @@ Class { #name : #ClassAnnotationTestCase, #superclass : #TestCase, - #category : #'ClassAnnotation-Tests' + #category : #'ClassAnnotation-Tests-Base' } { #category : #testing } diff --git a/src/ClassAnnotation-Tests/CompositeAnnotationContextTest.class.st b/src/ClassAnnotation-Tests/CompositeAnnotationContextTest.class.st index caba08983f7..25881b53312 100644 --- a/src/ClassAnnotation-Tests/CompositeAnnotationContextTest.class.st +++ b/src/ClassAnnotation-Tests/CompositeAnnotationContextTest.class.st @@ -1,7 +1,7 @@ Class { #name : #CompositeAnnotationContextTest, #superclass : #TestCase, - #category : #'ClassAnnotation-Tests' + #category : #'ClassAnnotation-Tests-Base' } { #category : #tests } diff --git a/src/ClassAnnotation-Tests/QueryAnnotationsFromClassTest.class.st b/src/ClassAnnotation-Tests/QueryAnnotationsFromClassTest.class.st index 25986fe59dc..ff93dc11e7a 100644 --- a/src/ClassAnnotation-Tests/QueryAnnotationsFromClassTest.class.st +++ b/src/ClassAnnotation-Tests/QueryAnnotationsFromClassTest.class.st @@ -1,7 +1,7 @@ Class { #name : #QueryAnnotationsFromClassTest, #superclass : #ClassAnnotationTestCase, - #category : #'ClassAnnotation-Tests' + #category : #'ClassAnnotation-Tests-Base' } { #category : #tests } diff --git a/src/ClassAnnotation-Tests/RegisteredClassAnnotationsTest.class.st b/src/ClassAnnotation-Tests/RegisteredClassAnnotationsTest.class.st index 717d417be06..8b75cae7171 100644 --- a/src/ClassAnnotation-Tests/RegisteredClassAnnotationsTest.class.st +++ b/src/ClassAnnotation-Tests/RegisteredClassAnnotationsTest.class.st @@ -1,7 +1,7 @@ Class { #name : #RegisteredClassAnnotationsTest, #superclass : #ClassAnnotationTestCase, - #category : #'ClassAnnotation-Tests' + #category : #'ClassAnnotation-Tests-Base' } { #category : #running } diff --git a/src/ClassAnnotation-Tests/SimpleAnnotationContextTest.class.st b/src/ClassAnnotation-Tests/SimpleAnnotationContextTest.class.st index 03999ed6023..7c46c462acf 100644 --- a/src/ClassAnnotation-Tests/SimpleAnnotationContextTest.class.st +++ b/src/ClassAnnotation-Tests/SimpleAnnotationContextTest.class.st @@ -1,7 +1,7 @@ Class { #name : #SimpleAnnotationContextTest, #superclass : #TestCase, - #category : #'ClassAnnotation-Tests' + #category : #'ClassAnnotation-Tests-Base' } { #category : #tests } diff --git a/src/ClassAnnotation-Tests/VisibleClassAnnotationsTest.class.st b/src/ClassAnnotation-Tests/VisibleClassAnnotationsTest.class.st index 965b53b19a7..e2851d9e445 100644 --- a/src/ClassAnnotation-Tests/VisibleClassAnnotationsTest.class.st +++ b/src/ClassAnnotation-Tests/VisibleClassAnnotationsTest.class.st @@ -1,7 +1,7 @@ Class { #name : #VisibleClassAnnotationsTest, #superclass : #ClassAnnotationTestCase, - #category : #'ClassAnnotation-Tests' + #category : #'ClassAnnotation-Tests-Base' } { #category : #tests } diff --git a/src/ClassAnnotation/CompositeAnnotationContext.class.st b/src/ClassAnnotation/CompositeAnnotationContext.class.st index dabedf84ee1..52e18c6f3b6 100644 --- a/src/ClassAnnotation/CompositeAnnotationContext.class.st +++ b/src/ClassAnnotation/CompositeAnnotationContext.class.st @@ -31,7 +31,7 @@ CompositeAnnotationContext class >> with: contextCollection [ { #category : #converting } CompositeAnnotationContext >> , anAnnotationContext [ - ^ CompositeAnnotationContext with: (parts copyWith: anAnnotationContext asAnnotationContext) + ^ self class with: (parts copyWith: anAnnotationContext asAnnotationContext) ] { #category : #comparing } diff --git a/src/Collections-Abstract/SequenceableCollection.class.st b/src/Collections-Abstract/SequenceableCollection.class.st index c1e69c45aeb..5b0011cdfaf 100644 --- a/src/Collections-Abstract/SequenceableCollection.class.st +++ b/src/Collections-Abstract/SequenceableCollection.class.st @@ -142,7 +142,7 @@ SequenceableCollection >> allButFirst [ SequenceableCollection >> allButFirst: n [ "Answer a copy of the receiver containing all but the first n elements. Raise an error if there are not enough elements." - + "#(a b c) allButFirst >>> #(b c)" ^ self copyFrom: n + 1 to: self size ] diff --git a/src/Debugger-Tests/AssignmentAndLiteralDebuggerTest.class.st b/src/Debugger-Tests/AssignmentAndLiteralDebuggerTest.class.st index f1575f7786f..db8e32f0b1e 100644 --- a/src/Debugger-Tests/AssignmentAndLiteralDebuggerTest.class.st +++ b/src/Debugger-Tests/AssignmentAndLiteralDebuggerTest.class.st @@ -1,7 +1,7 @@ Class { #name : #AssignmentAndLiteralDebuggerTest, #superclass : #DebuggerTest, - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #running } diff --git a/src/Debugger-Tests/DebugSessionContexts2Test.class.st b/src/Debugger-Tests/DebugSessionContexts2Test.class.st index 78b5b1f6388..b8bbbd82ede 100644 --- a/src/Debugger-Tests/DebugSessionContexts2Test.class.st +++ b/src/Debugger-Tests/DebugSessionContexts2Test.class.st @@ -4,7 +4,7 @@ Class { #classVars : [ 'debugSession' ], - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #'as yet unclassified' } diff --git a/src/Debugger-Tests/DebugSessionContextsTest.class.st b/src/Debugger-Tests/DebugSessionContextsTest.class.st index 9f894404400..c9b2c048977 100644 --- a/src/Debugger-Tests/DebugSessionContextsTest.class.st +++ b/src/Debugger-Tests/DebugSessionContextsTest.class.st @@ -4,7 +4,7 @@ Class { #instVars : [ 'debuggedThisContext' ], - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #running } diff --git a/src/Debugger-Tests/DebuggerModelTest.class.st b/src/Debugger-Tests/DebuggerModelTest.class.st index 00a18a6b699..f37ebe7ec9f 100644 --- a/src/Debugger-Tests/DebuggerModelTest.class.st +++ b/src/Debugger-Tests/DebuggerModelTest.class.st @@ -9,7 +9,7 @@ Class { 'process', 'context' ], - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Model' } { #category : #running } diff --git a/src/Debugger-Tests/DebuggerTest.class.st b/src/Debugger-Tests/DebuggerTest.class.st index 2b7cb60bad8..ff5413dbed3 100644 --- a/src/Debugger-Tests/DebuggerTest.class.st +++ b/src/Debugger-Tests/DebuggerTest.class.st @@ -10,7 +10,7 @@ Class { 'session', 'process' ], - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #utilities } diff --git a/src/Debugger-Tests/DynamicMessageImplementorTest.class.st b/src/Debugger-Tests/DynamicMessageImplementorTest.class.st index 051328b7d34..df6b78933fb 100644 --- a/src/Debugger-Tests/DynamicMessageImplementorTest.class.st +++ b/src/Debugger-Tests/DynamicMessageImplementorTest.class.st @@ -7,7 +7,7 @@ Class { #instVars : [ 'instVar' ], - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #testing } diff --git a/src/Debugger-Tests/ErrorWasInUIProcessTest.class.st b/src/Debugger-Tests/ErrorWasInUIProcessTest.class.st index d6bc3527f36..2c16bbfd5d9 100644 --- a/src/Debugger-Tests/ErrorWasInUIProcessTest.class.st +++ b/src/Debugger-Tests/ErrorWasInUIProcessTest.class.st @@ -1,7 +1,7 @@ Class { #name : #ErrorWasInUIProcessTest, #superclass : #DebuggerTest, - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #tests } diff --git a/src/Debugger-Tests/FilterTest.class.st b/src/Debugger-Tests/FilterTest.class.st index 37a0ce77b7e..20a74acb2dd 100644 --- a/src/Debugger-Tests/FilterTest.class.st +++ b/src/Debugger-Tests/FilterTest.class.st @@ -12,7 +12,7 @@ Class { 'otherProcess', 'otherSession' ], - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Filter' } { #category : #running } diff --git a/src/Debugger-Tests/IsContextPostMortemTest.class.st b/src/Debugger-Tests/IsContextPostMortemTest.class.st index 4ce129a959a..335d47571d9 100644 --- a/src/Debugger-Tests/IsContextPostMortemTest.class.st +++ b/src/Debugger-Tests/IsContextPostMortemTest.class.st @@ -1,7 +1,7 @@ Class { #name : #IsContextPostMortemTest, #superclass : #DebuggerTest, - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #helper } diff --git a/src/Debugger-Tests/MyHalt.class.st b/src/Debugger-Tests/MyHalt.class.st index d9142fad9bc..106807397b6 100644 --- a/src/Debugger-Tests/MyHalt.class.st +++ b/src/Debugger-Tests/MyHalt.class.st @@ -1,7 +1,10 @@ +" +A custom exception used in halts +" Class { #name : #MyHalt, #superclass : #Exception, - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Exceptions' } { #category : #accessing } diff --git a/src/Debugger-Tests/RestartTest.class.st b/src/Debugger-Tests/RestartTest.class.st index 5413210699e..0f884c92e3c 100644 --- a/src/Debugger-Tests/RestartTest.class.st +++ b/src/Debugger-Tests/RestartTest.class.st @@ -1,7 +1,7 @@ Class { #name : #RestartTest, #superclass : #DebuggerTest, - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #tests } diff --git a/src/Debugger-Tests/StepIntoTest.class.st b/src/Debugger-Tests/StepIntoTest.class.st index ec3aa43984f..7ff0b6facb5 100644 --- a/src/Debugger-Tests/StepIntoTest.class.st +++ b/src/Debugger-Tests/StepIntoTest.class.st @@ -1,7 +1,7 @@ Class { #name : #StepIntoTest, #superclass : #DebuggerTest, - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #helper } diff --git a/src/Debugger-Tests/StepOverTest.class.st b/src/Debugger-Tests/StepOverTest.class.st index f70f490ddea..db81adb0b71 100644 --- a/src/Debugger-Tests/StepOverTest.class.st +++ b/src/Debugger-Tests/StepOverTest.class.st @@ -1,7 +1,7 @@ Class { #name : #StepOverTest, #superclass : #DebuggerTest, - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #helper } diff --git a/src/Debugger-Tests/StepThroughTest.class.st b/src/Debugger-Tests/StepThroughTest.class.st index 4b426401f73..b7cce7c6dd8 100644 --- a/src/Debugger-Tests/StepThroughTest.class.st +++ b/src/Debugger-Tests/StepThroughTest.class.st @@ -4,7 +4,7 @@ Class { #instVars : [ 'assistant' ], - #category : #'Debugger-Tests' + #category : #'Debugger-Tests-Base' } { #category : #helper } diff --git a/src/NECompletion/CompletionEngine.class.st b/src/NECompletion/CompletionEngine.class.st index 00f2329a814..f67151e331c 100644 --- a/src/NECompletion/CompletionEngine.class.st +++ b/src/NECompletion/CompletionEngine.class.st @@ -235,12 +235,14 @@ CompletionEngine >> newSmartCharacterInsertionStringForLeft: left right: right [ { #category : #'menu morph' } CompletionEngine >> openMenu [ - | theMenu | + | theMenu class | self stopCompletionDelay. + class := editor model ifNotNil: [ :model | model selectedClassOrMetaClass ]. + context := self contextClass engine: self - class: editor model selectedClassOrMetaClass + class: class source: editor text string position: editor caret - 1. diff --git a/src/NECompletion/NECSpecialVariableEntry.class.st b/src/NECompletion/NECSpecialVariableEntry.class.st index f572cbbd6dc..ea190b6bffb 100644 --- a/src/NECompletion/NECSpecialVariableEntry.class.st +++ b/src/NECompletion/NECSpecialVariableEntry.class.st @@ -1,5 +1,5 @@ " -I represent self, super and thisContext. +I represent self, super and thisContext and in addion true, false, nil " Class { #name : #NECSpecialVariableEntry, diff --git a/src/NECompletion/RBVariableNode.extension.st b/src/NECompletion/RBVariableNode.extension.st index 39782c05475..249b9f5029b 100644 --- a/src/NECompletion/RBVariableNode.extension.st +++ b/src/NECompletion/RBVariableNode.extension.st @@ -41,7 +41,7 @@ RBVariableNode >> completionToken: offset [ { #category : #'*NECompletion' } RBVariableNode >> entriesSpecialVariables [ - ^ #('self' 'super' 'thisContext' ) + ^ #('self' 'super' 'thisContext' 'nil' 'false' 'true') select: [ :each | each beginsWith: self name ] thenCollect: [ :each | NECSpecialVariableEntry contents: each node: self ] ] diff --git a/src/Reflectivity-Tools/MetaLinkIconStyler.class.st b/src/Reflectivity-Tools/MetaLinkIconStyler.class.st new file mode 100644 index 00000000000..6962ee19724 --- /dev/null +++ b/src/Reflectivity-Tools/MetaLinkIconStyler.class.st @@ -0,0 +1,38 @@ +" +I'm in charge to style an ast when there are metalink in the ast +" +Class { + #name : #MetaLinkIconStyler, + #superclass : #IconStyler, + #category : #'Reflectivity-Tools-Breakpoints' +} + +{ #category : #defaults } +MetaLinkIconStyler >> highlightColor [ + ^(Color orange alpha: 0.1) +] + +{ #category : #defaults } +MetaLinkIconStyler >> iconBlock: aNode [ + ^ [ aNode links inspect ] +] + +{ #category : #defaults } +MetaLinkIconStyler >> iconFor: aNode [ + ^ self iconNamed: #smallDebugIcon +] + +{ #category : #defaults } +MetaLinkIconStyler >> iconLabel: aNode [ + ^ 'Metalinks...' +] + +{ #category : #testing } +MetaLinkIconStyler >> shouldStyleNode: aNode [ + ^ aNode hasLinks and: [ + aNode links anySatisfy: [ :link | + (link metaObject == Break or: [ + { + Watchpoint. + ExecutionCounter } includes: link metaObject class ]) not ] ] +] diff --git a/src/Reflectivity/MetaLink.class.st b/src/Reflectivity/MetaLink.class.st index ccafbbd6499..3bf78a0497f 100644 --- a/src/Reflectivity/MetaLink.class.st +++ b/src/Reflectivity/MetaLink.class.st @@ -477,16 +477,29 @@ MetaLink >> permaLinkFor: aClassOrObject option: option instanceSpecific: instan ^ permaLink ] -{ #category : #'link api' } +{ #category : #printing } MetaLink >> printString [ - |ws| + | ws keywords | ws := WriteStream on: String new. - ws nextPutAll: (self control ifNil:['']). + ws nextPutAll: 'Link'. + ws space. + ws nextPutAll: (self control ifNil: [ '' ]). ws space. ws nextPutAll: metaObject printString. ws space. - ws nextPutAll: selector asString. - ^ws contents + selector isKeyword ifFalse: [ + ws nextPutAll: selector asString. + ^ ws contents ]. + keywords := selector separateKeywords splitOn: ' '. + (arguments isEmpty or: [ keywords size ~= arguments size ]) ifTrue: [ + ws nextPutAll: 'Error: wrong number of arguments'. + ^ ws contents ]. + keywords with: arguments do: [ :keyword :argument | + ws nextPutAll: keyword. + ws space. + ws nextPutAll: argument printString. + ws space ]. + ^ ws contents ] { #category : #private } diff --git a/src/Renraku-Help/RenrakuCritiqueDesignHelp.class.st b/src/Renraku-Help/RenrakuCritiqueDesignHelp.class.st index b48c7a785c6..0c11ca3020c 100644 --- a/src/Renraku-Help/RenrakuCritiqueDesignHelp.class.st +++ b/src/Renraku-Help/RenrakuCritiqueDesignHelp.class.st @@ -66,7 +66,9 @@ RenrakuCritiqueDesignHelp class >> hierarchy [ ^ HelpTopic title: 'Class Hierarchy' contents: -'ReAbstractCritique is the root of the critiques hierarchy.' +'ReAbstractCritique is the root of the critiques hierarchy. + +ReAbstractCritique inherits from ReProperty which represents an external property of some entity related to a piece of code. It defines a basic interface of a title an and an icon that can be used to display it in a user interface. It also has a source anchor pointing the piece of code.' ] { #category : #accessing } diff --git a/src/Renraku/ManifestRenraku.class.st b/src/Renraku/ManifestRenraku.class.st index b2a41dc1414..2f320a5c7cf 100644 --- a/src/Renraku/ManifestRenraku.class.st +++ b/src/Renraku/ManifestRenraku.class.st @@ -1,3 +1,15 @@ +" +Renraku is a framework for defining and processing quality rules. The framework operates with three main concepts: entities, rules and critiques. + +!! Entities +Entities are not a part of Renraku, but Renraku is validating entities. Theoretically entity can be any object, but in practice we mostly focus on code entities such as methods, classes, packages, AST nodes. + +!! Rules +Rules are the objects that describe constraints about entities. A rule can check an entity and produce critiques that describe the violations of the entity according to the rule. + +!! Critiques +Critique is an object that binds an entity with a rule that is violated by that entity. The critique describes a specific violation, and may provide a solutions to fix it. +" Class { #name : #ManifestRenraku, #superclass : #PackageManifest, diff --git a/src/Renraku/ReAbstractCritique.class.st b/src/Renraku/ReAbstractCritique.class.st index 93bbef08ba2..035fb877bd3 100644 --- a/src/Renraku/ReAbstractCritique.class.st +++ b/src/Renraku/ReAbstractCritique.class.st @@ -1,7 +1,21 @@ " -I am an abstract critic class. +I am an abstract critique class. -My subclasses should define whether they provide a selection interval, or refactory change +A critique links a quality rule to a source code target. It is the main unit that should be used to provide information to the user. + +I specialize the ReProperty class by extracting information from the rule that reported the violation. +The #title is extracted from the rule's #name, the #icon based on the rule's #severity and a #description is provided based on the rule's #rationale. + +A critique has the #providesChange method which returns a boolean value specifying whether the critique can provide a change which will resolve the issue. The #change method can be used to obtain an object of RBRefactoryChange kind. + +The reference to the critized entity is established through ReSourceAnchor. +A critique has a reference to the criticized entity. + +This link is established through ReSourceAnchor. A source anchor has a reference to the actual class, method, or other entity that is criticized. An anchor also has a #providesInterval method that returns a boolean indicating if the anchor provides a selection interval to the actual source of the critique. The interval can be accessed through the #interval method. + +There are two subclasses of ReSourceAnchor. +ReIntervalSourceAnchor stores the actual interval object which is set during initialization. +ReSearchStringSourceAnchor stores a searchString which will be searched for in the entities source code on demand to find an interval of substring " Class { #name : #ReAbstractCritique, diff --git a/src/Renraku/ReAbstractRule.class.st b/src/Renraku/ReAbstractRule.class.st index fcd78013664..7faa3bee9d1 100644 --- a/src/Renraku/ReAbstractRule.class.st +++ b/src/Renraku/ReAbstractRule.class.st @@ -1,7 +1,32 @@ " -I an the root of all quality rules rules. +I am the root of all quality rules rules. -If you want to learn about the features of rules or how to create your own, please read: +Each rule should provide a short name string returned from the #name method. You also have to override the #rationale method to return a detailed description about the rule. You may also put the rationale in the class comment, as by default #rationale method returns the comment of the rule's class. + +The class-side methods #checksMethod, #checksClass, #checksPackage and #checksNode return true if the rule checks methods, classes or traits, packages and AST nodes respectively. Tools will pass entities of the specified type to the rule for checking. + +To check the rule, while there is a default implementation which relies on #basicCheck: and creates an instance of ReTrivialCritique, it is advised to override the #check:forCritiquesDo: method. + +It's a good idea to assign your rule to a specific group. For this override the #group method and return string with the name of the group. While you can use any name you want, maybe you would like to put your rule into one of the existing groups: API Change, API Hints, Architectural, Bugs, Coding Idiom Violation, Design Flaws, Optimization, Potential Bugs, Rubric, SUnit, Style, Unclassified rules. + +You can also specify the severity of your rue by returning one of: #information, #warning, or #error symbols from the #severity method. + + + +It is fairly easy to run your rule and obtain the results. Just create an instance of it an send it the #check: message with the entity you want to check. The result is a collection of critiques. For example inspecting + + RBExcessiveMethodsRule new check: Object + +should give you a collection with one critique (because the Object class always has many methods ;) ). Go on click on the critique item and inspect it. You will see that there is a special ""description"" tab. This is the power of critique objects, they can present themselves in a different way. Guess what: you can even visualize the critique if needed. + + +To have quality assistant (and maybe other tools) pick up your changes you have to reset the cache. Do this by going to System > Settings > Code Browsing > QualityAssistant > Renraku > Rule Cache +and pressing the reset button. Or simply executing ReRuleManager reset + + +When you load complete rules into the system, the cache will be reset automatically. But as you are creating a new rule and it is in the incomplete state you have to reset the cache once you are ready. + +If you want to learn more about the features of rules or how to create your own, please read: RenrakuRuleHelp readInHelpBrowser " @@ -125,7 +150,6 @@ ReAbstractRule >> basicCheck: anEntity [ ReAbstractRule >> check: anEntity [ | critiques | - critiques := OrderedCollection new. self check: anEntity forCritiquesDo: [ :critique | critiques add: critique ]. ^ critiques @@ -133,7 +157,8 @@ ReAbstractRule >> check: anEntity [ { #category : #running } ReAbstractRule >> check: anEntity forCritiquesDo: aCriticBlock [ - + "Accepts an entity and a block which could be evaluated for each detected critique + aCriticBlock may accept one argument: the critique object" (self basicCheck: anEntity) ifTrue: [ aCriticBlock cull: (self critiqueFor: anEntity) ] ] diff --git a/src/Renraku/ReCriticEngine.class.st b/src/Renraku/ReCriticEngine.class.st index 67a087bb78c..e45419415db 100644 --- a/src/Renraku/ReCriticEngine.class.st +++ b/src/Renraku/ReCriticEngine.class.st @@ -1,4 +1,10 @@ " +I keep information about the critiques that exist on certain entities. +I'm invoked usually as follows: + + Point critiques + (Point >> #degrees) critiques + I contain some functionality shared between code entities " Class { diff --git a/src/Renraku/ReProperty.class.st b/src/Renraku/ReProperty.class.st index bbd0ef98738..1547b612a7d 100644 --- a/src/Renraku/ReProperty.class.st +++ b/src/Renraku/ReProperty.class.st @@ -1,5 +1,8 @@ " -I'm an external property of some entity. I have a source anchor to it… +I'm an external property of some entity related to a piece of code. + +I define a basic interface of a #title and an #icon that can be used to display it in a user interface +I also have a source anchor with a reference to the actual class, method, or other source code entity that I am related to. " Class { #name : #ReProperty, diff --git a/src/Renraku/ReSourceAnchor.class.st b/src/Renraku/ReSourceAnchor.class.st index 8572cd8cb2e..7fcf5acd4ff 100644 --- a/src/Renraku/ReSourceAnchor.class.st +++ b/src/Renraku/ReSourceAnchor.class.st @@ -1,5 +1,5 @@ " -A source anchor has a refference to the actual class, method, or other entity that is criticized. An anchor also has a #providesInterval method that returns a boolean indicating if the anchor provides a selection interval to the actual source of the critique. The interval can be accessed through the #interval method +A source anchor has a refference to the actual class, method, or other entity that is criticized. An anchor also has a #providesInterval method that returns a boolean indicating if the anchor provides a selection interval to the actual source of the critique. The interval can be accessed through the #interval method. " Class { #name : #ReSourceAnchor, diff --git a/src/Ring-Core/ClassVariable.extension.st b/src/Ring-Core/ClassVariable.extension.st index ff8b55e4398..6985aca8c58 100644 --- a/src/Ring-Core/ClassVariable.extension.st +++ b/src/Ring-Core/ClassVariable.extension.st @@ -5,7 +5,7 @@ ClassVariable >> asRingMinimalDefinitionIn: anRGEnvironment [ ^ anRGEnvironment backend definitionFor: self ifAbsentRegister: [ | def realClass | - realClass := Smalltalk allClasses detect: [ :each | each classVariables includes: self ]. + realClass := Smalltalk globals allClasses detect: [ :each | each classVariables includes: self ]. def := RGClassVariable named: self key asSymbol parent: (realClass asRingMinimalDefinitionIn: anRGEnvironment). def ]. ] diff --git a/src/SystemCommands-SourceCodeCommands/SycDebuggingMenuActivation.class.st b/src/SystemCommands-SourceCodeCommands/SycDebuggingMenuActivation.class.st new file mode 100644 index 00000000000..432e6a4126a --- /dev/null +++ b/src/SystemCommands-SourceCodeCommands/SycDebuggingMenuActivation.class.st @@ -0,0 +1,8 @@ +" +I represent an activation of debugging commands using a separate debugging menu. +" +Class { + #name : #SycDebuggingMenuActivation, + #superclass : #CmdMenuCommandActivationStrategy, + #category : #'SystemCommands-SourceCodeCommands' +} diff --git a/src/SystemCommands-SourceCodeCommands/SycOpenDebuggingMenuCommand.class.st b/src/SystemCommands-SourceCodeCommands/SycOpenDebuggingMenuCommand.class.st new file mode 100644 index 00000000000..09466de2ddd --- /dev/null +++ b/src/SystemCommands-SourceCodeCommands/SycOpenDebuggingMenuCommand.class.st @@ -0,0 +1,24 @@ +" +I am a command to open the debugging menu after a right click on the source code. +I show in the menu all commands annotated by SycDebuggingMenuActivation +" +Class { + #name : #SycOpenDebuggingMenuCommand, + #superclass : #SycOpenSourceCodeMenuCommand, + #category : #'SystemCommands-SourceCodeCommands' +} + +{ #category : #execution } +SycOpenDebuggingMenuCommand >> activationStrategy [ + ^SycDebuggingMenuActivation +] + +{ #category : #accessing } +SycOpenDebuggingMenuCommand >> defaultMenuIconName [ + ^#smallDebugIcon +] + +{ #category : #accessing } +SycOpenDebuggingMenuCommand >> defaultMenuItemName [ + ^'Debugging' +]