From 33b4750b405572a9a0fd004365bcff56b3bf28d9 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Tue, 4 Feb 2025 16:36:52 +0100 Subject: [PATCH 1/4] Add better inspector --- .../MolMyClockSystem.class.st | 63 +++--- .../MolComponentImpl.extension.st | 49 ++++ .../MolComponentToRoassal.class.st | 214 ++++++++++++------ src/Molecule-IDE/MolHomeServices.extension.st | 10 + src/Molecule-IDE/MolRSContractModel.class.st | 29 --- 5 files changed, 234 insertions(+), 131 deletions(-) diff --git a/src/Molecule-Examples/MolMyClockSystem.class.st b/src/Molecule-Examples/MolMyClockSystem.class.st index ddbdf531..00556cf4 100644 --- a/src/Molecule-Examples/MolMyClockSystem.class.st +++ b/src/Molecule-Examples/MolMyClockSystem.class.st @@ -29,60 +29,69 @@ MolMyClockSystem class >> start [ | cm | cm := MolComponentManager default. self deploy. - - cm homeServices instanciateComponent: MolMyServerTimeComponentImpl. - cm homeServices instanciateComponent: MolMyClockComponentImpl. - cm homeServices instanciateComponent: MolMyUserFacadeComponentImpl. - cm homeServices instanciateComponent: MolMyAlarmComponentImpl. - + + cm homeServices instantiateComponent: MolMyServerTimeComponentImpl. + cm homeServices instantiateComponent: MolMyClockComponentImpl. + cm homeServices instantiateComponent: MolMyUserFacadeComponentImpl. + cm homeServices instantiateComponent: MolMyAlarmComponentImpl. + cm homeServices activateComponent: MolMyServerTimeComponentImpl. cm homeServices activateComponent: MolMyClockComponentImpl. cm homeServices activateComponent: MolMyUserFacadeComponentImpl. - cm homeServices activateComponent: MolMyAlarmComponentImpl. + cm homeServices activateComponent: MolMyAlarmComponentImpl ] { #category : #launcher } MolMyClockSystem class >> startAlarmExample [ "Start Clock System example : simulate a clock alarm for sleeping !" + | now alarm alarmParameters alarmActivationServices isLogActive | - "Activate the Molecule log for display results" isLogActive := MolUtils isLogActive. - isLogActive ifFalse:[MolUtils toggleLog]. - + isLogActive ifFalse: [ MolUtils toggleLog ]. + "Dialog to inform user to open a Transcript to see results" - (UIManager default confirm: 'This example displays results in a transcript and stop after 10 seconds. + (UIManager default + confirm: + 'This example displays results in a transcript and stop after 10 seconds. Do you want to open a transcript window ?' - label: 'Molecule - Clock System Example') ifTrue:[Transcript open]. - + label: 'Molecule - Clock System Example') ifTrue: [ + Transcript open ]. + "Clean up the Component Manager in case of previous example running" MolComponentManager cleanUp. - + "Start the system" self start. - + "Configure an alarm in 5 seconds" now := Time now. - alarm := Time hour: now hour minute: now minute second: now second + 5. - + alarm := Time + hour: now hour + minute: now minute + second: now second + 5. + "The alarm is configured by MolMyClockSystem, we need to get manualy each services and parameters because MolMyClockSystem is not a Molecule component" "First : setup the time of the alarm" - alarmParameters := MolComponentManager default locatorServices searchParametersProviderFor: MolMyAlarmParameters. + alarmParameters := MolComponentManager default locatorServices + searchParametersProviderFor: MolMyAlarmParameters. alarmParameters setTime: alarm. - + "Second : activate the alarm" - alarmActivationServices := MolComponentManager default locatorServices searchServicesProviderFor: MolMyAlarmActivationServices. + alarmActivationServices := MolComponentManager default + locatorServices + searchServicesProviderFor: + MolMyAlarmActivationServices. alarmActivationServices activate. - + "Stop the system in 10 seconds" [ - (Duration seconds: 10) wait. - self stop. - "Clean up the Component Manager in case of next example running" - MolComponentManager cleanUp. - isLogActive ifFalse:[MolUtils toggleLog]. - ] fork. + (Duration seconds: 10000) wait. + self stop. + "Clean up the Component Manager in case of next example running" + MolComponentManager cleanUp. + isLogActive ifFalse: [ MolUtils toggleLog ] ] fork ] { #category : #'start-stop' } diff --git a/src/Molecule-IDE/MolComponentImpl.extension.st b/src/Molecule-IDE/MolComponentImpl.extension.st index 6685d2fe..311f3ae8 100644 --- a/src/Molecule-IDE/MolComponentImpl.extension.st +++ b/src/Molecule-IDE/MolComponentImpl.extension.st @@ -1,5 +1,54 @@ 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 [ diff --git a/src/Molecule-IDE/MolComponentToRoassal.class.st b/src/Molecule-IDE/MolComponentToRoassal.class.st index b5e31104..3041f7b7 100644 --- a/src/Molecule-IDE/MolComponentToRoassal.class.st +++ b/src/Molecule-IDE/MolComponentToRoassal.class.st @@ -11,6 +11,25 @@ Class { #category : #'Molecule-IDE-Inspectors' } +{ #category : #'as yet unclassified' } +MolComponentToRoassal class >> activateLogoOf: aRSBox [ + + (aRSBox propertyAt: #activateLogo) value +] + +{ #category : #adding } +MolComponentToRoassal class >> addBreakpointOnceOnInstance: anInstance withSelector: aSelector [ + + | bp ast | + bp := Breakpoint new. + ast := (anInstance class >> aSelector) ast. + + bp node: ast. + bp scopeTo: anInstance. + bp install. + +] + { #category : #model } MolComponentToRoassal class >> associationsAllConsumedEventsAndTargetsFor: aMolComponent [ @@ -20,8 +39,6 @@ MolComponentToRoassal class >> associationsAllConsumedEventsAndTargetsFor: aMolC eventClass: asso key; name: asso value; component: aMolComponent; - color: self eventColor; - rsLogo: self eventLogoIn; yourself ] ] @@ -33,8 +50,6 @@ MolComponentToRoassal class >> associationsAllProducedEventsAndTargetsFor: aMolC eventClass: event; name: aMolComponent componentName; component: aMolComponent; - color: self eventColor; - rsLogo: self eventLogoOut; yourself ] ] @@ -46,8 +61,6 @@ MolComponentToRoassal class >> associationsAllProvidedParametersAndTargetsFor: a eventClass: event; name: aMolComponent componentName; component: aMolComponent; - color: self parameterColor; - rsLogo: self parameterLogoOut; yourself ] ] @@ -59,8 +72,6 @@ MolComponentToRoassal class >> associationsAllProvidedServicesAndTargetsFor: aMo eventClass: event; name: aMolComponent componentName; component: aMolComponent; - color: self serviceColor; - rsLogo: self serviceLogoOut; yourself ] ] @@ -73,8 +84,6 @@ MolComponentToRoassal class >> associationsAllUsedParametersAndTargetsFor: aMolC eventClass: asso key; name: asso value; component: aMolComponent; - color: self parameterColor; - rsLogo: self parameterLogoIn; yourself ] ] @@ -87,8 +96,6 @@ MolComponentToRoassal class >> associationsAllUsedServicesAndTargetsFor: aMolCom eventClass: asso key; name: asso value; component: aMolComponent; - color: self serviceColor; - rsLogo: self serviceLogoIn; yourself ] ] @@ -139,13 +146,16 @@ MolComponentToRoassal class >> canvasFromMultipleComponents: aCollectionOfCompon allAssociatedTargets do: [ :target | lineBuilder useAssociation: source -> target. "We use the rsShape included in the model to update the logo display on the graph." - source rsLogoActivate. - target rsLogoActivate. + self activateLogoOf: (lineBuilder fromShapes shapeFromModel: source). + self activateLogoOf: (lineBuilder toShapes shapeFromModel: target). ghostLineBuilder useAssociation: source component -> target component ] ]. - + "We change the color of not connected components" - componentShapes reject: [ :shape | shape hasLines ] thenDo: [ :notConnectedComponent | notConnectedComponent color: Color yellow muchLighter ]. + componentShapes + reject: [ :shape | shape hasLines ] + thenDo: [ :notConnectedComponent | + notConnectedComponent color: Color yellow muchLighter ]. "We create a layout for the components: - if they are not connected: they will be aligned on the top-left corner. @@ -180,6 +190,16 @@ MolComponentToRoassal class >> canvasFromSingleComponent: aMolComponent [ ^ canvas ] +{ #category : #'as yet unclassified' } +MolComponentToRoassal class >> contractColorFor: aMolRSContractModel [ + + (aMolRSContractModel eventClass includesTrait: MolComponentEvents) + ifTrue: [ ^ self eventColor ]. + (aMolRSContractModel eventClass includesTrait: MolComponentServices) + ifTrue: [ ^ self serviceColor ]. + ^ self parameterColor +] + { #category : #'instance creation' } MolComponentToRoassal class >> contractFromMolComponentImpl: aMolComponent [ @@ -223,61 +243,29 @@ MolComponentToRoassal class >> contractFromMolComponentImpl: aMolComponent [ ^ contractsAll ] -{ #category : #'instance creation' } -MolComponentToRoassal class >> contractsFromMolRSContracts: aCollectionOfMolRSContractModel [ - - ^ aCollectionOfMolRSContractModel collect: [ :rsContractModel | - | linkBox eventBox eventName logo | - eventName := RSLabel new - text: rsContractModel eventClass printString; - color: Color black; - yourself. - - eventBox := RSBox new - withBorder; - color: rsContractModel color; - extent: eventName extent + 10; - cornerRadius: rsContractModel rsCornerRadius; - yourself. - - linkBox := RSBox new - extent: 1 asPoint; - color: Color transparent; - model: rsContractModel; - yourself. - logo := rsContractModel rsLogo. - rsContractModel isContractSource - ifTrue: [ - linkBox position: eventBox extent x / 2 @ 0. - logo position: eventBox extent x / -2 - 16 @ 0 ] - ifFalse: [ - linkBox position: eventBox extent x / -2 @ 0. - logo position: eventBox extent x / 2 + 16 @ 0 ]. - - RSComposite new - shapes: { - linkBox. - eventBox. - eventName. - logo }; - adjustToChildren; - model: rsContractModel eventClass; - yourself ] +{ #category : #'as yet unclassified' } +MolComponentToRoassal class >> contractLogoFor: aMolRSContractModel [ + + (aMolRSContractModel eventClass includesTrait: MolComponentEvents) + ifTrue: [ ^ self eventLogo ]. + (aMolRSContractModel eventClass includesTrait: MolComponentServices) + ifTrue: [ ^ self serviceLogo ]. + ^ self parameterLogo ] { #category : #'instance creation' } MolComponentToRoassal class >> contractsInFor: aMolComponent [ | connectors services events parameters | - services := self contractsFromMolRSContracts: - (self associationsAllUsedServicesAndTargetsFor: - aMolComponent) sorted. - events := self contractsFromMolRSContracts: - (self associationsAllConsumedEventsAndTargetsFor: - aMolComponent) sorted. - parameters := self contractsFromMolRSContracts: - (self associationsAllUsedParametersAndTargetsFor: - aMolComponent) sorted. + services := (self associationsAllUsedServicesAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeContractShapeFor: each ]. + events := (self associationsAllConsumedEventsAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeContractShapeFor: each ]. + parameters := (self associationsAllUsedParametersAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeContractShapeFor: each ]. connectors := RSComposite new shapes: events , services , parameters; @@ -295,16 +283,17 @@ MolComponentToRoassal class >> contractsInFor: aMolComponent [ { #category : #'instance creation' } MolComponentToRoassal class >> contractsOutFor: aMolComponent [ - | connectors services events parameters | - services := self contractsFromMolRSContracts: - (self associationsAllProvidedServicesAndTargetsFor: - aMolComponent) sorted. - events := self contractsFromMolRSContracts: - (self associationsAllProducedEventsAndTargetsFor: - aMolComponent) sorted. - parameters := self contractsFromMolRSContracts: - (self associationsAllProvidedParametersAndTargetsFor: - aMolComponent) sorted. + | connectors events services parameters | + + services := (self associationsAllProvidedServicesAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeContractShapeFor: each ]. + events := (self associationsAllProducedEventsAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeContractShapeFor: each ]. + parameters := (self associationsAllProvidedParametersAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeContractShapeFor: each ]. connectors := RSComposite new shapes: events , services , parameters; @@ -365,6 +354,81 @@ MolComponentToRoassal class >> eventLogoOut [ ^ rsLogo ] +{ #category : #'as yet unclassified' } +MolComponentToRoassal class >> makeContractShapeFor: aMolRSContractModel [ + + | linkBox eventBox eventName logo composite color | + eventName := RSLabel new + text: aMolRSContractModel eventClass printString; + color: Color black; + yourself. + + color := self contractColorFor: aMolRSContractModel. + eventBox := RSBox new + withBorder; + color: color; + extent: eventName extent + 10; + cornerRadius: aMolRSContractModel rsCornerRadius; + yourself. + + logo := self contractLogoFor: aMolRSContractModel. + linkBox := RSBox new + extent: 1 asPoint; + color: Color transparent; + model: aMolRSContractModel; + propertyAt: #activateLogo put: [ + logo nodes do: [ :each | + each + color: (color + alpha: 1; + adjustSaturation: 0.3 brightness: 0.09); + withBorder ] ]; + yourself. + + aMolRSContractModel isContractSource + ifTrue: [ + 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. + logo position: eventBox extent x / -2 - 16 @ 0 ] + ifFalse: [ + linkBox position: eventBox extent x / -2 @ 0. + logo position: eventBox extent x / 2 + 16 @ 0 ]. + + composite := RSComposite new + shapes: { + linkBox. + eventBox. + eventName. + logo }; + adjustToChildren; + model: aMolRSContractModel eventClass; + yourself. + composite @ (RSMenuActivable new menuDo: [ :aMenuMorph :anRSBox | + aMenuMorph + add: 'Inspect Contract' + target: aMolRSContractModel + selector: #inspect + argument: #( ). + aMolRSContractModel eventClass selectors do: [ :selector | + aMenuMorph + add: 'Break on #' , selector + target: aMolRSContractModel + selector: #inspect + argument: #( ). + ] + ]). + ^ composite +] + { #category : #color } MolComponentToRoassal class >> parameterColor [ diff --git a/src/Molecule-IDE/MolHomeServices.extension.st b/src/Molecule-IDE/MolHomeServices.extension.st index 30911401..a8f3b155 100644 --- a/src/Molecule-IDE/MolHomeServices.extension.st +++ b/src/Molecule-IDE/MolHomeServices.extension.st @@ -1,5 +1,15 @@ Extension { #name : #MolHomeServices } +{ #category : #'*Molecule-IDE' } +MolHomeServices >> detachCanvas [ + | components canvas | + components := self deployedComponents flatCollect: #values. + canvas := MolComponentToRoassal canvasFromMultipleComponents: + components. + + ^ canvas open +] + { #category : #'*Molecule-IDE' } MolHomeServices >> inspectionDeployedComponentsGraph [ diff --git a/src/Molecule-IDE/MolRSContractModel.class.st b/src/Molecule-IDE/MolRSContractModel.class.st index f2d92594..0188c080 100644 --- a/src/Molecule-IDE/MolRSContractModel.class.st +++ b/src/Molecule-IDE/MolRSContractModel.class.st @@ -28,18 +28,6 @@ MolRSContractModel >> <= aMolRSContractModel [ ^ self eventClass name < aMolRSContractModel eventClass name ] -{ #category : #accessing } -MolRSContractModel >> color [ - - ^ color -] - -{ #category : #accessing } -MolRSContractModel >> color: anObject [ - - color := anObject -] - { #category : #accessing } MolRSContractModel >> component [ @@ -87,20 +75,3 @@ MolRSContractModel >> rsCornerRadius [ ^ self shouldBeImplemented ] - -{ #category : #'as yet unclassified' } -MolRSContractModel >> rsLogo [ - - ^ rsLogo -] - -{ #category : #accessing } -MolRSContractModel >> rsLogo: aRSComposite [ - rsLogo := aRSComposite -] - -{ #category : #'as yet unclassified' } -MolRSContractModel >> rsLogoActivate [ - - self rsLogo nodes do: [ :each | each color: (self color alpha: 1; adjustSaturation: 0.3 brightness: 0.09); withBorder ] -] From 0044760d86bd87216975b203daf94c8ec527bc70 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Tue, 4 Feb 2025 17:18:09 +0100 Subject: [PATCH 2/4] add breakpoints --- .../MolComponentToRoassal.class.st | 100 +++++------------- src/Molecule-IDE/MolRSContractModel.class.st | 16 ++- .../MolRSContractModelSource.class.st | 7 ++ .../MolRSContractModelTarget.class.st | 6 ++ 4 files changed, 52 insertions(+), 77 deletions(-) diff --git a/src/Molecule-IDE/MolComponentToRoassal.class.st b/src/Molecule-IDE/MolComponentToRoassal.class.st index 5cb0cdc3..019df93b 100644 --- a/src/Molecule-IDE/MolComponentToRoassal.class.st +++ b/src/Molecule-IDE/MolComponentToRoassal.class.st @@ -22,24 +22,39 @@ MolComponentToRoassal class >> addBreakpointOnceOnInstance: anInstance withSelec | bp ast | bp := Breakpoint new. - ast := (anInstance class >> aSelector) ast. + ast := (anInstance class methodNamed: aSelector) ast. bp node: ast. bp scopeTo: anInstance. - bp install. + 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 eventsSubscribers associations + ^ aMolComponent componentConnector ifNotNil: [ :connector | connector eventsSubscribers associations collect: [ :asso | MolRSContractModelTarget new eventClass: asso key; name: asso value; component: aMolComponent; - yourself ] + yourself ] ]. + ^ { } ] { #category : #model } @@ -336,24 +351,6 @@ MolComponentToRoassal class >> eventLogo [ rsLogoOut } ] -{ #category : #resources } -MolComponentToRoassal class >> eventLogoIn [ - - | rsLogo | - rsLogo := self eventLogo. - rsLogo nodes second color: Color transparent; border: nil. - ^ rsLogo -] - -{ #category : #resources } -MolComponentToRoassal class >> eventLogoOut [ - - | rsLogo | - rsLogo := self eventLogo. - rsLogo nodes first color: Color transparent; border: nil. - ^ rsLogo -] - { #category : #'as yet unclassified' } MolComponentToRoassal class >> makeContractShapeFor: aMolRSContractModel [ @@ -418,14 +415,13 @@ MolComponentToRoassal class >> makeContractShapeFor: aMolRSContractModel [ target: aMolRSContractModel selector: #inspect argument: #( ). - aMolRSContractModel eventClass selectors do: [ :selector | - aMenuMorph - add: 'Break on #' , selector - target: aMolRSContractModel - selector: #inspect - argument: #( ). - ] - ]). + aMolRSContractModel eventClass selectors do: [ :selector | + (aMolRSContractModel canBreakOn: selector) ifTrue: [ + aMenuMorph + add: 'Break on #' , selector + target: aMolRSContractModel + selector: #breakOnceOnSelector: + argument: selector ] ] ]). ^ composite ] @@ -462,28 +458,6 @@ MolComponentToRoassal class >> parameterLogo [ rsLogoOut } ] -{ #category : #resources } -MolComponentToRoassal class >> parameterLogoIn [ - - | rsLogo | - rsLogo := self parameterLogo. - rsLogo nodes second - color: Color transparent; - border: nil. - ^ rsLogo -] - -{ #category : #resources } -MolComponentToRoassal class >> parameterLogoOut [ - - | rsLogo | - rsLogo := self parameterLogo. - rsLogo nodes first - color: Color transparent; - border: nil. - ^ rsLogo -] - { #category : #color } MolComponentToRoassal class >> serviceColor [ @@ -519,28 +493,6 @@ MolComponentToRoassal class >> serviceLogo [ rsLogoOut } ] -{ #category : #resources } -MolComponentToRoassal class >> serviceLogoIn [ - - | rsLogo | - rsLogo := self serviceLogo. - rsLogo nodes second - color: Color transparent; - border: nil. - ^ rsLogo -] - -{ #category : #resources } -MolComponentToRoassal class >> serviceLogoOut [ - - | rsLogo | - rsLogo := self serviceLogo. - rsLogo nodes first - color: Color transparent; - border: nil. - ^ rsLogo -] - { #category : #'see class side' } MolComponentToRoassal >> seeClassSide [ ] diff --git a/src/Molecule-IDE/MolRSContractModel.class.st b/src/Molecule-IDE/MolRSContractModel.class.st index 0188c080..aa48da35 100644 --- a/src/Molecule-IDE/MolRSContractModel.class.st +++ b/src/Molecule-IDE/MolRSContractModel.class.st @@ -15,9 +15,7 @@ Class { #instVars : [ 'component', 'name', - 'eventClass', - 'color', - 'rsLogo' + 'eventClass' ], #category : #'Molecule-IDE-Inspectors' } @@ -28,6 +26,18 @@ MolRSContractModel >> <= aMolRSContractModel [ ^ self eventClass name < aMolRSContractModel eventClass name ] +{ #category : #'as yet unclassified' } +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 +] + { #category : #accessing } MolRSContractModel >> component [ diff --git a/src/Molecule-IDE/MolRSContractModelSource.class.st b/src/Molecule-IDE/MolRSContractModelSource.class.st index f3097df7..dca646f9 100644 --- a/src/Molecule-IDE/MolRSContractModelSource.class.st +++ b/src/Molecule-IDE/MolRSContractModelSource.class.st @@ -7,6 +7,13 @@ Class { #category : #'Molecule-IDE-Inspectors' } +{ #category : #testing } +MolRSContractModelSource >> canBreakOn: aString [ + + ^ (self eventClass includesTrait: MolComponentServices) or: [ self eventClass includesTrait: MolComponentParameters ] + +] + { #category : #testing } MolRSContractModelSource >> isContractSource [ diff --git a/src/Molecule-IDE/MolRSContractModelTarget.class.st b/src/Molecule-IDE/MolRSContractModelTarget.class.st index 6c82102a..9bc4b99e 100644 --- a/src/Molecule-IDE/MolRSContractModelTarget.class.st +++ b/src/Molecule-IDE/MolRSContractModelTarget.class.st @@ -7,6 +7,12 @@ Class { #category : #'Molecule-IDE-Inspectors' } +{ #category : #testing } +MolRSContractModelTarget >> canBreakOn: aString [ + ^ self eventClass includesTrait: MolComponentEvents + +] + { #category : #'as yet unclassified' } MolRSContractModelTarget >> rsCornerRadius [ ^ RSCornerRadius new right: 10 From f7775c964aebf1521f62c073f4f1d8667e461605 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Tue, 4 Feb 2025 18:36:09 +0100 Subject: [PATCH 3/4] 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 311f3ae8..71cf0d9d 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 019df93b..725d0769 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 a8f3b155..87c53869 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 aa48da35..9f6c0971 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 dca646f9..8e889074 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 9bc4b99e..5bdead73 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 ] From bfa5ff3faa0bf611fc34daa7cbd461c6b0f68f2b Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Tue, 4 Feb 2025 18:44:21 +0100 Subject: [PATCH 4/4] Reset the example --- .../MolMyClockSystem.class.st | 49 ++++++++----------- 1 file changed, 20 insertions(+), 29 deletions(-) diff --git a/src/Molecule-Examples/MolMyClockSystem.class.st b/src/Molecule-Examples/MolMyClockSystem.class.st index 00556cf4..4eb6c46a 100644 --- a/src/Molecule-Examples/MolMyClockSystem.class.st +++ b/src/Molecule-Examples/MolMyClockSystem.class.st @@ -44,54 +44,45 @@ MolMyClockSystem class >> start [ { #category : #launcher } MolMyClockSystem class >> startAlarmExample [ "Start Clock System example : simulate a clock alarm for sleeping !" - | now alarm alarmParameters alarmActivationServices isLogActive | + "Activate the Molecule log for display results" isLogActive := MolUtils isLogActive. - isLogActive ifFalse: [ MolUtils toggleLog ]. - + isLogActive ifFalse:[MolUtils toggleLog]. + "Dialog to inform user to open a Transcript to see results" - (UIManager default - confirm: - 'This example displays results in a transcript and stop after 10 seconds. + (UIManager default confirm: 'This example displays results in a transcript and stop after 10 seconds. Do you want to open a transcript window ?' - label: 'Molecule - Clock System Example') ifTrue: [ - Transcript open ]. - + label: 'Molecule - Clock System Example') ifTrue:[Transcript open]. + "Clean up the Component Manager in case of previous example running" MolComponentManager cleanUp. - + "Start the system" self start. - + "Configure an alarm in 5 seconds" now := Time now. - alarm := Time - hour: now hour - minute: now minute - second: now second + 5. - + alarm := Time hour: now hour minute: now minute second: now second + 5. + "The alarm is configured by MolMyClockSystem, we need to get manualy each services and parameters because MolMyClockSystem is not a Molecule component" "First : setup the time of the alarm" - alarmParameters := MolComponentManager default locatorServices - searchParametersProviderFor: MolMyAlarmParameters. + alarmParameters := MolComponentManager default locatorServices searchParametersProviderFor: MolMyAlarmParameters. alarmParameters setTime: alarm. - + "Second : activate the alarm" - alarmActivationServices := MolComponentManager default - locatorServices - searchServicesProviderFor: - MolMyAlarmActivationServices. + alarmActivationServices := MolComponentManager default locatorServices searchServicesProviderFor: MolMyAlarmActivationServices. alarmActivationServices activate. - + "Stop the system in 10 seconds" [ - (Duration seconds: 10000) wait. - self stop. - "Clean up the Component Manager in case of next example running" - MolComponentManager cleanUp. - isLogActive ifFalse: [ MolUtils toggleLog ] ] fork + (Duration seconds: 10) wait. + self stop. + "Clean up the Component Manager in case of next example running" + MolComponentManager cleanUp. + isLogActive ifFalse:[MolUtils toggleLog]. + ] fork. ] { #category : #'start-stop' }