From 6d55d2475e64e494e300a57d752ed3d47a766c5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 19 May 2026 17:14:31 +0200 Subject: [PATCH 01/14] add a tab that allows handling BlElement depending on its type --- .../PyramidBlocGeometryPlugin.class.st | 94 ----------- .../PyramidSaveModelVerifier.class.st | 5 +- src/Pyramid/PyramidEditorPlugin.class.st | 158 ++++++++++++++++++ .../PyramidGeometryCommand.class.st | 12 +- .../PyramidIconInputPresenter.class.st | 68 ++++++++ ...oundedRectangleCornerRadiiCommand.class.st | 12 +- .../PyramidToButtonEndIconCommand.class.st | 29 ++++ .../PyramidToButtonIconCommand.class.st | 31 ++++ .../PyramidToButtonLabelCommand.class.st | 22 +++ .../PyramidToImageInnerImageCommand.class.st | 28 ++++ .../PyramidToLabelTextCommand.class.st | 23 +++ 11 files changed, 378 insertions(+), 104 deletions(-) delete mode 100644 src/Pyramid-Bloc/PyramidBlocGeometryPlugin.class.st create mode 100644 src/Pyramid/PyramidEditorPlugin.class.st rename src/{Pyramid-Bloc => Pyramid}/PyramidGeometryCommand.class.st (53%) create mode 100644 src/Pyramid/PyramidIconInputPresenter.class.st rename src/{Pyramid-Bloc => Pyramid}/PyramidRoundedRectangleCornerRadiiCommand.class.st (62%) create mode 100644 src/Pyramid/PyramidToButtonEndIconCommand.class.st create mode 100644 src/Pyramid/PyramidToButtonIconCommand.class.st create mode 100644 src/Pyramid/PyramidToButtonLabelCommand.class.st create mode 100644 src/Pyramid/PyramidToImageInnerImageCommand.class.st create mode 100644 src/Pyramid/PyramidToLabelTextCommand.class.st diff --git a/src/Pyramid-Bloc/PyramidBlocGeometryPlugin.class.st b/src/Pyramid-Bloc/PyramidBlocGeometryPlugin.class.st deleted file mode 100644 index 63799cd9..00000000 --- a/src/Pyramid-Bloc/PyramidBlocGeometryPlugin.class.st +++ /dev/null @@ -1,94 +0,0 @@ -Class { - #name : #PyramidBlocGeometryPlugin, - #superclass : #Object, - #traits : 'TPyramidPlugin', - #classTraits : 'TPyramidPlugin classTrait', - #instVars : [ - 'propertiesManager' - ], - #category : #'Pyramid-Bloc-plugin-bloc-geometry' -} - -{ #category : #accessing } -PyramidBlocGeometryPlugin class >> cornerRadii [ - - | property | - property := PyramidProperty new - name: 'Corner radius'; - command: PyramidRoundedRectangleCornerRadiiCommand new; - inputPresenterClass: - PyramidCornerRadiiInputPresenter; - yourself. - property inputPresenterModel help: - 'Change the corner radius of the geometry. For example: - - "10" to set a radius of 10 px on each corner. - - "10 20" to set a radius of 10 px on the top-left and bottom-right corner and 20 px on the top-right and bottom-left corner. - - "10 20 30 40" to set a radius of 10 px on top-left, 20 px on top-right, 30 px on bottom-right and 40 px on bottom-left.'. - ^ property -] - -{ #category : #accessing } -PyramidBlocGeometryPlugin class >> geometry [ - - | property | - property := PyramidProperty new - name: 'Geo'; - command: PyramidGeometryCommand new; - inputPresenterClass: PyramidMagicButtonsInputPresenter; - yourself. - self geometryClasses do: [ :each | - property inputPresenterModel addButtonModel: - each asPyramidMagicButton ]. - ^ property -] - -{ #category : #'as yet unclassified' } -PyramidBlocGeometryPlugin class >> geometryClasses [ - - ^ { - BlRectangleGeometry. - BlRoundedRectangleGeometry. - BlSquareGeometry. - BlEllipseGeometry. - BlCircleGeometry. - BlAnnulusSectorGeometry. - BlTriangleGeometry. - BlLineGeometry . - BlPolylineGeometry. - BlBezierCurveGeometry. - BlPolygonGeometry } -] - -{ #category : #adding } -PyramidBlocGeometryPlugin >> addPanelsOn: aPyramidSimpleWindow [ - - aPyramidSimpleWindow at: #tabRight addItem: [ :builder | - builder - makeTab: self propertiesManager mainPresenter - label: 'Geo' - icon: (Smalltalk ui icons iconNamed: #box) - order: 4 ] -] - -{ #category : #connecting } -PyramidBlocGeometryPlugin >> connectOn: aPyramidEditor [ - - propertiesManager projectModel: aPyramidEditor projectModel. - propertiesManager commandExecutor: - aPyramidEditor commandExecutor -] - -{ #category : #initialization } -PyramidBlocGeometryPlugin >> initialize [ - - propertiesManager := PyramidPropertiesManagerForSelection new. - - propertiesManager addProperty: self class geometry. - propertiesManager addProperty: self class cornerRadii. -] - -{ #category : #adding } -PyramidBlocGeometryPlugin >> propertiesManager [ - - ^ propertiesManager -] diff --git a/src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st b/src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st index d8425326..6374cc47 100644 --- a/src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st +++ b/src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st @@ -47,9 +47,10 @@ PyramidSaveModelVerifier class >> classPackageIsEqual [ PyramidSaveModelVerifier class >> methodIsValid [ ^ self new - verifyBlock: [ :model | model savingMethodName isValidSelector ]; + verifyBlock: [ :model | + OCScanner isSelector: model savingMethodName ]; showBlock: [ :view | view showMethodIsNotValidError ]; - yourself. + yourself ] { #category : #constructor } diff --git a/src/Pyramid/PyramidEditorPlugin.class.st b/src/Pyramid/PyramidEditorPlugin.class.st new file mode 100644 index 00000000..fe8ffb80 --- /dev/null +++ b/src/Pyramid/PyramidEditorPlugin.class.st @@ -0,0 +1,158 @@ +Class { + #name : #PyramidEditorPlugin, + #superclass : #Object, + #traits : 'TPyramidPlugin', + #classTraits : 'TPyramidPlugin classTrait', + #instVars : [ + 'propertiesManager' + ], + #category : #'Pyramid-plugin-editor' +} + +{ #category : #accessing } +PyramidEditorPlugin class >> cornerRadii [ + + | property | + property := PyramidProperty new + name: 'Corner radius'; + command: PyramidRoundedRectangleCornerRadiiCommand new; + inputPresenterClass: PyramidCornerRadiiInputPresenter; + yourself. + property inputPresenterModel help: + 'Change the corner radius of the geometry. For example: + - "10" to set a radius of 10 px on each corner. + - "10 20" to set a radius of 10 px on the top-left and bottom-right corner and 20 px on the top-right and bottom-left corner. + - "10 20 30 40" to set a radius of 10 px on top-left, 20 px on top-right, 30 px on bottom-right and 40 px on bottom-left.'. + ^ property +] + +{ #category : #accessing } +PyramidEditorPlugin class >> geometry [ + + | property | + property := PyramidProperty new + name: 'Geo'; + command: PyramidGeometryCommand new; + inputPresenterClass: PyramidMagicButtonsInputPresenter; + yourself. + self geometryClasses do: [ :each | + property inputPresenterModel addButtonModel: + each asPyramidMagicButton ]. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> geometryClasses [ + + ^ { + BlRectangleGeometry. + BlRoundedRectangleGeometry. + BlSquareGeometry. + BlEllipseGeometry. + BlCircleGeometry. + BlAnnulusSectorGeometry. + BlTriangleGeometry. + BlLineGeometry. + BlPolylineGeometry. + BlBezierCurveGeometry. + BlPolygonGeometry } +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toButtonEndIcon [ + + | property | + property := PyramidProperty new + name: 'EndIcon'; + command: PyramidToButtonEndIconCommand new; + inputPresenterClass: PyramidIconInputPresenter; + yourself. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toButtonIcon [ + + | property | + property := PyramidProperty new + name: 'Icon'; + command: PyramidToButtonIconCommand new; + inputPresenterClass: PyramidIconInputPresenter; + yourself. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toButtonLabel [ + + | property | + property := PyramidProperty new + name: 'Text'; + command: PyramidToButtonLabelCommand new; + inputPresenterClass: PyramidTextInputPresenter; + yourself. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toImageInnerImage [ + + | property | + property := PyramidProperty new + name: 'InnerImage'; + command: PyramidToImageInnerImageCommand new; + inputPresenterClass: PyramidIconInputPresenter; + yourself. + ^ property +] + +{ #category : #'as yet unclassified' } +PyramidEditorPlugin class >> toLabelText [ + + | property | + property := PyramidProperty new + name: 'Text'; + command: PyramidToLabelTextCommand new; + inputPresenterClass: PyramidTextInputPresenter; + yourself. + ^ property +] + +{ #category : #adding } +PyramidEditorPlugin >> addPanelsOn: aPyramidSimpleWindow [ + + aPyramidSimpleWindow at: #tabRight addItem: [ :builder | + builder + makeTab: propertiesManager mainPresenter + label: 'Editor' + icon: (Smalltalk ui icons iconNamed: #box) + order: 5 ] +] + +{ #category : #connecting } +PyramidEditorPlugin >> connectOn: aPyramidEditor [ + + propertiesManager projectModel: aPyramidEditor projectModel. + propertiesManager commandExecutor: aPyramidEditor commandExecutor +] + +{ #category : #initialization } +PyramidEditorPlugin >> initialize [ + + propertiesManager := PyramidPropertiesManagerForSelection new. + + "BlElements properties" + propertiesManager addProperty: self class geometry. + propertiesManager addProperty: self class cornerRadii. + + "ToButton properties" + propertiesManager addProperty: self class toButtonLabel. + propertiesManager addProperty: self class toButtonIcon. + propertiesManager addProperty: self class toButtonEndIcon. + + "ToImage properties" + propertiesManager addProperty: self class toImageInnerImage. + + "ToLabel properties" + propertiesManager addProperty: self class toLabelText +] diff --git a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st b/src/Pyramid/PyramidGeometryCommand.class.st similarity index 53% rename from src/Pyramid-Bloc/PyramidGeometryCommand.class.st rename to src/Pyramid/PyramidGeometryCommand.class.st index 411acf89..67711ebc 100644 --- a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st +++ b/src/Pyramid/PyramidGeometryCommand.class.st @@ -1,16 +1,22 @@ Class { #name : #PyramidGeometryCommand, #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-Bloc-plugin-bloc-geometry' + #category : #'Pyramid-plugin-editor' } -{ #category : #'as yet unclassified' } +{ #category : #testing } +PyramidGeometryCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ anObject class = BlElement ] +] + +{ #category : #getter } PyramidGeometryCommand >> getValueFor: aBlElement [ ^ aBlElement geometry ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidGeometryCommand >> setValueFor: aBlElement with: anArgument [ aBlElement geometry: anArgument diff --git a/src/Pyramid/PyramidIconInputPresenter.class.st b/src/Pyramid/PyramidIconInputPresenter.class.st new file mode 100644 index 00000000..f4fcc832 --- /dev/null +++ b/src/Pyramid/PyramidIconInputPresenter.class.st @@ -0,0 +1,68 @@ +Class { + #name : #PyramidIconInputPresenter, + #superclass : #PyramidInputPresenter, + #instVars : [ + 'textInput', + 'button', + 'list', + 'whenValueChangedDo' + ], + #category : #'Pyramid-specs-custom' +} + +{ #category : #layout } +PyramidIconInputPresenter >> defaultLayout [ + + ^ SpBoxLayout newHorizontal + spacing: 2; + add: textInput; + add: button width: 24; + yourself +] + +{ #category : #initialization } +PyramidIconInputPresenter >> initializePresenters [ + + whenValueChangedDo := [ :v | ]. + list := SpFilteringListPresenter new. + list items: + Smalltalk ui icons allIconNames asSortedCollection asArray. + list display: [ :name | name ]. + list displayIcon: [ :name | Smalltalk ui icons iconNamed: name ]. + textInput := SpTextInputFieldPresenter new. + textInput whenSubmitDo: [ :text | whenValueChangedDo value: text ]. + button := SpButtonPresenter new + help: 'Select an icon'; + icon: (Smalltalk ui icons iconNamed: #image); + action: [ self openIconModal ]; + yourself +] + +{ #category : #'as yet unclassified' } +PyramidIconInputPresenter >> openIconModal [ + + | window dialog | + window := list asModalWindow. + window title: 'Choose an icon'. + window centered. + dialog := window open. + dialog isOk ifFalse: [ ^ self ]. + self value: list selectedItem. + whenValueChangedDo value: list selectedItem +] + +{ #category : #'as yet unclassified' } +PyramidIconInputPresenter >> value [ + ^ textInput text +] + +{ #category : #'as yet unclassified' } +PyramidIconInputPresenter >> value: aString [ + + textInput text: (aString ifNil: [ '' ]) +] + +{ #category : #'as yet unclassified' } +PyramidIconInputPresenter >> whenValueChangedDo: aBlock [ + whenValueChangedDo := aBlock +] diff --git a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st b/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st similarity index 62% rename from src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st rename to src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st index f239660b..617f15d5 100644 --- a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st +++ b/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st @@ -1,24 +1,26 @@ Class { #name : #PyramidRoundedRectangleCornerRadiiCommand, #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-Bloc-plugin-bloc-geometry' + #category : #'Pyramid-plugin-editor' } { #category : #testing } PyramidRoundedRectangleCornerRadiiCommand >> canBeUsedFor: anObject [ ^ (super canBeUsedFor: anObject) and: [ - anObject geometry class = BlRoundedRectangleGeometry ] + anObject class = BlElement and: [ + anObject geometry class = BlRoundedRectangleGeometry ] ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidRoundedRectangleCornerRadiiCommand >> getValueFor: aBlElement [ ^ aBlElement geometry cornerRadii ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidRoundedRectangleCornerRadiiCommand >> setValueFor: aBlElement with: anArgument [ - aBlElement geometry: (BlRoundedRectangleGeometry cornerRadii: anArgument) + aBlElement geometry: + (BlRoundedRectangleGeometry cornerRadii: anArgument) ] diff --git a/src/Pyramid/PyramidToButtonEndIconCommand.class.st b/src/Pyramid/PyramidToButtonEndIconCommand.class.st new file mode 100644 index 00000000..cc65026c --- /dev/null +++ b/src/Pyramid/PyramidToButtonEndIconCommand.class.st @@ -0,0 +1,29 @@ +Class { + #name : #PyramidToButtonEndIconCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-plugin-editor' +} + +{ #category : #testing } +PyramidToButtonEndIconCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToButton ] +] + +{ #category : #getter } +PyramidToButtonEndIconCommand >> getValueFor: aToButton [ + | form | + aToButton endIcon ifNil: [ ^ '' ]. + form := aToButton endIcon image innerFormImage. + ^ Smalltalk ui icons allIconNames + detect: [ :name | (Smalltalk ui icons iconNamed: name) = form ] + ifNone: [ '' ] +] + +{ #category : #setter } +PyramidToButtonEndIconCommand >> setValueFor: aToButton with: aSymbol [ + | icon | + icon := ToIcon new. + icon iconImage: (Smalltalk ui icons iconNamed: aSymbol). + aToButton endIcon: icon. +] diff --git a/src/Pyramid/PyramidToButtonIconCommand.class.st b/src/Pyramid/PyramidToButtonIconCommand.class.st new file mode 100644 index 00000000..90047c19 --- /dev/null +++ b/src/Pyramid/PyramidToButtonIconCommand.class.st @@ -0,0 +1,31 @@ +Class { + #name : #PyramidToButtonIconCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-plugin-editor' +} + +{ #category : #testing } +PyramidToButtonIconCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToButton ] +] + +{ #category : #getter } +PyramidToButtonIconCommand >> getValueFor: aToButton [ + + | form | + aToButton icon ifNil: [ ^ '' ]. + form := aToButton icon image innerFormImage. + ^ Smalltalk ui icons allIconNames + detect: [ :name | (Smalltalk ui icons iconNamed: name) = form ] + ifNone: [ '' ] +] + +{ #category : #setter } +PyramidToButtonIconCommand >> setValueFor: aToButton with: aSymbol [ + + | icon | + icon := ToIcon new. + icon iconImage: (Smalltalk ui icons iconNamed: aSymbol). + aToButton icon: icon +] diff --git a/src/Pyramid/PyramidToButtonLabelCommand.class.st b/src/Pyramid/PyramidToButtonLabelCommand.class.st new file mode 100644 index 00000000..4591d27e --- /dev/null +++ b/src/Pyramid/PyramidToButtonLabelCommand.class.st @@ -0,0 +1,22 @@ +Class { + #name : #PyramidToButtonLabelCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-plugin-editor' +} + +{ #category : #testing } +PyramidToButtonLabelCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToButton ] +] + +{ #category : #getter } +PyramidToButtonLabelCommand >> getValueFor: aToButton [ + + ^ aToButton labelText ifNil: [ '' ] +] + +{ #category : #setter } +PyramidToButtonLabelCommand >> setValueFor: aToButton with: aString [ + aToButton labelText: aString +] diff --git a/src/Pyramid/PyramidToImageInnerImageCommand.class.st b/src/Pyramid/PyramidToImageInnerImageCommand.class.st new file mode 100644 index 00000000..745bdc9c --- /dev/null +++ b/src/Pyramid/PyramidToImageInnerImageCommand.class.st @@ -0,0 +1,28 @@ +Class { + #name : #PyramidToImageInnerImageCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-plugin-editor' +} + +{ #category : #testing } +PyramidToImageInnerImageCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToImage ] +] + +{ #category : #getter } +PyramidToImageInnerImageCommand >> getValueFor: aToImage [ + + | form | + aToImage innerFormImage ifNil: [ ^ '' ]. + form := aToImage innerFormImage. + ^ Smalltalk ui icons allIconNames + detect: [ :name | (Smalltalk ui icons iconNamed: name) = form ] + ifNone: [ '' ] +] + +{ #category : #setter } +PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ + + aToImage innerImage: (Smalltalk ui icons iconNamed: aSymbol) +] diff --git a/src/Pyramid/PyramidToLabelTextCommand.class.st b/src/Pyramid/PyramidToLabelTextCommand.class.st new file mode 100644 index 00000000..dd347bbb --- /dev/null +++ b/src/Pyramid/PyramidToLabelTextCommand.class.st @@ -0,0 +1,23 @@ +Class { + #name : #PyramidToLabelTextCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-plugin-editor' +} + +{ #category : #testing } +PyramidToLabelTextCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [anObject class = ToLabel] +] + +{ #category : #getter } +PyramidToLabelTextCommand >> getValueFor: aToLabel [ + + ^ aToLabel text asString ifNil: [ '' ] +] + +{ #category : #setter } +PyramidToLabelTextCommand >> setValueFor: aToLabel with: aString [ + + aToLabel text: aString +] From 2e8ba2bd53df9cdeab65f8613bb3eae1d5ccd03e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 21 May 2026 14:29:29 +0200 Subject: [PATCH 02/14] Rename input fields' names and fix an error regarding the elements selection --- .../PyramidSelectionMakerExtension.class.st | 14 +++++++++++-- src/Pyramid/PyramidEditorPlugin.class.st | 4 ++-- src/Pyramid/PyramidGeometryCommand.class.st | 3 +-- .../PyramidToButtonLabelCommand.class.st | 12 ++++++----- .../PyramidToImageInnerImageCommand.class.st | 21 +++++++------------ .../PyramidToLabelTextCommand.class.st | 8 +++---- 6 files changed, 33 insertions(+), 29 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st b/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st index f067f356..a02676ee 100644 --- a/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st +++ b/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st @@ -186,12 +186,22 @@ PyramidSelectionMakerExtension >> selectAllElementsInBound: aBound [ { #category : #'as yet unclassified' } PyramidSelectionMakerExtension >> selectFirstElementAt: aPosition [ - | selectedElements | + | selectedElements filtered isInnerOfImage isInnerOfLabel isLabelOfButton | self projectModel ifNil: [ ^ { } ]. selectedElements := self projectModel allElements select: [ :each | each boundsInSpace containsPoint: aPosition ]. selectedElements ifEmpty: [ ^ { } ]. - ^ { selectedElements last } + filtered := selectedElements reject: [ :e | + isInnerOfImage := e class = BlElement and: [ + e parent class = ToImage ]. + isInnerOfLabel := e class = ToLabelMonoLineInnerElement + and: [ e parent class = ToLabel ]. + isLabelOfButton := e class = ToLabel and: [ + e parent parent class = ToButton ]. + isInnerOfImage or: [ + isInnerOfLabel or: [ isLabelOfButton ] ] ]. + filtered ifEmpty: [ ^ { selectedElements last } ]. + ^ { filtered last } ] { #category : #accessing } diff --git a/src/Pyramid/PyramidEditorPlugin.class.st b/src/Pyramid/PyramidEditorPlugin.class.st index fe8ffb80..64da94cf 100644 --- a/src/Pyramid/PyramidEditorPlugin.class.st +++ b/src/Pyramid/PyramidEditorPlugin.class.st @@ -63,7 +63,7 @@ PyramidEditorPlugin class >> toButtonEndIcon [ | property | property := PyramidProperty new - name: 'EndIcon'; + name: 'End Icon'; command: PyramidToButtonEndIconCommand new; inputPresenterClass: PyramidIconInputPresenter; yourself. @@ -99,7 +99,7 @@ PyramidEditorPlugin class >> toImageInnerImage [ | property | property := PyramidProperty new - name: 'InnerImage'; + name: 'Image'; command: PyramidToImageInnerImageCommand new; inputPresenterClass: PyramidIconInputPresenter; yourself. diff --git a/src/Pyramid/PyramidGeometryCommand.class.st b/src/Pyramid/PyramidGeometryCommand.class.st index 67711ebc..39c7f9e6 100644 --- a/src/Pyramid/PyramidGeometryCommand.class.st +++ b/src/Pyramid/PyramidGeometryCommand.class.st @@ -6,8 +6,7 @@ Class { { #category : #testing } PyramidGeometryCommand >> canBeUsedFor: anObject [ - - ^ (super canBeUsedFor: anObject) and: [ anObject class = BlElement ] + ^ (super canBeUsedFor: anObject) and: [ anObject class = BlElement ] ] { #category : #getter } diff --git a/src/Pyramid/PyramidToButtonLabelCommand.class.st b/src/Pyramid/PyramidToButtonLabelCommand.class.st index 4591d27e..30b6c128 100644 --- a/src/Pyramid/PyramidToButtonLabelCommand.class.st +++ b/src/Pyramid/PyramidToButtonLabelCommand.class.st @@ -7,16 +7,18 @@ Class { { #category : #testing } PyramidToButtonLabelCommand >> canBeUsedFor: anObject [ - ^ (super canBeUsedFor: anObject) and: [ anObject class = ToButton ] + ^ (super canBeUsedFor: anObject) and: [ + anObject class = ToButton ] ] { #category : #getter } -PyramidToButtonLabelCommand >> getValueFor: aToButton [ +PyramidToButtonLabelCommand >> getValueFor: anObject [ - ^ aToButton labelText ifNil: [ '' ] + ^ anObject labelText ifNil: [ '' ] ] { #category : #setter } -PyramidToButtonLabelCommand >> setValueFor: aToButton with: aString [ - aToButton labelText: aString +PyramidToButtonLabelCommand >> setValueFor: anObject with: aString [ + + anObject labelText: aString ] diff --git a/src/Pyramid/PyramidToImageInnerImageCommand.class.st b/src/Pyramid/PyramidToImageInnerImageCommand.class.st index 745bdc9c..fbcfcd7e 100644 --- a/src/Pyramid/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid/PyramidToImageInnerImageCommand.class.st @@ -6,23 +6,18 @@ Class { { #category : #testing } PyramidToImageInnerImageCommand >> canBeUsedFor: anObject [ - - ^ (super canBeUsedFor: anObject) and: [ anObject class = ToImage ] + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToImage ] ] { #category : #getter } -PyramidToImageInnerImageCommand >> getValueFor: aToImage [ - - | form | - aToImage innerFormImage ifNil: [ ^ '' ]. - form := aToImage innerFormImage. - ^ Smalltalk ui icons allIconNames - detect: [ :name | (Smalltalk ui icons iconNamed: name) = form ] - ifNone: [ '' ] +PyramidToImageInnerImageCommand >> getValueFor: anObject [ + anObject innerFormImage ifNil: [ ^ '' ]. + ^ Smalltalk ui icons allIconNames + detect: [ :name | (Smalltalk ui icons iconNamed: name) = anObject innerFormImage ] + ifNone: [ '' ] ] { #category : #setter } -PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ - - aToImage innerImage: (Smalltalk ui icons iconNamed: aSymbol) +PyramidToImageInnerImageCommand >> setValueFor: anObject with: aSymbol [ + anObject innerImage: (Smalltalk ui icons iconNamed: aSymbol) ] diff --git a/src/Pyramid/PyramidToLabelTextCommand.class.st b/src/Pyramid/PyramidToLabelTextCommand.class.st index dd347bbb..bfaebdac 100644 --- a/src/Pyramid/PyramidToLabelTextCommand.class.st +++ b/src/Pyramid/PyramidToLabelTextCommand.class.st @@ -7,17 +7,15 @@ Class { { #category : #testing } PyramidToLabelTextCommand >> canBeUsedFor: anObject [ - ^ (super canBeUsedFor: anObject) and: [anObject class = ToLabel] + ^ (super canBeUsedFor: anObject) and: [ anObject class = ToLabel ] ] { #category : #getter } PyramidToLabelTextCommand >> getValueFor: aToLabel [ - - ^ aToLabel text asString ifNil: [ '' ] + ^ aToLabel text asString ifNil: [ '' ] ] { #category : #setter } PyramidToLabelTextCommand >> setValueFor: aToLabel with: aString [ - - aToLabel text: aString + aToLabel text: aString ] From d7123d75a9ddf2e7b2915a223a7494b322734ff4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 28 May 2026 11:45:17 +0200 Subject: [PATCH 03/14] add 'Ant Icon' and 'Material Icon' for ToButton and ToImage use ToImage instead of ToIcon for ToButton generalize element selection using parentsShouldSerializeChildren use PyramidExternalRessourceProxy for the serialization --- .../PyramidSelectionMakerExtension.class.st | 13 +- .../PyramidExternalRessourceProxy.class.st | 16 ++ .../PyramidIconInputPresenter.class.st | 182 ++++++++++++++++-- .../PyramidToButtonEndIconCommand.class.st | 47 ++++- .../PyramidToButtonIconCommand.class.st | 46 ++++- .../PyramidToImageInnerImageCommand.class.st | 46 ++++- 6 files changed, 293 insertions(+), 57 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st b/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st index a02676ee..8713a645 100644 --- a/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st +++ b/src/Pyramid-Bloc/PyramidSelectionMakerExtension.class.st @@ -186,20 +186,13 @@ PyramidSelectionMakerExtension >> selectAllElementsInBound: aBound [ { #category : #'as yet unclassified' } PyramidSelectionMakerExtension >> selectFirstElementAt: aPosition [ - | selectedElements filtered isInnerOfImage isInnerOfLabel isLabelOfButton | + | selectedElements filtered | self projectModel ifNil: [ ^ { } ]. selectedElements := self projectModel allElements select: [ :each | each boundsInSpace containsPoint: aPosition ]. selectedElements ifEmpty: [ ^ { } ]. - filtered := selectedElements reject: [ :e | - isInnerOfImage := e class = BlElement and: [ - e parent class = ToImage ]. - isInnerOfLabel := e class = ToLabelMonoLineInnerElement - and: [ e parent class = ToLabel ]. - isLabelOfButton := e class = ToLabel and: [ - e parent parent class = ToButton ]. - isInnerOfImage or: [ - isInnerOfLabel or: [ isLabelOfButton ] ] ]. + filtered := selectedElements select: [ :e | + e parentsShouldSerializeChildren ]. filtered ifEmpty: [ ^ { selectedElements last } ]. ^ { filtered last } ] diff --git a/src/Pyramid/PyramidExternalRessourceProxy.class.st b/src/Pyramid/PyramidExternalRessourceProxy.class.st index 049fdf16..c1035b96 100644 --- a/src/Pyramid/PyramidExternalRessourceProxy.class.st +++ b/src/Pyramid/PyramidExternalRessourceProxy.class.st @@ -33,6 +33,22 @@ PyramidExternalRessourceProxy class >> fromTarget: aTarget selector: aSelector a postConstructionBlock: aBlock) ] +{ #category : #converting } +PyramidExternalRessourceProxy >> asBlBackground [ + + ^ BlBackground image: self +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> asElement [ + + (self pyramidExternalRessourceObject isKindOf: Form ) ifTrue: [ ^ BlElement new + extent: self extent; + background: self; + yourself ]. + ^ self pyramidExternalRessourceObject asElement +] + { #category : #converting } PyramidExternalRessourceProxy >> asStashConstructor [ diff --git a/src/Pyramid/PyramidIconInputPresenter.class.st b/src/Pyramid/PyramidIconInputPresenter.class.st index f4fcc832..66e1a33f 100644 --- a/src/Pyramid/PyramidIconInputPresenter.class.st +++ b/src/Pyramid/PyramidIconInputPresenter.class.st @@ -4,31 +4,170 @@ Class { #instVars : [ 'textInput', 'button', - 'list', - 'whenValueChangedDo' + 'whenValueChangedDo', + 'categoryList', + 'iconList' ], #category : #'Pyramid-specs-custom' } +{ #category : #adding } +PyramidIconInputPresenter class >> toploAntIconCategory [ + + ^ self + toploIconThemeCategoryFromClass: ToAntDesignIconProvider + withCategoryPrefix: 'Ant Design - ' +] + +{ #category : #adding } +PyramidIconInputPresenter class >> toploIconThemeCategoryFromClass: aClass withCategoryPrefix: aString [ + + | categoriesMethods | + categoriesMethods := aClass class methods select: [ :method | + method selector first = $_ and: [ + ($_ split: method selector) last = 'loaded' ] ]. + + ^ categoriesMethods collect: [ :method | + | prefix elementSelectors elements | + prefix := ($_ split: method selector) second. + + elementSelectors := (aClass perform: method selector) collect: [ + :suffix | prefix , '_' , suffix ]. + + elements := elementSelectors collect: [ :selector | + PyramidLibraryElement new + name: selector; + icon: (Smalltalk ui icons iconNamed: #blank); + block: [ + | image | + image := ToImage new + extent: 48 asPoint; + innerImage: + (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource + new + postConstructionBlock: [ :obj | + obj constraints horizontal + matchParent. + obj constraints vertical + matchParent ]; + target: BlSvgConverter; + selector: #convertFromString:; + arguments: + { (PyramidExternalRessourceProxy + new + + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource + new + target: aClass; + selector: + selector asSymbol; + arguments: { }; + yourself); + yourself) }; + yourself); + yourself). + { image } ]; + yourself ]. + PyramidLibraryCategory new + name: aString , prefix; + icon: (Smalltalk ui icons iconNamed: #image); + elements: elements; + yourself ] +] + +{ #category : #adding } +PyramidIconInputPresenter class >> toploMaterialIconCategory [ + + ^ self + toploIconThemeCategoryFromClass: ToMaterialDesignIconProvider + withCategoryPrefix: 'Material Design - ' +] + +{ #category : #private } +PyramidIconInputPresenter >> buildIconPickerPresenter [ + | categories presenter | + categories := OrderedCollection new. + categories add: (PyramidLibraryCategory new + name: 'Smalltalk Icons'; + icon: (Smalltalk ui icons iconNamed: #image); + elements: + (Smalltalk ui icons allIconNames asSortedCollection collect: [ + :name | + PyramidLibraryElement new + name: name; + icon: (Smalltalk ui icons iconNamed: name); + yourself ]); + yourself). + categories addAll: self class toploAntIconCategory. + categories addAll: self class toploMaterialIconCategory. + categoryList := SpFilteringListPresenter new. + categoryList + items: categories asArray; + display: [ :category | category name ]; + displayIcon: [ :category | category icon ]; + itemFilter: [ :category :filter | + filter isEmpty or: [ + category name asLowercase includesSubstring: filter asLowercase ] ]. + iconList := SpListPresenter new. + iconList + display: [ :element | element name ]; + displayIcon: [ :element | + [ element asForm scaledToSize: 16 @ 16 ] + on: Error + do: [ element icon ifNil: [ #blank ] ] ]. + categoryList whenSelectionChangedDo: [ :selection | + selection isEmpty + ifTrue: [ iconList items: #( ) ] + ifFalse: [ + iconList items: selection selectedItem elements asArray ] ]. + categories isNotEmpty ifTrue: [ categoryList selectIndex: 1 ]. + presenter := SpPresenter new. + presenter layout: (SpBoxLayout newHorizontal + add: categoryList width: 220; + add: iconList; + yourself). + ^ presenter +] + { #category : #layout } PyramidIconInputPresenter >> defaultLayout [ - ^ SpBoxLayout newHorizontal - spacing: 2; - add: textInput; - add: button width: 24; - yourself + spacing: 2; + add: textInput; + add: button width: 24; + yourself +] + +{ #category : #private } +PyramidIconInputPresenter >> iconFormFromName: aSymbol [ + + | iconImage element | + iconImage := Smalltalk ui icons iconNamed: aSymbol. + iconImage = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ + element := (PyramidToploThemePlugin + toploIconThemeCategoryFromClass: + ToAntDesignIconProvider + withCategoryPrefix: '') , (PyramidToploThemePlugin + toploIconThemeCategoryFromClass: + ToMaterialDesignIconProvider + withCategoryPrefix: '') + inject: nil + into: [ :found :cat | + found ifNil: [ + cat elements + detect: [ :e | e name = aSymbol ] + ifNone: [ nil ] ] ]. + element ifNotNil: [ ^ element block value first innerFormImage ] ]. + ^ iconImage ] { #category : #initialization } PyramidIconInputPresenter >> initializePresenters [ whenValueChangedDo := [ :v | ]. - list := SpFilteringListPresenter new. - list items: - Smalltalk ui icons allIconNames asSortedCollection asArray. - list display: [ :name | name ]. - list displayIcon: [ :name | Smalltalk ui icons iconNamed: name ]. textInput := SpTextInputFieldPresenter new. textInput whenSubmitDo: [ :text | whenValueChangedDo value: text ]. button := SpButtonPresenter new @@ -38,31 +177,34 @@ PyramidIconInputPresenter >> initializePresenters [ yourself ] -{ #category : #'as yet unclassified' } +{ #category : #private } PyramidIconInputPresenter >> openIconModal [ - | window dialog | - window := list asModalWindow. + | modalPresenter window dialog selected | + modalPresenter := self buildIconPickerPresenter. + window := modalPresenter asModalWindow. window title: 'Choose an icon'. window centered. dialog := window open. dialog isOk ifFalse: [ ^ self ]. - self value: list selectedItem. - whenValueChangedDo value: list selectedItem + selected := iconList selectedItem. + selected ifNil: [ ^ self ]. + self value: selected name. + whenValueChangedDo value: selected name ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidIconInputPresenter >> value [ ^ textInput text ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidIconInputPresenter >> value: aString [ textInput text: (aString ifNil: [ '' ]) ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidIconInputPresenter >> whenValueChangedDo: aBlock [ whenValueChangedDo := aBlock ] diff --git a/src/Pyramid/PyramidToButtonEndIconCommand.class.st b/src/Pyramid/PyramidToButtonEndIconCommand.class.st index cc65026c..2d32c877 100644 --- a/src/Pyramid/PyramidToButtonEndIconCommand.class.st +++ b/src/Pyramid/PyramidToButtonEndIconCommand.class.st @@ -1,6 +1,9 @@ Class { #name : #PyramidToButtonEndIconCommand, #superclass : #PyramidAbstractBlocCommand, + #instVars : [ + 'endIconName' + ], #category : #'Pyramid-plugin-editor' } @@ -12,18 +15,42 @@ PyramidToButtonEndIconCommand >> canBeUsedFor: anObject [ { #category : #getter } PyramidToButtonEndIconCommand >> getValueFor: aToButton [ - | form | - aToButton endIcon ifNil: [ ^ '' ]. - form := aToButton endIcon image innerFormImage. - ^ Smalltalk ui icons allIconNames - detect: [ :name | (Smalltalk ui icons iconNamed: name) = form ] - ifNone: [ '' ] + + ^ endIconName ifNil: [ ^ '' ] ] { #category : #setter } PyramidToButtonEndIconCommand >> setValueFor: aToButton with: aSymbol [ - | icon | - icon := ToIcon new. - icon iconImage: (Smalltalk ui icons iconNamed: aSymbol). - aToButton endIcon: icon. + + endIconName := aSymbol. + aToButton endIcon: (self toImageFromName: aSymbol) +] + +{ #category : #private } +PyramidToButtonEndIconCommand >> toImageFromName: aSymbol [ + + | element | + (Smalltalk ui icons iconNamed: aSymbol) + = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ + element := (PyramidToploThemePlugin + toploIconThemeCategoryFromClass: + ToAntDesignIconProvider + withCategoryPrefix: '') , (PyramidToploThemePlugin + toploIconThemeCategoryFromClass: + ToMaterialDesignIconProvider + withCategoryPrefix: '') + inject: nil + into: [ :found :cat | + found ifNil: [ + cat elements + detect: [ :e | e name = aSymbol ] + ifNone: [ nil ] ] ]. + element ifNotNil: [ ^ element block value first ] ]. + ^ ToImage new + innerImage: (PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: Object + selector: #iconNamed: + arguments: { aSymbol })); + yourself ] diff --git a/src/Pyramid/PyramidToButtonIconCommand.class.st b/src/Pyramid/PyramidToButtonIconCommand.class.st index 90047c19..0219cb52 100644 --- a/src/Pyramid/PyramidToButtonIconCommand.class.st +++ b/src/Pyramid/PyramidToButtonIconCommand.class.st @@ -1,6 +1,9 @@ Class { #name : #PyramidToButtonIconCommand, #superclass : #PyramidAbstractBlocCommand, + #instVars : [ + 'iconName' + ], #category : #'Pyramid-plugin-editor' } @@ -13,19 +16,42 @@ PyramidToButtonIconCommand >> canBeUsedFor: anObject [ { #category : #getter } PyramidToButtonIconCommand >> getValueFor: aToButton [ - | form | - aToButton icon ifNil: [ ^ '' ]. - form := aToButton icon image innerFormImage. - ^ Smalltalk ui icons allIconNames - detect: [ :name | (Smalltalk ui icons iconNamed: name) = form ] - ifNone: [ '' ] + ^ iconName ifNil: [ ^ '' ] + ] { #category : #setter } PyramidToButtonIconCommand >> setValueFor: aToButton with: aSymbol [ - | icon | - icon := ToIcon new. - icon iconImage: (Smalltalk ui icons iconNamed: aSymbol). - aToButton icon: icon + iconName := aSymbol. + aToButton icon: (self toImageFromName: aSymbol) +] + +{ #category : #private } +PyramidToButtonIconCommand >> toImageFromName: aSymbol [ + + | element | + (Smalltalk ui icons iconNamed: aSymbol) + = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ + element := (PyramidToploThemePlugin + toploIconThemeCategoryFromClass: + ToAntDesignIconProvider + withCategoryPrefix: '') , (PyramidToploThemePlugin + toploIconThemeCategoryFromClass: + ToMaterialDesignIconProvider + withCategoryPrefix: '') + inject: nil + into: [ :found :cat | + found ifNil: [ + cat elements + detect: [ :e | e name = aSymbol ] + ifNone: [ nil ] ] ]. + element ifNotNil: [ ^ element block value first ] ]. + ^ ToImage new + innerImage: (PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: Object + selector: #iconNamed: + arguments: { aSymbol })); + yourself ] diff --git a/src/Pyramid/PyramidToImageInnerImageCommand.class.st b/src/Pyramid/PyramidToImageInnerImageCommand.class.st index fbcfcd7e..01f20541 100644 --- a/src/Pyramid/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid/PyramidToImageInnerImageCommand.class.st @@ -1,6 +1,9 @@ Class { #name : #PyramidToImageInnerImageCommand, #superclass : #PyramidAbstractBlocCommand, + #instVars : [ + 'iconName' + ], #category : #'Pyramid-plugin-editor' } @@ -10,14 +13,43 @@ PyramidToImageInnerImageCommand >> canBeUsedFor: anObject [ ] { #category : #getter } -PyramidToImageInnerImageCommand >> getValueFor: anObject [ - anObject innerFormImage ifNil: [ ^ '' ]. - ^ Smalltalk ui icons allIconNames - detect: [ :name | (Smalltalk ui icons iconNamed: name) = anObject innerFormImage ] - ifNone: [ '' ] +PyramidToImageInnerImageCommand >> getValueFor: aToImage [ + + ^ iconName ifNil: [ ^ '' ] ] { #category : #setter } -PyramidToImageInnerImageCommand >> setValueFor: anObject with: aSymbol [ - anObject innerImage: (Smalltalk ui icons iconNamed: aSymbol) +PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ + + iconName := aSymbol. + aToImage innerImage: (self toImageFromName: aSymbol) +] + +{ #category : #private } +PyramidToImageInnerImageCommand >> toImageFromName: aSymbol [ + + | element | + (Smalltalk ui icons iconNamed: aSymbol) + = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ + element := (PyramidToploThemePlugin + toploIconThemeCategoryFromClass: + ToAntDesignIconProvider + withCategoryPrefix: '') , (PyramidToploThemePlugin + toploIconThemeCategoryFromClass: + ToMaterialDesignIconProvider + withCategoryPrefix: '') + inject: nil + into: [ :found :cat | + found ifNil: [ + cat elements + detect: [ :e | e name = aSymbol ] + ifNone: [ nil ] ] ]. + element ifNotNil: [ ^ element block value first ] ]. + ^ ToImage new + innerImage: (PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: Object + selector: #iconNamed: + arguments: { aSymbol })); + yourself ] From fe88e369649608603ce753d8e1d27ad16403a3f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Wed, 3 Jun 2026 10:25:34 +0200 Subject: [PATCH 04/14] update methods and fix an issue with the filter in the presenter --- .../PyramidToploThemePlugin.class.st | 8 +- .../PyramidIconInputPresenter.class.st | 156 ++++++++++-------- .../PyramidToButtonEndIconCommand.class.st | 31 +--- .../PyramidToButtonIconCommand.class.st | 31 +--- .../PyramidToImageInnerImageCommand.class.st | 31 +--- 5 files changed, 94 insertions(+), 163 deletions(-) diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index b1164fa2..dca929dd 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -45,9 +45,7 @@ PyramidToploThemePlugin class >> defaultThemeSettingOn: aBuilder [ PyramidToploThemePlugin class >> toploAntIconCategory [ - ^ PyramidToploThemePlugin - toploIconThemeCategoryFromClass: ToAntDesignIconProvider - withCategoryPrefix: 'Ant Design - ' + ^ PyramidIconInputPresenter toploAntIconCategory ] { #category : #adding } @@ -140,9 +138,7 @@ PyramidToploThemePlugin class >> toploLibraryCategory [ PyramidToploThemePlugin class >> toploMaterialIconCategory [ - ^ PyramidToploThemePlugin - toploIconThemeCategoryFromClass: ToMaterialDesignIconProvider - withCategoryPrefix: 'Material Design - ' + ^ PyramidIconInputPresenter toploMaterialIconCategory ] { #category : #adding } diff --git a/src/Pyramid/PyramidIconInputPresenter.class.st b/src/Pyramid/PyramidIconInputPresenter.class.st index 66e1a33f..55b83f06 100644 --- a/src/Pyramid/PyramidIconInputPresenter.class.st +++ b/src/Pyramid/PyramidIconInputPresenter.class.st @@ -11,6 +11,38 @@ Class { #category : #'Pyramid-specs-custom' } +{ #category : #private } +PyramidIconInputPresenter class >> findToploIconNamed: aSymbol [ + ^ (self + toploIconThemeCategoryFromClass: ToAntDesignIconProvider + withCategoryPrefix: '') , + (self + toploIconThemeCategoryFromClass: ToMaterialDesignIconProvider + withCategoryPrefix: '') + inject: nil + into: [ :found :cat | + found ifNil: [ + cat elements + detect: [ :e | e name = aSymbol ] + ifNone: [ nil ] ] ] +] + +{ #category : #private } +PyramidIconInputPresenter class >> toImageFromName: aSymbol [ + | element | + (Smalltalk ui icons iconNamed: aSymbol) + = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ + element := self findToploIconNamed: aSymbol. + element ifNotNil: [ ^ element block value first ] ]. + ^ ToImage new + innerImage: (PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: Object + selector: #iconNamed: + arguments: { aSymbol })); + yourself +] + { #category : #adding } PyramidIconInputPresenter class >> toploAntIconCategory [ @@ -88,48 +120,59 @@ PyramidIconInputPresenter class >> toploMaterialIconCategory [ { #category : #private } PyramidIconInputPresenter >> buildIconPickerPresenter [ - | categories presenter | - categories := OrderedCollection new. - categories add: (PyramidLibraryCategory new - name: 'Smalltalk Icons'; - icon: (Smalltalk ui icons iconNamed: #image); - elements: - (Smalltalk ui icons allIconNames asSortedCollection collect: [ - :name | - PyramidLibraryElement new - name: name; - icon: (Smalltalk ui icons iconNamed: name); - yourself ]); - yourself). - categories addAll: self class toploAntIconCategory. - categories addAll: self class toploMaterialIconCategory. - categoryList := SpFilteringListPresenter new. - categoryList - items: categories asArray; - display: [ :category | category name ]; - displayIcon: [ :category | category icon ]; - itemFilter: [ :category :filter | - filter isEmpty or: [ - category name asLowercase includesSubstring: filter asLowercase ] ]. - iconList := SpListPresenter new. - iconList - display: [ :element | element name ]; - displayIcon: [ :element | - [ element asForm scaledToSize: 16 @ 16 ] - on: Error - do: [ element icon ifNil: [ #blank ] ] ]. - categoryList whenSelectionChangedDo: [ :selection | - selection isEmpty - ifTrue: [ iconList items: #( ) ] - ifFalse: [ - iconList items: selection selectedItem elements asArray ] ]. - categories isNotEmpty ifTrue: [ categoryList selectIndex: 1 ]. - presenter := SpPresenter new. - presenter layout: (SpBoxLayout newHorizontal - add: categoryList width: 220; - add: iconList; - yourself). - ^ presenter + + | categories presenter | + categories := OrderedCollection new. + categories add: (PyramidLibraryCategory new + name: 'Smalltalk Icons'; + icon: (Smalltalk ui icons iconNamed: #image); + elements: + (Smalltalk ui icons allIconNames asSortedCollection collect: [ + :name | + PyramidLibraryElement new + name: name asString; + icon: (Smalltalk ui icons iconNamed: name); + yourself ]); + yourself). + + categories addAll: self class toploAntIconCategory. + categories addAll: self class toploMaterialIconCategory. + + categoryList := SpListPresenter new. + categoryList + items: categories asArray; + display: [ :category | category name ]; + displayIcon: [ :category | category icon ]. + + + iconList := SpFilteringListPresenter new. + iconList + display: [ :element | element name ]; + displayIcon: [ :element | + | icon | + icon := element icon. + (icon isNil or: [ icon = (Smalltalk ui icons iconNamed: #blank) ]) + ifTrue: [ + [ element asForm scaledToSize: 16 @ 16 ] + on: Error + do: [ Smalltalk ui icons iconNamed: #blank ] ] + ifFalse: [ icon ] ]; + itemFilter: [ :element :filter | + filter isEmpty or: [ + element asLowercase includesSubstring: filter asLowercase ] ]. + + categoryList whenSelectionChangedDo: [ :selection | + selection isEmpty + ifTrue: [ iconList items: #( ) ] + ifFalse: [ + iconList items: selection selectedItem elements asArray ] ]. + categories isNotEmpty ifTrue: [ categoryList selectIndex: 1 ]. + presenter := SpPresenter new. + presenter layout: (SpBoxLayout newHorizontal + add: categoryList width: 220; + add: iconList; + yourself). + ^ presenter -> iconList ] { #category : #layout } @@ -141,29 +184,6 @@ PyramidIconInputPresenter >> defaultLayout [ yourself ] -{ #category : #private } -PyramidIconInputPresenter >> iconFormFromName: aSymbol [ - - | iconImage element | - iconImage := Smalltalk ui icons iconNamed: aSymbol. - iconImage = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ - element := (PyramidToploThemePlugin - toploIconThemeCategoryFromClass: - ToAntDesignIconProvider - withCategoryPrefix: '') , (PyramidToploThemePlugin - toploIconThemeCategoryFromClass: - ToMaterialDesignIconProvider - withCategoryPrefix: '') - inject: nil - into: [ :found :cat | - found ifNil: [ - cat elements - detect: [ :e | e name = aSymbol ] - ifNone: [ nil ] ] ]. - element ifNotNil: [ ^ element block value first innerFormImage ] ]. - ^ iconImage -] - { #category : #initialization } PyramidIconInputPresenter >> initializePresenters [ @@ -180,8 +200,10 @@ PyramidIconInputPresenter >> initializePresenters [ { #category : #private } PyramidIconInputPresenter >> openIconModal [ - | modalPresenter window dialog selected | - modalPresenter := self buildIconPickerPresenter. + | result modalPresenter window dialog selected | + result := self buildIconPickerPresenter. + modalPresenter := result key. + iconList := result value. window := modalPresenter asModalWindow. window title: 'Choose an icon'. window centered. diff --git a/src/Pyramid/PyramidToButtonEndIconCommand.class.st b/src/Pyramid/PyramidToButtonEndIconCommand.class.st index 2d32c877..8c69013e 100644 --- a/src/Pyramid/PyramidToButtonEndIconCommand.class.st +++ b/src/Pyramid/PyramidToButtonEndIconCommand.class.st @@ -23,34 +23,5 @@ PyramidToButtonEndIconCommand >> getValueFor: aToButton [ PyramidToButtonEndIconCommand >> setValueFor: aToButton with: aSymbol [ endIconName := aSymbol. - aToButton endIcon: (self toImageFromName: aSymbol) -] - -{ #category : #private } -PyramidToButtonEndIconCommand >> toImageFromName: aSymbol [ - - | element | - (Smalltalk ui icons iconNamed: aSymbol) - = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ - element := (PyramidToploThemePlugin - toploIconThemeCategoryFromClass: - ToAntDesignIconProvider - withCategoryPrefix: '') , (PyramidToploThemePlugin - toploIconThemeCategoryFromClass: - ToMaterialDesignIconProvider - withCategoryPrefix: '') - inject: nil - into: [ :found :cat | - found ifNil: [ - cat elements - detect: [ :e | e name = aSymbol ] - ifNone: [ nil ] ] ]. - element ifNotNil: [ ^ element block value first ] ]. - ^ ToImage new - innerImage: (PyramidExternalRessourceProxy fromSource: - (PyramidExternalRessourceSource - target: Object - selector: #iconNamed: - arguments: { aSymbol })); - yourself + aToButton endIcon: (PyramidIconInputPresenter toImageFromName: aSymbol) ] diff --git a/src/Pyramid/PyramidToButtonIconCommand.class.st b/src/Pyramid/PyramidToButtonIconCommand.class.st index 0219cb52..203b067b 100644 --- a/src/Pyramid/PyramidToButtonIconCommand.class.st +++ b/src/Pyramid/PyramidToButtonIconCommand.class.st @@ -24,34 +24,5 @@ PyramidToButtonIconCommand >> getValueFor: aToButton [ PyramidToButtonIconCommand >> setValueFor: aToButton with: aSymbol [ iconName := aSymbol. - aToButton icon: (self toImageFromName: aSymbol) -] - -{ #category : #private } -PyramidToButtonIconCommand >> toImageFromName: aSymbol [ - - | element | - (Smalltalk ui icons iconNamed: aSymbol) - = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ - element := (PyramidToploThemePlugin - toploIconThemeCategoryFromClass: - ToAntDesignIconProvider - withCategoryPrefix: '') , (PyramidToploThemePlugin - toploIconThemeCategoryFromClass: - ToMaterialDesignIconProvider - withCategoryPrefix: '') - inject: nil - into: [ :found :cat | - found ifNil: [ - cat elements - detect: [ :e | e name = aSymbol ] - ifNone: [ nil ] ] ]. - element ifNotNil: [ ^ element block value first ] ]. - ^ ToImage new - innerImage: (PyramidExternalRessourceProxy fromSource: - (PyramidExternalRessourceSource - target: Object - selector: #iconNamed: - arguments: { aSymbol })); - yourself + aToButton icon: (PyramidIconInputPresenter toImageFromName: aSymbol) ] diff --git a/src/Pyramid/PyramidToImageInnerImageCommand.class.st b/src/Pyramid/PyramidToImageInnerImageCommand.class.st index 01f20541..ec7f3b1e 100644 --- a/src/Pyramid/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid/PyramidToImageInnerImageCommand.class.st @@ -22,34 +22,5 @@ PyramidToImageInnerImageCommand >> getValueFor: aToImage [ PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ iconName := aSymbol. - aToImage innerImage: (self toImageFromName: aSymbol) -] - -{ #category : #private } -PyramidToImageInnerImageCommand >> toImageFromName: aSymbol [ - - | element | - (Smalltalk ui icons iconNamed: aSymbol) - = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ - element := (PyramidToploThemePlugin - toploIconThemeCategoryFromClass: - ToAntDesignIconProvider - withCategoryPrefix: '') , (PyramidToploThemePlugin - toploIconThemeCategoryFromClass: - ToMaterialDesignIconProvider - withCategoryPrefix: '') - inject: nil - into: [ :found :cat | - found ifNil: [ - cat elements - detect: [ :e | e name = aSymbol ] - ifNone: [ nil ] ] ]. - element ifNotNil: [ ^ element block value first ] ]. - ^ ToImage new - innerImage: (PyramidExternalRessourceProxy fromSource: - (PyramidExternalRessourceSource - target: Object - selector: #iconNamed: - arguments: { aSymbol })); - yourself + aToImage innerImage: (PyramidIconInputPresenter toImageFromName: aSymbol) ] From 8a69e6e12cb04f9c415f9daf9e29581a0459b1de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 4 Jun 2026 13:38:27 +0200 Subject: [PATCH 05/14] fix problems with PyramidGeometryCommand and PyramidRoundedRectangleCornerRadiiCommand --- src/Pyramid/PyramidGeometryCommand.class.st | 7 ++++--- .../PyramidRoundedRectangleCornerRadiiCommand.class.st | 6 +++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Pyramid/PyramidGeometryCommand.class.st b/src/Pyramid/PyramidGeometryCommand.class.st index 39c7f9e6..4cc0574b 100644 --- a/src/Pyramid/PyramidGeometryCommand.class.st +++ b/src/Pyramid/PyramidGeometryCommand.class.st @@ -6,17 +6,18 @@ Class { { #category : #testing } PyramidGeometryCommand >> canBeUsedFor: anObject [ - ^ (super canBeUsedFor: anObject) and: [ anObject class = BlElement ] + + ^ (super canBeUsedFor: anObject) and: [ anObject class = BlElement ] ] { #category : #getter } -PyramidGeometryCommand >> getValueFor: aBlElement [ +PyramidGeometryCommand >> getValueFor: aBlElement [ ^ aBlElement geometry ] { #category : #setter } -PyramidGeometryCommand >> setValueFor: aBlElement with: anArgument [ +PyramidGeometryCommand >> setValueFor: aBlElement with: anArgument [ aBlElement geometry: anArgument ] diff --git a/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st b/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st index 617f15d5..28389f8d 100644 --- a/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st +++ b/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st @@ -5,7 +5,7 @@ Class { } { #category : #testing } -PyramidRoundedRectangleCornerRadiiCommand >> canBeUsedFor: anObject [ +PyramidRoundedRectangleCornerRadiiCommand >> canBeUsedFor: anObject [ ^ (super canBeUsedFor: anObject) and: [ anObject class = BlElement and: [ @@ -13,13 +13,13 @@ PyramidRoundedRectangleCornerRadiiCommand >> canBeUsedFor: anObject [ ] { #category : #getter } -PyramidRoundedRectangleCornerRadiiCommand >> getValueFor: aBlElement [ +PyramidRoundedRectangleCornerRadiiCommand >> getValueFor: aBlElement [ ^ aBlElement geometry cornerRadii ] { #category : #setter } -PyramidRoundedRectangleCornerRadiiCommand >> setValueFor: aBlElement with: anArgument [ +PyramidRoundedRectangleCornerRadiiCommand >> setValueFor: aBlElement with: anArgument [ aBlElement geometry: (BlRoundedRectangleGeometry cornerRadii: anArgument) From 8ee8a1e05e8ac7a7b7807d7a6916fd677057a39a Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 9 Jun 2026 09:15:35 +0200 Subject: [PATCH 06/14] Use a Form as innerImage instead of a ToImage to avoid nesting ToImage inside ToImage --- .../PyramidIconInputPresenter.class.st | 40 +++++++++++++------ .../PyramidToImageInnerImageCommand.class.st | 3 +- 2 files changed, 30 insertions(+), 13 deletions(-) diff --git a/src/Pyramid/PyramidIconInputPresenter.class.st b/src/Pyramid/PyramidIconInputPresenter.class.st index 55b83f06..8b9b6d9f 100644 --- a/src/Pyramid/PyramidIconInputPresenter.class.st +++ b/src/Pyramid/PyramidIconInputPresenter.class.st @@ -27,20 +27,36 @@ PyramidIconInputPresenter class >> findToploIconNamed: aSymbol [ ifNone: [ nil ] ] ] ] +{ #category : #private } +PyramidIconInputPresenter class >> innerElementFromName: aSymbol [ + + (Smalltalk ui icons iconNamed: aSymbol) + = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ + | element | + element := self findToploIconNamed: aSymbol. + element ifNotNil: [ ^ element block value first asForm ] ]. + ^ PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: Object + selector: #iconNamed: + arguments: { aSymbol }) +] + { #category : #private } PyramidIconInputPresenter class >> toImageFromName: aSymbol [ - | element | - (Smalltalk ui icons iconNamed: aSymbol) - = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ - element := self findToploIconNamed: aSymbol. - element ifNotNil: [ ^ element block value first ] ]. - ^ ToImage new - innerImage: (PyramidExternalRessourceProxy fromSource: - (PyramidExternalRessourceSource - target: Object - selector: #iconNamed: - arguments: { aSymbol })); - yourself + + (Smalltalk ui icons iconNamed: aSymbol) + = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ + | element | + element := self findToploIconNamed: aSymbol. + element ifNotNil: [^ element block value first ] ]. + ^ ToImage new + innerImage: (PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: Object + selector: #iconNamed: + arguments: { aSymbol })); + yourself ] { #category : #adding } diff --git a/src/Pyramid/PyramidToImageInnerImageCommand.class.st b/src/Pyramid/PyramidToImageInnerImageCommand.class.st index ec7f3b1e..b38914ac 100644 --- a/src/Pyramid/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid/PyramidToImageInnerImageCommand.class.st @@ -22,5 +22,6 @@ PyramidToImageInnerImageCommand >> getValueFor: aToImage [ PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ iconName := aSymbol. - aToImage innerImage: (PyramidIconInputPresenter toImageFromName: aSymbol) + aToImage innerImage: + (PyramidIconInputPresenter innerElementFromName: aSymbol) ] From 321f2b10ce8b35a30b1faf9eca8f0b5266a69464 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Thu, 16 Jul 2026 15:12:49 +0200 Subject: [PATCH 07/14] fix problems with ToImage and add tests --- .../PyramidLibraryElement.class.st | 15 ++++++- ...amidCornerRadiiInputPresenterTest.class.st | 2 +- .../PyramidGeometryCommandTest.class.st | 2 +- ...edRectangleCornerRadiiCommandTest.class.st | 2 +- .../PyramidToButtonLabelCommandTest.class.st | 34 +++++++++++++++ ...ramidToImageInnerImageCommandTest.class.st | 38 +++++++++++++++++ .../PyramidToLabelTextCommandTest.class.st | 35 ++++++++++++++++ src/Pyramid/PyramidEditorPlugin.class.st | 2 +- .../PyramidIconInputPresenter.class.st | 42 ++++++++++++++++++- .../PyramidToImageInnerImageCommand.class.st | 3 +- 10 files changed, 167 insertions(+), 8 deletions(-) create mode 100644 src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st create mode 100644 src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st create mode 100644 src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index 08385a16..b1799b85 100644 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryElement.class.st @@ -4,7 +4,8 @@ Class { #instVars : [ 'name', 'icon', - 'block' + 'block', + 'provider' ], #category : #'Pyramid-Bloc-plugin-navigation' } @@ -85,3 +86,15 @@ PyramidLibraryElement >> name: anObject [ name := anObject ] + +{ #category : #accessing } +PyramidLibraryElement >> provider [ + + ^ provider +] + +{ #category : #accessing } +PyramidLibraryElement >> provider: aClass [ + +provider := aClass +] diff --git a/src/Pyramid-Tests/PyramidCornerRadiiInputPresenterTest.class.st b/src/Pyramid-Tests/PyramidCornerRadiiInputPresenterTest.class.st index 2ea3d1e0..8a9e7b79 100644 --- a/src/Pyramid-Tests/PyramidCornerRadiiInputPresenterTest.class.st +++ b/src/Pyramid-Tests/PyramidCornerRadiiInputPresenterTest.class.st @@ -3,7 +3,7 @@ Class { #superclass : #TestCase, #traits : 'TPyramidInputPresenterTest', #classTraits : 'TPyramidInputPresenterTest classTrait', - #category : #'Pyramid-Tests-cases-plugin-bloc-geometry' + #category : #'Pyramid-Tests-cases-plugin-editor' } { #category : #accessing } diff --git a/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st b/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st index 070c4ad8..4d4d3a7a 100644 --- a/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st @@ -3,7 +3,7 @@ Class { #superclass : #TestCase, #traits : 'TPyramidCommandTest', #classTraits : 'TPyramidCommandTest classTrait', - #category : #'Pyramid-Tests-cases-plugin-bloc-geometry' + #category : #'Pyramid-Tests-cases-plugin-editor' } { #category : #accessing } diff --git a/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st b/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st index 68db7048..300b257a 100644 --- a/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st @@ -3,7 +3,7 @@ Class { #superclass : #TestCase, #traits : 'TPyramidCommandTest', #classTraits : 'TPyramidCommandTest classTrait', - #category : #'Pyramid-Tests-cases-plugin-bloc-geometry' + #category : #'Pyramid-Tests-cases-plugin-editor' } { #category : #accessing } diff --git a/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st b/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st new file mode 100644 index 00000000..b3a4f8f8 --- /dev/null +++ b/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st @@ -0,0 +1,34 @@ +Class { + #name : #PyramidToButtonLabelCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToButtonLabelCommandTest >> command [ + +^ PyramidToButtonLabelCommand new +] + +{ #category : #'as yet unclassified' } +PyramidToButtonLabelCommandTest >> targetContainers [ + + ^ { + (PyramidCommandTestContainer + no: ToButton new + with: (ToButton new + labelText: 'hello'; + yourself) + prop: 'hello'). + + (PyramidCommandTestContainer + no: (ToButton new + labelText: 'hello'; + yourself) + with: (ToButton new + labelText: 'pyramid'; + yourself) + prop: 'pyramid') } +] diff --git a/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st new file mode 100644 index 00000000..3ae713ab --- /dev/null +++ b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st @@ -0,0 +1,38 @@ +Class { + #name : #PyramidToImageInnerImageCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToImageInnerImageCommandTest >> command [ + +^ PyramidToImageInnerImageCommand new +] + +{ #category : #'as yet unclassified' } +PyramidToImageInnerImageCommandTest >> targetContainers [ + + | icon1 icon2 | + icon1 := Smalltalk ui icons iconNamed: #add. + icon2 := Smalltalk ui icons iconNamed: #remove. + + ^ { + (PyramidCommandTestContainer + no: ToImage new + with: (ToImage new + innerImage: icon1; + yourself) + prop: #add). + + (PyramidCommandTestContainer + no: (ToImage new + innerImage: icon1; + yourself) + with: (ToImage new + innerImage: icon2; + yourself) + prop: #remove) } +] diff --git a/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st b/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st new file mode 100644 index 00000000..dc2fdfc0 --- /dev/null +++ b/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st @@ -0,0 +1,35 @@ +Class { + #name : #PyramidToLabelTextCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToLabelTextCommandTest >> command [ + +^ PyramidToLabelTextCommand new +] + +{ #category : #'as yet unclassified' } +PyramidToLabelTextCommandTest >> targetContainers [ + + ^ { + + (PyramidCommandTestContainer + no: ToLabel new + with: (ToLabel new + text: 'hello'; + yourself) + prop: 'hello'). + + (PyramidCommandTestContainer + no: (ToLabel new + text: 'hello'; + yourself) + with: (ToLabel new + text: 'pyramid'; + yourself) + prop: 'pyramid') } +] diff --git a/src/Pyramid/PyramidEditorPlugin.class.st b/src/Pyramid/PyramidEditorPlugin.class.st index 64da94cf..5dec4bfe 100644 --- a/src/Pyramid/PyramidEditorPlugin.class.st +++ b/src/Pyramid/PyramidEditorPlugin.class.st @@ -154,5 +154,5 @@ PyramidEditorPlugin >> initialize [ propertiesManager addProperty: self class toImageInnerImage. "ToLabel properties" - propertiesManager addProperty: self class toLabelText + propertiesManager addProperty: self class toLabelText. ] diff --git a/src/Pyramid/PyramidIconInputPresenter.class.st b/src/Pyramid/PyramidIconInputPresenter.class.st index 8b9b6d9f..ccdbb684 100644 --- a/src/Pyramid/PyramidIconInputPresenter.class.st +++ b/src/Pyramid/PyramidIconInputPresenter.class.st @@ -34,7 +34,27 @@ PyramidIconInputPresenter class >> innerElementFromName: aSymbol [ = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ | element | element := self findToploIconNamed: aSymbol. - element ifNotNil: [ ^ element block value first asForm ] ]. + element ifNotNil: [ + ^ PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource new + + postConstructionBlock: [ :obj | + obj constraints horizontal matchParent. + obj constraints vertical matchParent ]; + + target: BlSvgConverter; + selector: #convertFromString:; + arguments: { (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource new + target: element provider; + selector: element name asSymbol; + arguments: { }; + yourself); + yourself) }; + yourself); + yourself ] ]. ^ PyramidExternalRessourceProxy fromSource: (PyramidExternalRessourceSource target: Object @@ -49,7 +69,24 @@ PyramidIconInputPresenter class >> toImageFromName: aSymbol [ = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ | element | element := self findToploIconNamed: aSymbol. - element ifNotNil: [^ element block value first ] ]. + element ifNotNil: [ + ^ ToImage new + innerImage: + (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource new + target: BlSvgConverter; + selector: #convertFromString:; + arguments: { (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource new + target: element provider; + selector: element name asSymbol; + arguments: { }; + yourself); + yourself) }; + yourself)); + yourself ] ]. ^ ToImage new innerImage: (PyramidExternalRessourceProxy fromSource: (PyramidExternalRessourceSource @@ -85,6 +122,7 @@ PyramidIconInputPresenter class >> toploIconThemeCategoryFromClass: aClass withC elements := elementSelectors collect: [ :selector | PyramidLibraryElement new name: selector; + provider: aClass; icon: (Smalltalk ui icons iconNamed: #blank); block: [ | image | diff --git a/src/Pyramid/PyramidToImageInnerImageCommand.class.st b/src/Pyramid/PyramidToImageInnerImageCommand.class.st index b38914ac..53d4bff5 100644 --- a/src/Pyramid/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid/PyramidToImageInnerImageCommand.class.st @@ -15,13 +15,14 @@ PyramidToImageInnerImageCommand >> canBeUsedFor: anObject [ { #category : #getter } PyramidToImageInnerImageCommand >> getValueFor: aToImage [ - ^ iconName ifNil: [ ^ '' ] + ^ aToImage userData at: #pyramidIconName ifAbsent: [ '' ] ] { #category : #setter } PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ iconName := aSymbol. + aToImage extent isZero ifTrue: [ aToImage extent: 48 asPoint ]. aToImage innerImage: (PyramidIconInputPresenter innerElementFromName: aSymbol) ] From 4910683d611b3e92e5633681731182f9746352c4 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 28 Jul 2026 15:53:35 +0200 Subject: [PATCH 08/14] update metadata method and add tests --- .../PyramidLibraryElement.class.st | 1 + .../PyramidMainExtension.class.st | 43 ++++++- src/Pyramid-Bloc/PyramidSavePlugin.class.st | 9 +- .../PyramidSavingService.class.st | 63 +++++++--- ...PyramidToButtonEndIconCommandTest.class.st | 36 ++++++ .../PyramidToButtonIconCommandTest.class.st | 36 ++++++ .../PyramidToButtonLabelCommandTest.class.st | 2 +- ...ramidToImageInnerImageCommandTest.class.st | 10 +- .../PyramidToLabelTextCommandTest.class.st | 2 +- src/Pyramid/PyramidGeometryCommand.class.st | 23 ---- src/Pyramid/PyramidHistory.class.st | 4 +- .../PyramidIconInputPresenter.class.st | 109 +++++++++--------- ...oundedRectangleCornerRadiiCommand.class.st | 26 ----- .../PyramidToButtonEndIconCommand.class.st | 15 +-- .../PyramidToButtonIconCommand.class.st | 11 +- .../PyramidToImageInnerImageCommand.class.st | 12 +- 16 files changed, 242 insertions(+), 160 deletions(-) create mode 100644 src/Pyramid-Tests/PyramidToButtonEndIconCommandTest.class.st create mode 100644 src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st delete mode 100644 src/Pyramid/PyramidGeometryCommand.class.st delete mode 100644 src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index dd729813..62dd2f0a 100644 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryElement.class.st @@ -5,6 +5,7 @@ Class { 'name', 'icon', 'block', + 'provider', 'status' ], #category : #'Pyramid-Bloc-plugin-navigation' diff --git a/src/Pyramid-Bloc/PyramidMainExtension.class.st b/src/Pyramid-Bloc/PyramidMainExtension.class.st index 78f4d36f..1b48b841 100644 --- a/src/Pyramid-Bloc/PyramidMainExtension.class.st +++ b/src/Pyramid-Bloc/PyramidMainExtension.class.st @@ -21,11 +21,17 @@ Class { 'currentGridWindowSize', 'currentGridVisibility', 'currentGridSpacing', - 'currentGridColor' + 'currentGridColor', + 'currentProjectIcons' ], #category : #'Pyramid-Bloc-plugin-space-extensions' } +{ #category : #adding } +PyramidMainExtension class >> addIconName: aSymbol forElementId: aString [ + self currentProjectIcons at: aString asSymbol put: aSymbol +] + { #category : #accessing } PyramidMainExtension class >> currentGridColor [ @@ -73,6 +79,29 @@ PyramidMainExtension class >> currentGridWindowSize: aPoint [ currentGridWindowSize := aPoint ] +{ #category : #accessing } +PyramidMainExtension class >> currentProjectIcons [ + + ^ currentProjectIcons ifNil: [ currentProjectIcons := Dictionary new ] +] + +{ #category : #accessing } +PyramidMainExtension class >> currentProjectIcons: aDictionary [ + currentProjectIcons := aDictionary + +] + +{ #category : #accessing } +PyramidMainExtension class >> iconNameForElementId: aString [ + ^ self currentProjectIcons at: aString ifAbsent: [ nil ] +] + +{ #category : #initialization } +PyramidMainExtension class >> resetCurrentProjectIcons [ + + currentProjectIcons := Dictionary new +] + { #category : #accessing } PyramidMainExtension >> borderElement [ @@ -296,11 +325,13 @@ PyramidMainExtension >> informTransformationChanged [ { #category : #initialization } PyramidMainExtension >> initialize [ "Set the default parameter value of the grid" + self class currentGridWindowSize: self defaultExtent. self class currentGridVisibility: self defaultGridVisibility. self class currentGridSpacing: self defaultGridSpacing. self class currentGridColor: self defaultGridColor. - + self class resetCurrentProjectIcons. + gridWindowSize := self defaultExtent. gridVisibility := self defaultGridVisibility. gridSpacing := self defaultGridSpacing. @@ -308,14 +339,14 @@ PyramidMainExtension >> initialize [ "Set up the graphical parameter windows of the grid and the space extension" workplacePropertiesView := PyramidWorkplacePropertiesPresenter new - workplaceSizeValue: self defaultExtent; + workplaceSizeValue: self defaultExtent; whenWorkplaceValuesChangedDo: [ :point | self extent: point ]; whenVisibilityChangedDo: [ gridVisibility := workplacePropertiesView visibilityButton - state. - + state. + self class currentGridVisibility: gridVisibility. self createGrid ]; @@ -341,7 +372,7 @@ PyramidMainExtension >> initialize [ self class currentGridColor: color. self createGrid ]; yourself. - workplacePropertiesView visibilityButton state: gridVisibility. + workplacePropertiesView visibilityButton state: gridVisibility. self defaultGridSpacing <= 0 ifTrue: [ gridSpacing := 1 ]. diff --git a/src/Pyramid-Bloc/PyramidSavePlugin.class.st b/src/Pyramid-Bloc/PyramidSavePlugin.class.st index 6b297665..04cb13cf 100644 --- a/src/Pyramid-Bloc/PyramidSavePlugin.class.st +++ b/src/Pyramid-Bloc/PyramidSavePlugin.class.st @@ -20,7 +20,6 @@ PyramidSavePlugin class >> openOn: aCollectionOfBlElement saveModel: aSaveModel | editor savePlugin metaData mainExtension spacePlugin | PyramidSavingService currentProjectMetaData: nil. - PyramidMainExtension currentGridWindowSize: nil. editor := PyramidEditor buildEditor. savePlugin := editor plugins select: [ :each | each class = self ]. savePlugin size = 1 ifFalse: [ @@ -46,6 +45,8 @@ PyramidSavePlugin class >> openOn: aCollectionOfBlElement saveModel: aSaveModel editor open. metaData ifNotNil: [ + (metaData at: #icons ifAbsent: [ nil ]) ifNotNil: [ :icons | + PyramidMainExtension currentProjectIcons: icons ]. spacePlugin := editor plugins detect: [ :p | p isKindOf: PyramidSpacePlugin ] ifNone: [ nil ]. @@ -60,8 +61,10 @@ PyramidSavePlugin class >> openOn: aCollectionOfBlElement saveModel: aSaveModel mainExtension workplacePropertiesView workplaceSizeValue: size ]. (metaData at: #gridVisibility ifAbsent: [ nil ]) ifNotNil: [ - :visibility | mainExtension gridVisibility: visibility. - mainExtension workplacePropertiesView visibilityButton state: visibility ]. + :visibility | + mainExtension gridVisibility: visibility. + mainExtension workplacePropertiesView visibilityButton + state: visibility ]. (metaData at: #gridSpacing ifAbsent: [ nil ]) ifNotNil: [ :spacing | mainExtension gridSpacing: spacing. diff --git a/src/Pyramid-Bloc/PyramidSavingService.class.st b/src/Pyramid-Bloc/PyramidSavingService.class.st index 7e49cf9d..40028ee0 100644 --- a/src/Pyramid-Bloc/PyramidSavingService.class.st +++ b/src/Pyramid-Bloc/PyramidSavingService.class.st @@ -118,7 +118,7 @@ PyramidSavingService class >> ston [ { #category : #private } PyramidSavingService >> buildMetaDataMethod [ - | methodName windowSize gridVisibility gridSpacing gridColor dictContent nl tab header | + | methodName windowSize gridVisibility gridSpacing gridColor icons dictContent nl tab header existingIds | methodName := self saveModel savingMethodName , 'MetaData'. windowSize := PyramidMainExtension currentGridWindowSize ifNil: [ 800 @ 600 ]. @@ -127,34 +127,61 @@ PyramidSavingService >> buildMetaDataMethod [ gridSpacing := PyramidMainExtension currentGridSpacing ifNil: [ 10 ]. gridColor := PyramidMainExtension currentGridColor ifNil: [ Color black ]. + existingIds := Set new. + [ + self saveModel projectModel firstLevelElements do: [ :e | + (e respondsTo: #id) ifTrue: [ + e id ifNotNil: [ :anId | existingIds add: anId asString ] ] ] ] + on: Error + do: [ :err | existingIds := Set new ]. + icons := Dictionary new. + PyramidMainExtension currentProjectIcons keysAndValuesDo: [ + :key + :value | + | keyString suffix baseId | + keyString := key asString. + suffix := #( '_icon' '_endIcon' '_innerImage' ) + detect: [ :s | keyString endsWith: s ] + ifNone: [ nil ]. + suffix ifNotNil: [ + baseId := keyString copyFrom: 1 to: keyString size - suffix size. + (existingIds includes: baseId) ifTrue: [ + icons at: key put: value ] ] ] . (windowSize = (800 @ 600) and: [ gridVisibility not and: [ - gridSpacing = 10 and: [ gridColor = Color black ] ] ]) ifTrue: [ + gridSpacing = 10 and: [ + gridColor = Color black and: [ icons isEmpty ] ] ] ]) ifTrue: [ ^ nil ]. - nl := String with: Character cr. tab := String with: Character tab. - dictContent := ''. windowSize = (800 @ 600) ifFalse: [ - dictContent := dictContent , nl , tab , tab , 'at: #windowSize put: ' - , windowSize x printString , ' @ ' - , windowSize y printString , ';' ]. + dictContent := dictContent , nl , tab , tab + , 'at: #windowSize put: ' , windowSize x printString + , ' @ ' , windowSize y printString , ';' ]. gridVisibility ifTrue: [ - dictContent := dictContent - , nl , tab , tab , 'at: #gridVisibility put: true;' ]. + dictContent := dictContent , nl , tab , tab + , 'at: #gridVisibility put: true;' ]. gridSpacing = 10 ifFalse: [ - dictContent := dictContent , nl , tab , tab , 'at: #gridSpacing put: ' - , gridSpacing printString , ';' ]. + dictContent := dictContent , nl , tab , tab + , 'at: #gridSpacing put: ' , gridSpacing printString + , ';' ]. gridColor = Color black ifFalse: [ - dictContent := dictContent , nl , tab , tab , 'at: #gridColor put: ' - , gridColor printString , ';' ]. - - header := methodName , nl , tab , '"Pyramid project metadata"' , nl , tab. - + dictContent := dictContent , nl , tab , tab + , 'at: #gridColor put: ' , gridColor printString + , ';' ]. + icons ifNotEmpty: [ + dictContent := dictContent , nl , tab , tab + , 'at: #icons put: (Dictionary new'. + icons keysAndValuesDo: [ :id :symbol | + dictContent := dictContent , nl , tab , tab , tab , 'at: #' , id + , ' put: #' , symbol , ';' ]. + dictContent := dictContent , nl , tab , tab , tab , 'yourself);' ]. + header := methodName , nl , tab , '"Pyramid project metadata"' , nl + , tab. ^ header , '' , nl , tab - , 'PyramidSavingService currentProjectMetaData: (Dictionary new' - , dictContent , nl , tab , tab , 'yourself)' + , 'PyramidSavingService currentProjectMetaData: (Dictionary new' + , dictContent , nl , tab , tab , 'yourself)' ] { #category : #testing } diff --git a/src/Pyramid-Tests/PyramidToButtonEndIconCommandTest.class.st b/src/Pyramid-Tests/PyramidToButtonEndIconCommandTest.class.st new file mode 100644 index 00000000..188aab63 --- /dev/null +++ b/src/Pyramid-Tests/PyramidToButtonEndIconCommandTest.class.st @@ -0,0 +1,36 @@ +Class { + #name : #PyramidToButtonEndIconCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToButtonEndIconCommandTest >> command [ + + ^ PyramidToButtonEndIconCommand new +] + +{ #category : #accessing } +PyramidToButtonEndIconCommandTest >> targetContainers [ + + | buttonA buttonAWithIcon | + buttonA := ToButton new + id: 'A'; + yourself. + + buttonAWithIcon := ToButton new + id: 'A'; + icon: + (PyramidIconInputPresenter toImageFromName: #add); + yourself. + + PyramidMainExtension addIconName: #add forElementId: 'A_endIcon'. + + + ^ { (PyramidCommandTestContainer + no: buttonA + with: buttonAWithIcon + prop: #add) } +] diff --git a/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st b/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st new file mode 100644 index 00000000..cd7c1ce0 --- /dev/null +++ b/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st @@ -0,0 +1,36 @@ +Class { + #name : #PyramidToButtonIconCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-editor' +} + +{ #category : #accessing } +PyramidToButtonIconCommandTest >> command [ + + ^ PyramidToButtonIconCommand new +] + +{ #category : #accessing } +PyramidToButtonIconCommandTest >> targetContainers [ + + | buttonA buttonAWithIcon | + buttonA := ToButton new + id: 'A'; + yourself. + + buttonAWithIcon := ToButton new + id: 'A'; + icon: + (PyramidIconInputPresenter toImageFromName: #add); + yourself. + + PyramidMainExtension addIconName: #add forElementId: 'A'. + + + ^ { (PyramidCommandTestContainer + no: buttonA + with: buttonAWithIcon + prop: #add) } +] diff --git a/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st b/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st index b3a4f8f8..ec4de0cb 100644 --- a/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidToButtonLabelCommandTest.class.st @@ -12,7 +12,7 @@ PyramidToButtonLabelCommandTest >> command [ ^ PyramidToButtonLabelCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidToButtonLabelCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st index 3ae713ab..c26499df 100644 --- a/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st @@ -12,26 +12,26 @@ PyramidToImageInnerImageCommandTest >> command [ ^ PyramidToImageInnerImageCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidToImageInnerImageCommandTest >> targetContainers [ - | icon1 icon2 | icon1 := Smalltalk ui icons iconNamed: #add. icon2 := Smalltalk ui icons iconNamed: #remove. - ^ { (PyramidCommandTestContainer - no: ToImage new + no: (ToImage new id: 'A'; yourself) with: (ToImage new + id: 'A'; innerImage: icon1; yourself) prop: #add). - (PyramidCommandTestContainer no: (ToImage new + id: 'B'; innerImage: icon1; yourself) with: (ToImage new + id: 'B'; innerImage: icon2; yourself) prop: #remove) } diff --git a/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st b/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st index dc2fdfc0..4df79c65 100644 --- a/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidToLabelTextCommandTest.class.st @@ -12,7 +12,7 @@ PyramidToLabelTextCommandTest >> command [ ^ PyramidToLabelTextCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidToLabelTextCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid/PyramidGeometryCommand.class.st b/src/Pyramid/PyramidGeometryCommand.class.st deleted file mode 100644 index 4cc0574b..00000000 --- a/src/Pyramid/PyramidGeometryCommand.class.st +++ /dev/null @@ -1,23 +0,0 @@ -Class { - #name : #PyramidGeometryCommand, - #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-plugin-editor' -} - -{ #category : #testing } -PyramidGeometryCommand >> canBeUsedFor: anObject [ - - ^ (super canBeUsedFor: anObject) and: [ anObject class = BlElement ] -] - -{ #category : #getter } -PyramidGeometryCommand >> getValueFor: aBlElement [ - - ^ aBlElement geometry -] - -{ #category : #setter } -PyramidGeometryCommand >> setValueFor: aBlElement with: anArgument [ - - aBlElement geometry: anArgument -] diff --git a/src/Pyramid/PyramidHistory.class.st b/src/Pyramid/PyramidHistory.class.st index 05a8d77e..5c18bab4 100644 --- a/src/Pyramid/PyramidHistory.class.st +++ b/src/Pyramid/PyramidHistory.class.st @@ -66,6 +66,6 @@ PyramidHistory >> redo [ PyramidHistory >> undo [ self canUndo ifTrue: [ - (self mementosStack at: self position) key restore. - position := position - 1 ] + (self mementosStack at: self position) key restore. + position := position - 1 ]. ] diff --git a/src/Pyramid/PyramidIconInputPresenter.class.st b/src/Pyramid/PyramidIconInputPresenter.class.st index ccdbb684..acfaaec3 100644 --- a/src/Pyramid/PyramidIconInputPresenter.class.st +++ b/src/Pyramid/PyramidIconInputPresenter.class.st @@ -11,6 +11,16 @@ Class { #category : #'Pyramid-specs-custom' } +{ #category : #private } +PyramidIconInputPresenter class >> buildProxy: aTarget selector: aSelector args: anArray [ + + ^ PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: aTarget + selector: aSelector + arguments: anArray) +] + { #category : #private } PyramidIconInputPresenter class >> findToploIconNamed: aSymbol [ ^ (self @@ -30,69 +40,37 @@ PyramidIconInputPresenter class >> findToploIconNamed: aSymbol [ { #category : #private } PyramidIconInputPresenter class >> innerElementFromName: aSymbol [ - (Smalltalk ui icons iconNamed: aSymbol) - = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ - | element | - element := self findToploIconNamed: aSymbol. - element ifNotNil: [ - ^ PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: - (PyramidExternalRessourceSource new - - postConstructionBlock: [ :obj | - obj constraints horizontal matchParent. - obj constraints vertical matchParent ]; - - target: BlSvgConverter; - selector: #convertFromString:; - arguments: { (PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: - (PyramidExternalRessourceSource new - target: element provider; - selector: element name asSymbol; - arguments: { }; - yourself); - yourself) }; - yourself); - yourself ] ]. - ^ PyramidExternalRessourceProxy fromSource: - (PyramidExternalRessourceSource - target: Object - selector: #iconNamed: - arguments: { aSymbol }) + (self findToploIconNamed: aSymbol) ifNotNil: [ :element | + | proxy | + proxy := self toploSvgProxyFor: element. + + proxy pyramidExternalRessourceSource postConstructionBlock: [ :obj | + obj constraints horizontal matchParent. + obj constraints vertical matchParent ]. + + ^ proxy ]. + + ^ self buildProxy: Object selector: #iconNamed: args: { aSymbol } ] { #category : #private } PyramidIconInputPresenter class >> toImageFromName: aSymbol [ - (Smalltalk ui icons iconNamed: aSymbol) - = (Smalltalk ui icons iconNamed: #blank) ifTrue: [ - | element | - element := self findToploIconNamed: aSymbol. - element ifNotNil: [ - ^ ToImage new - innerImage: - (PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: - (PyramidExternalRessourceSource new - target: BlSvgConverter; - selector: #convertFromString:; - arguments: { (PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: - (PyramidExternalRessourceSource new - target: element provider; - selector: element name asSymbol; - arguments: { }; - yourself); - yourself) }; - yourself)); - yourself ] ]. + (self findToploIconNamed: aSymbol) ifNotNil: [ :element | + | proxy | + proxy := self toploSvgProxyFor: element. + + proxy pyramidExternalRessourceSource postConstructionBlock: [ :obj | + obj constraints horizontal exact: 16. + obj constraints vertical exact: 16 ]. + + ^ ToImage new + innerImage: proxy; + yourself ]. + ^ ToImage new - innerImage: (PyramidExternalRessourceProxy fromSource: - (PyramidExternalRessourceSource - target: Object - selector: #iconNamed: - arguments: { aSymbol })); + innerImage: + (self buildProxy: Object selector: #iconNamed: args: { aSymbol }); yourself ] @@ -172,6 +150,23 @@ PyramidIconInputPresenter class >> toploMaterialIconCategory [ withCategoryPrefix: 'Material Design - ' ] +{ #category : #private } +PyramidIconInputPresenter class >> toploSvgProxyFor: element [ + + | stringProxy svgProxy | + stringProxy := self + buildProxy: element provider + selector: element name asSymbol + args: #( ). + + svgProxy := self + buildProxy: BlSvgConverter + selector: #convertFromString: + args: { stringProxy }. + + ^ svgProxy +] + { #category : #private } PyramidIconInputPresenter >> buildIconPickerPresenter [ diff --git a/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st b/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st deleted file mode 100644 index 28389f8d..00000000 --- a/src/Pyramid/PyramidRoundedRectangleCornerRadiiCommand.class.st +++ /dev/null @@ -1,26 +0,0 @@ -Class { - #name : #PyramidRoundedRectangleCornerRadiiCommand, - #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-plugin-editor' -} - -{ #category : #testing } -PyramidRoundedRectangleCornerRadiiCommand >> canBeUsedFor: anObject [ - - ^ (super canBeUsedFor: anObject) and: [ - anObject class = BlElement and: [ - anObject geometry class = BlRoundedRectangleGeometry ] ] -] - -{ #category : #getter } -PyramidRoundedRectangleCornerRadiiCommand >> getValueFor: aBlElement [ - - ^ aBlElement geometry cornerRadii -] - -{ #category : #setter } -PyramidRoundedRectangleCornerRadiiCommand >> setValueFor: aBlElement with: anArgument [ - - aBlElement geometry: - (BlRoundedRectangleGeometry cornerRadii: anArgument) -] diff --git a/src/Pyramid/PyramidToButtonEndIconCommand.class.st b/src/Pyramid/PyramidToButtonEndIconCommand.class.st index 8c69013e..2e3e8bab 100644 --- a/src/Pyramid/PyramidToButtonEndIconCommand.class.st +++ b/src/Pyramid/PyramidToButtonEndIconCommand.class.st @@ -1,9 +1,6 @@ Class { #name : #PyramidToButtonEndIconCommand, #superclass : #PyramidAbstractBlocCommand, - #instVars : [ - 'endIconName' - ], #category : #'Pyramid-plugin-editor' } @@ -15,13 +12,17 @@ PyramidToButtonEndIconCommand >> canBeUsedFor: anObject [ { #category : #getter } PyramidToButtonEndIconCommand >> getValueFor: aToButton [ - - ^ endIconName ifNil: [ ^ '' ] + ^ (PyramidMainExtension currentProjectIcons + at: aToButton id , '_endIcon' ifAbsent: [ nil ]) + ifNil: [ '' ] ] { #category : #setter } PyramidToButtonEndIconCommand >> setValueFor: aToButton with: aSymbol [ - endIconName := aSymbol. - aToButton endIcon: (PyramidIconInputPresenter toImageFromName: aSymbol) + aToButton endIcon: + (PyramidIconInputPresenter toImageFromName: aSymbol). + PyramidMainExtension + addIconName: aSymbol + forElementId: aToButton id , '_endIcon' ] diff --git a/src/Pyramid/PyramidToButtonIconCommand.class.st b/src/Pyramid/PyramidToButtonIconCommand.class.st index 203b067b..69f1b931 100644 --- a/src/Pyramid/PyramidToButtonIconCommand.class.st +++ b/src/Pyramid/PyramidToButtonIconCommand.class.st @@ -1,9 +1,6 @@ Class { #name : #PyramidToButtonIconCommand, #superclass : #PyramidAbstractBlocCommand, - #instVars : [ - 'iconName' - ], #category : #'Pyramid-plugin-editor' } @@ -15,14 +12,16 @@ PyramidToButtonIconCommand >> canBeUsedFor: anObject [ { #category : #getter } PyramidToButtonIconCommand >> getValueFor: aToButton [ + ^ (PyramidMainExtension iconNameForElementId: aToButton id , '_icon') ifNil: [ '' ] - ^ iconName ifNil: [ ^ '' ] ] { #category : #setter } PyramidToButtonIconCommand >> setValueFor: aToButton with: aSymbol [ - iconName := aSymbol. - aToButton icon: (PyramidIconInputPresenter toImageFromName: aSymbol) + aToButton icon: (PyramidIconInputPresenter toImageFromName: aSymbol). + PyramidMainExtension + addIconName: aSymbol + forElementId: aToButton id , '_icon' ] diff --git a/src/Pyramid/PyramidToImageInnerImageCommand.class.st b/src/Pyramid/PyramidToImageInnerImageCommand.class.st index 53d4bff5..79d96ad1 100644 --- a/src/Pyramid/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid/PyramidToImageInnerImageCommand.class.st @@ -14,15 +14,17 @@ PyramidToImageInnerImageCommand >> canBeUsedFor: anObject [ { #category : #getter } PyramidToImageInnerImageCommand >> getValueFor: aToImage [ - - ^ aToImage userData at: #pyramidIconName ifAbsent: [ '' ] + ^ (PyramidMainExtension currentProjectIcons + at: aToImage id , '_innerImage' ifAbsent: [ nil ]) + ifNil: [ '' ] ] { #category : #setter } PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ - iconName := aSymbol. - aToImage extent isZero ifTrue: [ aToImage extent: 48 asPoint ]. aToImage innerImage: - (PyramidIconInputPresenter innerElementFromName: aSymbol) + (PyramidIconInputPresenter innerElementFromName: aSymbol). + PyramidMainExtension + addIconName: aSymbol + forElementId: aToImage id , '_innerImage' ] From 1ffb8c55b466a5b8b33f7ad25da9f2aee0bb55cb Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 28 Jul 2026 16:05:37 +0200 Subject: [PATCH 09/14] fix 'methodIsValid' --- src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st b/src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st index 6374cc47..d8425326 100644 --- a/src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st +++ b/src/Pyramid-Bloc/PyramidSaveModelVerifier.class.st @@ -47,10 +47,9 @@ PyramidSaveModelVerifier class >> classPackageIsEqual [ PyramidSaveModelVerifier class >> methodIsValid [ ^ self new - verifyBlock: [ :model | - OCScanner isSelector: model savingMethodName ]; + verifyBlock: [ :model | model savingMethodName isValidSelector ]; showBlock: [ :view | view showMethodIsNotValidError ]; - yourself + yourself. ] { #category : #constructor } From 58ef8919ff90734ca27ce8e1f3adcb540934fdc7 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 28 Jul 2026 16:42:48 +0200 Subject: [PATCH 10/14] fix problem with geometry command --- .../PyramidEditorPlugin.class.st | 2 +- .../PyramidGeometryCommand.class.st | 24 ++++++++++++++++++ ...oundedRectangleCornerRadiiCommand.class.st | 25 +++++++++++++++++++ .../PyramidToButtonEndIconCommand.class.st | 2 +- .../PyramidToButtonIconCommand.class.st | 2 +- .../PyramidToButtonLabelCommand.class.st | 2 +- .../PyramidToImageInnerImageCommand.class.st | 2 +- .../PyramidToLabelTextCommand.class.st | 2 +- 8 files changed, 55 insertions(+), 6 deletions(-) rename src/{Pyramid => Pyramid-Bloc}/PyramidEditorPlugin.class.st (98%) create mode 100644 src/Pyramid-Bloc/PyramidGeometryCommand.class.st create mode 100644 src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st rename src/{Pyramid => Pyramid-Bloc}/PyramidToButtonEndIconCommand.class.st (93%) rename src/{Pyramid => Pyramid-Bloc}/PyramidToButtonIconCommand.class.st (93%) rename src/{Pyramid => Pyramid-Bloc}/PyramidToButtonLabelCommand.class.st (91%) rename src/{Pyramid => Pyramid-Bloc}/PyramidToImageInnerImageCommand.class.st (94%) rename src/{Pyramid => Pyramid-Bloc}/PyramidToLabelTextCommand.class.st (91%) diff --git a/src/Pyramid/PyramidEditorPlugin.class.st b/src/Pyramid-Bloc/PyramidEditorPlugin.class.st similarity index 98% rename from src/Pyramid/PyramidEditorPlugin.class.st rename to src/Pyramid-Bloc/PyramidEditorPlugin.class.st index 5dec4bfe..8e2a5911 100644 --- a/src/Pyramid/PyramidEditorPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidEditorPlugin.class.st @@ -6,7 +6,7 @@ Class { #instVars : [ 'propertiesManager' ], - #category : #'Pyramid-plugin-editor' + #category : #'Pyramid-Bloc-plugin-bloc-editor' } { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st b/src/Pyramid-Bloc/PyramidGeometryCommand.class.st new file mode 100644 index 00000000..00504b3c --- /dev/null +++ b/src/Pyramid-Bloc/PyramidGeometryCommand.class.st @@ -0,0 +1,24 @@ +Class { + #name : #PyramidGeometryCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-editor' +} + +{ #category : #testing } +PyramidGeometryCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ + anObject class = BlElement ] +] + +{ #category : #getter } +PyramidGeometryCommand >> getValueFor: aBlElement [ + + ^ aBlElement geometry +] + +{ #category : #setter } +PyramidGeometryCommand >> setValueFor: aBlElement with: anArgument [ + + aBlElement geometry: anArgument +] diff --git a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st b/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st new file mode 100644 index 00000000..f614852f --- /dev/null +++ b/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st @@ -0,0 +1,25 @@ +Class { + #name : #PyramidRoundedRectangleCornerRadiiCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-editor' +} + +{ #category : #testing } +PyramidRoundedRectangleCornerRadiiCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ + anObject geometry class = BlRoundedRectangleGeometry ] +] + +{ #category : #getter } +PyramidRoundedRectangleCornerRadiiCommand >> getValueFor: aBlElement [ + + ^ aBlElement geometry cornerRadii +] + +{ #category : #initialization } +PyramidRoundedRectangleCornerRadiiCommand >> setValueFor: aBlElement with: anArgument [ + + aBlElement geometry: + (BlRoundedRectangleGeometry cornerRadii: anArgument) +] diff --git a/src/Pyramid/PyramidToButtonEndIconCommand.class.st b/src/Pyramid-Bloc/PyramidToButtonEndIconCommand.class.st similarity index 93% rename from src/Pyramid/PyramidToButtonEndIconCommand.class.st rename to src/Pyramid-Bloc/PyramidToButtonEndIconCommand.class.st index 2e3e8bab..3c9bb5ad 100644 --- a/src/Pyramid/PyramidToButtonEndIconCommand.class.st +++ b/src/Pyramid-Bloc/PyramidToButtonEndIconCommand.class.st @@ -1,7 +1,7 @@ Class { #name : #PyramidToButtonEndIconCommand, #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-plugin-editor' + #category : #'Pyramid-Bloc-plugin-bloc-editor' } { #category : #testing } diff --git a/src/Pyramid/PyramidToButtonIconCommand.class.st b/src/Pyramid-Bloc/PyramidToButtonIconCommand.class.st similarity index 93% rename from src/Pyramid/PyramidToButtonIconCommand.class.st rename to src/Pyramid-Bloc/PyramidToButtonIconCommand.class.st index 69f1b931..dafe7bb7 100644 --- a/src/Pyramid/PyramidToButtonIconCommand.class.st +++ b/src/Pyramid-Bloc/PyramidToButtonIconCommand.class.st @@ -1,7 +1,7 @@ Class { #name : #PyramidToButtonIconCommand, #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-plugin-editor' + #category : #'Pyramid-Bloc-plugin-bloc-editor' } { #category : #testing } diff --git a/src/Pyramid/PyramidToButtonLabelCommand.class.st b/src/Pyramid-Bloc/PyramidToButtonLabelCommand.class.st similarity index 91% rename from src/Pyramid/PyramidToButtonLabelCommand.class.st rename to src/Pyramid-Bloc/PyramidToButtonLabelCommand.class.st index 30b6c128..a73dabbe 100644 --- a/src/Pyramid/PyramidToButtonLabelCommand.class.st +++ b/src/Pyramid-Bloc/PyramidToButtonLabelCommand.class.st @@ -1,7 +1,7 @@ Class { #name : #PyramidToButtonLabelCommand, #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-plugin-editor' + #category : #'Pyramid-Bloc-plugin-bloc-editor' } { #category : #testing } diff --git a/src/Pyramid/PyramidToImageInnerImageCommand.class.st b/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st similarity index 94% rename from src/Pyramid/PyramidToImageInnerImageCommand.class.st rename to src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st index 79d96ad1..4cec109c 100644 --- a/src/Pyramid/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st @@ -4,7 +4,7 @@ Class { #instVars : [ 'iconName' ], - #category : #'Pyramid-plugin-editor' + #category : #'Pyramid-Bloc-plugin-bloc-editor' } { #category : #testing } diff --git a/src/Pyramid/PyramidToLabelTextCommand.class.st b/src/Pyramid-Bloc/PyramidToLabelTextCommand.class.st similarity index 91% rename from src/Pyramid/PyramidToLabelTextCommand.class.st rename to src/Pyramid-Bloc/PyramidToLabelTextCommand.class.st index bfaebdac..2bed4705 100644 --- a/src/Pyramid/PyramidToLabelTextCommand.class.st +++ b/src/Pyramid-Bloc/PyramidToLabelTextCommand.class.st @@ -1,7 +1,7 @@ Class { #name : #PyramidToLabelTextCommand, #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-plugin-editor' + #category : #'Pyramid-Bloc-plugin-bloc-editor' } { #category : #testing } From 2fcece8a5256ff4ef91e55705f228e53e740b664 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 28 Jul 2026 16:53:09 +0200 Subject: [PATCH 11/14] update tests --- .../PyramidToButtonIconCommandTest.class.st | 2 +- ...ramidToImageInnerImageCommandTest.class.st | 34 +++++++------------ 2 files changed, 14 insertions(+), 22 deletions(-) diff --git a/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st b/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st index cd7c1ce0..46f64a8c 100644 --- a/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidToButtonIconCommandTest.class.st @@ -26,7 +26,7 @@ PyramidToButtonIconCommandTest >> targetContainers [ (PyramidIconInputPresenter toImageFromName: #add); yourself. - PyramidMainExtension addIconName: #add forElementId: 'A'. + PyramidMainExtension addIconName: #add forElementId: 'A_icon'. ^ { (PyramidCommandTestContainer diff --git a/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st index c26499df..0ec6e5ec 100644 --- a/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st @@ -14,25 +14,17 @@ PyramidToImageInnerImageCommandTest >> command [ { #category : #accessing } PyramidToImageInnerImageCommandTest >> targetContainers [ - | icon1 icon2 | - icon1 := Smalltalk ui icons iconNamed: #add. - icon2 := Smalltalk ui icons iconNamed: #remove. - ^ { - (PyramidCommandTestContainer - no: (ToImage new id: 'A'; yourself) - with: (ToImage new - id: 'A'; - innerImage: icon1; - yourself) - prop: #add). - (PyramidCommandTestContainer - no: (ToImage new - id: 'B'; - innerImage: icon1; - yourself) - with: (ToImage new - id: 'B'; - innerImage: icon2; - yourself) - prop: #remove) } + + | icon | + icon := Smalltalk ui icons iconNamed: #add. + PyramidMainExtension addIconName: #add forElementId: 'A_innerImage'. + ^ { (PyramidCommandTestContainer + no: (ToImage new + id: 'A'; + yourself) + with: (ToImage new + id: 'A'; + innerImage: icon; + yourself) + prop: #add) } ] From f34b457373fdceccf3ec6ec8e1b4fce675b4cf5f Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Wed, 29 Jul 2026 09:44:15 +0200 Subject: [PATCH 12/14] Fix error when selecting a ToButton with an icon via mouse --- src/Pyramid-Bloc/PyramidGeometryCommand.class.st | 7 ------- src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st | 7 ++++--- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st b/src/Pyramid-Bloc/PyramidGeometryCommand.class.st index 00504b3c..d67417ef 100644 --- a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st +++ b/src/Pyramid-Bloc/PyramidGeometryCommand.class.st @@ -4,13 +4,6 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-editor' } -{ #category : #testing } -PyramidGeometryCommand >> canBeUsedFor: anObject [ - - ^ (super canBeUsedFor: anObject) and: [ - anObject class = BlElement ] -] - { #category : #getter } PyramidGeometryCommand >> getValueFor: aBlElement [ diff --git a/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st b/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st index 4cec109c..2ca8a1f4 100644 --- a/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st @@ -14,9 +14,10 @@ PyramidToImageInnerImageCommand >> canBeUsedFor: anObject [ { #category : #getter } PyramidToImageInnerImageCommand >> getValueFor: aToImage [ - ^ (PyramidMainExtension currentProjectIcons - at: aToImage id , '_innerImage' ifAbsent: [ nil ]) - ifNil: [ '' ] + + ^ (PyramidMainExtension currentProjectIcons + at: aToImage id asString, '_innerImage' + ifAbsent: [ nil ]) ifNil: [ '' ] ] { #category : #setter } From 77950c19f5a0a39173db4e86eea73f15b75b24eb Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Wed, 29 Jul 2026 11:11:37 +0200 Subject: [PATCH 13/14] fix problem with the setter of ToImage icon --- src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st b/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st index 2ca8a1f4..4925d79d 100644 --- a/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st +++ b/src/Pyramid-Bloc/PyramidToImageInnerImageCommand.class.st @@ -27,5 +27,5 @@ PyramidToImageInnerImageCommand >> setValueFor: aToImage with: aSymbol [ (PyramidIconInputPresenter innerElementFromName: aSymbol). PyramidMainExtension addIconName: aSymbol - forElementId: aToImage id , '_innerImage' + forElementId: aToImage id asString, '_innerImage' ] From d851a5f4cdbdbd7020ac856561c732235d069fe2 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Wed, 29 Jul 2026 11:24:51 +0200 Subject: [PATCH 14/14] update tests --- ...ramidToImageInnerImageCommandTest.class.st | 27 ++++++++++++------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st index 0ec6e5ec..0543da31 100644 --- a/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidToImageInnerImageCommandTest.class.st @@ -18,13 +18,22 @@ PyramidToImageInnerImageCommandTest >> targetContainers [ | icon | icon := Smalltalk ui icons iconNamed: #add. PyramidMainExtension addIconName: #add forElementId: 'A_innerImage'. - ^ { (PyramidCommandTestContainer - no: (ToImage new - id: 'A'; - yourself) - with: (ToImage new - id: 'A'; - innerImage: icon; - yourself) - prop: #add) } + PyramidMainExtension addIconName: #add forElementId: 'nil_innerImage'. + ^ { + (PyramidCommandTestContainer + no: (ToImage new + id: 'A'; + yourself) + with: (ToImage new + id: 'A'; + innerImage: icon; + yourself) + prop: #add). + (PyramidCommandTestContainer + no: (ToImage + new) + with: (ToImage new + innerImage: icon; + yourself) + prop: #add) } ]