From f7775c964aebf1521f62c073f4f1d8667e461605 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Tue, 4 Feb 2025 18:36:09 +0100 Subject: [PATCH] Clean up + better name --- .../MolComponentImpl.extension.st | 67 +---- .../MolComponentToRoassal.class.st | 276 ++++++++---------- src/Molecule-IDE/MolHomeServices.extension.st | 22 +- src/Molecule-IDE/MolRSContractModel.class.st | 33 ++- .../MolRSContractModelSource.class.st | 6 - .../MolRSContractModelTarget.class.st | 7 +- 6 files changed, 173 insertions(+), 238 deletions(-) diff --git a/src/Molecule-IDE/MolComponentImpl.extension.st b/src/Molecule-IDE/MolComponentImpl.extension.st index 311f3ae..71cf0d9 100644 --- a/src/Molecule-IDE/MolComponentImpl.extension.st +++ b/src/Molecule-IDE/MolComponentImpl.extension.st @@ -1,54 +1,5 @@ Extension { #name : #MolComponentImpl } -{ #category : #'*Molecule-IDE' } -MolComponentImpl >> allComponentClients [ - - | clients allComponents | - clients := Set new. - allComponents := MolComponentManager default homeServices - deployedComponents flatCollect: #values. - ^ allComponents select: [ :each | - each allComponentProviders includes: self ] -] - -{ #category : #'*Molecule-IDE' } -MolComponentImpl >> allComponentProviders [ - - | providers locatorServices | - providers := Set new. - locatorServices := MolComponentManager default locatorServices. - self servicesProviders keysAndValuesDo: [ :key :value | - providers add: - (locatorServices searchServicesProviderFor: key named: value) ]. - self parametersProviders keysAndValuesDo: [ :key :value | - providers add: - (locatorServices searchParametersProviderFor: key named: value) ]. - self eventsSubscribers keysAndValuesDo: [ :key :value | - providers addAll: - (locatorServices searchEventsSubscriberFor: key named: value) - originators ]. - ^ providers asArray -] - -{ #category : #'*Molecule-IDE' } -MolComponentImpl >> allComponentProvidersRecursive [ - - | accumulator | - accumulator := Set new. - self allComponentProvidersRecursiveWithAccumulator: accumulator. - ^ (accumulator reject: [ :each | each = self ]) asArray -] - -{ #category : #'*Molecule-IDE' } -MolComponentImpl >> allComponentProvidersRecursiveWithAccumulator: anAccumulator [ - - | providers | - anAccumulator add: self. - providers := self allComponentProviders. - (providers difference: anAccumulator) do: [ :each | - each allComponentProvidersRecursiveWithAccumulator: anAccumulator ] -] - { #category : #'*Molecule-IDE' } MolComponentImpl >> asRSMoleculeShape [ @@ -65,7 +16,7 @@ MolComponentImpl >> asRSMoleculeShape [ fontSize: 18; yourself. - contracts := MolComponentToRoassal contractFromMolComponentImpl: self. + contracts := MolComponentToRoassal makeContractShapesFor: self. RSVerticalLineLayout new alignCenter; @@ -88,11 +39,17 @@ MolComponentImpl >> asRSMoleculeShape [ composite adjustToChildren. composite extent: composite extent + (0 @ 20). composite @ (RSMenuActivable new menuDo: [ :aMenuMorph :anRSBox | - aMenuMorph - add: 'Inspect' - target: self - selector: #inspect - argument: #( ) ]). + (aMenuMorph + add: 'Inspect component' + target: self + selector: #inspect + argument: #( )) icon: + (Smalltalk ui icons iconNamed: #smallInspectIt). + (aMenuMorph + add: 'Browse component' + target: self + selector: #browse + argument: #( )) icon: (Smalltalk ui icons iconNamed: #nautilus) ]). ^ composite ] diff --git a/src/Molecule-IDE/MolComponentToRoassal.class.st b/src/Molecule-IDE/MolComponentToRoassal.class.st index 019df93..725d076 100644 --- a/src/Molecule-IDE/MolComponentToRoassal.class.st +++ b/src/Molecule-IDE/MolComponentToRoassal.class.st @@ -11,50 +11,24 @@ Class { #category : #'Molecule-IDE-Inspectors' } -{ #category : #'as yet unclassified' } +{ #category : #resources } MolComponentToRoassal class >> activateLogoOf: aRSBox [ (aRSBox propertyAt: #activateLogo) value ] -{ #category : #adding } -MolComponentToRoassal class >> addBreakpointOnceOnInstance: anInstance withSelector: aSelector [ - - | bp ast | - bp := Breakpoint new. - ast := (anInstance class methodNamed: aSelector) ast. - - bp node: ast. - bp scopeTo: anInstance. - bp once: true. - bp install -] - -{ #category : #adding } -MolComponentToRoassal class >> addBreakpointOnceOnInstanceWithSelector: anArray [ - - self addBreakpointOnceOnInstance: anArray first withSelector: anArray second -] - -{ #category : #adding } -MolComponentToRoassal class >> addBreakpointOnceOnModelWithSelector: anArray [ - - self - addBreakpointOnceOnModel: anArray first - withSelector: anArray second -] - { #category : #model } MolComponentToRoassal class >> associationsAllConsumedEventsAndTargetsFor: aMolComponent [ - ^ aMolComponent componentConnector ifNotNil: [ :connector | connector eventsSubscribers associations - collect: [ :asso | - MolRSContractModelTarget new - eventClass: asso key; - name: asso value; - component: aMolComponent; - yourself ] ]. - ^ { } + ^ aMolComponent componentConnector + ifNotNil: [ :connector | + connector eventsSubscribers associations collect: [ :asso | + MolRSContractModelTarget new + eventClass: asso key; + name: asso value; + component: aMolComponent; + yourself ] ] + ifNil: [ { } ] ] { #category : #model } @@ -93,25 +67,29 @@ MolComponentToRoassal class >> associationsAllProvidedServicesAndTargetsFor: aMo { #category : #model } MolComponentToRoassal class >> associationsAllUsedParametersAndTargetsFor: aMolComponent [ - ^ aMolComponent componentConnector parametersProviders associations - collect: [ :asso | - MolRSContractModelTarget new - eventClass: asso key; - name: asso value; - component: aMolComponent; - yourself ] + ^ aMolComponent componentConnector + ifNotNil: [ :connector | + connector parametersProviders associations collect: [ :asso | + MolRSContractModelTarget new + eventClass: asso key; + name: asso value; + component: aMolComponent; + yourself ] ] + ifNil: [ { } ] ] { #category : #model } MolComponentToRoassal class >> associationsAllUsedServicesAndTargetsFor: aMolComponent [ - ^ aMolComponent componentConnector servicesProviders associations - collect: [ :asso | - MolRSContractModelTarget new - eventClass: asso key; - name: asso value; - component: aMolComponent; - yourself ] + ^ aMolComponent componentConnector + ifNotNil: [ :connector | + connector servicesProviders associations collect: [ :asso | + MolRSContractModelTarget new + eventClass: asso key; + name: asso value; + component: aMolComponent; + yourself ] ] + ifNil: [ { } ] ] { #category : #'instance creation' } @@ -205,7 +183,7 @@ MolComponentToRoassal class >> canvasFromSingleComponent: aMolComponent [ ^ canvas ] -{ #category : #'as yet unclassified' } +{ #category : #color } MolComponentToRoassal class >> contractColorFor: aMolRSContractModel [ (aMolRSContractModel eventClass includesTrait: MolComponentEvents) @@ -215,50 +193,7 @@ MolComponentToRoassal class >> contractColorFor: aMolRSContractModel [ ^ self parameterColor ] -{ #category : #'instance creation' } -MolComponentToRoassal class >> contractFromMolComponentImpl: aMolComponent [ - - | contractsAll contractsIn contractsOut model | - contractsIn := self contractsInFor: aMolComponent. - contractsOut := self contractsOutFor: aMolComponent. - - model := contractsIn model asOrderedCollection - , contractsOut model asOrderedCollection. - - (contractsIn children isEmpty and: [ - contractsOut children isNotEmpty ]) ifTrue: [ - contractsIn - add: (RSBox new - extent: contractsOut extent; - color: Color transparent; - model: aMolComponent; - yourself); - adjustToChildren ]. - (contractsOut children isEmpty and: [ - contractsIn children isNotEmpty ]) ifTrue: [ - contractsOut - add: (RSBox new - extent: contractsIn extent; - color: Color transparent; - model: aMolComponent; - yourself); - adjustToChildren ]. - - contractsAll := RSComposite new - shapes: { - contractsIn. - contractsOut }; - yourself. - contractsAll model: model. - - RSHorizontalLineLayout new - alignTop; - on: contractsAll shapes. - contractsAll adjustToChildren. - ^ contractsAll -] - -{ #category : #'as yet unclassified' } +{ #category : #resources } MolComponentToRoassal class >> contractLogoFor: aMolRSContractModel [ (aMolRSContractModel eventClass includesTrait: MolComponentEvents) @@ -268,19 +203,47 @@ MolComponentToRoassal class >> contractLogoFor: aMolRSContractModel [ ^ self parameterLogo ] +{ #category : #color } +MolComponentToRoassal class >> eventColor [ + + ^ Color blue muchLighter +] + +{ #category : #resources } +MolComponentToRoassal class >> eventLogo [ + + | rsLogoIn rsLogoOut | + rsLogoIn := RSPieSlice new + withBorder; + externalRadius: 12; + innerRadius: 9; + alphaAngle: -90; + betaAngle: 90; + color: self eventColor; + yourself. + rsLogoOut := RSCircle new + withBorder; + color: self eventColor; + size: 10 asPoint; + yourself. + ^ RSComposite new shapes: { + rsLogoIn. + rsLogoOut } +] + { #category : #'instance creation' } -MolComponentToRoassal class >> contractsInFor: aMolComponent [ +MolComponentToRoassal class >> makeContractConsumerShapesFor: aMolComponent [ | connectors services events parameters | services := (self associationsAllUsedServicesAndTargetsFor: aMolComponent) sorted collect: [ :each | - self makeContractShapeFor: each ]. + self makeSingleContractShapeFor: each ]. events := (self associationsAllConsumedEventsAndTargetsFor: aMolComponent) sorted collect: [ :each | - self makeContractShapeFor: each ]. + self makeSingleContractShapeFor: each ]. parameters := (self associationsAllUsedParametersAndTargetsFor: aMolComponent) sorted collect: [ :each | - self makeContractShapeFor: each ]. + self makeSingleContractShapeFor: each ]. connectors := RSComposite new shapes: events , services , parameters; @@ -296,19 +259,19 @@ MolComponentToRoassal class >> contractsInFor: aMolComponent [ ] { #category : #'instance creation' } -MolComponentToRoassal class >> contractsOutFor: aMolComponent [ +MolComponentToRoassal class >> makeContractProviderShapesFor: aMolComponent [ | connectors events services parameters | services := (self associationsAllProvidedServicesAndTargetsFor: aMolComponent) sorted collect: [ :each | - self makeContractShapeFor: each ]. + self makeSingleContractShapeFor: each ]. events := (self associationsAllProducedEventsAndTargetsFor: aMolComponent) sorted collect: [ :each | - self makeContractShapeFor: each ]. + self makeSingleContractShapeFor: each ]. parameters := (self associationsAllProvidedParametersAndTargetsFor: aMolComponent) sorted collect: [ :each | - self makeContractShapeFor: each ]. + self makeSingleContractShapeFor: each ]. connectors := RSComposite new shapes: events , services , parameters; @@ -323,36 +286,51 @@ MolComponentToRoassal class >> contractsOutFor: aMolComponent [ ^ connectors ] -{ #category : #color } -MolComponentToRoassal class >> eventColor [ +{ #category : #'instance creation' } +MolComponentToRoassal class >> makeContractShapesFor: aMolComponent [ - ^ Color blue muchLighter -] + | contractsAll contractsIn contractsOut model | + contractsIn := self makeContractConsumerShapesFor: aMolComponent. + contractsOut := self makeContractProviderShapesFor: aMolComponent. -{ #category : #resources } -MolComponentToRoassal class >> eventLogo [ + model := contractsIn model asOrderedCollection + , contractsOut model asOrderedCollection. - | rsLogoIn rsLogoOut | - rsLogoIn := RSPieSlice new - withBorder; - externalRadius: 12; - innerRadius: 9; - alphaAngle: -90; - betaAngle: 90; - color: self eventColor; - yourself. - rsLogoOut := RSCircle new - withBorder; - color: self eventColor; - size: 10 asPoint; - yourself. - ^ RSComposite new shapes: { - rsLogoIn. - rsLogoOut } + (contractsIn children isEmpty and: [ + contractsOut children isNotEmpty ]) ifTrue: [ + contractsIn + add: (RSBox new + extent: contractsOut extent; + color: Color transparent; + model: aMolComponent; + yourself); + adjustToChildren ]. + (contractsOut children isEmpty and: [ + contractsIn children isNotEmpty ]) ifTrue: [ + contractsOut + add: (RSBox new + extent: contractsIn extent; + color: Color transparent; + model: aMolComponent; + yourself); + adjustToChildren ]. + + contractsAll := RSComposite new + shapes: { + contractsIn. + contractsOut }; + yourself. + contractsAll model: model. + + RSHorizontalLineLayout new + alignTop; + on: contractsAll shapes. + contractsAll adjustToChildren. + ^ contractsAll ] -{ #category : #'as yet unclassified' } -MolComponentToRoassal class >> makeContractShapeFor: aMolRSContractModel [ +{ #category : #'instance creation' } +MolComponentToRoassal class >> makeSingleContractShapeFor: aMolRSContractModel [ | linkBox eventBox eventName logo composite color | eventName := RSLabel new @@ -365,7 +343,6 @@ MolComponentToRoassal class >> makeContractShapeFor: aMolRSContractModel [ withBorder; color: color; extent: eventName extent + 10; - cornerRadius: aMolRSContractModel rsCornerRadius; yourself. logo := self contractLogoFor: aMolRSContractModel. @@ -384,20 +361,18 @@ MolComponentToRoassal class >> makeContractShapeFor: aMolRSContractModel [ aMolRSContractModel isContractSource ifTrue: [ + eventBox cornerRadius: (RSCornerRadius new left: 10). + linkBox position: eventBox extent x / 2 @ 0. logo nodes first color: Color transparent; - border: nil ] - ifFalse: [ - logo nodes second - color: Color transparent; - border: nil ]. - - aMolRSContractModel isContractSource - ifTrue: [ - linkBox position: eventBox extent x / 2 @ 0. + border: nil. logo position: eventBox extent x / -2 - 16 @ 0 ] ifFalse: [ + eventBox cornerRadius: (RSCornerRadius new right: 10). linkBox position: eventBox extent x / -2 @ 0. + logo nodes second + color: Color transparent; + border: nil. logo position: eventBox extent x / 2 + 16 @ 0 ]. composite := RSComposite new @@ -410,18 +385,23 @@ MolComponentToRoassal class >> makeContractShapeFor: aMolRSContractModel [ model: aMolRSContractModel eventClass; yourself. composite @ (RSMenuActivable new menuDo: [ :aMenuMorph :anRSBox | - aMenuMorph - add: 'Inspect Contract' - target: aMolRSContractModel - selector: #inspect - argument: #( ). + | separator | + separator := false. + (aMenuMorph + add: 'Browse Trait' + target: aMolRSContractModel eventClass + selector: #browse + argument: #( )) icon: (Smalltalk ui icons iconNamed: #nautilus). aMolRSContractModel eventClass selectors do: [ :selector | (aMolRSContractModel canBreakOn: selector) ifTrue: [ - aMenuMorph - add: 'Break on #' , selector - target: aMolRSContractModel - selector: #breakOnceOnSelector: - argument: selector ] ] ]). + separator ifFalse: [ + separator := true. + aMenuMorph addSeparator ]. + (aMenuMorph + add: 'Halt once on #' , selector + target: aMolRSContractModel + selector: #breakOnceOnSelector: + argument: selector) icon: (Smalltalk ui icons iconNamed: #halt) ] ] ]). ^ composite ] diff --git a/src/Molecule-IDE/MolHomeServices.extension.st b/src/Molecule-IDE/MolHomeServices.extension.st index a8f3b15..87c5386 100644 --- a/src/Molecule-IDE/MolHomeServices.extension.st +++ b/src/Molecule-IDE/MolHomeServices.extension.st @@ -1,24 +1,26 @@ Extension { #name : #MolHomeServices } { #category : #'*Molecule-IDE' } -MolHomeServices >> detachCanvas [ - | components canvas | +MolHomeServices >> inspectionDeployedComponentsGraph [ + + + | canvas components | components := self deployedComponents flatCollect: #values. canvas := MolComponentToRoassal canvasFromMultipleComponents: components. - ^ canvas open + ^ SpRoassalInspectorPresenter new + canvas: canvas; + yourself ] { #category : #'*Molecule-IDE' } -MolHomeServices >> inspectionDeployedComponentsGraph [ +MolHomeServices >> openRoassalView [ - - | canvas components | + | components canvas | components := self deployedComponents flatCollect: #values. - canvas := MolComponentToRoassal canvasFromMultipleComponents: components. + canvas := MolComponentToRoassal canvasFromMultipleComponents: + components. - ^ SpRoassalInspectorPresenter new - canvas: canvas; - yourself + ^ canvas openWithTitle: 'MolHomeService' ] diff --git a/src/Molecule-IDE/MolRSContractModel.class.st b/src/Molecule-IDE/MolRSContractModel.class.st index aa48da3..9f6c097 100644 --- a/src/Molecule-IDE/MolRSContractModel.class.st +++ b/src/Molecule-IDE/MolRSContractModel.class.st @@ -20,22 +20,29 @@ Class { #category : #'Molecule-IDE-Inspectors' } +{ #category : #testing } +MolRSContractModel class >> isAbstract [ + + ^ self == MolRSContractModel +] + { #category : #comparing } MolRSContractModel >> <= aMolRSContractModel [ ^ self eventClass name < aMolRSContractModel eventClass name ] -{ #category : #'as yet unclassified' } +{ #category : #debug } MolRSContractModel >> breakOnceOnSelector: aSelector [ - | bp ast | - bp := Breakpoint new. - ast := (self component class methodNamed: aSelector) ast. - - bp node: ast. - bp scopeTo: self component. - bp once: true. - bp install + + (self component breakOnceOnCallTo: aSelector) + +] + +{ #category : #debug } +MolRSContractModel >> canBreakOn: aString [ + + ^ self explicitRequirement ] { #category : #accessing } @@ -65,7 +72,7 @@ MolRSContractModel >> eventClass: anObject [ { #category : #testing } MolRSContractModel >> isContractSource [ - ^ false + ^ self explicitRequirement ] { #category : #accessing } @@ -79,9 +86,3 @@ MolRSContractModel >> name: anObject [ name := anObject ] - -{ #category : #'as yet unclassified' } -MolRSContractModel >> rsCornerRadius [ - - ^ self shouldBeImplemented -] diff --git a/src/Molecule-IDE/MolRSContractModelSource.class.st b/src/Molecule-IDE/MolRSContractModelSource.class.st index dca646f..8e88907 100644 --- a/src/Molecule-IDE/MolRSContractModelSource.class.st +++ b/src/Molecule-IDE/MolRSContractModelSource.class.st @@ -19,9 +19,3 @@ MolRSContractModelSource >> isContractSource [ ^ true ] - -{ #category : #'as yet unclassified' } -MolRSContractModelSource >> rsCornerRadius [ - - ^ RSCornerRadius new left: 10 -] diff --git a/src/Molecule-IDE/MolRSContractModelTarget.class.st b/src/Molecule-IDE/MolRSContractModelTarget.class.st index 9bc4b99..5bdead7 100644 --- a/src/Molecule-IDE/MolRSContractModelTarget.class.st +++ b/src/Molecule-IDE/MolRSContractModelTarget.class.st @@ -13,7 +13,8 @@ MolRSContractModelTarget >> canBreakOn: aString [ ] -{ #category : #'as yet unclassified' } -MolRSContractModelTarget >> rsCornerRadius [ - ^ RSCornerRadius new right: 10 +{ #category : #testing } +MolRSContractModelTarget >> isContractSource [ + + ^ false ]