From 9a9ef48f7597149cafec22bc9fac84eb2a230fd8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Wed, 1 Apr 2026 11:08:39 +0200 Subject: [PATCH 01/58] add BlSimpleShadowEffect --- .../PyramidBackgroundBlocPlugin.class.st | 68 ++++++++++++++++++- .../PyramidSaveModelVerifier.class.st | 5 +- .../PyramidShadowColorCommand.class.st | 21 ++++++ .../PyramidShadowCommand.class.st | 17 +++++ .../PyramidShadowOffsetCommand.class.st | 24 +++++++ 5 files changed, 132 insertions(+), 3 deletions(-) create mode 100644 src/Pyramid-Bloc/PyramidShadowColorCommand.class.st create mode 100644 src/Pyramid-Bloc/PyramidShadowCommand.class.st create mode 100644 src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st diff --git a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st index e2702d10..163a2f2e 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st @@ -671,6 +671,67 @@ PyramidBackgroundBlocPlugin class >> outskirts [ ^ property ] +{ #category : #accessing } +PyramidBackgroundBlocPlugin class >> shadow [ + + | property | + property := PyramidProperty new + name: 'Shadow Effect'; + command: PyramidShadowCommand new; + inputPresenterClass: PyramidMagicButtonsInputPresenter; + yourself. + property inputPresenterModel + addButtonModel: (PyramidMagicButtonModel new + icon: (Smalltalk ui icons iconNamed: #blank); + helpSelected: 'No shadow.'; + helpNotSelected: 'Remove shadow.'; + label: 'None'; + inputValue: [ BlNullEffect new]; + inputValidation: [ :value | value class = BlNullEffect]; + yourself); + addButtonModel: (PyramidMagicButtonModel new + icon: (Smalltalk ui icons iconNamed: #menuPin); + helpSelected: 'Shadow type is simple.'; + helpNotSelected: 'Set shadow type to simple.'; + label: 'Simple'; + inputValue: [ + BlSimpleShadowEffect color: Color random offset: 2 @ 2 ]; + inputValidation: [ :value | value class = BlSimpleShadowEffect ]; + yourself); + yourself. + ^ property +] + +{ #category : #accessing } +PyramidBackgroundBlocPlugin class >> shadowColor [ + + | property | + property := PyramidProperty new + name: 'Shadow Color'; + command: PyramidShadowColorCommand new; + inputPresenterClass: + PyramidColorInputSingleLineWithPickupButtonPresenter; + yourself. + ^ property + + +] + +{ #category : #accessing } +PyramidBackgroundBlocPlugin class >> shadowOffset [ + + | property | + property := PyramidProperty new + name: 'Shadow Offset'; + command: PyramidShadowOffsetCommand new; + inputPresenterClass: + PyramidPointInputPresenter; + yourself. + property inputPresenterModel help: + 'Set the position x and y for the shadow offset'. + ^ property +] + { #category : #adding } PyramidBackgroundBlocPlugin >> addPanelsOn: aPyramidSimpleWindow [ @@ -747,7 +808,12 @@ PyramidBackgroundBlocPlugin >> initialize [ propertiesManager addProperty: self class borderRadialInnerCenter. propertiesManager addProperty: self class borderRadialInnerRadius. propertiesManager addProperty: self class borderRadialOuterCenter. - propertiesManager addProperty: self class borderRadialOuterRadius + propertiesManager addProperty: self class borderRadialOuterRadius. + + "Shadow" + propertiesManager addProperty: self class shadow. + propertiesManager addProperty: self class shadowColor. + propertiesManager addProperty: self class shadowOffset ] { #category : #adding } 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-Bloc/PyramidShadowColorCommand.class.st b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st new file mode 100644 index 00000000..d9c6793e --- /dev/null +++ b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st @@ -0,0 +1,21 @@ +Class { + #name : #PyramidShadowColorCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-visuals' +} + +{ #category : #testing } +PyramidShadowColorCommand >> canBeUsedFor: anObject [ + ^ (super canBeUsedFor: anObject) and: [ + anObject effect isKindOf: BlShadowEffect ] +] + +{ #category : #'as yet unclassified' } +PyramidShadowColorCommand >> getValueFor: aBlElement [ + ^ aBlElement effect color +] + +{ #category : #initialization } +PyramidShadowColorCommand >> setValueFor: aBlElement with: aColor [ + aBlElement effect: (aBlElement effect copyWithColor: aColor) +] diff --git a/src/Pyramid-Bloc/PyramidShadowCommand.class.st b/src/Pyramid-Bloc/PyramidShadowCommand.class.st new file mode 100644 index 00000000..4999233d --- /dev/null +++ b/src/Pyramid-Bloc/PyramidShadowCommand.class.st @@ -0,0 +1,17 @@ +Class { + #name : #PyramidShadowCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-visuals' +} + +{ #category : #'as yet unclassified' } +PyramidShadowCommand >> getValueFor: aBlElement [ + + ^ aBlElement effect +] + +{ #category : #'as yet unclassified' } +PyramidShadowCommand >> setValueFor: aBlElement with: anArgument [ + + aBlElement effect: anArgument +] diff --git a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st new file mode 100644 index 00000000..225f9660 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st @@ -0,0 +1,24 @@ +Class { + #name : #PyramidShadowOffsetCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-visuals' +} + +{ #category : #testing } +PyramidShadowOffsetCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ + anObject effect isKindOf: BlShadowEffect ] +] + +{ #category : #'as yet unclassified' } +PyramidShadowOffsetCommand >> getValueFor: aBlElement [ + + ^ aBlElement effect offset +] + +{ #category : #'as yet unclassified' } +PyramidShadowOffsetCommand >> setValueFor: aBlElement with: aPoint [ + + aBlElement effect: (aBlElement effect copyWithOffset: aPoint) +] From b862d3defc7660a2581e0a1a2ead1484ea28298e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Wed, 1 Apr 2026 14:52:03 +0200 Subject: [PATCH 02/58] add BlGaussianShadow and its properties --- .../PyramidBackgroundBlocPlugin.class.st | 29 +++++++++++++++++-- ...PyramidGaussianShadowWidthCommand.class.st | 24 +++++++++++++++ 2 files changed, 50 insertions(+), 3 deletions(-) create mode 100644 src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st diff --git a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st index 163a2f2e..2d9ede16 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st @@ -618,6 +618,19 @@ PyramidBackgroundBlocPlugin class >> borderWidth [ ^ property ] +{ #category : #'as yet unclassified' } +PyramidBackgroundBlocPlugin class >> gaussianShadowWidth [ + + | property | + property := PyramidProperty new + name: 'Shadow Width'; + command: PyramidGaussianShadowWidthCommand new; + inputPresenterClass: PyramidNumberInputPresenter; + yourself. + property inputPresenterModel help: 'Set the width value'. + ^ property +] + { #category : #accessing } PyramidBackgroundBlocPlugin class >> opacity [ @@ -686,8 +699,8 @@ PyramidBackgroundBlocPlugin class >> shadow [ helpSelected: 'No shadow.'; helpNotSelected: 'Remove shadow.'; label: 'None'; - inputValue: [ BlNullEffect new]; - inputValidation: [ :value | value class = BlNullEffect]; + inputValue: [ BlNullEffect new ]; + inputValidation: [ :value | value class = BlNullEffect ]; yourself); addButtonModel: (PyramidMagicButtonModel new icon: (Smalltalk ui icons iconNamed: #menuPin); @@ -698,6 +711,15 @@ PyramidBackgroundBlocPlugin class >> shadow [ BlSimpleShadowEffect color: Color random offset: 2 @ 2 ]; inputValidation: [ :value | value class = BlSimpleShadowEffect ]; yourself); + addButtonModel: (PyramidMagicButtonModel new + icon: (Smalltalk ui icons iconNamed: #menuPin); + helpSelected: 'Shadow type is gaussian.'; + helpNotSelected: 'Set shadow type to gaussian.'; + label: 'Gaussian'; + inputValue: [ + BlGaussianShadowEffect color: Color random width: 2 offset: 2 @ 2 ]; + inputValidation: [ :value | value class = BlGaussianShadowEffect ]; + yourself); yourself. ^ property ] @@ -813,7 +835,8 @@ PyramidBackgroundBlocPlugin >> initialize [ "Shadow" propertiesManager addProperty: self class shadow. propertiesManager addProperty: self class shadowColor. - propertiesManager addProperty: self class shadowOffset + propertiesManager addProperty: self class shadowOffset. + propertiesManager addProperty: self class gaussianShadowWidth ] { #category : #adding } diff --git a/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st b/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st new file mode 100644 index 00000000..e71d80dc --- /dev/null +++ b/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st @@ -0,0 +1,24 @@ +Class { + #name : #PyramidGaussianShadowWidthCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-visuals' +} + +{ #category : #testing } +PyramidGaussianShadowWidthCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ + anObject effect isKindOf: BlGaussianShadowEffect ] +] + +{ #category : #'as yet unclassified' } +PyramidGaussianShadowWidthCommand >> getValueFor: aBlElement [ + + ^ aBlElement effect width +] + +{ #category : #'as yet unclassified' } +PyramidGaussianShadowWidthCommand >> setValueFor: aBlElement with: aValue [ + + aBlElement effect: (aBlElement effect copyWithWidth: aValue) +] From 0e5367d2c5cadbb9bfd27d36b4cc710255dad59c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Mon, 13 Apr 2026 13:55:21 +0200 Subject: [PATCH 03/58] icon changes for BlShadowEffect --- src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st index 2d9ede16..c2810361 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st @@ -703,7 +703,7 @@ PyramidBackgroundBlocPlugin class >> shadow [ inputValidation: [ :value | value class = BlNullEffect ]; yourself); addButtonModel: (PyramidMagicButtonModel new - icon: (Smalltalk ui icons iconNamed: #menuPin); + icon: (Smalltalk ui icons iconNamed: #windowMaximize); helpSelected: 'Shadow type is simple.'; helpNotSelected: 'Set shadow type to simple.'; label: 'Simple'; @@ -712,12 +712,15 @@ PyramidBackgroundBlocPlugin class >> shadow [ inputValidation: [ :value | value class = BlSimpleShadowEffect ]; yourself); addButtonModel: (PyramidMagicButtonModel new - icon: (Smalltalk ui icons iconNamed: #menuPin); + icon: (Smalltalk ui icons iconNamed: #radioButtonUnselected); helpSelected: 'Shadow type is gaussian.'; helpNotSelected: 'Set shadow type to gaussian.'; label: 'Gaussian'; inputValue: [ - BlGaussianShadowEffect color: Color random width: 2 offset: 2 @ 2 ]; + BlGaussianShadowEffect + color: Color random + width: 2 + offset: 2 @ 2 ]; inputValidation: [ :value | value class = BlGaussianShadowEffect ]; yourself); yourself. From 66d84f430541cda5311305a55dcde3dda7779099 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 14 Apr 2026 10:59:02 +0200 Subject: [PATCH 04/58] Add support for saving the previous state of the shadow --- .../PyramidBackgroundBlocPlugin.class.st | 23 ++++++---- ...PyramidGaussianShadowWidthCommand.class.st | 5 ++- .../PyramidShadowColorCommand.class.st | 4 +- .../PyramidShadowCommand.class.st | 44 +++++++++++++++++++ .../PyramidShadowOffsetCommand.class.st | 4 +- 5 files changed, 66 insertions(+), 14 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st index c2810361..3f1581a5 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st @@ -6,6 +6,9 @@ Class { #instVars : [ 'propertiesManager' ], + #classInstVars : [ + 'shadowCommand' + ], #category : #'Pyramid-Bloc-plugin-bloc-visuals' } @@ -685,12 +688,18 @@ PyramidBackgroundBlocPlugin class >> outskirts [ ] { #category : #accessing } -PyramidBackgroundBlocPlugin class >> shadow [ +PyramidBackgroundBlocPlugin class >> resetShadowCommand [ + shadowCommand := nil +] +{ #category : #accessing } +PyramidBackgroundBlocPlugin class >> shadow [ | property | + shadowCommand ifNil: [ shadowCommand := PyramidShadowCommand new ]. + PyramidShadowCommand current: shadowCommand. property := PyramidProperty new name: 'Shadow Effect'; - command: PyramidShadowCommand new; + command: shadowCommand; inputPresenterClass: PyramidMagicButtonsInputPresenter; yourself. property inputPresenterModel @@ -707,8 +716,7 @@ PyramidBackgroundBlocPlugin class >> shadow [ helpSelected: 'Shadow type is simple.'; helpNotSelected: 'Set shadow type to simple.'; label: 'Simple'; - inputValue: [ - BlSimpleShadowEffect color: Color random offset: 2 @ 2 ]; + inputValue: [ shadowCommand lastSimpleShadow ]; inputValidation: [ :value | value class = BlSimpleShadowEffect ]; yourself); addButtonModel: (PyramidMagicButtonModel new @@ -716,11 +724,7 @@ PyramidBackgroundBlocPlugin class >> shadow [ helpSelected: 'Shadow type is gaussian.'; helpNotSelected: 'Set shadow type to gaussian.'; label: 'Gaussian'; - inputValue: [ - BlGaussianShadowEffect - color: Color random - width: 2 - offset: 2 @ 2 ]; + inputValue: [ shadowCommand lastGaussianShadow ]; inputValidation: [ :value | value class = BlGaussianShadowEffect ]; yourself); yourself. @@ -836,6 +840,7 @@ PyramidBackgroundBlocPlugin >> initialize [ propertiesManager addProperty: self class borderRadialOuterRadius. "Shadow" + self class resetShadowCommand. propertiesManager addProperty: self class shadow. propertiesManager addProperty: self class shadowColor. propertiesManager addProperty: self class shadowOffset. diff --git a/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st b/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st index e71d80dc..d134185b 100644 --- a/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st +++ b/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st @@ -18,7 +18,8 @@ PyramidGaussianShadowWidthCommand >> getValueFor: aBlElement [ ] { #category : #'as yet unclassified' } -PyramidGaussianShadowWidthCommand >> setValueFor: aBlElement with: aValue [ +PyramidGaussianShadowWidthCommand >> setValueFor: aBlElement with: aWidth [ - aBlElement effect: (aBlElement effect copyWithWidth: aValue) + aBlElement effect: (aBlElement effect copyWithWidth: aWidth). + PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st index d9c6793e..8faeb5cd 100644 --- a/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st @@ -17,5 +17,7 @@ PyramidShadowColorCommand >> getValueFor: aBlElement [ { #category : #initialization } PyramidShadowColorCommand >> setValueFor: aBlElement with: aColor [ - aBlElement effect: (aBlElement effect copyWithColor: aColor) + + aBlElement effect: (aBlElement effect copyWithColor: aColor). + PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Bloc/PyramidShadowCommand.class.st b/src/Pyramid-Bloc/PyramidShadowCommand.class.st index 4999233d..b873244e 100644 --- a/src/Pyramid-Bloc/PyramidShadowCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowCommand.class.st @@ -1,17 +1,61 @@ Class { #name : #PyramidShadowCommand, #superclass : #PyramidAbstractBlocCommand, + #instVars : [ + 'lastSimpleShadow', + 'lastGaussianShadow' + ], + #classInstVars : [ + 'current' + ], #category : #'Pyramid-Bloc-plugin-bloc-visuals' } +{ #category : #accessing } +PyramidShadowCommand class >> current [ + ^ current + + +] + +{ #category : #accessing } +PyramidShadowCommand class >> current: anInstance [ + current := anInstance +] + { #category : #'as yet unclassified' } PyramidShadowCommand >> getValueFor: aBlElement [ ^ aBlElement effect ] +{ #category : #accessing } +PyramidShadowCommand >> lastGaussianShadow [ + ^ lastGaussianShadow ifNil: [ BlGaussianShadowEffect color: Color black width: 2 offset: 2 @ 2 ] +] + +{ #category : #accessing } +PyramidShadowCommand >> lastSimpleShadow [ + + ^ lastSimpleShadow ifNil: [ + BlSimpleShadowEffect color: Color black offset: 2 @ 2 ] +] + { #category : #'as yet unclassified' } PyramidShadowCommand >> setValueFor: aBlElement with: anArgument [ + anArgument class = BlSimpleShadowEffect ifTrue: [ + lastSimpleShadow := anArgument ]. + anArgument class = BlGaussianShadowEffect ifTrue: [ + lastGaussianShadow := anArgument ]. aBlElement effect: anArgument ] + +{ #category : #'as yet unclassified' } +PyramidShadowCommand >> syncFromElement: aBlElement [ + + aBlElement effect class = BlSimpleShadowEffect ifTrue: [ + lastSimpleShadow := aBlElement effect ]. + aBlElement effect class = BlGaussianShadowEffect ifTrue: [ + lastGaussianShadow := aBlElement effect ] +] diff --git a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st index 225f9660..0448d0ee 100644 --- a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st @@ -19,6 +19,6 @@ PyramidShadowOffsetCommand >> getValueFor: aBlElement [ { #category : #'as yet unclassified' } PyramidShadowOffsetCommand >> setValueFor: aBlElement with: aPoint [ - - aBlElement effect: (aBlElement effect copyWithOffset: aPoint) + aBlElement effect: (aBlElement effect copyWithOffset: aPoint). + PyramidShadowCommand current syncFromElement: aBlElement ] From c9a7df289659b4ab25465250a6dbc4dc56a2f8d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 14 Apr 2026 14:16:34 +0200 Subject: [PATCH 05/58] Remove the shadowCommand class variable --- .../PyramidBackgroundBlocPlugin.class.st | 19 +++++-------------- .../PyramidShadowCommand.class.st | 10 +++++----- 2 files changed, 10 insertions(+), 19 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st index 3f1581a5..c89c96ac 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st @@ -6,9 +6,6 @@ Class { #instVars : [ 'propertiesManager' ], - #classInstVars : [ - 'shadowCommand' - ], #category : #'Pyramid-Bloc-plugin-bloc-visuals' } @@ -687,19 +684,13 @@ PyramidBackgroundBlocPlugin class >> outskirts [ ^ property ] -{ #category : #accessing } -PyramidBackgroundBlocPlugin class >> resetShadowCommand [ - shadowCommand := nil -] - { #category : #accessing } PyramidBackgroundBlocPlugin class >> shadow [ + | property | - shadowCommand ifNil: [ shadowCommand := PyramidShadowCommand new ]. - PyramidShadowCommand current: shadowCommand. property := PyramidProperty new name: 'Shadow Effect'; - command: shadowCommand; + command: PyramidShadowCommand current; inputPresenterClass: PyramidMagicButtonsInputPresenter; yourself. property inputPresenterModel @@ -716,7 +707,7 @@ PyramidBackgroundBlocPlugin class >> shadow [ helpSelected: 'Shadow type is simple.'; helpNotSelected: 'Set shadow type to simple.'; label: 'Simple'; - inputValue: [ shadowCommand lastSimpleShadow ]; + inputValue: [ PyramidShadowCommand current lastSimpleShadow ]; inputValidation: [ :value | value class = BlSimpleShadowEffect ]; yourself); addButtonModel: (PyramidMagicButtonModel new @@ -724,7 +715,7 @@ PyramidBackgroundBlocPlugin class >> shadow [ helpSelected: 'Shadow type is gaussian.'; helpNotSelected: 'Set shadow type to gaussian.'; label: 'Gaussian'; - inputValue: [ shadowCommand lastGaussianShadow ]; + inputValue: [ PyramidShadowCommand current lastGaussianShadow ]; inputValidation: [ :value | value class = BlGaussianShadowEffect ]; yourself); yourself. @@ -840,7 +831,7 @@ PyramidBackgroundBlocPlugin >> initialize [ propertiesManager addProperty: self class borderRadialOuterRadius. "Shadow" - self class resetShadowCommand. + PyramidShadowCommand resetShadowCommand. propertiesManager addProperty: self class shadow. propertiesManager addProperty: self class shadowColor. propertiesManager addProperty: self class shadowOffset. diff --git a/src/Pyramid-Bloc/PyramidShadowCommand.class.st b/src/Pyramid-Bloc/PyramidShadowCommand.class.st index b873244e..8c407cec 100644 --- a/src/Pyramid-Bloc/PyramidShadowCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowCommand.class.st @@ -13,14 +13,14 @@ Class { { #category : #accessing } PyramidShadowCommand class >> current [ - ^ current - - + current ifNil: [ current := self new ]. + ^ current ] { #category : #accessing } -PyramidShadowCommand class >> current: anInstance [ - current := anInstance +PyramidShadowCommand class >> resetShadowCommand [ + + current := nil ] { #category : #'as yet unclassified' } From 83d157c4c42217c3b0583f9141f530cefacc0148 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 14 Apr 2026 15:50:28 +0200 Subject: [PATCH 06/58] fix problem with move index child --- .../PyramidMoveChildInParentPlugin.class.st | 31 +++++++++---------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st b/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st index 74b2a560..2b1489c1 100644 --- a/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st @@ -46,22 +46,21 @@ PyramidMoveChildInParentPlugin >> contextMenuMoveChildInParent: aBuilder [ aBuilder addGroupSingleSelection: [ :group :single | - group - addItem: [ :item | - item - icon: (Smalltalk ui icons iconNamed: #up); - name: 'Move index child up'; - action: [ self moveChildIndexUpInParent ]; - yourself ]; - - addItem: [ :item | - item - icon: (Smalltalk ui icons iconNamed: #down); - name: 'Move index child down'; - action: [ self moveChildIndexDownInParent ]; - yourself ]; - yourself ] - order: 10. + group + addItem: [ :item | + item + icon: (Smalltalk ui icons iconNamed: #up); + name: 'Move child up'; + action: [ self moveChildIndexDownInParent ]; + yourself ]; + addItem: [ :item | + item + icon: (Smalltalk ui icons iconNamed: #down); + name: 'Move child down'; + action: [self moveChildIndexUpInParent]; + yourself ]; + yourself ] + order: 10 ] { #category : #accessing } From 649bd552218b152367260be676a46c3e9b7997e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 14 Apr 2026 17:30:12 +0200 Subject: [PATCH 07/58] fix error messages for moving a child --- .../PyramidMoveChildInParentPlugin.class.st | 60 ++++++++----------- 1 file changed, 26 insertions(+), 34 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st b/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st index 2b1489c1..5205f082 100644 --- a/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st @@ -90,28 +90,24 @@ PyramidMoveChildInParentPlugin >> moveChildIndexDownCommand: aBlElementParent wi PyramidMoveChildInParentPlugin >> moveChildIndexDownInParent [ | childToMoveCollection childToMove childIndexToMove parentChild navigationSelectionPanel | - childToMoveCollection := projectModel selection collection. - navigationSelectionPanel := navigationPlugin navigation selectionPanel. - - childToMoveCollection size = 1 - ifFalse: [ ^ self ]. + navigationSelectionPanel := navigationPlugin navigation + selectionPanel. + + childToMoveCollection size = 1 ifFalse: [ ^ self ]. childToMove := childToMoveCollection first. - - childToMove hasParent - ifFalse: [ ^ self ]. + + childToMove hasParent ifFalse: [ ^ self ]. parentChild := childToMove parent. - - childIndexToMove := (parentChild childIndexOf: childToMove). - - childIndexToMove > 1 - ifTrue: [ self moveChildIndexDownCommand: parentChild with: childToMove. - self refreshTreeTable ] - ifFalse: [ self inform: 'Cannot move down' ]. - - + childIndexToMove := parentChild childIndexOf: childToMove. + childIndexToMove > 1 + ifTrue: [ + self moveChildIndexDownCommand: parentChild with: childToMove. + self refreshTreeTable ] + ifFalse: [ + self inform: 'Cannot move up' ] "cannot move the child up and the index down" ] { #category : #'as yet unclassified' } @@ -128,27 +124,23 @@ PyramidMoveChildInParentPlugin >> moveChildIndexUpCommand: aBlElementParent with PyramidMoveChildInParentPlugin >> moveChildIndexUpInParent [ | childToMoveCollection childToMove childIndexToMove parentChild navigationSelectionPanel | - childToMoveCollection := projectModel selection collection. - navigationSelectionPanel := navigationPlugin navigation selectionPanel. - - childToMoveCollection size = 1 - ifFalse: [ ^ self ]. + navigationSelectionPanel := navigationPlugin navigation + selectionPanel. + + childToMoveCollection size = 1 ifFalse: [ ^ self ]. childToMove := childToMoveCollection first. - - childToMove hasParent - ifFalse: [ ^ self ]. + + childToMove hasParent ifFalse: [ ^ self ]. parentChild := childToMove parent. - - childIndexToMove := (parentChild childIndexOf: childToMove). - - childIndexToMove < (parentChild children size) - ifTrue: [ self moveChildIndexUpCommand: parentChild with: childToMove. - self refreshTreeTable ] - ifFalse: [ self inform: 'Cannot move up' ]. - - + childIndexToMove := parentChild childIndexOf: childToMove. + + childIndexToMove < parentChild children size + ifTrue: [ + self moveChildIndexUpCommand: parentChild with: childToMove. + self refreshTreeTable ] + ifFalse: [ self inform: 'Cannot move down' ] "cannot move the child down and the index up" ] { #category : #accessing } From 1888659367a30c3d8cbce287d44a2a7a207170db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Wed, 15 Apr 2026 10:01:34 +0200 Subject: [PATCH 08/58] fix error OCScanner --- 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 53f2c19cc434ac62113aeb3c5fd613d46ae4666e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 16 Apr 2026 15:22:28 +0200 Subject: [PATCH 09/58] add tests and update devShadow --- .../PyramidBackgroundBlocPlugin.class.st | 31 +++-- ...PyramidGaussianShadowWidthCommand.class.st | 25 ---- .../PyramidMoveChildInParentPlugin.class.st | 13 +- .../PyramidShadowColorCommand.class.st | 14 ++- .../PyramidShadowCommand.class.st | 8 +- ...PyramidShadowGaussianWidthCommand.class.st | 28 +++++ .../PyramidShadowOffsetCommand.class.st | 12 +- .../PyramidShadowColorCommandTest.class.st | 35 ++++++ .../PyramidShadowCommandTest.class.st | 114 ++++++++++++++++++ .../PyramidShadowGaussianWidthTest.class.st | 36 ++++++ .../PyramidShadowOffsetCommandTest.class.st | 35 ++++++ 11 files changed, 290 insertions(+), 61 deletions(-) delete mode 100644 src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st create mode 100644 src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st create mode 100644 src/Pyramid-Tests/PyramidShadowColorCommandTest.class.st create mode 100644 src/Pyramid-Tests/PyramidShadowCommandTest.class.st create mode 100644 src/Pyramid-Tests/PyramidShadowGaussianWidthTest.class.st create mode 100644 src/Pyramid-Tests/PyramidShadowOffsetCommandTest.class.st diff --git a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st index c89c96ac..1f36a867 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundBlocPlugin.class.st @@ -618,19 +618,6 @@ PyramidBackgroundBlocPlugin class >> borderWidth [ ^ property ] -{ #category : #'as yet unclassified' } -PyramidBackgroundBlocPlugin class >> gaussianShadowWidth [ - - | property | - property := PyramidProperty new - name: 'Shadow Width'; - command: PyramidGaussianShadowWidthCommand new; - inputPresenterClass: PyramidNumberInputPresenter; - yourself. - property inputPresenterModel help: 'Set the width value'. - ^ property -] - { #category : #accessing } PyramidBackgroundBlocPlugin class >> opacity [ @@ -717,8 +704,7 @@ PyramidBackgroundBlocPlugin class >> shadow [ label: 'Gaussian'; inputValue: [ PyramidShadowCommand current lastGaussianShadow ]; inputValidation: [ :value | value class = BlGaussianShadowEffect ]; - yourself); - yourself. + yourself). ^ property ] @@ -752,6 +738,19 @@ PyramidBackgroundBlocPlugin class >> shadowOffset [ ^ property ] +{ #category : #accessing } +PyramidBackgroundBlocPlugin class >> shadowWidthGaussian [ + + | property | + property := PyramidProperty new + name: 'Shadow Width'; + command: PyramidShadowGaussianWidthCommand new; + inputPresenterClass: PyramidNumberInputPresenter; + yourself. + property inputPresenterModel help: 'Set the width value'. + ^ property +] + { #category : #adding } PyramidBackgroundBlocPlugin >> addPanelsOn: aPyramidSimpleWindow [ @@ -835,7 +834,7 @@ PyramidBackgroundBlocPlugin >> initialize [ propertiesManager addProperty: self class shadow. propertiesManager addProperty: self class shadowColor. propertiesManager addProperty: self class shadowOffset. - propertiesManager addProperty: self class gaussianShadowWidth + propertiesManager addProperty: self class shadowWidthGaussian ] { #category : #adding } diff --git a/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st b/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st deleted file mode 100644 index d134185b..00000000 --- a/src/Pyramid-Bloc/PyramidGaussianShadowWidthCommand.class.st +++ /dev/null @@ -1,25 +0,0 @@ -Class { - #name : #PyramidGaussianShadowWidthCommand, - #superclass : #PyramidAbstractBlocCommand, - #category : #'Pyramid-Bloc-plugin-bloc-visuals' -} - -{ #category : #testing } -PyramidGaussianShadowWidthCommand >> canBeUsedFor: anObject [ - - ^ (super canBeUsedFor: anObject) and: [ - anObject effect isKindOf: BlGaussianShadowEffect ] -] - -{ #category : #'as yet unclassified' } -PyramidGaussianShadowWidthCommand >> getValueFor: aBlElement [ - - ^ aBlElement effect width -] - -{ #category : #'as yet unclassified' } -PyramidGaussianShadowWidthCommand >> setValueFor: aBlElement with: aWidth [ - - aBlElement effect: (aBlElement effect copyWithWidth: aWidth). - PyramidShadowCommand current syncFromElement: aBlElement -] diff --git a/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st b/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st index 5205f082..4fe6a43b 100644 --- a/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidMoveChildInParentPlugin.class.st @@ -91,8 +91,7 @@ PyramidMoveChildInParentPlugin >> moveChildIndexDownInParent [ | childToMoveCollection childToMove childIndexToMove parentChild navigationSelectionPanel | childToMoveCollection := projectModel selection collection. - navigationSelectionPanel := navigationPlugin navigation - selectionPanel. + navigationSelectionPanel := navigationPlugin navigation selectionPanel. childToMoveCollection size = 1 ifFalse: [ ^ self ]. childToMove := childToMoveCollection first. @@ -106,8 +105,8 @@ PyramidMoveChildInParentPlugin >> moveChildIndexDownInParent [ ifTrue: [ self moveChildIndexDownCommand: parentChild with: childToMove. self refreshTreeTable ] - ifFalse: [ - self inform: 'Cannot move up' ] "cannot move the child up and the index down" + ifFalse: [ "cannot move the child up and the index down" + self inform: 'Cannot move up' ] ] { #category : #'as yet unclassified' } @@ -125,8 +124,7 @@ PyramidMoveChildInParentPlugin >> moveChildIndexUpInParent [ | childToMoveCollection childToMove childIndexToMove parentChild navigationSelectionPanel | childToMoveCollection := projectModel selection collection. - navigationSelectionPanel := navigationPlugin navigation - selectionPanel. + navigationSelectionPanel := navigationPlugin navigation selectionPanel. childToMoveCollection size = 1 ifFalse: [ ^ self ]. childToMove := childToMoveCollection first. @@ -140,7 +138,8 @@ PyramidMoveChildInParentPlugin >> moveChildIndexUpInParent [ ifTrue: [ self moveChildIndexUpCommand: parentChild with: childToMove. self refreshTreeTable ] - ifFalse: [ self inform: 'Cannot move down' ] "cannot move the child down and the index up" + ifFalse: [ "cannot move the child down and the index up" + self inform: 'Cannot move down' ] ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st index 8faeb5cd..550930a1 100644 --- a/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st @@ -10,14 +10,20 @@ PyramidShadowColorCommand >> canBeUsedFor: anObject [ anObject effect isKindOf: BlShadowEffect ] ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowColorCommand >> getValueFor: aBlElement [ - ^ aBlElement effect color + + (aBlElement effect isKindOf: BlShadowEffect) + ifTrue: [ ^ aBlElement effect color ] + ifFalse: [ ^ self ] ] -{ #category : #initialization } +{ #category : #accessing } PyramidShadowColorCommand >> setValueFor: aBlElement with: aColor [ - aBlElement effect: (aBlElement effect copyWithColor: aColor). + (aBlElement effect isKindOf: BlShadowEffect) + ifTrue: [ + aBlElement effect: (aBlElement effect copyWithColor: aColor) ] + ifFalse: [ ^ self ]. PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Bloc/PyramidShadowCommand.class.st b/src/Pyramid-Bloc/PyramidShadowCommand.class.st index 8c407cec..6734091f 100644 --- a/src/Pyramid-Bloc/PyramidShadowCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowCommand.class.st @@ -23,10 +23,10 @@ PyramidShadowCommand class >> resetShadowCommand [ current := nil ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowCommand >> getValueFor: aBlElement [ - ^ aBlElement effect + ^ aBlElement effect ] { #category : #accessing } @@ -41,7 +41,7 @@ PyramidShadowCommand >> lastSimpleShadow [ BlSimpleShadowEffect color: Color black offset: 2 @ 2 ] ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowCommand >> setValueFor: aBlElement with: anArgument [ anArgument class = BlSimpleShadowEffect ifTrue: [ @@ -51,7 +51,7 @@ PyramidShadowCommand >> setValueFor: aBlElement with: anArgument [ aBlElement effect: anArgument ] -{ #category : #'as yet unclassified' } +{ #category : #updating } PyramidShadowCommand >> syncFromElement: aBlElement [ aBlElement effect class = BlSimpleShadowEffect ifTrue: [ diff --git a/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st b/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st new file mode 100644 index 00000000..9b0108f1 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st @@ -0,0 +1,28 @@ +Class { + #name : #PyramidShadowGaussianWidthCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : #'Pyramid-Bloc-plugin-bloc-visuals' +} + +{ #category : #testing } +PyramidShadowGaussianWidthCommand >> canBeUsedFor: anObject [ + + ^ (super canBeUsedFor: anObject) and: [ + anObject effect isKindOf: BlGaussianShadowEffect ] +] + +{ #category : #accessing } +PyramidShadowGaussianWidthCommand >> getValueFor: aBlElement [ + + ^ (aBlElement effect isKindOf: BlGaussianShadowEffect) ifTrue: [aBlElement effect width] ifFalse: [ ^ self ] +] + +{ #category : #accessing } +PyramidShadowGaussianWidthCommand >> setValueFor: aBlElement with: aWidth [ + + (aBlElement effect isKindOf: BlGaussianShadowEffect) + ifTrue: [ + aBlElement effect: (aBlElement effect copyWithWidth: aWidth) ] + ifFalse: [ ^ self ]. + PyramidShadowCommand current syncFromElement: aBlElement +] diff --git a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st index 0448d0ee..76ef190e 100644 --- a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st @@ -11,14 +11,16 @@ PyramidShadowOffsetCommand >> canBeUsedFor: anObject [ anObject effect isKindOf: BlShadowEffect ] ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowOffsetCommand >> getValueFor: aBlElement [ - ^ aBlElement effect offset + ^ (aBlElement effect isKindOf: BlShadowEffect) ifTrue: [aBlElement effect offset] ifFalse: [ ^ self ] ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowOffsetCommand >> setValueFor: aBlElement with: aPoint [ - aBlElement effect: (aBlElement effect copyWithOffset: aPoint). - PyramidShadowCommand current syncFromElement: aBlElement + + (aBlElement effect isKindOf: BlShadowEffect) + ifTrue: [aBlElement effect: (aBlElement effect copyWithOffset: aPoint)] ifFalse: [^ self] . + PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Tests/PyramidShadowColorCommandTest.class.st b/src/Pyramid-Tests/PyramidShadowColorCommandTest.class.st new file mode 100644 index 00000000..e5f446a1 --- /dev/null +++ b/src/Pyramid-Tests/PyramidShadowColorCommandTest.class.st @@ -0,0 +1,35 @@ +Class { + #name : #PyramidShadowColorCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-bloc-visuals' +} + +{ #category : #accessing } +PyramidShadowColorCommandTest >> command [ + + ^ PyramidShadowColorCommand new +] + +{ #category : #'as yet unclassified' } +PyramidShadowColorCommandTest >> targetContainers [ + + ^ { + (PyramidCommandTestContainer + no: (BlElement new effect: BlSimpleShadowEffect new) + with: (BlElement new + effect: (BlSimpleShadowEffect color: Color red offset: 2 @ 2); + yourself) + prop: Color red). + (PyramidCommandTestContainer + no: (BlElement new effect: BlGaussianShadowEffect new) + with: (BlElement new + effect: + (BlGaussianShadowEffect + color: Color blue + width: 10 + offset: 4 @ 4); + yourself) + prop: Color blue) } +] diff --git a/src/Pyramid-Tests/PyramidShadowCommandTest.class.st b/src/Pyramid-Tests/PyramidShadowCommandTest.class.st new file mode 100644 index 00000000..2dcdb309 --- /dev/null +++ b/src/Pyramid-Tests/PyramidShadowCommandTest.class.st @@ -0,0 +1,114 @@ +Class { + #name : #PyramidShadowCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-bloc-visuals' +} + +{ #category : #tests } +PyramidShadowCommandTest >> assert: anObject hasSamePropertiesAs: anotherObject [ + + self assert: anObject color equals: anotherObject color. + self assert: anObject offset equals: anotherObject offset. + (anObject isKindOf: BlGaussianShadowEffect) ifTrue: [ + self assert: anObject width equals: anotherObject width ] +] + +{ #category : #accessing } +PyramidShadowCommandTest >> command [ + + ^ PyramidShadowCommand new +] + +{ #category : #'as yet unclassified' } +PyramidShadowCommandTest >> targetContainers [ + + ^ { + (PyramidCommandTestContainer + no: BlElement new + with: (BlElement new + effect: (BlSimpleShadowEffect color: Color red offset: 2 @ 2); + yourself) + prop: (BlSimpleShadowEffect color: Color red offset: 2 @ 2)). + (PyramidCommandTestContainer + no: BlElement new + with: (BlElement new + effect: + (BlGaussianShadowEffect + color: Color blue + width: 10 + offset: 4 @ 4); + yourself) + prop: + (BlGaussianShadowEffect + color: Color blue + width: 10 + offset: 4 @ 4)). + (PyramidCommandTestContainer + no: (BlElement new effect: BlOverlayEffect new) + with: (BlElement new + effect: + (BlGaussianShadowEffect + color: Color blue + width: 10 + offset: 4 @ 4); + yourself) + prop: + (BlGaussianShadowEffect + color: Color blue + width: 10 + offset: 4 @ 4)) } +] + +{ #category : #tests } +PyramidShadowCommandTest >> testGetValueFor [ + + self targetsWithValuesAndValues do: [ :each | + self assert: (self command getValueFor: each key) hasSamePropertiesAs: each value ] +] + +{ #category : #tests } +PyramidShadowCommandTest >> testHistory [ + "Do once. + undo + redo + undo + redo" + + | history commandExecutor targets | + targets := self targetsCanBeUsedFor. + history := PyramidHistory new. + commandExecutor := PyramidHistoryCommandExecutor new + history: history; + wrappee: PyramidMainCommandExecutor new; + yourself. + + "Do once" + self argumentsForHistory do: [ :each | + commandExecutor use: self command on: targets with: each ]. + + "Undo all" + self argumentsForHistory reverseDo: [ :argument | + targets do: [ :target | + self assert: (self command getValueFor: target) hasSamePropertiesAs: argument ]. + history canUndo ifTrue: [ history undo ] ]. + + "Redo all" + self argumentsForHistory do: [ :argument | + history canRedo ifTrue: [ history redo ]. + targets do: [ :target | + self assert: (self command getValueFor: target) hasSamePropertiesAs: argument ] ]. + + "Undo all" + self argumentsForHistory reverseDo: [ :argument | + targets do: [ :target | + self assert: (self command getValueFor: target) hasSamePropertiesAs: argument ]. + history canUndo ifTrue: [ history undo ] ]. + + "Redo all" + self argumentsForHistory do: [ :argument | + history canRedo ifTrue: [ history redo ]. + targets do: [ :target | + self assert: (self command getValueFor: target) hasSamePropertiesAs: argument ] ] +] diff --git a/src/Pyramid-Tests/PyramidShadowGaussianWidthTest.class.st b/src/Pyramid-Tests/PyramidShadowGaussianWidthTest.class.st new file mode 100644 index 00000000..a417f5fc --- /dev/null +++ b/src/Pyramid-Tests/PyramidShadowGaussianWidthTest.class.st @@ -0,0 +1,36 @@ +Class { + #name : #PyramidShadowGaussianWidthTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-bloc-visuals' +} + +{ #category : #accessing } +PyramidShadowGaussianWidthTest >> command [ + + ^ PyramidShadowGaussianWidthCommand new + +] + +{ #category : #'as yet unclassified' } +PyramidShadowGaussianWidthTest >> targetContainers [ + + ^ { + (PyramidCommandTestContainer + no: (BlElement new effect: BlGaussianShadowEffect new) + with: (BlElement new + effect: (BlGaussianShadowEffect color: Color red width: 5 offset: 2 @ 2); + yourself) + prop: 5). + (PyramidCommandTestContainer + no: (BlElement new effect: BlGaussianShadowEffect new) + with: (BlElement new + effect: + (BlGaussianShadowEffect + color: Color blue + width: 10 + offset: 4 @ 4); + yourself) + prop: 10) } +] diff --git a/src/Pyramid-Tests/PyramidShadowOffsetCommandTest.class.st b/src/Pyramid-Tests/PyramidShadowOffsetCommandTest.class.st new file mode 100644 index 00000000..a68c8424 --- /dev/null +++ b/src/Pyramid-Tests/PyramidShadowOffsetCommandTest.class.st @@ -0,0 +1,35 @@ +Class { + #name : #PyramidShadowOffsetCommandTest, + #superclass : #TestCase, + #traits : 'TPyramidCommandTest', + #classTraits : 'TPyramidCommandTest classTrait', + #category : #'Pyramid-Tests-cases-plugin-bloc-visuals' +} + +{ #category : #accessing } +PyramidShadowOffsetCommandTest >> command [ + + ^ PyramidShadowOffsetCommand new +] + +{ #category : #'as yet unclassified' } +PyramidShadowOffsetCommandTest >> targetContainers [ + + ^ { + (PyramidCommandTestContainer + no: (BlElement new effect: BlSimpleShadowEffect new) + with: (BlElement new + effect: (BlSimpleShadowEffect color: Color red offset: 2 @ 2); + yourself) + prop: 2@2). + (PyramidCommandTestContainer + no: (BlElement new effect: BlGaussianShadowEffect new) + with: (BlElement new + effect: + (BlGaussianShadowEffect + color: Color blue + width: 10 + offset: 4 @ 4); + yourself) + prop: 4@4) } +] From 29092943da14af147a8c805290eab178d7bb93f7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 16 Apr 2026 16:17:43 +0200 Subject: [PATCH 10/58] update devShadow --- .../PyramidShadowColorCommand.class.st | 14 ++++++++------ .../PyramidShadowGaussianWidthCommand.class.st | 11 +++++++---- .../PyramidShadowOffsetCommand.class.st | 12 ++++++++---- .../PyramidAddChildCommandTest.class.st | 2 +- .../PyramidBackgroundImageCommandTest.class.st | 4 ++-- .../PyramidBackgroundOpacityCommandTest.class.st | 2 +- ...PyramidBackgroundPaintColorCommandTest.class.st | 4 ++-- .../PyramidBackgroundPaintCommandTest.class.st | 2 +- ...midBackgroundPaintLinearEndCommandTest.class.st | 4 ++-- ...dBackgroundPaintLinearStartCommandTest.class.st | 4 ++-- ...roundPaintRadialInnerCenterCommandTest.class.st | 4 ++-- ...roundPaintRadialInnerRadiusCommandTest.class.st | 4 ++-- ...roundPaintRadialOuterCenterCommandTest.class.st | 4 ++-- ...roundPaintRadialOuterRadiusCommandTest.class.st | 4 ++-- ...PyramidBackgroundPaintStopsCommandTest.class.st | 4 ++-- .../PyramidBackgroundTypeCommandTest.class.st | 2 +- ...ctHorizontalConstraintsBlocCommandTest.class.st | 4 ++-- ...xactVerticalConstraintsBlocCommandTest.class.st | 4 ++-- ...icHorizontalConstraintsBlocCommandTest.class.st | 4 ++-- ...asicVerticalConstraintsBlocCommandTest.class.st | 4 ++-- .../PyramidBorderDashArrayCommandTest.class.st | 2 +- .../PyramidBorderDashOffsetCommandTest.class.st | 2 +- .../PyramidBorderLineCapCommandTest.class.st | 2 +- .../PyramidBorderLineJoinCommandTest.class.st | 2 +- .../PyramidBorderMiterLimitCommandTest.class.st | 2 +- .../PyramidBorderOpacityCommandTest.class.st | 2 +- .../PyramidBorderTypeCommandTest.class.st | 2 +- ...PyramidChangeOrderWithIndexCommandTest.class.st | 4 ++-- .../PyramidChangeTextCommandTest.class.st | 2 +- .../PyramidClipChildrenCommandTest.class.st | 2 +- .../PyramidElementIdCommandTest.class.st | 2 +- .../PyramidFontSizeCommandTest.class.st | 2 +- .../PyramidFontWeightCommandTest.class.st | 2 +- .../PyramidGeometryCommandTest.class.st | 2 +- .../PyramidLayoutBlocCommandTest.class.st | 4 ++-- ...amidLayoutChangeOrientationCommandTest.class.st | 4 ++-- .../PyramidMarginCommandTest.class.st | 2 +- .../PyramidMoveBackwardOrderCommandTest.class.st | 8 ++++---- .../PyramidMoveForwardOrderCommandTest.class.st | 8 ++++---- .../PyramidOnBackgroundOrderCommandTest.class.st | 4 ++-- .../PyramidOnForegroundOrderCommandTest.class.st | 4 ++-- .../PyramidOpacityCommandTest.class.st | 2 +- .../PyramidPaddingCommandTest.class.st | 2 +- .../PyramidPositionCommandTest.class.st | 2 +- .../PyramidPositionOffsetCommandTest.class.st | 2 +- ...ionnalHorizontalConstraintsCommandTest.class.st | 4 ++-- ...rtionnalVerticalConstraintsCommandTest.class.st | 4 ++-- .../PyramidRemoveChildCommandTest.class.st | 2 +- .../PyramidRemoveSelectionCommandTest.class.st | 2 +- ...RoundedRectangleCornerRadiiCommandTest.class.st | 4 ++-- .../PyramidShadowColorCommandTest.class.st | 2 +- .../PyramidShadowCommandTest.class.st | 2 +- .../PyramidShadowGaussianWidthTest.class.st | 2 +- .../PyramidShadowOffsetCommandTest.class.st | 2 +- .../PyramidTextForegroundCommandTest.class.st | 2 +- .../PyramidVisibilityCommandTest.class.st | 2 +- .../PyramidWeightConstraintsCommandTest.class.st | 4 ++-- .../PyramidZIndexCommandTest.class.st | 2 +- src/Pyramid-Tests/TPyramidCommandTest.trait.st | 8 ++++---- .../PyramidStampCommandTest.class.st | 2 +- 60 files changed, 111 insertions(+), 102 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st index 550930a1..ec8cae3b 100644 --- a/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st @@ -6,24 +6,26 @@ Class { { #category : #testing } PyramidShadowColorCommand >> canBeUsedFor: anObject [ - ^ (super canBeUsedFor: anObject) and: [ - anObject effect isKindOf: BlShadowEffect ] + + ^ (super canBeUsedFor: anObject) and: [ + anObject effect class = BlSimpleShadowEffect or: [ + anObject effect class = BlGaussianShadowEffect ] ] ] { #category : #accessing } PyramidShadowColorCommand >> getValueFor: aBlElement [ - (aBlElement effect isKindOf: BlShadowEffect) + (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class = BlGaussianShadowEffect]) ifTrue: [ ^ aBlElement effect color ] - ifFalse: [ ^ self ] + ifFalse: [ ^ nil ] ] { #category : #accessing } PyramidShadowColorCommand >> setValueFor: aBlElement with: aColor [ - (aBlElement effect isKindOf: BlShadowEffect) + (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class= BlGaussianShadowEffect]) ifTrue: [ aBlElement effect: (aBlElement effect copyWithColor: aColor) ] - ifFalse: [ ^ self ]. + ifFalse: [ ^ nil ]. PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st b/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st index 9b0108f1..08272272 100644 --- a/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st @@ -8,21 +8,24 @@ Class { PyramidShadowGaussianWidthCommand >> canBeUsedFor: anObject [ ^ (super canBeUsedFor: anObject) and: [ - anObject effect isKindOf: BlGaussianShadowEffect ] + anObject effect class = BlGaussianShadowEffect ] ] { #category : #accessing } PyramidShadowGaussianWidthCommand >> getValueFor: aBlElement [ - ^ (aBlElement effect isKindOf: BlGaussianShadowEffect) ifTrue: [aBlElement effect width] ifFalse: [ ^ self ] + (aBlElement effect class = BlSimpleShadowEffect or: [ + aBlElement effect class = BlGaussianShadowEffect ]) + ifTrue: [ ^ aBlElement effect width ] + ifFalse: [ ^ nil ] ] { #category : #accessing } PyramidShadowGaussianWidthCommand >> setValueFor: aBlElement with: aWidth [ - (aBlElement effect isKindOf: BlGaussianShadowEffect) + (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class = BlGaussianShadowEffect]) ifTrue: [ aBlElement effect: (aBlElement effect copyWithWidth: aWidth) ] - ifFalse: [ ^ self ]. + ifFalse: [ ^ nil ]. PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st index 76ef190e..a4388e2b 100644 --- a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st @@ -8,19 +8,23 @@ Class { PyramidShadowOffsetCommand >> canBeUsedFor: anObject [ ^ (super canBeUsedFor: anObject) and: [ - anObject effect isKindOf: BlShadowEffect ] + anObject effect class = BlSimpleShadowEffect or: [anObject effect class = BlGaussianShadowEffect] ] ] { #category : #accessing } PyramidShadowOffsetCommand >> getValueFor: aBlElement [ - ^ (aBlElement effect isKindOf: BlShadowEffect) ifTrue: [aBlElement effect offset] ifFalse: [ ^ self ] + (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class = BlGaussianShadowEffect]) + ifTrue: [ ^ aBlElement effect offset ] + ifFalse: [ ^ nil ] ] { #category : #accessing } PyramidShadowOffsetCommand >> setValueFor: aBlElement with: aPoint [ - (aBlElement effect isKindOf: BlShadowEffect) - ifTrue: [aBlElement effect: (aBlElement effect copyWithOffset: aPoint)] ifFalse: [^ self] . + (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class = BlGaussianShadowEffect]) + ifTrue: [ + aBlElement effect: (aBlElement effect copyWithOffset: aPoint) ] + ifFalse: [ ^ nil ]. PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Tests/PyramidAddChildCommandTest.class.st b/src/Pyramid-Tests/PyramidAddChildCommandTest.class.st index ad54c577..39710d5d 100644 --- a/src/Pyramid-Tests/PyramidAddChildCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidAddChildCommandTest.class.st @@ -12,7 +12,7 @@ PyramidAddChildCommandTest >> command [ ^ PyramidAddChildCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidAddChildCommandTest >> targetsCanBeUsedFor [ ^ { BlElement new . BlElement new addChild: BlElement new; yourself } diff --git a/src/Pyramid-Tests/PyramidBackgroundImageCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundImageCommandTest.class.st index f5308c6b..d1c49058 100644 --- a/src/Pyramid-Tests/PyramidBackgroundImageCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundImageCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundImageCommandTest >> command [ ^ PyramidBackgroundImageCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundImageCommandTest >> targetContainers [ ^ { @@ -34,7 +34,7 @@ PyramidBackgroundImageCommandTest >> targetContainers [ prop: (Smalltalk ui icons iconNamed: #pharoBig)) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundImageCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundOpacityCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundOpacityCommandTest.class.st index 6f01df3d..32d70ba5 100644 --- a/src/Pyramid-Tests/PyramidBackgroundOpacityCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundOpacityCommandTest.class.st @@ -26,7 +26,7 @@ PyramidBackgroundOpacityCommandTest >> isBlBackgroundEqualityFix [ ^ e background == b2 ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundOpacityCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintColorCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintColorCommandTest.class.st index ea72a86d..8312b04b 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintColorCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintColorCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintColorCommandTest >> command [ ^ PyramidBackgroundPaintColorCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintColorCommandTest >> targetContainers [ ^ { @@ -35,7 +35,7 @@ PyramidBackgroundPaintColorCommandTest >> targetContainers [ } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintColorCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintCommandTest.class.st index 949a9ab7..fcbb4cbc 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintCommandTest >> command [ ^ PyramidBackgroundPaintCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintCommandTest >> targetContainers [ ^ {(PyramidCommandTestContainer diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintLinearEndCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintLinearEndCommandTest.class.st index 116912ab..f2a1768b 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintLinearEndCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintLinearEndCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintLinearEndCommandTest >> command [ ^ PyramidBackgroundPaintLinearEndCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintLinearEndCommandTest >> targetContainers [ ^ { @@ -58,7 +58,7 @@ PyramidBackgroundPaintLinearEndCommandTest >> targetContainers [ prop: 0 @ 0) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintLinearEndCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintLinearStartCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintLinearStartCommandTest.class.st index 31caf284..b6f99ab7 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintLinearStartCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintLinearStartCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintLinearStartCommandTest >> command [ ^ PyramidBackgroundPaintLinearStartCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintLinearStartCommandTest >> targetContainers [ ^ { @@ -58,7 +58,7 @@ PyramidBackgroundPaintLinearStartCommandTest >> targetContainers [ prop: 0 @ 10) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintLinearStartCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintRadialInnerCenterCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintRadialInnerCenterCommandTest.class.st index aac47749..402c74b6 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintRadialInnerCenterCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintRadialInnerCenterCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintRadialInnerCenterCommandTest >> command [ ^ PyramidBackgroundPaintRadialInnerCenterCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintRadialInnerCenterCommandTest >> targetContainers [ ^ { @@ -66,7 +66,7 @@ PyramidBackgroundPaintRadialInnerCenterCommandTest >> targetContainers [ prop: 500 asPoint) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintRadialInnerCenterCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintRadialInnerRadiusCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintRadialInnerRadiusCommandTest.class.st index b9bfbd44..63231a90 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintRadialInnerRadiusCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintRadialInnerRadiusCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintRadialInnerRadiusCommandTest >> command [ ^ PyramidBackgroundPaintRadialInnerRadiusCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintRadialInnerRadiusCommandTest >> targetContainers [ ^ { @@ -66,7 +66,7 @@ PyramidBackgroundPaintRadialInnerRadiusCommandTest >> targetContainers [ prop: 600) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintRadialInnerRadiusCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintRadialOuterCenterCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintRadialOuterCenterCommandTest.class.st index ba329f0d..2d8175df 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintRadialOuterCenterCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintRadialOuterCenterCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintRadialOuterCenterCommandTest >> command [ ^ PyramidBackgroundPaintRadialOuterCenterCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintRadialOuterCenterCommandTest >> targetContainers [ ^ { @@ -66,7 +66,7 @@ PyramidBackgroundPaintRadialOuterCenterCommandTest >> targetContainers [ prop: 500 asPoint) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintRadialOuterCenterCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintRadialOuterRadiusCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintRadialOuterRadiusCommandTest.class.st index 742ef40e..179e1144 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintRadialOuterRadiusCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintRadialOuterRadiusCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintRadialOuterRadiusCommandTest >> command [ ^ PyramidBackgroundPaintRadialOuterRadiusCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintRadialOuterRadiusCommandTest >> targetContainers [ ^ { @@ -58,7 +58,7 @@ PyramidBackgroundPaintRadialOuterRadiusCommandTest >> targetContainers [ prop: 600) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintRadialOuterRadiusCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundPaintStopsCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundPaintStopsCommandTest.class.st index 284afe89..d8ed51e3 100644 --- a/src/Pyramid-Tests/PyramidBackgroundPaintStopsCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundPaintStopsCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintStopsCommandTest >> command [ ^ PyramidBackgroundPaintStopsCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintStopsCommandTest >> targetContainers [ ^ { @@ -87,7 +87,7 @@ PyramidBackgroundPaintStopsCommandTest >> targetContainers [ } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundPaintStopsCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBackgroundTypeCommandTest.class.st b/src/Pyramid-Tests/PyramidBackgroundTypeCommandTest.class.st index b3c75e7b..b8f703c7 100644 --- a/src/Pyramid-Tests/PyramidBackgroundTypeCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBackgroundTypeCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBackgroundTypeCommandTest >> command [ ^ PyramidBackgroundTypeCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBackgroundTypeCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidBasicExactHorizontalConstraintsBlocCommandTest.class.st b/src/Pyramid-Tests/PyramidBasicExactHorizontalConstraintsBlocCommandTest.class.st index ddb32c3c..c5252455 100644 --- a/src/Pyramid-Tests/PyramidBasicExactHorizontalConstraintsBlocCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBasicExactHorizontalConstraintsBlocCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBasicExactHorizontalConstraintsBlocCommandTest >> command [ ^ PyramidBasicExactHorizontalConstraintsBlocCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBasicExactHorizontalConstraintsBlocCommandTest >> targetContainers [ | p1 a1 b1 p2 a2 b2 | @@ -42,7 +42,7 @@ PyramidBasicExactHorizontalConstraintsBlocCommandTest >> targetContainers [ (PyramidCommandTestContainer no: a2 with: b2 prop: 600) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBasicExactHorizontalConstraintsBlocCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBasicExactVerticalConstraintsBlocCommandTest.class.st b/src/Pyramid-Tests/PyramidBasicExactVerticalConstraintsBlocCommandTest.class.st index a1165f8e..db990f7f 100644 --- a/src/Pyramid-Tests/PyramidBasicExactVerticalConstraintsBlocCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBasicExactVerticalConstraintsBlocCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBasicExactVerticalConstraintsBlocCommandTest >> command [ ^ PyramidBasicExactVerticalConstraintsBlocCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBasicExactVerticalConstraintsBlocCommandTest >> targetContainers [ | p1 a1 b1 p2 a2 b2 | @@ -44,7 +44,7 @@ PyramidBasicExactVerticalConstraintsBlocCommandTest >> targetContainers [ (PyramidCommandTestContainer no: a2 with: b2 prop: 100) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBasicExactVerticalConstraintsBlocCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBasicHorizontalConstraintsBlocCommandTest.class.st b/src/Pyramid-Tests/PyramidBasicHorizontalConstraintsBlocCommandTest.class.st index 0c34c59c..1acbfbab 100644 --- a/src/Pyramid-Tests/PyramidBasicHorizontalConstraintsBlocCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBasicHorizontalConstraintsBlocCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBasicHorizontalConstraintsBlocCommandTest >> command [ ^ PyramidBasicHorizontalConstraintsBlocCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBasicHorizontalConstraintsBlocCommandTest >> targetContainers [ | p1 a1 b1 c1 d1 p2 a2 b2 c2 d2 | @@ -56,7 +56,7 @@ PyramidBasicHorizontalConstraintsBlocCommandTest >> targetContainers [ (PyramidCommandTestContainer no: a2 with: d2 prop: #matchParent) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBasicHorizontalConstraintsBlocCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBasicVerticalConstraintsBlocCommandTest.class.st b/src/Pyramid-Tests/PyramidBasicVerticalConstraintsBlocCommandTest.class.st index 6bd1493e..aca41fd1 100644 --- a/src/Pyramid-Tests/PyramidBasicVerticalConstraintsBlocCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBasicVerticalConstraintsBlocCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBasicVerticalConstraintsBlocCommandTest >> command [ ^ PyramidBasicVerticalConstraintsBlocCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBasicVerticalConstraintsBlocCommandTest >> targetContainers [ | p1 a1 b1 c1 d1 p2 a2 b2 c2 d2 | @@ -56,7 +56,7 @@ PyramidBasicVerticalConstraintsBlocCommandTest >> targetContainers [ (PyramidCommandTestContainer no: a2 with: d2 prop: #matchParent) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBasicVerticalConstraintsBlocCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidBorderDashArrayCommandTest.class.st b/src/Pyramid-Tests/PyramidBorderDashArrayCommandTest.class.st index 618ef42f..64e5d04c 100644 --- a/src/Pyramid-Tests/PyramidBorderDashArrayCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBorderDashArrayCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBorderDashArrayCommandTest >> command [ ^ PyramidBorderDashArrayCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBorderDashArrayCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidBorderDashOffsetCommandTest.class.st b/src/Pyramid-Tests/PyramidBorderDashOffsetCommandTest.class.st index a7d65f33..ce8b116c 100644 --- a/src/Pyramid-Tests/PyramidBorderDashOffsetCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBorderDashOffsetCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBorderDashOffsetCommandTest >> command [ ^ PyramidBorderDashOffsetCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBorderDashOffsetCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidBorderLineCapCommandTest.class.st b/src/Pyramid-Tests/PyramidBorderLineCapCommandTest.class.st index dce90ad7..9567d36d 100644 --- a/src/Pyramid-Tests/PyramidBorderLineCapCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBorderLineCapCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBorderLineCapCommandTest >> command [ ^ PyramidBorderLineCapCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBorderLineCapCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidBorderLineJoinCommandTest.class.st b/src/Pyramid-Tests/PyramidBorderLineJoinCommandTest.class.st index fef84f1f..8b25b0e1 100644 --- a/src/Pyramid-Tests/PyramidBorderLineJoinCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBorderLineJoinCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBorderLineJoinCommandTest >> command [ ^ PyramidBorderLineJoinCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBorderLineJoinCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidBorderMiterLimitCommandTest.class.st b/src/Pyramid-Tests/PyramidBorderMiterLimitCommandTest.class.st index f4ddb511..c97c1afa 100644 --- a/src/Pyramid-Tests/PyramidBorderMiterLimitCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBorderMiterLimitCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBorderMiterLimitCommandTest >> command [ ^ PyramidBorderMiterLimitCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBorderMiterLimitCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidBorderOpacityCommandTest.class.st b/src/Pyramid-Tests/PyramidBorderOpacityCommandTest.class.st index 77ba3328..e6cdffb0 100644 --- a/src/Pyramid-Tests/PyramidBorderOpacityCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBorderOpacityCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBorderOpacityCommandTest >> command [ ^ PyramidBorderOpacityCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBorderOpacityCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidBorderTypeCommandTest.class.st b/src/Pyramid-Tests/PyramidBorderTypeCommandTest.class.st index cc091120..72f3111e 100644 --- a/src/Pyramid-Tests/PyramidBorderTypeCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidBorderTypeCommandTest.class.st @@ -12,7 +12,7 @@ PyramidBorderTypeCommandTest >> command [ ^ PyramidBorderPaintCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidBorderTypeCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidChangeOrderWithIndexCommandTest.class.st b/src/Pyramid-Tests/PyramidChangeOrderWithIndexCommandTest.class.st index 3f304800..046812b1 100644 --- a/src/Pyramid-Tests/PyramidChangeOrderWithIndexCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidChangeOrderWithIndexCommandTest.class.st @@ -35,7 +35,7 @@ PyramidChangeOrderWithIndexCommandTest >> makeElementWithChildren [ ^ parent ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidChangeOrderWithIndexCommandTest >> targetContainers [ | test1 test2 test3 test4 test5 test6 | @@ -73,7 +73,7 @@ PyramidChangeOrderWithIndexCommandTest >> targetContainers [ prop: 1) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidChangeOrderWithIndexCommandTest >> targetsCanBeUsedFor [ ^ self targetContainers flatCollect: [ :each | diff --git a/src/Pyramid-Tests/PyramidChangeTextCommandTest.class.st b/src/Pyramid-Tests/PyramidChangeTextCommandTest.class.st index 18dd1eb5..bb1b4974 100644 --- a/src/Pyramid-Tests/PyramidChangeTextCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidChangeTextCommandTest.class.st @@ -12,7 +12,7 @@ PyramidChangeTextCommandTest >> command [ ^ PyramidChangeTextCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidChangeTextCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidClipChildrenCommandTest.class.st b/src/Pyramid-Tests/PyramidClipChildrenCommandTest.class.st index 07f02a09..c3ddf1e5 100644 --- a/src/Pyramid-Tests/PyramidClipChildrenCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidClipChildrenCommandTest.class.st @@ -12,7 +12,7 @@ PyramidClipChildrenCommandTest >> command [ ^ PyramidClipChildrenCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidClipChildrenCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidElementIdCommandTest.class.st b/src/Pyramid-Tests/PyramidElementIdCommandTest.class.st index b235dc3b..4b3d132a 100644 --- a/src/Pyramid-Tests/PyramidElementIdCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidElementIdCommandTest.class.st @@ -12,7 +12,7 @@ PyramidElementIdCommandTest >> command [ ^ PyramidElementIdCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidElementIdCommandTest >> targetContainers [ diff --git a/src/Pyramid-Tests/PyramidFontSizeCommandTest.class.st b/src/Pyramid-Tests/PyramidFontSizeCommandTest.class.st index effab2f4..343ce6e3 100644 --- a/src/Pyramid-Tests/PyramidFontSizeCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidFontSizeCommandTest.class.st @@ -18,7 +18,7 @@ PyramidFontSizeCommandTest >> command [ ^ PyramidFontSizeCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidFontSizeCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidFontWeightCommandTest.class.st b/src/Pyramid-Tests/PyramidFontWeightCommandTest.class.st index ca2f6b2e..1b5bfb98 100644 --- a/src/Pyramid-Tests/PyramidFontWeightCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidFontWeightCommandTest.class.st @@ -18,7 +18,7 @@ PyramidFontWeightCommandTest >> command [ ^ PyramidFontWeightCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidFontWeightCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st b/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st index 070c4ad8..1cefa683 100644 --- a/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidGeometryCommandTest.class.st @@ -12,7 +12,7 @@ PyramidGeometryCommandTest >> command [ ^ PyramidGeometryCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidGeometryCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidLayoutBlocCommandTest.class.st b/src/Pyramid-Tests/PyramidLayoutBlocCommandTest.class.st index 9da98d0b..a1c5f317 100644 --- a/src/Pyramid-Tests/PyramidLayoutBlocCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidLayoutBlocCommandTest.class.st @@ -12,7 +12,7 @@ PyramidLayoutBlocCommandTest >> command [ ^ PyramidLayoutBlocCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidLayoutBlocCommandTest >> targetContainers [ | flowLayoutVertical basicLayout proportionalLayout | @@ -43,7 +43,7 @@ PyramidLayoutBlocCommandTest >> targetContainers [ prop: proportionalLayout) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidLayoutBlocCommandTest >> targetsCanBeUsedFor [ ^ self targetContainers collect: [ :each | each targetNoProp ]. diff --git a/src/Pyramid-Tests/PyramidLayoutChangeOrientationCommandTest.class.st b/src/Pyramid-Tests/PyramidLayoutChangeOrientationCommandTest.class.st index b0e2e9e5..20cc4bcf 100644 --- a/src/Pyramid-Tests/PyramidLayoutChangeOrientationCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidLayoutChangeOrientationCommandTest.class.st @@ -12,7 +12,7 @@ PyramidLayoutChangeOrientationCommandTest >> command [ ^ PyramidLayoutChangeOrientationCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidLayoutChangeOrientationCommandTest >> targetContainers [ ^ { (PyramidCommandTestContainer @@ -49,7 +49,7 @@ PyramidLayoutChangeOrientationCommandTest >> targetContainers [ prop: BlLayoutOrientation horizontal) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidLayoutChangeOrientationCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidMarginCommandTest.class.st b/src/Pyramid-Tests/PyramidMarginCommandTest.class.st index 1ff7ea4b..5f6771c5 100644 --- a/src/Pyramid-Tests/PyramidMarginCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidMarginCommandTest.class.st @@ -12,7 +12,7 @@ PyramidMarginCommandTest >> command [ ^ PyramidMarginCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMarginCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidMoveBackwardOrderCommandTest.class.st b/src/Pyramid-Tests/PyramidMoveBackwardOrderCommandTest.class.st index beae1f5e..9c0a4d77 100644 --- a/src/Pyramid-Tests/PyramidMoveBackwardOrderCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidMoveBackwardOrderCommandTest.class.st @@ -6,7 +6,7 @@ Class { #category : #'Pyramid-Tests-cases-plugin-bloc-order' } -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMoveBackwardOrderCommandTest >> argumentsForHistory [ ^ { 3. 2. 1 } @@ -30,7 +30,7 @@ PyramidMoveBackwardOrderCommandTest >> makeElementWithChildren [ ^ parent ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMoveBackwardOrderCommandTest >> targetContainers [ | test1 test2 test3 | @@ -53,7 +53,7 @@ PyramidMoveBackwardOrderCommandTest >> targetContainers [ prop: 3) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMoveBackwardOrderCommandTest >> targetsCanBeUsedFor [ ^ self targetContainers flatCollect: [ :each | @@ -61,7 +61,7 @@ PyramidMoveBackwardOrderCommandTest >> targetsCanBeUsedFor [ each targetNoProp } ] ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMoveBackwardOrderCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidMoveForwardOrderCommandTest.class.st b/src/Pyramid-Tests/PyramidMoveForwardOrderCommandTest.class.st index 876ebefa..0cbc4141 100644 --- a/src/Pyramid-Tests/PyramidMoveForwardOrderCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidMoveForwardOrderCommandTest.class.st @@ -6,7 +6,7 @@ Class { #category : #'Pyramid-Tests-cases-plugin-bloc-order' } -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMoveForwardOrderCommandTest >> argumentsForHistory [ ^ { 1 . 2 . 3 } @@ -30,7 +30,7 @@ PyramidMoveForwardOrderCommandTest >> makeElementWithChildren [ ^ parent ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMoveForwardOrderCommandTest >> targetContainers [ | test1 test2 test3 | @@ -53,7 +53,7 @@ PyramidMoveForwardOrderCommandTest >> targetContainers [ prop: 3) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMoveForwardOrderCommandTest >> targetsCanBeUsedFor [ ^ self targetContainers flatCollect: [ :each | @@ -61,7 +61,7 @@ PyramidMoveForwardOrderCommandTest >> targetsCanBeUsedFor [ each targetNoProp } ] ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidMoveForwardOrderCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidOnBackgroundOrderCommandTest.class.st b/src/Pyramid-Tests/PyramidOnBackgroundOrderCommandTest.class.st index 0e57fc9e..5af89655 100644 --- a/src/Pyramid-Tests/PyramidOnBackgroundOrderCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidOnBackgroundOrderCommandTest.class.st @@ -35,7 +35,7 @@ PyramidOnBackgroundOrderCommandTest >> makeElementWithChildren [ ^ parent ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidOnBackgroundOrderCommandTest >> targetContainers [ | test1 test2 test3 | @@ -58,7 +58,7 @@ PyramidOnBackgroundOrderCommandTest >> targetContainers [ prop: 1) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidOnBackgroundOrderCommandTest >> targetsCanBeUsedFor [ ^ self targetContainers flatCollect: [ :each | diff --git a/src/Pyramid-Tests/PyramidOnForegroundOrderCommandTest.class.st b/src/Pyramid-Tests/PyramidOnForegroundOrderCommandTest.class.st index dfd10ec8..329c9857 100644 --- a/src/Pyramid-Tests/PyramidOnForegroundOrderCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidOnForegroundOrderCommandTest.class.st @@ -35,7 +35,7 @@ PyramidOnForegroundOrderCommandTest >> makeElementWithChildren [ ^ parent ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidOnForegroundOrderCommandTest >> targetContainers [ | test1 test2 test3 | @@ -58,7 +58,7 @@ PyramidOnForegroundOrderCommandTest >> targetContainers [ prop: 3) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidOnForegroundOrderCommandTest >> targetsCanBeUsedFor [ ^ self targetContainers flatCollect: [ :each | diff --git a/src/Pyramid-Tests/PyramidOpacityCommandTest.class.st b/src/Pyramid-Tests/PyramidOpacityCommandTest.class.st index 15abba92..90043941 100644 --- a/src/Pyramid-Tests/PyramidOpacityCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidOpacityCommandTest.class.st @@ -12,7 +12,7 @@ PyramidOpacityCommandTest >> command [ ^ PyramidOpacityCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidOpacityCommandTest >> targetContainers [ | e1 e2 | diff --git a/src/Pyramid-Tests/PyramidPaddingCommandTest.class.st b/src/Pyramid-Tests/PyramidPaddingCommandTest.class.st index 842a6e73..25058fe6 100644 --- a/src/Pyramid-Tests/PyramidPaddingCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidPaddingCommandTest.class.st @@ -12,7 +12,7 @@ PyramidPaddingCommandTest >> command [ ^ PyramidPaddingCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidPaddingCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidPositionCommandTest.class.st b/src/Pyramid-Tests/PyramidPositionCommandTest.class.st index 596e92eb..0d5784d3 100644 --- a/src/Pyramid-Tests/PyramidPositionCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidPositionCommandTest.class.st @@ -12,7 +12,7 @@ PyramidPositionCommandTest >> command [ ^ PyramidPositionCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidPositionCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidPositionOffsetCommandTest.class.st b/src/Pyramid-Tests/PyramidPositionOffsetCommandTest.class.st index 34285057..bf3c08a8 100644 --- a/src/Pyramid-Tests/PyramidPositionOffsetCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidPositionOffsetCommandTest.class.st @@ -12,7 +12,7 @@ PyramidPositionOffsetCommandTest >> command [ ^ PyramidPositionOffsetCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidPositionOffsetCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidProportionnalHorizontalConstraintsCommandTest.class.st b/src/Pyramid-Tests/PyramidProportionnalHorizontalConstraintsCommandTest.class.st index 40e93624..1da847b8 100644 --- a/src/Pyramid-Tests/PyramidProportionnalHorizontalConstraintsCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidProportionnalHorizontalConstraintsCommandTest.class.st @@ -12,7 +12,7 @@ PyramidProportionnalHorizontalConstraintsCommandTest >> command [ ^ PyramidProportionalHorizontalConstraintsCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidProportionnalHorizontalConstraintsCommandTest >> targetContainers [ | parent e1 e2 | @@ -31,7 +31,7 @@ PyramidProportionnalHorizontalConstraintsCommandTest >> targetContainers [ prop: 0.2 @ 0.4)} ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidProportionnalHorizontalConstraintsCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidProportionnalVerticalConstraintsCommandTest.class.st b/src/Pyramid-Tests/PyramidProportionnalVerticalConstraintsCommandTest.class.st index 81496cc8..7797a248 100644 --- a/src/Pyramid-Tests/PyramidProportionnalVerticalConstraintsCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidProportionnalVerticalConstraintsCommandTest.class.st @@ -12,7 +12,7 @@ PyramidProportionnalVerticalConstraintsCommandTest >> command [ ^ PyramidProportionalVerticalConstraintsCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidProportionnalVerticalConstraintsCommandTest >> targetContainers [ | parent e1 e2 | @@ -35,7 +35,7 @@ PyramidProportionnalVerticalConstraintsCommandTest >> targetContainers [ ^ { (PyramidCommandTestContainer no: e1 with: e2 prop: 0.3 @ 0.6) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidProportionnalVerticalConstraintsCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidRemoveChildCommandTest.class.st b/src/Pyramid-Tests/PyramidRemoveChildCommandTest.class.st index 30f24257..923c5ca1 100644 --- a/src/Pyramid-Tests/PyramidRemoveChildCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidRemoveChildCommandTest.class.st @@ -12,7 +12,7 @@ PyramidRemoveChildCommandTest >> command [ ^ PyramidRemoveChildCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidRemoveChildCommandTest >> targetsCanBeUsedFor [ ^ { BlElement new . BlElement new addChild: BlElement new; yourself } diff --git a/src/Pyramid-Tests/PyramidRemoveSelectionCommandTest.class.st b/src/Pyramid-Tests/PyramidRemoveSelectionCommandTest.class.st index 18aa0bb1..c2e6a27b 100644 --- a/src/Pyramid-Tests/PyramidRemoveSelectionCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidRemoveSelectionCommandTest.class.st @@ -116,7 +116,7 @@ PyramidRemoveSelectionCommandTest >> parentsAndElements [ ^ parents -> elements ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidRemoveSelectionCommandTest >> targetsCanBeUsedFor [ ^ { diff --git a/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st b/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st index 68db7048..38d349a6 100644 --- a/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidRoundedRectangleCornerRadiiCommandTest.class.st @@ -12,7 +12,7 @@ PyramidRoundedRectangleCornerRadiiCommandTest >> command [ ^ PyramidRoundedRectangleCornerRadiiCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidRoundedRectangleCornerRadiiCommandTest >> targetContainers [ ^ { @@ -30,7 +30,7 @@ PyramidRoundedRectangleCornerRadiiCommandTest >> targetContainers [ prop: (BlCornerRadii radius: 20)) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidRoundedRectangleCornerRadiiCommandTest >> targetsCannotBeUsedFor [ "override if needed" diff --git a/src/Pyramid-Tests/PyramidShadowColorCommandTest.class.st b/src/Pyramid-Tests/PyramidShadowColorCommandTest.class.st index e5f446a1..fcd6eddd 100644 --- a/src/Pyramid-Tests/PyramidShadowColorCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidShadowColorCommandTest.class.st @@ -12,7 +12,7 @@ PyramidShadowColorCommandTest >> command [ ^ PyramidShadowColorCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowColorCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidShadowCommandTest.class.st b/src/Pyramid-Tests/PyramidShadowCommandTest.class.st index 2dcdb309..0e96a6e3 100644 --- a/src/Pyramid-Tests/PyramidShadowCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidShadowCommandTest.class.st @@ -21,7 +21,7 @@ PyramidShadowCommandTest >> command [ ^ PyramidShadowCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidShadowGaussianWidthTest.class.st b/src/Pyramid-Tests/PyramidShadowGaussianWidthTest.class.st index a417f5fc..bf2b5df0 100644 --- a/src/Pyramid-Tests/PyramidShadowGaussianWidthTest.class.st +++ b/src/Pyramid-Tests/PyramidShadowGaussianWidthTest.class.st @@ -13,7 +13,7 @@ PyramidShadowGaussianWidthTest >> command [ ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowGaussianWidthTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidShadowOffsetCommandTest.class.st b/src/Pyramid-Tests/PyramidShadowOffsetCommandTest.class.st index a68c8424..2825bb4d 100644 --- a/src/Pyramid-Tests/PyramidShadowOffsetCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidShadowOffsetCommandTest.class.st @@ -12,7 +12,7 @@ PyramidShadowOffsetCommandTest >> command [ ^ PyramidShadowOffsetCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidShadowOffsetCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidTextForegroundCommandTest.class.st b/src/Pyramid-Tests/PyramidTextForegroundCommandTest.class.st index 36b77372..457a78b1 100644 --- a/src/Pyramid-Tests/PyramidTextForegroundCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidTextForegroundCommandTest.class.st @@ -18,7 +18,7 @@ PyramidTextForegroundCommandTest >> command [ ^ PyramidTextForegroundCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidTextForegroundCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidVisibilityCommandTest.class.st b/src/Pyramid-Tests/PyramidVisibilityCommandTest.class.st index abca3c83..028dad1c 100644 --- a/src/Pyramid-Tests/PyramidVisibilityCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidVisibilityCommandTest.class.st @@ -12,7 +12,7 @@ PyramidVisibilityCommandTest >> command [ ^ PyramidVisibilityCommand new. ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidVisibilityCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/PyramidWeightConstraintsCommandTest.class.st b/src/Pyramid-Tests/PyramidWeightConstraintsCommandTest.class.st index 3af4cf20..7680fbde 100644 --- a/src/Pyramid-Tests/PyramidWeightConstraintsCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidWeightConstraintsCommandTest.class.st @@ -12,7 +12,7 @@ PyramidWeightConstraintsCommandTest >> command [ ^ PyramidWeightConstraintsCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidWeightConstraintsCommandTest >> targetContainers [ | parentLinear e1Linear e2Linear parentFlow e1Flow e2Flow | @@ -41,7 +41,7 @@ PyramidWeightConstraintsCommandTest >> targetContainers [ ^ { (PyramidCommandTestContainer no: e1Linear with: e2Linear prop: 0.5) . (PyramidCommandTestContainer no: e1Flow with: e2Flow prop: 0.5) } ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidWeightConstraintsCommandTest >> targetsCannotBeUsedFor [ "override if needed" | parent child | diff --git a/src/Pyramid-Tests/PyramidZIndexCommandTest.class.st b/src/Pyramid-Tests/PyramidZIndexCommandTest.class.st index ccb5fe23..13a1594a 100644 --- a/src/Pyramid-Tests/PyramidZIndexCommandTest.class.st +++ b/src/Pyramid-Tests/PyramidZIndexCommandTest.class.st @@ -12,7 +12,7 @@ PyramidZIndexCommandTest >> command [ ^ PyramidZIndexCommand new. ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidZIndexCommandTest >> targetContainers [ ^ { diff --git a/src/Pyramid-Tests/TPyramidCommandTest.trait.st b/src/Pyramid-Tests/TPyramidCommandTest.trait.st index fb408590..c7f62f97 100644 --- a/src/Pyramid-Tests/TPyramidCommandTest.trait.st +++ b/src/Pyramid-Tests/TPyramidCommandTest.trait.st @@ -3,7 +3,7 @@ Trait { #category : #'Pyramid-Tests-cases-command' } -{ #category : #'as yet unclassified' } +{ #category : #accessing } TPyramidCommandTest >> argumentsForHistory [ @@ -16,19 +16,19 @@ TPyramidCommandTest >> command [ ^ self shouldBeImplemented ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } TPyramidCommandTest >> targetContainers [ ^ self shouldBeImplemented ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } TPyramidCommandTest >> targetsCanBeUsedFor [ ^ self targetContainers flatCollect: [ :each | { each targetNoProp . each targetWithProp } ]. ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } TPyramidCommandTest >> targetsCannotBeUsedFor [ "override if needed" ^ { nil . false . 0 . $a } diff --git a/src/Pyramid-Toplo-Tests/PyramidStampCommandTest.class.st b/src/Pyramid-Toplo-Tests/PyramidStampCommandTest.class.st index b27c592e..f7143ce0 100644 --- a/src/Pyramid-Toplo-Tests/PyramidStampCommandTest.class.st +++ b/src/Pyramid-Toplo-Tests/PyramidStampCommandTest.class.st @@ -12,7 +12,7 @@ PyramidStampCommandTest >> command [ ^ PyramidStampCommand new stamp: #test; yourself ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } PyramidStampCommandTest >> targetContainers [ ^ { From 1ea94f5ea541c05aaf0a8402178a677d4e2810f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 16 Apr 2026 16:39:45 +0200 Subject: [PATCH 11/58] update devStage_shadow --- src/Pyramid-Bloc/PyramidShadowColorCommand.class.st | 13 ++++++------- .../PyramidShadowGaussianWidthCommand.class.st | 12 +++++------- .../PyramidShadowOffsetCommand.class.st | 13 ++++++------- 3 files changed, 17 insertions(+), 21 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st index ec8cae3b..52bfd00c 100644 --- a/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowColorCommand.class.st @@ -15,17 +15,16 @@ PyramidShadowColorCommand >> canBeUsedFor: anObject [ { #category : #accessing } PyramidShadowColorCommand >> getValueFor: aBlElement [ - (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class = BlGaussianShadowEffect]) - ifTrue: [ ^ aBlElement effect color ] - ifFalse: [ ^ nil ] + (aBlElement effect class = BlSimpleShadowEffect or: [ + aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ]. + ^ aBlElement effect color ] { #category : #accessing } PyramidShadowColorCommand >> setValueFor: aBlElement with: aColor [ - (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class= BlGaussianShadowEffect]) - ifTrue: [ - aBlElement effect: (aBlElement effect copyWithColor: aColor) ] - ifFalse: [ ^ nil ]. + (aBlElement effect class = BlSimpleShadowEffect or: [ + aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ]. + aBlElement effect: (aBlElement effect copyWithColor: aColor). PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st b/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st index 08272272..c9e8984b 100644 --- a/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowGaussianWidthCommand.class.st @@ -15,17 +15,15 @@ PyramidShadowGaussianWidthCommand >> canBeUsedFor: anObject [ PyramidShadowGaussianWidthCommand >> getValueFor: aBlElement [ (aBlElement effect class = BlSimpleShadowEffect or: [ - aBlElement effect class = BlGaussianShadowEffect ]) - ifTrue: [ ^ aBlElement effect width ] - ifFalse: [ ^ nil ] + aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ]. + ^ aBlElement effect width ] { #category : #accessing } PyramidShadowGaussianWidthCommand >> setValueFor: aBlElement with: aWidth [ - (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class = BlGaussianShadowEffect]) - ifTrue: [ - aBlElement effect: (aBlElement effect copyWithWidth: aWidth) ] - ifFalse: [ ^ nil ]. + (aBlElement effect class = BlSimpleShadowEffect or: [ + aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ]. + aBlElement effect: (aBlElement effect copyWithWidth: aWidth). PyramidShadowCommand current syncFromElement: aBlElement ] diff --git a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st index a4388e2b..73737e5e 100644 --- a/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st +++ b/src/Pyramid-Bloc/PyramidShadowOffsetCommand.class.st @@ -14,17 +14,16 @@ PyramidShadowOffsetCommand >> canBeUsedFor: anObject [ { #category : #accessing } PyramidShadowOffsetCommand >> getValueFor: aBlElement [ - (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class = BlGaussianShadowEffect]) - ifTrue: [ ^ aBlElement effect offset ] - ifFalse: [ ^ nil ] + (aBlElement effect class = BlSimpleShadowEffect or: [ + aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ]. + ^ aBlElement effect offset ] { #category : #accessing } PyramidShadowOffsetCommand >> setValueFor: aBlElement with: aPoint [ - (aBlElement effect class = BlSimpleShadowEffect or: [aBlElement effect class = BlGaussianShadowEffect]) - ifTrue: [ - aBlElement effect: (aBlElement effect copyWithOffset: aPoint) ] - ifFalse: [ ^ nil ]. + (aBlElement effect class = BlSimpleShadowEffect or: [ + aBlElement effect class = BlGaussianShadowEffect ]) ifFalse: [ ^ nil ]. + aBlElement effect: (aBlElement effect copyWithOffset: aPoint). PyramidShadowCommand current syncFromElement: aBlElement ] From 8550b54e3b83d5f588c30563407e3c072483b76f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 21 Apr 2026 14:43:54 +0200 Subject: [PATCH 12/58] =?UTF-8?q?fix=20issue=20:=20Undo=20of=20remove=20el?= =?UTF-8?q?ement=20doesn=E2=80=99t=20put=20it=20back=20in=20the=20same=20p?= =?UTF-8?q?osition=20#187?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../PyramidAddChildCommand.class.st | 7 +- .../PyramidAddChildrenCommand.class.st | 4 +- ...amidRemoveSelectedElementsCommand.class.st | 29 ++++--- ...PyramidUndoRemoveChildCommandTest.class.st | 87 +++++++++++++++++++ src/Pyramid/PyramidCompositeMemento.class.st | 7 +- 5 files changed, 117 insertions(+), 17 deletions(-) create mode 100644 src/Pyramid-Tests/PyramidUndoRemoveChildCommandTest.class.st diff --git a/src/Pyramid-Bloc/PyramidAddChildCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildCommand.class.st index 5b13af98..05e2cb54 100644 --- a/src/Pyramid-Bloc/PyramidAddChildCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAddChildCommand.class.st @@ -12,6 +12,9 @@ PyramidAddChildCommand >> commandInverse [ { #category : #'as yet unclassified' } PyramidAddChildCommand >> setValueFor: aBlElement with: aChildToAdd [ - - aBlElement addChild: aChildToAdd + | index | + index := aChildToAdd userData at: #removedAtIndex ifAbsent: [ 0 ]. + (index = 0 or: [ index > aBlElement children size ]) + ifTrue: [ aBlElement addChild: aChildToAdd ] + ifFalse: [ aBlElement addChild: aChildToAdd at: index ] ] diff --git a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st index 1c146561..520fe7cd 100644 --- a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st @@ -12,6 +12,6 @@ PyramidAddChildrenCommand >> commandInverse [ { #category : #'as yet unclassified' } PyramidAddChildrenCommand >> setValueFor: aBlElement with: aChildrenToAdd [ - - aBlElement addChildren: aChildrenToAdd + aChildrenToAdd do: [ :child | + aBlElement addChild: child ] ] diff --git a/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st b/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st index 2beae596..9e281af1 100644 --- a/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st @@ -15,18 +15,23 @@ PyramidRemoveSelectedElementsCommand >> getValueFor: anElementOfSelection [ { #category : #'as yet unclassified' } PyramidRemoveSelectedElementsCommand >> mementoFor: anElement withArguments: anArgument [ - - (anArgument includes: anElement) ifTrue: [ - ^ PyramidCommandMemento new - command: PyramidRemoveFromCollectionCommand new commandInverse; - target: anArgument; - arguments: anElement; - yourself ]. - ^ PyramidCommandMemento new - command: PyramidRemoveChildCommand new commandInverse; - target: anElement parent; - arguments: anElement; - yourself + | index | + "Save index before removing" + index := anElement parent + ifNotNil: [ :p | p children indexOf: anElement ] + ifNil: [ 0 ]. + anElement userData at: #removedAtIndex put: index. + (anArgument includes: anElement) ifTrue: [ + ^ PyramidCommandMemento new + command: PyramidRemoveFromCollectionCommand new commandInverse; + target: anArgument; + arguments: anElement; + yourself ]. + ^ PyramidCommandMemento new + command: PyramidRemoveChildCommand new commandInverse; + target: anElement parent; + arguments: anElement; + yourself ] { #category : #accessing } diff --git a/src/Pyramid-Tests/PyramidUndoRemoveChildCommandTest.class.st b/src/Pyramid-Tests/PyramidUndoRemoveChildCommandTest.class.st new file mode 100644 index 00000000..76ffedc0 --- /dev/null +++ b/src/Pyramid-Tests/PyramidUndoRemoveChildCommandTest.class.st @@ -0,0 +1,87 @@ +Class { + #name : #PyramidUndoRemoveChildCommandTest, + #superclass : #TestCase, + #category : #'Pyramid-Tests-cases-plugin-bloc' +} + +{ #category : #tests } +PyramidUndoRemoveChildCommandTest >> testUndoRemoveAllChildrenRestoresIndex [ + + | history commandExecutor parent child1 child2 child3 child4| + parent := BlElement new. + child1 := BlElement new. + child2 := BlElement new. + child3 := BlElement new. + child4 := BlElement new. + parent addChildren: {child1. child2 .child3. child4}. + + history := PyramidHistory new. + commandExecutor := PyramidHistoryCommandExecutor new + history: history; + wrappee: PyramidMainCommandExecutor new; + yourself. + commandExecutor + use: PyramidRemoveSelectedElementsCommand new + on: { + child4. + child2. + child1 } + with: { parent }. + + self deny: (parent children includes: child2). + self deny: (parent children includes: child1). + self deny: (parent children includes: child4). + + "Undo" + history undo. + + self assert: (parent children includes: child1). + self assert: (parent children includes: child2). + self assert: (parent children indexOf: child1) equals: 1. + self assert: (parent children indexOf: child2) equals: 2. + self assert: (parent children indexOf: child4) equals: 4 +] + +{ #category : #tests } +PyramidUndoRemoveChildCommandTest >> testUndoRemoveChildRestoresIndex [ + + | history commandExecutor parent child1 child2 child3 | + + parent := BlElement new. + child1 := BlElement new. + child2 := BlElement new. + child3 := BlElement new. + parent addChild: child1. + parent addChild: child2. + parent addChild: child3. + + history := PyramidHistory new. + commandExecutor := PyramidHistoryCommandExecutor new + history: history; + wrappee: PyramidMainCommandExecutor new; + yourself. + + commandExecutor + use: PyramidRemoveSelectedElementsCommand new + on: { child2 } + with: { parent }. + + self deny: (parent children includes: child2). + + "Undo" + history undo. + + self assert: (parent children includes: child2). + self assert: (parent children indexOf: child2) equals: 2. + + "Redo" + history redo. + + self deny: (parent children includes: child2). + + "Undo" + history undo. + + self assert: (parent children includes: child2). + self assert: (parent children indexOf: child2) equals: 2 +] diff --git a/src/Pyramid/PyramidCompositeMemento.class.st b/src/Pyramid/PyramidCompositeMemento.class.st index f3eb07f9..8ec74569 100644 --- a/src/Pyramid/PyramidCompositeMemento.class.st +++ b/src/Pyramid/PyramidCompositeMemento.class.st @@ -34,5 +34,10 @@ PyramidCompositeMemento >> mementos: anObject [ { #category : #'window management' } PyramidCompositeMemento >> restore [ - self mementos do: [ :each | each restore ] + (self mementos allSatisfy: [ :m | m arguments isKindOf: BlElement ]) + ifFalse: [ self mementos do: [ :each | each restore ]. ^ self ]. + (self mementos asSortedCollection: [ :a :b | + (a arguments userData at: #removedAtIndex ifAbsent: [ 0 ]) + < (b arguments userData at: #removedAtIndex ifAbsent: [ 0 ]) ]) + do: [ :each | each restore ] ] From 4e82ec8a0a53bdc6a6c79189f207fd69e4f0d5c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 23 Apr 2026 14:48:56 +0200 Subject: [PATCH 13/58] update devStage_fixIssueUndo187 --- src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st index 520fe7cd..24c741a9 100644 --- a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st @@ -12,6 +12,6 @@ PyramidAddChildrenCommand >> commandInverse [ { #category : #'as yet unclassified' } PyramidAddChildrenCommand >> setValueFor: aBlElement with: aChildrenToAdd [ - aChildrenToAdd do: [ :child | - aBlElement addChild: child ] + + aBlElement addChildren: aChildrenToAdd ] From d425f9fdf45dd7e02fa24ead3ddd1fdce91adefc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 28 Apr 2026 14:26:17 +0200 Subject: [PATCH 14/58] =?UTF-8?q?update=20fix=20issue=20:=20Undo=20of=20re?= =?UTF-8?q?move=20element=20doesn=E2=80=99t=20put=20it=20back=20in=20the?= =?UTF-8?q?=20same=20position=20#187?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../PyramidAbstractBorderCommand.class.st | 2 +- ...midAbstractChangeDrawOrderCommand.class.st | 2 +- .../PyramidAddChildCommand.class.st | 23 ++++++--- .../PyramidAddChildrenCommand.class.st | 4 +- .../PyramidBackgroundImageCommand.class.st | 4 +- .../PyramidBackgroundOpacityCommand.class.st | 4 +- ...yramidBackgroundPaintColorCommand.class.st | 4 +- .../PyramidBackgroundPaintCommand.class.st | 6 +-- ...idBackgroundPaintLinearEndCommand.class.st | 4 +- ...BackgroundPaintLinearStartCommand.class.st | 4 +- ...oundPaintRadialInnerCenterCommand.class.st | 4 +- ...oundPaintRadialInnerRadiusCommand.class.st | 4 +- ...oundPaintRadialOuterCenterCommand.class.st | 4 +- ...oundPaintRadialOuterRadiusCommand.class.st | 4 +- ...yramidBackgroundPaintStopsCommand.class.st | 4 +- .../PyramidBackgroundTypeCommand.class.st | 6 +-- ...tHorizontalConstraintsBlocCommand.class.st | 4 +- ...actVerticalConstraintsBlocCommand.class.st | 4 +- ...cHorizontalConstraintsBlocCommand.class.st | 6 +-- ...sicVerticalConstraintsBlocCommand.class.st | 6 +-- .../PyramidBorderDashArrayCommand.class.st | 2 +- .../PyramidBorderDashOffsetCommand.class.st | 2 +- .../PyramidBorderLineCapCommand.class.st | 2 +- .../PyramidBorderLineJoinCommand.class.st | 2 +- .../PyramidBorderMiterLimitCommand.class.st | 2 +- .../PyramidBorderOpacityCommand.class.st | 2 +- .../PyramidBorderPaintColorCommand.class.st | 2 +- .../PyramidBorderPaintCommand.class.st | 2 +- ...derPaintLinearDirectionEndCommand.class.st | 2 +- ...rPaintLinearDirectionStartCommand.class.st | 2 +- ...rderPaintRadialInnerCenterCommand.class.st | 2 +- ...rderPaintRadialInnerRadiusCommand.class.st | 2 +- ...rderPaintRadialOuterCenterCommand.class.st | 2 +- ...rderPaintRadialOuterRadiusCommand.class.st | 2 +- .../PyramidBorderPaintStopsCommand.class.st | 2 +- .../PyramidBorderWidthCommand.class.st | 2 +- ...yramidChangeOrderWithIndexCommand.class.st | 2 +- .../PyramidChangeTextCommand.class.st | 4 +- .../PyramidChildrenCommand.class.st | 4 +- .../PyramidClipChildrenCommand.class.st | 4 +- .../PyramidDynamicResizeCommand.class.st | 8 ++-- .../PyramidElementIdCommand.class.st | 4 +- .../PyramidFontSizeCommand.class.st | 4 +- .../PyramidFontWeightCommand.class.st | 4 +- ...FrameHorizontalConstraintsCommand.class.st | 4 +- ...idFrameVerticalConstraintsCommand.class.st | 4 +- .../PyramidGeometryCommand.class.st | 4 +- src/Pyramid-Bloc/PyramidGroupCommand.class.st | 10 ++-- .../PyramidLayoutBlocCommand.class.st | 4 +- ...midLayoutChangeOrientationCommand.class.st | 4 +- .../PyramidMarginCommand.class.st | 4 +- .../PyramidMoveBackwardOrderCommand.class.st | 4 +- .../PyramidMoveChildInParentCommand.class.st | 4 +- .../PyramidMoveChildIndexDownCommand.class.st | 4 +- .../PyramidMoveChildIndexUpCommand.class.st | 4 +- .../PyramidMoveForwardOrderCommand.class.st | 4 +- .../PyramidOnBackgroundOrderCommand.class.st | 4 +- .../PyramidOnForegroundOrderCommand.class.st | 4 +- .../PyramidOpacityCommand.class.st | 4 +- .../PyramidOutskirtsCommand.class.st | 4 +- .../PyramidPaddingCommand.class.st | 4 +- .../PyramidPositionCommand.class.st | 4 +- .../PyramidPositionOffsetCommand.class.st | 8 ++-- ...ionalHorizontalConstraintsCommand.class.st | 4 +- ...rtionalVerticalConstraintsCommand.class.st | 4 +- .../PyramidRedoGroupCommand.class.st | 6 +-- .../PyramidRemoveChildCommand.class.st | 4 +- .../PyramidRemoveChildrenCommand.class.st | 4 +- ...amidRemoveSelectedElementsCommand.class.st | 48 +++++++++++-------- ...oundedRectangleCornerRadiiCommand.class.st | 4 +- .../PyramidTextForegroundCommand.class.st | 4 +- ...ramidUndoDynamicResizeBlocCommand.class.st | 6 +-- .../PyramidUndoGroupCommand.class.st | 6 +-- .../PyramidVisibilityCommand.class.st | 4 +- .../PyramidWeightConstraintsCommand.class.st | 4 +- .../PyramidZIndexCommand.class.st | 4 +- .../PyramidDecreaseMockCommand.class.st | 6 +-- .../PyramidIncreaseMockCommand.class.st | 6 +-- .../PyramidSimpleMockCommand.class.st | 4 +- .../PyramidSimpleMockGroupedCommand.class.st | 2 +- .../PyramidStampCommand.class.st | 4 +- .../PyramidThemeCommand.class.st | 4 +- .../PyramidAddAllToCollectionCommand.class.st | 6 +-- .../PyramidAddToCollectionCommand.class.st | 6 +-- src/Pyramid/PyramidCollectionCommand.class.st | 2 +- src/Pyramid/PyramidCommand.class.st | 18 +++---- ...midRemoveAllFromCollectionCommand.class.st | 6 +-- ...yramidRemoveFromCollectionCommand.class.st | 6 +-- 88 files changed, 221 insertions(+), 206 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidAbstractBorderCommand.class.st b/src/Pyramid-Bloc/PyramidAbstractBorderCommand.class.st index d95e6834..d355e19a 100644 --- a/src/Pyramid-Bloc/PyramidAbstractBorderCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAbstractBorderCommand.class.st @@ -20,7 +20,7 @@ PyramidAbstractBorderCommand >> borderBuilderOf: aBlElement [ ^ builder ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidAbstractBorderCommand >> setValueFor: aBlElement with: anArgument [ | builder | diff --git a/src/Pyramid-Bloc/PyramidAbstractChangeDrawOrderCommand.class.st b/src/Pyramid-Bloc/PyramidAbstractChangeDrawOrderCommand.class.st index 38ee07cb..a6616327 100644 --- a/src/Pyramid-Bloc/PyramidAbstractChangeDrawOrderCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAbstractChangeDrawOrderCommand.class.st @@ -16,7 +16,7 @@ PyramidAbstractChangeDrawOrderCommand >> canBeUsedFor: anObject [ ^ (super canBeUsedFor: anObject) and: [ anObject hasParent] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidAbstractChangeDrawOrderCommand >> getValueFor: aBlElement [ "return current index for testing." diff --git a/src/Pyramid-Bloc/PyramidAddChildCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildCommand.class.st index 05e2cb54..40ae11b1 100644 --- a/src/Pyramid-Bloc/PyramidAddChildCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAddChildCommand.class.st @@ -4,17 +4,26 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidAddChildCommand >> commandInverse [ ^ PyramidRemoveChildCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #private } +PyramidAddChildCommand >> savedIndexFor: aChild in: aParent [ + + | index | + index := aChild userData at: #removedAtIndex ifAbsent: [ 0 ]. + (index = 0 or: [ index > aParent children size ]) + ifTrue: [ ^ aParent children size + 1 ] + ifFalse: [ ^ index ] +] + +{ #category : #setter } PyramidAddChildCommand >> setValueFor: aBlElement with: aChildToAdd [ - | index | - index := aChildToAdd userData at: #removedAtIndex ifAbsent: [ 0 ]. - (index = 0 or: [ index > aBlElement children size ]) - ifTrue: [ aBlElement addChild: aChildToAdd ] - ifFalse: [ aBlElement addChild: aChildToAdd at: index ] + + aBlElement + addChild: aChildToAdd + at: (self savedIndexFor: aChildToAdd in: aBlElement) ] diff --git a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st index 520fe7cd..34df84a2 100644 --- a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidAddChildrenCommand >> commandInverse [ ^ PyramidRemoveChildrenCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidAddChildrenCommand >> setValueFor: aBlElement with: aChildrenToAdd [ aChildrenToAdd do: [ :child | aBlElement addChild: child ] diff --git a/src/Pyramid-Bloc/PyramidBackgroundImageCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundImageCommand.class.st index e8d958a4..42bda929 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundImageCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundImageCommand.class.st @@ -11,13 +11,13 @@ PyramidBackgroundImageCommand >> canBeUsedFor: anObject [ anObject background isKindOf: BlImageBackground ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundImageCommand >> getValueFor: aBlElement [ ^ aBlElement background image ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundImageCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background: (BlBackground image: anArgument) diff --git a/src/Pyramid-Bloc/PyramidBackgroundOpacityCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundOpacityCommand.class.st index f5093b8e..5521f475 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundOpacityCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundOpacityCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundOpacityCommand >> getValueFor: aBlElement [ ^ aBlElement background opacity ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundOpacityCommand >> setValueFor: aBlElement with: anArgument [ | background | diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintColorCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintColorCommand.class.st index d2249ff9..0a63dd0d 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintColorCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintColorCommand.class.st @@ -12,13 +12,13 @@ PyramidBackgroundPaintColorCommand >> canBeUsedFor: anObject [ anObject background paint isKindOf: BlColorPaint ] ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintColorCommand >> getValueFor: aBlElement [ ^ aBlElement background paint color ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintColorCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background: (BlBackground paint: anArgument asBlPaint) diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintCommand.class.st index 95c0fd85..45a5f776 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintCommand.class.st @@ -11,19 +11,19 @@ PyramidBackgroundPaintCommand >> canBeUsedFor: anObject [ anObject background isKindOf: BlPaintBackground ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintCommand >> getGroupedValueFor: aBlElement [ ^ aBlElement background paint class ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintCommand >> getValueFor: aBlElement [ ^ aBlElement background paint ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background: (BlBackground paint: anArgument value) diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintLinearEndCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintLinearEndCommand.class.st index 4201cb78..54897472 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintLinearEndCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintLinearEndCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintLinearEndCommand >> getValueFor: aBlElement [ ^ aBlElement background paint end ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintLinearEndCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background paint end: anArgument diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintLinearStartCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintLinearStartCommand.class.st index c62bbd9f..317cd3a6 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintLinearStartCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintLinearStartCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintLinearStartCommand >> getValueFor: aBlElement [ ^ aBlElement background paint start ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintLinearStartCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background paint start: anArgument diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintRadialInnerCenterCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintRadialInnerCenterCommand.class.st index e85efec8..3e5181ee 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintRadialInnerCenterCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintRadialInnerCenterCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintRadialInnerCenterCommand >> getValueFor: aBlElement [ ^ aBlElement background paint innerCenter ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintRadialInnerCenterCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background paint innerCenter: anArgument diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintRadialInnerRadiusCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintRadialInnerRadiusCommand.class.st index a2c2888d..2416e8c1 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintRadialInnerRadiusCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintRadialInnerRadiusCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintRadialInnerRadiusCommand >> getValueFor: aBlElement [ ^ aBlElement background paint innerRadius ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintRadialInnerRadiusCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background paint innerRadius: anArgument diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintRadialOuterCenterCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintRadialOuterCenterCommand.class.st index 8d8deac9..352d4e4c 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintRadialOuterCenterCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintRadialOuterCenterCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintRadialOuterCenterCommand >> getValueFor: aBlElement [ ^ aBlElement background paint outerCenter ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintRadialOuterCenterCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background paint outerCenter: anArgument diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintRadialOuterRadiusCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintRadialOuterRadiusCommand.class.st index f1ba79b4..c313f420 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintRadialOuterRadiusCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintRadialOuterRadiusCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintRadialOuterRadiusCommand >> getValueFor: aBlElement [ ^ aBlElement background paint outerRadius ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintRadialOuterRadiusCommand >> setValueFor: aBlElement with: anArgument [ aBlElement background paint outerRadius: anArgument diff --git a/src/Pyramid-Bloc/PyramidBackgroundPaintStopsCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundPaintStopsCommand.class.st index faebbb2a..57073903 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundPaintStopsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundPaintStopsCommand.class.st @@ -12,7 +12,7 @@ PyramidBackgroundPaintStopsCommand >> canBeUsedFor: anObject [ anObject background paint isKindOf: BlGradientPaint ] ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundPaintStopsCommand >> getValueFor: aBlElement [ "We ensure that we are working with a copy of the associations." @@ -20,7 +20,7 @@ PyramidBackgroundPaintStopsCommand >> getValueFor: aBlElement [ asso key copy -> asso value copy ] ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundPaintStopsCommand >> setValueFor: aBlElement with: anArgument [ "We ensure that we are working with a copy of the associations." diff --git a/src/Pyramid-Bloc/PyramidBackgroundTypeCommand.class.st b/src/Pyramid-Bloc/PyramidBackgroundTypeCommand.class.st index 9031fa54..77e77faa 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundTypeCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundTypeCommand.class.st @@ -4,19 +4,19 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundTypeCommand >> getGroupedValueFor: aBlElement [ ^ aBlElement background class ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBackgroundTypeCommand >> getValueFor: aBlElement [ ^ aBlElement background ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBackgroundTypeCommand >> setValueFor: aBlElement with: anArgument [ "Must be a blockClosure to ensure no background are created." diff --git a/src/Pyramid-Bloc/PyramidBasicExactHorizontalConstraintsBlocCommand.class.st b/src/Pyramid-Bloc/PyramidBasicExactHorizontalConstraintsBlocCommand.class.st index 0988c930..cbd6cff3 100644 --- a/src/Pyramid-Bloc/PyramidBasicExactHorizontalConstraintsBlocCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBasicExactHorizontalConstraintsBlocCommand.class.st @@ -11,13 +11,13 @@ PyramidBasicExactHorizontalConstraintsBlocCommand >> canBeUsedFor: anObject [ anObject constraints horizontal resizer isExact ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBasicExactHorizontalConstraintsBlocCommand >> getValueFor: anObject [ ^ anObject constraints horizontal resizer size ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBasicExactHorizontalConstraintsBlocCommand >> setValueFor: anObject with: anArgument [ ^ anObject constraintsDo: [ :c | c horizontal exact: anArgument ] diff --git a/src/Pyramid-Bloc/PyramidBasicExactVerticalConstraintsBlocCommand.class.st b/src/Pyramid-Bloc/PyramidBasicExactVerticalConstraintsBlocCommand.class.st index 664cf61e..34b3f184 100644 --- a/src/Pyramid-Bloc/PyramidBasicExactVerticalConstraintsBlocCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBasicExactVerticalConstraintsBlocCommand.class.st @@ -11,13 +11,13 @@ PyramidBasicExactVerticalConstraintsBlocCommand >> canBeUsedFor: anObject [ anObject constraints vertical resizer isExact ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBasicExactVerticalConstraintsBlocCommand >> getValueFor: anObject [ ^ anObject constraints vertical resizer size ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBasicExactVerticalConstraintsBlocCommand >> setValueFor: anObject with: anArgument [ ^ anObject constraintsDo: [ :c | c vertical exact: anArgument ] diff --git a/src/Pyramid-Bloc/PyramidBasicHorizontalConstraintsBlocCommand.class.st b/src/Pyramid-Bloc/PyramidBasicHorizontalConstraintsBlocCommand.class.st index 1c1af430..3286df52 100644 --- a/src/Pyramid-Bloc/PyramidBasicHorizontalConstraintsBlocCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBasicHorizontalConstraintsBlocCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBasicHorizontalConstraintsBlocCommand >> getValueFor: anObject [ ^ anObject constraints horizontal ] -{ #category : #'as yet unclassified' } +{ #category : #private } PyramidBasicHorizontalConstraintsBlocCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [ | mementos | @@ -26,7 +26,7 @@ PyramidBasicHorizontalConstraintsBlocCommand >> saveStatesOf: aCollection withCo yourself ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBasicHorizontalConstraintsBlocCommand >> setValueFor: anObject with: anArgument [ anArgument isSymbol diff --git a/src/Pyramid-Bloc/PyramidBasicVerticalConstraintsBlocCommand.class.st b/src/Pyramid-Bloc/PyramidBasicVerticalConstraintsBlocCommand.class.st index b68c7202..db8daf3f 100644 --- a/src/Pyramid-Bloc/PyramidBasicVerticalConstraintsBlocCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBasicVerticalConstraintsBlocCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBasicVerticalConstraintsBlocCommand >> getValueFor: anObject [ ^ anObject constraints vertical ] -{ #category : #'as yet unclassified' } +{ #category : #private } PyramidBasicVerticalConstraintsBlocCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [ | mementos | @@ -27,7 +27,7 @@ PyramidBasicVerticalConstraintsBlocCommand >> saveStatesOf: aCollection withComm yourself ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidBasicVerticalConstraintsBlocCommand >> setValueFor: anObject with: anArgument [ anArgument isSymbol diff --git a/src/Pyramid-Bloc/PyramidBorderDashArrayCommand.class.st b/src/Pyramid-Bloc/PyramidBorderDashArrayCommand.class.st index c8d064ae..009c994b 100644 --- a/src/Pyramid-Bloc/PyramidBorderDashArrayCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderDashArrayCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderDashArrayCommand >> getValueFor: aBlElement [ ^ aBlElement border style dashArray diff --git a/src/Pyramid-Bloc/PyramidBorderDashOffsetCommand.class.st b/src/Pyramid-Bloc/PyramidBorderDashOffsetCommand.class.st index a30514b4..ca51c9d2 100644 --- a/src/Pyramid-Bloc/PyramidBorderDashOffsetCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderDashOffsetCommand.class.st @@ -11,7 +11,7 @@ PyramidBorderDashOffsetCommand >> canBeUsedFor: anObject [ anObject border style dashArray isNotEmpty ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderDashOffsetCommand >> getValueFor: aBlElement [ ^ aBlElement border style dashOffset diff --git a/src/Pyramid-Bloc/PyramidBorderLineCapCommand.class.st b/src/Pyramid-Bloc/PyramidBorderLineCapCommand.class.st index 90ae60e9..f9c10852 100644 --- a/src/Pyramid-Bloc/PyramidBorderLineCapCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderLineCapCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderLineCapCommand >> getValueFor: aBlElement [ ^ aBlElement border style lineCap diff --git a/src/Pyramid-Bloc/PyramidBorderLineJoinCommand.class.st b/src/Pyramid-Bloc/PyramidBorderLineJoinCommand.class.st index 3ea1dbb1..3b461432 100644 --- a/src/Pyramid-Bloc/PyramidBorderLineJoinCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderLineJoinCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderLineJoinCommand >> getValueFor: aBlElement [ ^ aBlElement border style lineJoin diff --git a/src/Pyramid-Bloc/PyramidBorderMiterLimitCommand.class.st b/src/Pyramid-Bloc/PyramidBorderMiterLimitCommand.class.st index e70e6d41..c6f86446 100644 --- a/src/Pyramid-Bloc/PyramidBorderMiterLimitCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderMiterLimitCommand.class.st @@ -11,7 +11,7 @@ PyramidBorderMiterLimitCommand >> canBeUsedFor: anObject [ (anObject border style lineJoin isKindOf: BlStrokeLineMiterJoin) ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderMiterLimitCommand >> getValueFor: aBlElement [ ^ aBlElement border style miterLimit diff --git a/src/Pyramid-Bloc/PyramidBorderOpacityCommand.class.st b/src/Pyramid-Bloc/PyramidBorderOpacityCommand.class.st index e1d6b44e..5c818acf 100644 --- a/src/Pyramid-Bloc/PyramidBorderOpacityCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderOpacityCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderOpacityCommand >> getValueFor: aBlElement [ ^ aBlElement border opacity diff --git a/src/Pyramid-Bloc/PyramidBorderPaintColorCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintColorCommand.class.st index 10eeb2d7..de5ff490 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintColorCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintColorCommand.class.st @@ -11,7 +11,7 @@ PyramidBorderPaintColorCommand >> canBeUsedFor: anObject [ anObject border paint isKindOf: BlColorPaint ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintColorCommand >> getValueFor: aBlElement [ ^ aBlElement border paint color diff --git a/src/Pyramid-Bloc/PyramidBorderPaintCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintCommand.class.st index 44fb1a6d..85ac677c 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintCommand >> getValueFor: aBlElement [ ^ aBlElement border paint diff --git a/src/Pyramid-Bloc/PyramidBorderPaintLinearDirectionEndCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintLinearDirectionEndCommand.class.st index 1b18eb86..5b30c8b9 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintLinearDirectionEndCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintLinearDirectionEndCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintLinearDirectionEndCommand >> getValueFor: aBlElement [ ^ aBlElement border paint end diff --git a/src/Pyramid-Bloc/PyramidBorderPaintLinearDirectionStartCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintLinearDirectionStartCommand.class.st index 4f08a8a9..ca09f43d 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintLinearDirectionStartCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintLinearDirectionStartCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintLinearDirectionStartCommand >> getValueFor: aBlElement [ ^ aBlElement border paint start diff --git a/src/Pyramid-Bloc/PyramidBorderPaintRadialInnerCenterCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintRadialInnerCenterCommand.class.st index bdb47e7b..e95c8e32 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintRadialInnerCenterCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintRadialInnerCenterCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintRadialInnerCenterCommand >> getValueFor: aBlElement [ ^ aBlElement border paint innerCenter diff --git a/src/Pyramid-Bloc/PyramidBorderPaintRadialInnerRadiusCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintRadialInnerRadiusCommand.class.st index 8f6a2812..a2f83c29 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintRadialInnerRadiusCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintRadialInnerRadiusCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintRadialInnerRadiusCommand >> getValueFor: aBlElement [ ^ aBlElement border paint innerRadius diff --git a/src/Pyramid-Bloc/PyramidBorderPaintRadialOuterCenterCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintRadialOuterCenterCommand.class.st index 5a32a29a..9cc5cc8d 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintRadialOuterCenterCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintRadialOuterCenterCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintRadialOuterCenterCommand >> getValueFor: aBlElement [ ^ aBlElement border paint outerCenter diff --git a/src/Pyramid-Bloc/PyramidBorderPaintRadialOuterRadiusCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintRadialOuterRadiusCommand.class.st index 43c5b541..95a573e0 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintRadialOuterRadiusCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintRadialOuterRadiusCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintRadialOuterRadiusCommand >> getValueFor: aBlElement [ ^ aBlElement border paint outerRadius diff --git a/src/Pyramid-Bloc/PyramidBorderPaintStopsCommand.class.st b/src/Pyramid-Bloc/PyramidBorderPaintStopsCommand.class.st index 2626a3dd..da994230 100644 --- a/src/Pyramid-Bloc/PyramidBorderPaintStopsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderPaintStopsCommand.class.st @@ -11,7 +11,7 @@ PyramidBorderPaintStopsCommand >> canBeUsedFor: anObject [ anObject border paint isKindOf: BlGradientPaint ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderPaintStopsCommand >> getValueFor: aBlElement [ "We ensure that we are working with a copy of the associations." diff --git a/src/Pyramid-Bloc/PyramidBorderWidthCommand.class.st b/src/Pyramid-Bloc/PyramidBorderWidthCommand.class.st index b943532a..f7ed7450 100644 --- a/src/Pyramid-Bloc/PyramidBorderWidthCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBorderWidthCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidBorderWidthCommand >> getValueFor: aBlElement [ ^ aBlElement border width diff --git a/src/Pyramid-Bloc/PyramidChangeOrderWithIndexCommand.class.st b/src/Pyramid-Bloc/PyramidChangeOrderWithIndexCommand.class.st index f314fb83..9db79209 100644 --- a/src/Pyramid-Bloc/PyramidChangeOrderWithIndexCommand.class.st +++ b/src/Pyramid-Bloc/PyramidChangeOrderWithIndexCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-order' } -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidChangeOrderWithIndexCommand >> setValueFor: aBlElement with: anArgument [ | currentIndex parent | diff --git a/src/Pyramid-Bloc/PyramidChangeTextCommand.class.st b/src/Pyramid-Bloc/PyramidChangeTextCommand.class.st index 93a2bbda..228a26b3 100644 --- a/src/Pyramid-Bloc/PyramidChangeTextCommand.class.st +++ b/src/Pyramid-Bloc/PyramidChangeTextCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-text' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidChangeTextCommand >> getValueFor: aBlTextElement [ ^ aBlTextElement text asString ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidChangeTextCommand >> setValueFor: aBlTextElement with: aString [ | attributes rope | diff --git a/src/Pyramid-Bloc/PyramidChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidChildrenCommand.class.st index 0331d157..d06778ef 100644 --- a/src/Pyramid-Bloc/PyramidChildrenCommand.class.st +++ b/src/Pyramid-Bloc/PyramidChildrenCommand.class.st @@ -10,13 +10,13 @@ PyramidChildrenCommand class >> isAbstract [ ^ self == PyramidChildrenCommand ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidChildrenCommand >> getValueFor: aBlElement [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #private } PyramidChildrenCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [ | mementos | diff --git a/src/Pyramid-Bloc/PyramidClipChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidClipChildrenCommand.class.st index a4209f42..df44798a 100644 --- a/src/Pyramid-Bloc/PyramidClipChildrenCommand.class.st +++ b/src/Pyramid-Bloc/PyramidClipChildrenCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidClipChildrenCommand >> getValueFor: aBlElement [ ^ aBlElement clipChildren ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidClipChildrenCommand >> setValueFor: aBlElement with: anArgument [ aBlElement clipChildren: anArgument diff --git a/src/Pyramid-Bloc/PyramidDynamicResizeCommand.class.st b/src/Pyramid-Bloc/PyramidDynamicResizeCommand.class.st index 816bac00..0808cfe1 100644 --- a/src/Pyramid-Bloc/PyramidDynamicResizeCommand.class.st +++ b/src/Pyramid-Bloc/PyramidDynamicResizeCommand.class.st @@ -11,19 +11,19 @@ PyramidDynamicResizeCommand >> canBeUsedFor: anObject [ anObject size ] ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidDynamicResizeCommand >> commandInverse [ ^ PyramidUndoDynamicResizeBlocCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidDynamicResizeCommand >> getValueFor: anObject [ ^ anObject extent ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidDynamicResizeCommand >> saveStatesWithCommandInverseOf: aCollection with: arguments [ | mementos | @@ -39,7 +39,7 @@ PyramidDynamicResizeCommand >> saveStatesWithCommandInverseOf: aCollection with: yourself ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidDynamicResizeCommand >> setValueFor: anObject with: anArgument [ ^ anObject constraintsDo: [ :c | diff --git a/src/Pyramid-Bloc/PyramidElementIdCommand.class.st b/src/Pyramid-Bloc/PyramidElementIdCommand.class.st index 66f89484..f6c48266 100644 --- a/src/Pyramid-Bloc/PyramidElementIdCommand.class.st +++ b/src/Pyramid-Bloc/PyramidElementIdCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidElementIdCommand >> getValueFor: aBlElement [ ^ aBlElement id ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidElementIdCommand >> setValueFor: aBlElement with: anArgument [ aBlElement id: anArgument diff --git a/src/Pyramid-Bloc/PyramidFontSizeCommand.class.st b/src/Pyramid-Bloc/PyramidFontSizeCommand.class.st index 8dbf1c83..ae3786ae 100644 --- a/src/Pyramid-Bloc/PyramidFontSizeCommand.class.st +++ b/src/Pyramid-Bloc/PyramidFontSizeCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-text' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidFontSizeCommand >> getValueFor: aBlTextElement [ aBlTextElement text attributesFinder @@ -14,7 +14,7 @@ PyramidFontSizeCommand >> getValueFor: aBlTextElement [ ^ 10 ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidFontSizeCommand >> setValueFor: aBlTextElement with: aNumber [ aBlTextElement text attribute: (BlFontSizeAttribute size: aNumber). diff --git a/src/Pyramid-Bloc/PyramidFontWeightCommand.class.st b/src/Pyramid-Bloc/PyramidFontWeightCommand.class.st index a7c5ba98..5a175d22 100644 --- a/src/Pyramid-Bloc/PyramidFontWeightCommand.class.st +++ b/src/Pyramid-Bloc/PyramidFontWeightCommand.class.st @@ -4,14 +4,14 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-text' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidFontWeightCommand >> getValueFor: aBlTextElement [ aBlTextElement text attributesFinder findAttributesSuchThat: [ :a | a class = BlFontWeightAttribute ] indicesDo: [ :new :old :a | ^ a weight ]. ^ LogicalFont weightRegular ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidFontWeightCommand >> setValueFor: aBlTextElement with: aNumber [ aBlTextElement text attribute: diff --git a/src/Pyramid-Bloc/PyramidFrameHorizontalConstraintsCommand.class.st b/src/Pyramid-Bloc/PyramidFrameHorizontalConstraintsCommand.class.st index 271f6c0e..62753f9b 100644 --- a/src/Pyramid-Bloc/PyramidFrameHorizontalConstraintsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidFrameHorizontalConstraintsCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidFrameHorizontalConstraintsCommand >> getValueFor: anObject [ ^ anObject constraints frame horizontal alignment ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidFrameHorizontalConstraintsCommand >> setValueFor: anObject with: anArgument [ anObject constraintsDo: [ :c | diff --git a/src/Pyramid-Bloc/PyramidFrameVerticalConstraintsCommand.class.st b/src/Pyramid-Bloc/PyramidFrameVerticalConstraintsCommand.class.st index 99b53c7a..af0b2905 100644 --- a/src/Pyramid-Bloc/PyramidFrameVerticalConstraintsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidFrameVerticalConstraintsCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidFrameVerticalConstraintsCommand >> getValueFor: anObject [ ^ anObject constraints frame vertical alignment ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidFrameVerticalConstraintsCommand >> setValueFor: anObject with: anArgument [ anObject constraintsDo: [ :c | diff --git a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st b/src/Pyramid-Bloc/PyramidGeometryCommand.class.st index 411acf89..ad6277e3 100644 --- a/src/Pyramid-Bloc/PyramidGeometryCommand.class.st +++ b/src/Pyramid-Bloc/PyramidGeometryCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-geometry' } -{ #category : #'as yet unclassified' } +{ #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-Bloc/PyramidGroupCommand.class.st b/src/Pyramid-Bloc/PyramidGroupCommand.class.st index bfb54ab2..e5292bd5 100644 --- a/src/Pyramid-Bloc/PyramidGroupCommand.class.st +++ b/src/Pyramid-Bloc/PyramidGroupCommand.class.st @@ -20,7 +20,7 @@ PyramidGroupCommand >> canBeUsedFor: aCollectionOfBlElements [ each parent = parent ] ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidGroupCommand >> commandInverse [ "Command used to undo the group." @@ -67,7 +67,7 @@ PyramidGroupCommand >> createNewGroupElement: aCollectionOfBlElement [ yourself. ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidGroupCommand >> getValueFor: aBlElement [ ^ self historyCommandArguments @@ -106,7 +106,7 @@ PyramidGroupCommand >> positionGroupElement: groupElement [ child constraints position - (currentLeft @ currentTop) ] ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidGroupCommand >> saveStatesOf: aCollection with: arguments [ ^ self @@ -116,7 +116,7 @@ PyramidGroupCommand >> saveStatesOf: aCollection with: arguments [ (self commandRestaurationArgumentsFor: aCollection and: arguments) ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidGroupCommand >> saveStatesWithCommandInverseOf: aCollection with: arguments [ ^ self @@ -126,7 +126,7 @@ PyramidGroupCommand >> saveStatesWithCommandInverseOf: aCollection with: argumen (self commandInverseArgumentsFor: aCollection and: arguments) ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidGroupCommand >> setValueFor: aCollectionToGroup with: aCollectionOfFirstLevelElements [ | groupInCorrectOrder parent groupElement removedElementFromFirstLevel | diff --git a/src/Pyramid-Bloc/PyramidLayoutBlocCommand.class.st b/src/Pyramid-Bloc/PyramidLayoutBlocCommand.class.st index 880f6ede..fd6180e7 100644 --- a/src/Pyramid-Bloc/PyramidLayoutBlocCommand.class.st +++ b/src/Pyramid-Bloc/PyramidLayoutBlocCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidLayoutBlocCommand >> getValueFor: anObject [ ^ anObject layout ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidLayoutBlocCommand >> setValueFor: anObject with: anArgument [ anObject layout: anArgument diff --git a/src/Pyramid-Bloc/PyramidLayoutChangeOrientationCommand.class.st b/src/Pyramid-Bloc/PyramidLayoutChangeOrientationCommand.class.st index 57cc5aab..26ec48bd 100644 --- a/src/Pyramid-Bloc/PyramidLayoutChangeOrientationCommand.class.st +++ b/src/Pyramid-Bloc/PyramidLayoutChangeOrientationCommand.class.st @@ -11,13 +11,13 @@ PyramidLayoutChangeOrientationCommand >> canBeUsedFor: anObject [ { BlFlowLayout . BlLinearLayout } includes: anObject layout class ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidLayoutChangeOrientationCommand >> getValueFor: anObject [ ^ anObject layout orientation ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidLayoutChangeOrientationCommand >> setValueFor: anObject with: anArgument [ anObject layout orientation: anArgument diff --git a/src/Pyramid-Bloc/PyramidMarginCommand.class.st b/src/Pyramid-Bloc/PyramidMarginCommand.class.st index 40950338..c773ea9a 100644 --- a/src/Pyramid-Bloc/PyramidMarginCommand.class.st +++ b/src/Pyramid-Bloc/PyramidMarginCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidMarginCommand >> getValueFor: aBlElement [ ^ aBlElement margin ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidMarginCommand >> setValueFor: aBlElement with: anArgument [ aBlElement margin: anArgument diff --git a/src/Pyramid-Bloc/PyramidMoveBackwardOrderCommand.class.st b/src/Pyramid-Bloc/PyramidMoveBackwardOrderCommand.class.st index 4fc68ba7..6003f24b 100644 --- a/src/Pyramid-Bloc/PyramidMoveBackwardOrderCommand.class.st +++ b/src/Pyramid-Bloc/PyramidMoveBackwardOrderCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-order' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidMoveBackwardOrderCommand >> commandInverse [ ^ PyramidMoveForwardOrderCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidMoveBackwardOrderCommand >> setValueFor: aBlElement with: anArgument [ | currentIndex | diff --git a/src/Pyramid-Bloc/PyramidMoveChildInParentCommand.class.st b/src/Pyramid-Bloc/PyramidMoveChildInParentCommand.class.st index 362a3ca1..df0b5e5a 100644 --- a/src/Pyramid-Bloc/PyramidMoveChildInParentCommand.class.st +++ b/src/Pyramid-Bloc/PyramidMoveChildInParentCommand.class.st @@ -7,13 +7,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidMoveChildInParentCommand >> getValueFor: aBlElement [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #private } PyramidMoveChildInParentCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [ | mementos | diff --git a/src/Pyramid-Bloc/PyramidMoveChildIndexDownCommand.class.st b/src/Pyramid-Bloc/PyramidMoveChildIndexDownCommand.class.st index be0b637d..5742b92f 100644 --- a/src/Pyramid-Bloc/PyramidMoveChildIndexDownCommand.class.st +++ b/src/Pyramid-Bloc/PyramidMoveChildIndexDownCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidMoveChildIndexDownCommand >> commandInverse [ ^ PyramidMoveChildIndexUpCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidMoveChildIndexDownCommand >> setValueFor: aBlElementParent with: aBlElementToMove [ | childIndexToMove | diff --git a/src/Pyramid-Bloc/PyramidMoveChildIndexUpCommand.class.st b/src/Pyramid-Bloc/PyramidMoveChildIndexUpCommand.class.st index 4eabe2dc..bf5c13aa 100644 --- a/src/Pyramid-Bloc/PyramidMoveChildIndexUpCommand.class.st +++ b/src/Pyramid-Bloc/PyramidMoveChildIndexUpCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidMoveChildIndexUpCommand >> commandInverse [ ^ PyramidMoveChildIndexDownCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidMoveChildIndexUpCommand >> setValueFor: aBlElementParent with: aBlElementToMove [ | childIndexToMove | diff --git a/src/Pyramid-Bloc/PyramidMoveForwardOrderCommand.class.st b/src/Pyramid-Bloc/PyramidMoveForwardOrderCommand.class.st index 35008ed9..4eb2ec15 100644 --- a/src/Pyramid-Bloc/PyramidMoveForwardOrderCommand.class.st +++ b/src/Pyramid-Bloc/PyramidMoveForwardOrderCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-order' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidMoveForwardOrderCommand >> commandInverse [ ^ PyramidMoveBackwardOrderCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidMoveForwardOrderCommand >> setValueFor: aBlElement with: anArgument [ | currentIndex | diff --git a/src/Pyramid-Bloc/PyramidOnBackgroundOrderCommand.class.st b/src/Pyramid-Bloc/PyramidOnBackgroundOrderCommand.class.st index 257fd1b4..9a671789 100644 --- a/src/Pyramid-Bloc/PyramidOnBackgroundOrderCommand.class.st +++ b/src/Pyramid-Bloc/PyramidOnBackgroundOrderCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-order' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidOnBackgroundOrderCommand >> commandInverse [ ^ PyramidChangeOrderWithIndexCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidOnBackgroundOrderCommand >> setValueFor: aBlElement with: anArgument [ | currentIndex parent | diff --git a/src/Pyramid-Bloc/PyramidOnForegroundOrderCommand.class.st b/src/Pyramid-Bloc/PyramidOnForegroundOrderCommand.class.st index dda01bb0..41477cf2 100644 --- a/src/Pyramid-Bloc/PyramidOnForegroundOrderCommand.class.st +++ b/src/Pyramid-Bloc/PyramidOnForegroundOrderCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-order' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidOnForegroundOrderCommand >> commandInverse [ ^ PyramidChangeOrderWithIndexCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidOnForegroundOrderCommand >> setValueFor: aBlElement with: anArgument [ | currentIndex parent | diff --git a/src/Pyramid-Bloc/PyramidOpacityCommand.class.st b/src/Pyramid-Bloc/PyramidOpacityCommand.class.st index 31e02fdb..0b8b82d3 100644 --- a/src/Pyramid-Bloc/PyramidOpacityCommand.class.st +++ b/src/Pyramid-Bloc/PyramidOpacityCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidOpacityCommand >> getValueFor: aBlElement [ ^ aBlElement opacity ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidOpacityCommand >> setValueFor: aBlElement with: anArgument [ aBlElement opacity: anArgument diff --git a/src/Pyramid-Bloc/PyramidOutskirtsCommand.class.st b/src/Pyramid-Bloc/PyramidOutskirtsCommand.class.st index 07421899..288e90ed 100644 --- a/src/Pyramid-Bloc/PyramidOutskirtsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidOutskirtsCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-visuals' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidOutskirtsCommand >> getValueFor: aBlElement [ ^ aBlElement outskirts ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidOutskirtsCommand >> setValueFor: aBlElement with: anArgument [ aBlElement outskirts: anArgument diff --git a/src/Pyramid-Bloc/PyramidPaddingCommand.class.st b/src/Pyramid-Bloc/PyramidPaddingCommand.class.st index 50eb962e..8e5c4c09 100644 --- a/src/Pyramid-Bloc/PyramidPaddingCommand.class.st +++ b/src/Pyramid-Bloc/PyramidPaddingCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidPaddingCommand >> getValueFor: aBlElement [ ^ aBlElement padding ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidPaddingCommand >> setValueFor: aBlElement with: anArgument [ aBlElement padding: anArgument diff --git a/src/Pyramid-Bloc/PyramidPositionCommand.class.st b/src/Pyramid-Bloc/PyramidPositionCommand.class.st index 7f586f75..96f1ac9f 100644 --- a/src/Pyramid-Bloc/PyramidPositionCommand.class.st +++ b/src/Pyramid-Bloc/PyramidPositionCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidPositionCommand >> getValueFor: aBlElement [ ^ aBlElement constraints position ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidPositionCommand >> setValueFor: aBlElement with: anArgument [ anArgument isPoint ifFalse: [ ^ self ]. diff --git a/src/Pyramid-Bloc/PyramidPositionOffsetCommand.class.st b/src/Pyramid-Bloc/PyramidPositionOffsetCommand.class.st index 6abce729..9bef2315 100644 --- a/src/Pyramid-Bloc/PyramidPositionOffsetCommand.class.st +++ b/src/Pyramid-Bloc/PyramidPositionOffsetCommand.class.st @@ -4,25 +4,25 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidPositionOffsetCommand >> commandInverse [ ^ PyramidPositionCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidPositionOffsetCommand >> getValueFor: aBlElement [ ^ aBlElement constraints position ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidPositionOffsetCommand >> saveStatesOf: aCollection with: arguments [ ^ self saveStatesWithCommandInverseOf: aCollection with: arguments ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidPositionOffsetCommand >> setValueFor: aBlElement with: anArgument [ anArgument isPoint ifFalse: [ ^ self ]. diff --git a/src/Pyramid-Bloc/PyramidProportionalHorizontalConstraintsCommand.class.st b/src/Pyramid-Bloc/PyramidProportionalHorizontalConstraintsCommand.class.st index 61b5aafb..ebd5ca24 100644 --- a/src/Pyramid-Bloc/PyramidProportionalHorizontalConstraintsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidProportionalHorizontalConstraintsCommand.class.st @@ -4,14 +4,14 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidProportionalHorizontalConstraintsCommand >> getValueFor: anObject [ ^ anObject constraints proportional horizontal left @ anObject constraints proportional horizontal right ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidProportionalHorizontalConstraintsCommand >> setValueFor: anObject with: anArgument [ anObject constraintsDo: [ :c | diff --git a/src/Pyramid-Bloc/PyramidProportionalVerticalConstraintsCommand.class.st b/src/Pyramid-Bloc/PyramidProportionalVerticalConstraintsCommand.class.st index 466755dd..38324d5f 100644 --- a/src/Pyramid-Bloc/PyramidProportionalVerticalConstraintsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidProportionalVerticalConstraintsCommand.class.st @@ -4,14 +4,14 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-layout' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidProportionalVerticalConstraintsCommand >> getValueFor: anObject [ ^ anObject constraints proportional vertical top @ anObject constraints proportional vertical bottom ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidProportionalVerticalConstraintsCommand >> setValueFor: anObject with: anArgument [ anObject constraintsDo: [ :c | diff --git a/src/Pyramid-Bloc/PyramidRedoGroupCommand.class.st b/src/Pyramid-Bloc/PyramidRedoGroupCommand.class.st index 05c74d6e..a21047ff 100644 --- a/src/Pyramid-Bloc/PyramidRedoGroupCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRedoGroupCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-group' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidRedoGroupCommand >> commandInverse [ ^ PyramidUndoGroupCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidRedoGroupCommand >> getValueFor: aBlElement [ ^ nil @@ -34,7 +34,7 @@ PyramidRedoGroupCommand >> positionGroupElement: groupElement [ child constraints position - (currentLeft @ currentTop) ] ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidRedoGroupCommand >> setValueFor: aCollectionToGroup with: aGroupModel [ | anyElementInFirstLevels | diff --git a/src/Pyramid-Bloc/PyramidRemoveChildCommand.class.st b/src/Pyramid-Bloc/PyramidRemoveChildCommand.class.st index 2288f8f1..dc97608a 100644 --- a/src/Pyramid-Bloc/PyramidRemoveChildCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRemoveChildCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidRemoveChildCommand >> commandInverse [ ^ PyramidAddChildCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidRemoveChildCommand >> setValueFor: aBlElement with: aChildToRemove [ aBlElement removeChild: aChildToRemove diff --git a/src/Pyramid-Bloc/PyramidRemoveChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidRemoveChildrenCommand.class.st index 6d09bbb6..70cdbc18 100644 --- a/src/Pyramid-Bloc/PyramidRemoveChildrenCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRemoveChildrenCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidRemoveChildrenCommand >> commandInverse [ ^ PyramidAddChildrenCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidRemoveChildrenCommand >> setValueFor: aBlElement with: aChildrenToAdd [ aBlElement removeChildren: aChildrenToAdd diff --git a/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st b/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st index 9e281af1..a7545749 100644 --- a/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st @@ -7,7 +7,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidRemoveSelectedElementsCommand >> getValueFor: anElementOfSelection [ ^ nil @@ -15,23 +15,19 @@ PyramidRemoveSelectedElementsCommand >> getValueFor: anElementOfSelection [ { #category : #'as yet unclassified' } PyramidRemoveSelectedElementsCommand >> mementoFor: anElement withArguments: anArgument [ - | index | - "Save index before removing" - index := anElement parent - ifNotNil: [ :p | p children indexOf: anElement ] - ifNil: [ 0 ]. - anElement userData at: #removedAtIndex put: index. - (anArgument includes: anElement) ifTrue: [ - ^ PyramidCommandMemento new - command: PyramidRemoveFromCollectionCommand new commandInverse; - target: anArgument; - arguments: anElement; - yourself ]. - ^ PyramidCommandMemento new - command: PyramidRemoveChildCommand new commandInverse; - target: anElement parent; - arguments: anElement; - yourself + + self saveIndexOf: anElement. + (anArgument includes: anElement) ifTrue: [ + ^ PyramidCommandMemento new + command: PyramidRemoveFromCollectionCommand new commandInverse; + target: anArgument; + arguments: anElement; + yourself ]. + ^ PyramidCommandMemento new + command: PyramidRemoveChildCommand new commandInverse; + target: anElement parent; + arguments: anElement; + yourself ] { #category : #accessing } @@ -46,14 +42,24 @@ PyramidRemoveSelectedElementsCommand >> mementoInverse: anObject [ mementoInverse := anObject ] -{ #category : #'as yet unclassified' } +{ #category : #private } +PyramidRemoveSelectedElementsCommand >> saveIndexOf: anElement [ + + | index | + index := anElement parent + ifNotNil: [ :p | p children indexOf: anElement ] + ifNil: [ 0 ]. + anElement userData at: #removedAtIndex put: index +] + +{ #category : #history } PyramidRemoveSelectedElementsCommand >> saveStatesOf: aCollection with: aRoots [ "We ignore the state recovery for the redo, we will force the inverse of the undo state." ^ self mementoInverse accept: PyramidMementoInverser new. ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidRemoveSelectedElementsCommand >> saveStatesWithCommandInverseOf: aCollection with: aRoots [ | mementos finalMemento | @@ -69,7 +75,7 @@ PyramidRemoveSelectedElementsCommand >> saveStatesWithCommandInverseOf: aCollect ^ finalMemento ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidRemoveSelectedElementsCommand >> setValueFor: aBlElementToRemove with: aRoot [ "Remove the element from its parent" diff --git a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st b/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st index f239660b..a035164b 100644 --- a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st @@ -11,13 +11,13 @@ PyramidRoundedRectangleCornerRadiiCommand >> canBeUsedFor: anObject [ 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) diff --git a/src/Pyramid-Bloc/PyramidTextForegroundCommand.class.st b/src/Pyramid-Bloc/PyramidTextForegroundCommand.class.st index ac96ad6e..e904f324 100644 --- a/src/Pyramid-Bloc/PyramidTextForegroundCommand.class.st +++ b/src/Pyramid-Bloc/PyramidTextForegroundCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-text' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidTextForegroundCommand >> getValueFor: aBlTextElement [ aBlTextElement text attributesFinder @@ -14,7 +14,7 @@ PyramidTextForegroundCommand >> getValueFor: aBlTextElement [ ^ Color black ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidTextForegroundCommand >> setValueFor: aBlTextElement with: aColor [ aBlTextElement text attribute: diff --git a/src/Pyramid-Bloc/PyramidUndoDynamicResizeBlocCommand.class.st b/src/Pyramid-Bloc/PyramidUndoDynamicResizeBlocCommand.class.st index 6cf5688b..127f7083 100644 --- a/src/Pyramid-Bloc/PyramidUndoDynamicResizeBlocCommand.class.st +++ b/src/Pyramid-Bloc/PyramidUndoDynamicResizeBlocCommand.class.st @@ -11,19 +11,19 @@ PyramidUndoDynamicResizeBlocCommand >> canBeUsedFor: anObject [ anObject size ] ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidUndoDynamicResizeBlocCommand >> commandInverse [ ^ PyramidDynamicResizeCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidUndoDynamicResizeBlocCommand >> getValueFor: anObject [ ^ anObject userData at: #pyramidPreviousDynamicResize ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidUndoDynamicResizeBlocCommand >> setValueFor: anObject with: anArgument [ ^ anObject constraintsDo: [ :c | diff --git a/src/Pyramid-Bloc/PyramidUndoGroupCommand.class.st b/src/Pyramid-Bloc/PyramidUndoGroupCommand.class.st index 8fb36fa9..c6cd082c 100644 --- a/src/Pyramid-Bloc/PyramidUndoGroupCommand.class.st +++ b/src/Pyramid-Bloc/PyramidUndoGroupCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc-group' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidUndoGroupCommand >> commandInverse [ ^ PyramidRedoGroupCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidUndoGroupCommand >> getValueFor: aBlElement [ ^ nil @@ -27,7 +27,7 @@ PyramidUndoGroupCommand >> positionChildrenOfGroupElement: groupElement [ child constraints position + (currentLeft @ currentTop) ] ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidUndoGroupCommand >> setValueFor: aCollectionToGroup with: aGroupModel [ "Remove children of group. Remove children of origin. diff --git a/src/Pyramid-Bloc/PyramidVisibilityCommand.class.st b/src/Pyramid-Bloc/PyramidVisibilityCommand.class.st index bb53e301..fd465919 100644 --- a/src/Pyramid-Bloc/PyramidVisibilityCommand.class.st +++ b/src/Pyramid-Bloc/PyramidVisibilityCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidVisibilityCommand >> getValueFor: aBlElement [ ^ aBlElement visibility ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidVisibilityCommand >> setValueFor: aBlElement with: anArgument [ aBlElement visibility: anArgument diff --git a/src/Pyramid-Bloc/PyramidWeightConstraintsCommand.class.st b/src/Pyramid-Bloc/PyramidWeightConstraintsCommand.class.st index 19f60089..2586c90d 100644 --- a/src/Pyramid-Bloc/PyramidWeightConstraintsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidWeightConstraintsCommand.class.st @@ -12,13 +12,13 @@ PyramidWeightConstraintsCommand >> canBeUsedFor: anObject [ { BlFlowLayout . BlLinearLayout } includes: anObject parent layout class ] ] ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidWeightConstraintsCommand >> getValueFor: anObject [ ^ anObject constraints linear weight ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidWeightConstraintsCommand >> setValueFor: anObject with: anArgument [ anObject constraints linear weight: anArgument. diff --git a/src/Pyramid-Bloc/PyramidZIndexCommand.class.st b/src/Pyramid-Bloc/PyramidZIndexCommand.class.st index 3e09f726..1ce22820 100644 --- a/src/Pyramid-Bloc/PyramidZIndexCommand.class.st +++ b/src/Pyramid-Bloc/PyramidZIndexCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Bloc-plugin-bloc' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidZIndexCommand >> getValueFor: aBlElement [ ^ aBlElement elevation elevation ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidZIndexCommand >> setValueFor: aBlElement with: anArgument [ aBlElement zIndex: anArgument diff --git a/src/Pyramid-Tests/PyramidDecreaseMockCommand.class.st b/src/Pyramid-Tests/PyramidDecreaseMockCommand.class.st index 6e1c22c6..6b72ba7d 100644 --- a/src/Pyramid-Tests/PyramidDecreaseMockCommand.class.st +++ b/src/Pyramid-Tests/PyramidDecreaseMockCommand.class.st @@ -4,19 +4,19 @@ Class { #category : #'Pyramid-Tests-cases-command' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidDecreaseMockCommand >> commandInverse [ ^ PyramidIncreaseMockCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidDecreaseMockCommand >> getValueFor: anObject [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidDecreaseMockCommand >> setValueFor: anObject with: anArgument [ anObject count: anObject count - 1 diff --git a/src/Pyramid-Tests/PyramidIncreaseMockCommand.class.st b/src/Pyramid-Tests/PyramidIncreaseMockCommand.class.st index cd869468..22b48fd0 100644 --- a/src/Pyramid-Tests/PyramidIncreaseMockCommand.class.st +++ b/src/Pyramid-Tests/PyramidIncreaseMockCommand.class.st @@ -4,19 +4,19 @@ Class { #category : #'Pyramid-Tests-cases-command' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidIncreaseMockCommand >> commandInverse [ ^ PyramidDecreaseMockCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidIncreaseMockCommand >> getValueFor: anObject [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidIncreaseMockCommand >> setValueFor: anObject with: anArgument [ anObject count: anObject count + 1 diff --git a/src/Pyramid-Tests/PyramidSimpleMockCommand.class.st b/src/Pyramid-Tests/PyramidSimpleMockCommand.class.st index abf1e620..3160782a 100644 --- a/src/Pyramid-Tests/PyramidSimpleMockCommand.class.st +++ b/src/Pyramid-Tests/PyramidSimpleMockCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Tests-cases-command' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidSimpleMockCommand >> getValueFor: anObject [ ^ anObject count. ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidSimpleMockCommand >> setValueFor: anObject with: anArgument [ anObject count: anArgument diff --git a/src/Pyramid-Tests/PyramidSimpleMockGroupedCommand.class.st b/src/Pyramid-Tests/PyramidSimpleMockGroupedCommand.class.st index 84fcebb0..2a34f662 100644 --- a/src/Pyramid-Tests/PyramidSimpleMockGroupedCommand.class.st +++ b/src/Pyramid-Tests/PyramidSimpleMockGroupedCommand.class.st @@ -4,7 +4,7 @@ Class { #category : #'Pyramid-Tests-cases-command' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidSimpleMockGroupedCommand >> getGroupedValueFor: anObject [ ^ #group diff --git a/src/Pyramid-Toplo/PyramidStampCommand.class.st b/src/Pyramid-Toplo/PyramidStampCommand.class.st index 2ec2f0c1..7bfb5753 100644 --- a/src/Pyramid-Toplo/PyramidStampCommand.class.st +++ b/src/Pyramid-Toplo/PyramidStampCommand.class.st @@ -7,13 +7,13 @@ Class { #category : #'Pyramid-Toplo-plugin-theme-management' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidStampCommand >> getValueFor: anObject [ ^ anObject hasStamp: self stamp ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidStampCommand >> setValueFor: anObject with: aBoolean [ aBoolean diff --git a/src/Pyramid-Toplo/PyramidThemeCommand.class.st b/src/Pyramid-Toplo/PyramidThemeCommand.class.st index 66c4f825..d26dcdc1 100644 --- a/src/Pyramid-Toplo/PyramidThemeCommand.class.st +++ b/src/Pyramid-Toplo/PyramidThemeCommand.class.st @@ -4,13 +4,13 @@ Class { #category : #'Pyramid-Toplo-plugin-theme-management' } -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidThemeCommand >> getValueFor: anObject [ ^ anObject localTheme ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidThemeCommand >> setValueFor: anObject with: nilOrToTheme [ anObject localTheme: nilOrToTheme diff --git a/src/Pyramid/PyramidAddAllToCollectionCommand.class.st b/src/Pyramid/PyramidAddAllToCollectionCommand.class.st index b4a0224b..5bc12e91 100644 --- a/src/Pyramid/PyramidAddAllToCollectionCommand.class.st +++ b/src/Pyramid/PyramidAddAllToCollectionCommand.class.st @@ -4,19 +4,19 @@ Class { #category : #'Pyramid-commands' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidAddAllToCollectionCommand >> commandInverse [ ^ PyramidRemoveAllFromCollectionCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidAddAllToCollectionCommand >> getValueFor: anObject [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidAddAllToCollectionCommand >> setValueFor: anObject with: anArgument [ anObject addAll: anArgument diff --git a/src/Pyramid/PyramidAddToCollectionCommand.class.st b/src/Pyramid/PyramidAddToCollectionCommand.class.st index c1eb5377..fdf034e8 100644 --- a/src/Pyramid/PyramidAddToCollectionCommand.class.st +++ b/src/Pyramid/PyramidAddToCollectionCommand.class.st @@ -4,19 +4,19 @@ Class { #category : #'Pyramid-commands' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidAddToCollectionCommand >> commandInverse [ ^ PyramidRemoveFromCollectionCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidAddToCollectionCommand >> getValueFor: anObject [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidAddToCollectionCommand >> setValueFor: anObject with: anArgument [ anObject add: anArgument diff --git a/src/Pyramid/PyramidCollectionCommand.class.st b/src/Pyramid/PyramidCollectionCommand.class.st index 3a225279..c5700017 100644 --- a/src/Pyramid/PyramidCollectionCommand.class.st +++ b/src/Pyramid/PyramidCollectionCommand.class.st @@ -16,7 +16,7 @@ PyramidCollectionCommand >> canBeUsedFor: anObject [ ^ anObject isCollection ] -{ #category : #'as yet unclassified' } +{ #category : #private } PyramidCollectionCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [ | mementos | diff --git a/src/Pyramid/PyramidCommand.class.st b/src/Pyramid/PyramidCommand.class.st index 4bf754c6..46b6692e 100644 --- a/src/Pyramid/PyramidCommand.class.st +++ b/src/Pyramid/PyramidCommand.class.st @@ -27,7 +27,7 @@ PyramidCommand >> canBeUsedFor: anObject [ ^ self shouldBeImplemented ] -{ #category : #'as yet unclassified' } +{ #category : #actions } PyramidCommand >> clusterOf: aCollection [ | users cluster | @@ -40,25 +40,25 @@ PyramidCommand >> clusterOf: aCollection [ ^ cluster ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidCommand >> commandInverse [ ^ self ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidCommand >> getGroupedValueFor: anObject [ ^ self getValueFor: anObject ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidCommand >> getValueFor: anObject [ ^ self shouldBeImplemented ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidCommand >> saveStatesOf: aCollection with: arguments [ ^ self @@ -67,7 +67,7 @@ PyramidCommand >> saveStatesOf: aCollection with: arguments [ withArguments: arguments ] -{ #category : #'as yet unclassified' } +{ #category : #private } PyramidCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [ | mementos | @@ -83,19 +83,19 @@ PyramidCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: yourself ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidCommand >> saveStatesWithCommandInverseOf: aCollection with: arguments [ ^ self saveStatesOf: aCollection withCommand: self commandInverse withArguments: arguments ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidCommand >> setValueFor: anObject with: anArgument [ self shouldBeImplemented ] -{ #category : #'as yet unclassified' } +{ #category : #actions } PyramidCommand >> useOn: aCollection with: anArgument [ aCollection do: [ :each | self setValueFor: each with: anArgument ] diff --git a/src/Pyramid/PyramidRemoveAllFromCollectionCommand.class.st b/src/Pyramid/PyramidRemoveAllFromCollectionCommand.class.st index e039ab4d..91c4cb82 100644 --- a/src/Pyramid/PyramidRemoveAllFromCollectionCommand.class.st +++ b/src/Pyramid/PyramidRemoveAllFromCollectionCommand.class.st @@ -4,19 +4,19 @@ Class { #category : #'Pyramid-commands' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidRemoveAllFromCollectionCommand >> commandInverse [ ^ PyramidAddAllToCollectionCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidRemoveAllFromCollectionCommand >> getValueFor: anObject [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidRemoveAllFromCollectionCommand >> setValueFor: anObject with: anArgument [ anObject removeAll: anArgument diff --git a/src/Pyramid/PyramidRemoveFromCollectionCommand.class.st b/src/Pyramid/PyramidRemoveFromCollectionCommand.class.st index cf9386a4..56c0aafe 100644 --- a/src/Pyramid/PyramidRemoveFromCollectionCommand.class.st +++ b/src/Pyramid/PyramidRemoveFromCollectionCommand.class.st @@ -4,19 +4,19 @@ Class { #category : #'Pyramid-commands' } -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidRemoveFromCollectionCommand >> commandInverse [ ^ PyramidAddToCollectionCommand new ] -{ #category : #'as yet unclassified' } +{ #category : #getter } PyramidRemoveFromCollectionCommand >> getValueFor: anObject [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #setter } PyramidRemoveFromCollectionCommand >> setValueFor: anObject with: anArgument [ anObject remove: anArgument From 40f8dc2cac0b6c40f12aaa416ae745f651d2c95f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 28 Apr 2026 14:52:33 +0200 Subject: [PATCH 15/58] =?UTF-8?q?update=20fix=20issue=20:=20Undo=20of=20re?= =?UTF-8?q?move=20element=20doesn=E2=80=99t=20put=20it=20back=20in=20the?= =?UTF-8?q?=20same=20position=20#187?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st index 34df84a2..d03a1e21 100644 --- a/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAddChildrenCommand.class.st @@ -12,6 +12,6 @@ PyramidAddChildrenCommand >> commandInverse [ { #category : #setter } PyramidAddChildrenCommand >> setValueFor: aBlElement with: aChildrenToAdd [ - aChildrenToAdd do: [ :child | - aBlElement addChild: child ] + + aBlElement addChildren: aChildrenToAdd ] From 4134e5167d3701d48e1cb64cdb242c871a4b7e72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 28 Apr 2026 14:55:23 +0200 Subject: [PATCH 16/58] =?UTF-8?q?update=20fix=20issue=20:=20Undo=20of=20re?= =?UTF-8?q?move=20element=20doesn=E2=80=99t=20put=20it=20back=20in=20the?= =?UTF-8?q?=20same=20position=20#187?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st b/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st index a7545749..dee6455b 100644 --- a/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st @@ -13,7 +13,7 @@ PyramidRemoveSelectedElementsCommand >> getValueFor: anElementOfSelection [ ^ nil ] -{ #category : #'as yet unclassified' } +{ #category : #history } PyramidRemoveSelectedElementsCommand >> mementoFor: anElement withArguments: anArgument [ self saveIndexOf: anElement. From a0dcc1dd1c57cb3116569114772dae475f946dfa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 30 Apr 2026 10:21:53 +0200 Subject: [PATCH 17/58] Split Toplo library into separate categories: hide broken elements, move unserialized elements to 'Unstable' category --- .../PyramidLibraryElement.class.st | 15 +++- .../PyramidToploThemePlugin.class.st | 85 +++++++++++++++---- 2 files changed, 81 insertions(+), 19 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index 08385a16..27ba1e4b 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', + 'status' ], #category : #'Pyramid-Bloc-plugin-navigation' } @@ -85,3 +86,15 @@ PyramidLibraryElement >> name: anObject [ name := anObject ] + +{ #category : #accessing } +PyramidLibraryElement >> status [ + + ^ status ifNil: [ #ok ] +] + +{ #category : #accessing } +PyramidLibraryElement >> status: aSymbol [ + + status := aSymbol +] diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index b1164fa2..a5fb2c45 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -110,30 +110,79 @@ PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass withCat PyramidToploThemePlugin class >> toploLibraryCategory [ - | classes elements | + | classes elements knownBroken testClass okElements unserializedElements | + knownBroken := #( #ToCircularMenuInnerElement + #ToCircularMenuList #ToExPicsumNode #ToAnimatedIcon ). + testClass := Smalltalk at: #ToSerializerTest. classes := ToElement allSubclasses , { ToElement }. - elements := classes - reject: [ :each | - each isAbstract or: [ - (each name findString: 'Abstract') > 0 or: [ - [ - each new. - false ] - on: Error - do: [ true ] ] ] ] - thenCollect: [ :class | + classes := classes reject: [ :each | + each isAbstract or: [ + (each name findString: 'Abstract') > 0 ] ]. + elements := classes collect: [ :class | + | broken serializable status | + broken := [ + class new. + false ] + on: Error + do: [ :e | true ]. + broken := broken or: [ + knownBroken includes: class name asSymbol ]. + serializable := [ + | suite prefix | + prefix := 'test' , class name. + suite := testClass suite tests + select: [ :t | + (t selector beginsWith: + prefix) and: [ + t selector size + = prefix size or: [ + | suffix | + suffix := t selector + copyFrom: + prefix size + + 1 + to: + t selector + size. + suffix allSatisfy: [ + :c | c isDigit ] ] ] ]. + suite isNotEmpty ] + on: Error + do: [ false ]. + status := broken + ifTrue: [ #broken ] + ifFalse: [ + serializable + ifTrue: [ #ok ] + ifFalse: [ #unserialized ] ]. PyramidLibraryElement new icon: - (Smalltalk ui icons iconNamed: class systemIconName); + (Smalltalk ui icons iconNamed: (status = #broken + ifTrue: [ #error ] + ifFalse: [ + status = #unserialized + ifTrue: [ #warning ] + ifFalse: [ class systemIconName ] ])); name: class name; block: [ { class new } ]; + status: status; yourself ]. - - ^ { (PyramidLibraryCategory new - name: 'Toplo'; - icon: (Smalltalk ui icons iconNamed: #box); - elements: (elements sorted: [ :a :b | a name < b name ]); - yourself) } + elements := elements reject: [ :e | e status = #broken ]. + okElements := elements select: [ :e | e status = #ok ]. + unserializedElements := elements select: [ :e | + e status = #unserialized ]. + ^ { + (PyramidLibraryCategory new + name: 'Toplo'; + icon: (Smalltalk ui icons iconNamed: #box); + elements: (okElements sorted: [ :a :b | a name < b name ]); + yourself). + (PyramidLibraryCategory new + name: 'Unstable'; + icon: (Smalltalk ui icons iconNamed: #warning); + elements: + (unserializedElements sorted: [ :a :b | a name < b name ]); + yourself) } ] { #category : #adding } From 82fc95532e9ffb3ae36239990b5cbb51b7ea1ef3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 19 May 2026 10:50:57 +0200 Subject: [PATCH 18/58] Edit the symbol's name in 'User Data' with the prefix 'pyramid' --- src/Pyramid-Bloc/PyramidAddChildCommand.class.st | 2 +- .../PyramidRemoveSelectedElementsCommand.class.st | 2 +- src/Pyramid/PyramidCompositeMemento.class.st | 8 +++++--- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidAddChildCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildCommand.class.st index 40ae11b1..8d99e4b6 100644 --- a/src/Pyramid-Bloc/PyramidAddChildCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAddChildCommand.class.st @@ -14,7 +14,7 @@ PyramidAddChildCommand >> commandInverse [ PyramidAddChildCommand >> savedIndexFor: aChild in: aParent [ | index | - index := aChild userData at: #removedAtIndex ifAbsent: [ 0 ]. + index := aChild userData at: #pyramidRemovedAtIndex ifAbsent: [ 0 ]. (index = 0 or: [ index > aParent children size ]) ifTrue: [ ^ aParent children size + 1 ] ifFalse: [ ^ index ] diff --git a/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st b/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st index dee6455b..7394355f 100644 --- a/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRemoveSelectedElementsCommand.class.st @@ -49,7 +49,7 @@ PyramidRemoveSelectedElementsCommand >> saveIndexOf: anElement [ index := anElement parent ifNotNil: [ :p | p children indexOf: anElement ] ifNil: [ 0 ]. - anElement userData at: #removedAtIndex put: index + anElement userData at: #pyramidRemovedAtIndex put: index ] { #category : #history } diff --git a/src/Pyramid/PyramidCompositeMemento.class.st b/src/Pyramid/PyramidCompositeMemento.class.st index 8ec74569..26eb9ab0 100644 --- a/src/Pyramid/PyramidCompositeMemento.class.st +++ b/src/Pyramid/PyramidCompositeMemento.class.st @@ -35,9 +35,11 @@ PyramidCompositeMemento >> mementos: anObject [ PyramidCompositeMemento >> restore [ (self mementos allSatisfy: [ :m | m arguments isKindOf: BlElement ]) - ifFalse: [ self mementos do: [ :each | each restore ]. ^ self ]. + ifFalse: [ + self mementos do: [ :each | each restore ]. + ^ self ]. (self mementos asSortedCollection: [ :a :b | - (a arguments userData at: #removedAtIndex ifAbsent: [ 0 ]) - < (b arguments userData at: #removedAtIndex ifAbsent: [ 0 ]) ]) + (a arguments userData at: #pyramidRemovedAtIndex ifAbsent: [ 0 ]) + < (b arguments userData at: #pyramidRemovedAtIndex ifAbsent: [ 0 ]) ]) do: [ :each | each restore ] ] 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 19/58] 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 20/58] 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 21/58] 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 0f7eca33e5ce09399585dffd58f0a67d1ca344b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 28 May 2026 15:13:28 +0200 Subject: [PATCH 22/58] update the method named 'toploLibraryCategory' --- .../PyramidToploThemePlugin.class.st | 74 +++++++++---------- 1 file changed, 36 insertions(+), 38 deletions(-) diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index a5fb2c45..bc3b3343 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -110,67 +110,65 @@ PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass withCat PyramidToploThemePlugin class >> toploLibraryCategory [ - | classes elements knownBroken testClass okElements unserializedElements | - knownBroken := #( #ToCircularMenuInnerElement - #ToCircularMenuList #ToExPicsumNode #ToAnimatedIcon ). + | allowedClasses allClasses elements knownNotUsable testClass okElements unserializedElements | + allowedClasses := { + ToButton. + ToLabel. + ToImage. + ToAlbum. + ToTextField. + ToListElement. }. + knownNotUsable := #( #ToCircularMenuInnerElement + #ToCircularMenuList #ToExPicsumNode + #ToAnimatedIcon ). testClass := Smalltalk at: #ToSerializerTest. - classes := ToElement allSubclasses , { ToElement }. - classes := classes reject: [ :each | - each isAbstract or: [ - (each name findString: 'Abstract') > 0 ] ]. - elements := classes collect: [ :class | - | broken serializable status | - broken := [ - class new. - false ] - on: Error - do: [ :e | true ]. - broken := broken or: [ - knownBroken includes: class name asSymbol ]. + allClasses := ToElement allSubclasses , { ToElement }. + allClasses := allClasses reject: [ :each | + each isAbstract or: [ + (each name findString: 'Abstract') > 0 ] ]. + elements := allClasses collect: [ :class | + | notUsable serializable status | + notUsable := [ + class new. + false ] + on: Error + do: [ :e | true ]. + notUsable := notUsable or: [ + knownNotUsable includes: + class name asSymbol ]. serializable := [ | suite prefix | prefix := 'test' , class name. suite := testClass suite tests select: [ :t | - (t selector beginsWith: - prefix) and: [ - t selector size - = prefix size or: [ - | suffix | - suffix := t selector - copyFrom: - prefix size - + 1 - to: - t selector - size. - suffix allSatisfy: [ - :c | c isDigit ] ] ] ]. + t selector beginsWith: + prefix ]. suite isNotEmpty ] on: Error do: [ false ]. - status := broken - ifTrue: [ #broken ] + status := notUsable + ifTrue: [ #notUsable ] ifFalse: [ - serializable + ((allowedClasses includes: class) and: [ + serializable ]) ifTrue: [ #ok ] - ifFalse: [ #unserialized ] ]. + ifFalse: [ #unstable ] ]. PyramidLibraryElement new icon: - (Smalltalk ui icons iconNamed: (status = #broken + (Smalltalk ui icons iconNamed: (status = #notUsable ifTrue: [ #error ] ifFalse: [ - status = #unserialized + status = #unstable ifTrue: [ #warning ] ifFalse: [ class systemIconName ] ])); name: class name; block: [ { class new } ]; status: status; yourself ]. - elements := elements reject: [ :e | e status = #broken ]. + elements := elements reject: [ :e | e status = #notUsable ]. okElements := elements select: [ :e | e status = #ok ]. unserializedElements := elements select: [ :e | - e status = #unserialized ]. + e status = #unstable ]. ^ { (PyramidLibraryCategory new name: 'Toplo'; From a692c9bb9a0a08d502e0f75873f9972fac161c18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Mon, 1 Jun 2026 10:32:38 +0200 Subject: [PATCH 23/58] Add status class methods --- .../PyramidLibraryElement.class.st | 18 +++++++++- .../PyramidToploThemePlugin.class.st | 33 +++++++++++-------- 2 files changed, 37 insertions(+), 14 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index 27ba1e4b..a885324e 100644 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryElement.class.st @@ -10,6 +10,22 @@ Class { #category : #'Pyramid-Bloc-plugin-navigation' } +{ #category : #accessing } +PyramidLibraryElement class >> statusNotUsable [ + ^ #notUsable +] + +{ #category : #accessing } +PyramidLibraryElement class >> statusOk [ + + ^ #ok +] + +{ #category : #accessing } +PyramidLibraryElement class >> statusUnstable [ + ^ #unstable +] + { #category : #converting } PyramidLibraryElement >> asArray [ @@ -90,7 +106,7 @@ PyramidLibraryElement >> name: anObject [ { #category : #accessing } PyramidLibraryElement >> status [ - ^ status ifNil: [ #ok ] + ^ status ifNil: [self class statusUnstable] ] { #category : #accessing } diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index bc3b3343..11e4534f 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -113,11 +113,13 @@ PyramidToploThemePlugin class >> toploLibraryCategory [ | allowedClasses allClasses elements knownNotUsable testClass okElements unserializedElements | allowedClasses := { ToButton. + ToRadioButton. + ToToggleButton. ToLabel. ToImage. ToAlbum. ToTextField. - ToListElement. }. + ToListElement }. knownNotUsable := #( #ToCircularMenuInnerElement #ToCircularMenuList #ToExPicsumNode #ToAnimatedIcon ). @@ -147,36 +149,41 @@ PyramidToploThemePlugin class >> toploLibraryCategory [ on: Error do: [ false ]. status := notUsable - ifTrue: [ #notUsable ] + ifTrue: [ + PyramidLibraryElement statusNotUsable ] ifFalse: [ ((allowedClasses includes: class) and: [ serializable ]) - ifTrue: [ #ok ] - ifFalse: [ #unstable ] ]. + ifTrue: [ PyramidLibraryElement statusOk ] + ifFalse: [ + PyramidLibraryElement statusUnstable ] ]. PyramidLibraryElement new - icon: - (Smalltalk ui icons iconNamed: (status = #notUsable + icon: (Smalltalk ui icons iconNamed: + (status = PyramidLibraryElement statusNotUsable ifTrue: [ #error ] ifFalse: [ - status = #unstable + status = PyramidLibraryElement statusUnstable ifTrue: [ #warning ] ifFalse: [ class systemIconName ] ])); name: class name; block: [ { class new } ]; status: status; yourself ]. - elements := elements reject: [ :e | e status = #notUsable ]. - okElements := elements select: [ :e | e status = #ok ]. + elements := elements reject: [ :e | + e status = PyramidLibraryElement statusNotUsable ]. + okElements := elements select: [ :e | + e status = PyramidLibraryElement statusOk ]. unserializedElements := elements select: [ :e | - e status = #unstable ]. + e status + = PyramidLibraryElement statusUnstable ]. ^ { (PyramidLibraryCategory new - name: 'Toplo'; - icon: (Smalltalk ui icons iconNamed: #box); + name: 'Toplo-Verified'; + icon: (Smalltalk ui icons iconNamed: #smallOk); elements: (okElements sorted: [ :a :b | a name < b name ]); yourself). (PyramidLibraryCategory new - name: 'Unstable'; + name: 'Toplo-Unverified'; icon: (Smalltalk ui icons iconNamed: #warning); elements: (unserializedElements sorted: [ :a :b | a name < b name ]); From 60c42596c5e73ab25abdbb833a7af465dac301ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Tue, 2 Jun 2026 11:13:28 +0200 Subject: [PATCH 24/58] update list of allowed elements --- src/Pyramid-Toplo/PyramidToploThemePlugin.class.st | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index 11e4534f..bd42e465 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -118,8 +118,7 @@ PyramidToploThemePlugin class >> toploLibraryCategory [ ToLabel. ToImage. ToAlbum. - ToTextField. - ToListElement }. + ToTextField}. knownNotUsable := #( #ToCircularMenuInnerElement #ToCircularMenuList #ToExPicsumNode #ToAnimatedIcon ). 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 25/58] 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 c452df60242e2bc4e8fdb0834a0b5c50d8f8a000 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 4 Jun 2026 11:12:07 +0200 Subject: [PATCH 26/58] remove #pyramidRemovedAtIndex from userData when a BlElement is added with PyramidAddChildCommand and add tests --- .../PyramidAddChildCommand.class.st | 3 +- .../PyramidRemoveChildCommand.class.st | 14 +- ...midUndoRedoRemoveChildCommandTest.class.st | 150 ++++++++++++++++++ ...PyramidUndoRemoveChildCommandTest.class.st | 87 ---------- src/Pyramid/PyramidCompositeMemento.class.st | 30 +++- 5 files changed, 190 insertions(+), 94 deletions(-) create mode 100644 src/Pyramid-Tests/PyramidUndoRedoRemoveChildCommandTest.class.st delete mode 100644 src/Pyramid-Tests/PyramidUndoRemoveChildCommandTest.class.st diff --git a/src/Pyramid-Bloc/PyramidAddChildCommand.class.st b/src/Pyramid-Bloc/PyramidAddChildCommand.class.st index 8d99e4b6..a9031835 100644 --- a/src/Pyramid-Bloc/PyramidAddChildCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAddChildCommand.class.st @@ -25,5 +25,6 @@ PyramidAddChildCommand >> setValueFor: aBlElement with: aChildToAdd [ aBlElement addChild: aChildToAdd - at: (self savedIndexFor: aChildToAdd in: aBlElement) + at: (self savedIndexFor: aChildToAdd in: aBlElement). + aChildToAdd userData removeKey: #pyramidRemovedAtIndex ifAbsent: [ ] ] diff --git a/src/Pyramid-Bloc/PyramidRemoveChildCommand.class.st b/src/Pyramid-Bloc/PyramidRemoveChildCommand.class.st index dc97608a..5cb81d95 100644 --- a/src/Pyramid-Bloc/PyramidRemoveChildCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRemoveChildCommand.class.st @@ -10,8 +10,18 @@ PyramidRemoveChildCommand >> commandInverse [ ^ PyramidAddChildCommand new ] +{ #category : #private } +PyramidRemoveChildCommand >> saveIndexOf: anElement [ + + | index | + index := anElement parent + ifNotNil: [ :p | p children indexOf: anElement ] + ifNil: [ 0 ]. + anElement userData at: #pyramidRemovedAtIndex put: index +] + { #category : #setter } PyramidRemoveChildCommand >> setValueFor: aBlElement with: aChildToRemove [ - - aBlElement removeChild: aChildToRemove + self saveIndexOf: aChildToRemove. + aBlElement removeChild: aChildToRemove. ] diff --git a/src/Pyramid-Tests/PyramidUndoRedoRemoveChildCommandTest.class.st b/src/Pyramid-Tests/PyramidUndoRedoRemoveChildCommandTest.class.st new file mode 100644 index 00000000..b9f1e55f --- /dev/null +++ b/src/Pyramid-Tests/PyramidUndoRedoRemoveChildCommandTest.class.st @@ -0,0 +1,150 @@ +Class { + #name : #PyramidUndoRedoRemoveChildCommandTest, + #superclass : #TestCase, + #category : #'Pyramid-Tests-cases-plugin-bloc' +} + +{ #category : #tests } +PyramidUndoRedoRemoveChildCommandTest >> testUndoRedoUndoRemoveChildRestoresIndex [ + + | history commandExecutor parent child1 child2 child3 | + parent := BlElement new + layout: BlFlowLayout new; + yourself. + child1 := BlElement new. + child2 := BlElement new. + child3 := BlElement new. + parent addChild: child1. + parent addChild: child2. + parent addChild: child3. + history := PyramidHistory new. + commandExecutor := PyramidHistoryCommandExecutor new + history: history; + wrappee: PyramidMainCommandExecutor new; + yourself. + + commandExecutor + use: PyramidRemoveSelectedElementsCommand new + on: { child2 } + with: { parent }. + self deny: (parent children includes: child2). + self assert: (child2 userData at: #pyramidRemovedAtIndex) equals: 2. + + "Undo" + history undo. + self assert: (parent children includes: child2). + self deny: (child2 userData includesKey: #pyramidRemovedAtIndex). + + "Redo" + history redo. + self deny: (parent children includes: child2). + self assert: (child2 userData at: #pyramidRemovedAtIndex) equals: 2. + + "Undo" + history undo. + self assert: (parent children includes: child2). + self assert: (parent children indexOf: child2) equals: 2. + self assert: (parent children indexOf: child1) equals: 1. + self assert: (parent children indexOf: child3) equals: 3 +] + +{ #category : #tests } +PyramidUndoRedoRemoveChildCommandTest >> testUndoRedoUndoRemoveMultipleChildrenRestoresIndex [ + + | history commandExecutor parent child1 child2 child3 child4 child5 child6 | + parent := BlElement new + layout: BlFlowLayout new; + yourself. + child1 := BlElement new. + child2 := BlElement new. + child3 := BlElement new. + child4 := BlElement new. + child5 := BlElement new. + child6 := BlElement new. + parent addChild: child1. + parent addChild: child2. + parent addChild: child3. + parent addChild: child4. + parent addChild: child5. + parent addChild: child6. + + history := PyramidHistory new. + commandExecutor := PyramidHistoryCommandExecutor new + history: history; + wrappee: PyramidMainCommandExecutor new; + yourself. + + commandExecutor + use: PyramidRemoveSelectedElementsCommand new + on: { + child6. + child1. + child4. + child3 } + with: { parent }. + self deny: (parent children includes: child1). + self deny: (parent children includes: child3). + self deny: (parent children includes: child4). + self deny: (parent children includes: child6). + self assert: (parent children includes: child2). + self assert: (parent children includes: child5). + self assert: parent children size equals: 2. + self assert: (child1 userData at: #pyramidRemovedAtIndex) equals: 1. + self assert: (child3 userData at: #pyramidRemovedAtIndex) equals: 3. + self assert: (child4 userData at: #pyramidRemovedAtIndex) equals: 4. + self assert: (child6 userData at: #pyramidRemovedAtIndex) equals: 6. + + "Undo" + history undo. + self assert: (parent children includes: child1). + self assert: (parent children includes: child2). + self assert: (parent children includes: child3). + self assert: (parent children includes: child4). + self assert: (parent children includes: child5). + self assert: (parent children includes: child6). + self assert: parent children size equals: 6. + self assert: (parent children indexOf: child1) equals: 1. + self assert: (parent children indexOf: child2) equals: 2. + self assert: (parent children indexOf: child3) equals: 3. + self assert: (parent children indexOf: child4) equals: 4. + self assert: (parent children indexOf: child5) equals: 5. + self assert: (parent children indexOf: child6) equals: 6. + self deny: (child1 userData includesKey: #pyramidRemovedAtIndex). + self deny: (child3 userData includesKey: #pyramidRemovedAtIndex). + self deny: (child4 userData includesKey: #pyramidRemovedAtIndex). + self deny: (child6 userData includesKey: #pyramidRemovedAtIndex). + + "Redo" + history redo. + self deny: (parent children includes: child1). + self deny: (parent children includes: child3). + self deny: (parent children includes: child4). + self deny: (parent children includes: child6). + self assert: (parent children includes: child2). + self assert: (parent children includes: child5). + self assert: parent children size equals: 2. + self assert: (child1 userData at: #pyramidRemovedAtIndex) equals: 1. + self assert: (child3 userData at: #pyramidRemovedAtIndex) equals: 3. + self assert: (child4 userData at: #pyramidRemovedAtIndex) equals: 4. + self assert: (child6 userData at: #pyramidRemovedAtIndex) equals: 6. + + "Undo" + history undo. + self assert: (parent children includes: child1). + self assert: (parent children includes: child2). + self assert: (parent children includes: child3). + self assert: (parent children includes: child4). + self assert: (parent children includes: child5). + self assert: (parent children includes: child6). + self assert: parent children size equals: 6. + self assert: (parent children indexOf: child1) equals: 1. + self assert: (parent children indexOf: child2) equals: 2. + self assert: (parent children indexOf: child3) equals: 3. + self assert: (parent children indexOf: child4) equals: 4. + self assert: (parent children indexOf: child5) equals: 5. + self assert: (parent children indexOf: child6) equals: 6. + self deny: (child1 userData includesKey: #pyramidRemovedAtIndex). + self deny: (child3 userData includesKey: #pyramidRemovedAtIndex). + self deny: (child4 userData includesKey: #pyramidRemovedAtIndex). + self deny: (child6 userData includesKey: #pyramidRemovedAtIndex). +] diff --git a/src/Pyramid-Tests/PyramidUndoRemoveChildCommandTest.class.st b/src/Pyramid-Tests/PyramidUndoRemoveChildCommandTest.class.st deleted file mode 100644 index 76ffedc0..00000000 --- a/src/Pyramid-Tests/PyramidUndoRemoveChildCommandTest.class.st +++ /dev/null @@ -1,87 +0,0 @@ -Class { - #name : #PyramidUndoRemoveChildCommandTest, - #superclass : #TestCase, - #category : #'Pyramid-Tests-cases-plugin-bloc' -} - -{ #category : #tests } -PyramidUndoRemoveChildCommandTest >> testUndoRemoveAllChildrenRestoresIndex [ - - | history commandExecutor parent child1 child2 child3 child4| - parent := BlElement new. - child1 := BlElement new. - child2 := BlElement new. - child3 := BlElement new. - child4 := BlElement new. - parent addChildren: {child1. child2 .child3. child4}. - - history := PyramidHistory new. - commandExecutor := PyramidHistoryCommandExecutor new - history: history; - wrappee: PyramidMainCommandExecutor new; - yourself. - commandExecutor - use: PyramidRemoveSelectedElementsCommand new - on: { - child4. - child2. - child1 } - with: { parent }. - - self deny: (parent children includes: child2). - self deny: (parent children includes: child1). - self deny: (parent children includes: child4). - - "Undo" - history undo. - - self assert: (parent children includes: child1). - self assert: (parent children includes: child2). - self assert: (parent children indexOf: child1) equals: 1. - self assert: (parent children indexOf: child2) equals: 2. - self assert: (parent children indexOf: child4) equals: 4 -] - -{ #category : #tests } -PyramidUndoRemoveChildCommandTest >> testUndoRemoveChildRestoresIndex [ - - | history commandExecutor parent child1 child2 child3 | - - parent := BlElement new. - child1 := BlElement new. - child2 := BlElement new. - child3 := BlElement new. - parent addChild: child1. - parent addChild: child2. - parent addChild: child3. - - history := PyramidHistory new. - commandExecutor := PyramidHistoryCommandExecutor new - history: history; - wrappee: PyramidMainCommandExecutor new; - yourself. - - commandExecutor - use: PyramidRemoveSelectedElementsCommand new - on: { child2 } - with: { parent }. - - self deny: (parent children includes: child2). - - "Undo" - history undo. - - self assert: (parent children includes: child2). - self assert: (parent children indexOf: child2) equals: 2. - - "Redo" - history redo. - - self deny: (parent children includes: child2). - - "Undo" - history undo. - - self assert: (parent children includes: child2). - self assert: (parent children indexOf: child2) equals: 2 -] diff --git a/src/Pyramid/PyramidCompositeMemento.class.st b/src/Pyramid/PyramidCompositeMemento.class.st index 26eb9ab0..40809718 100644 --- a/src/Pyramid/PyramidCompositeMemento.class.st +++ b/src/Pyramid/PyramidCompositeMemento.class.st @@ -34,12 +34,34 @@ PyramidCompositeMemento >> mementos: anObject [ { #category : #'window management' } PyramidCompositeMemento >> restore [ + | isRemove | (self mementos allSatisfy: [ :m | m arguments isKindOf: BlElement ]) ifFalse: [ self mementos do: [ :each | each restore ]. ^ self ]. - (self mementos asSortedCollection: [ :a :b | - (a arguments userData at: #pyramidRemovedAtIndex ifAbsent: [ 0 ]) - < (b arguments userData at: #pyramidRemovedAtIndex ifAbsent: [ 0 ]) ]) - do: [ :each | each restore ] + + isRemove := self mementos first command isKindOf: + PyramidRemoveChildCommand. + isRemove + ifTrue: [ + self mementos do: [ :each | + each command saveIndexOf: each arguments ]. + (self mementos asSortedCollection: [ :a :b | + (a arguments userData + at: #pyramidRemovedAtIndex + ifAbsent: [ 0 ]) + > + (b arguments userData + at: #pyramidRemovedAtIndex + ifAbsent: [ 0 ]) ]) do: [ :each | + each target removeChild: each arguments ] ] + ifFalse: [ + (self mementos asSortedCollection: [ :a :b | + (a arguments userData + at: #pyramidRemovedAtIndex + ifAbsent: [ 0 ]) + < + (b arguments userData + at: #pyramidRemovedAtIndex + ifAbsent: [ 0 ]) ]) do: [ :each | each restore ] ] ] From 0c1222958fba655928b3a8f677e9a8d99d041877 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mathieu=20Magu=C3=A9r=C3=A8s?= Date: Thu, 4 Jun 2026 13:23:10 +0200 Subject: [PATCH 27/58] Add a feature that allows opening the interface in a window --- .../PyramidPluginOpenInWindow.class.st | 95 +++++++++++++++++++ .../PyramidDynamicLayoutStrategy.class.st | 2 +- src/Pyramid/PyramidPanelModel.class.st | 11 +++ .../PyramidToolbarPanelBuilder.class.st | 16 +++- src/Pyramid/PyramidWindow.class.st | 4 +- 5 files changed, 124 insertions(+), 4 deletions(-) create mode 100644 src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st diff --git a/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st b/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st new file mode 100644 index 00000000..91d853dd --- /dev/null +++ b/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st @@ -0,0 +1,95 @@ +Class { + #name : #PyramidPluginOpenInWindow, + #superclass : #Object, + #traits : 'TPyramidPlugin + TPyramidEditorExtension', + #classTraits : 'TPyramidPlugin classTrait + TPyramidEditorExtension classTrait', + #instVars : [ + 'button', + 'spacePlugin', + 'builder', + 'projectModel', + 'savePlugin' + ], + #category : #'Pyramid-Bloc-plugin-openinwindow' +} + +{ #category : #adding } +PyramidPluginOpenInWindow >> addPanelsOn: aPyramidSimpleWindow [ + + aPyramidSimpleWindow + at: #topRight + addItem: [ :b | b makeButtonWithIcon: self button order: 1 ]. +] + +{ #category : #accessing } +PyramidPluginOpenInWindow >> builder [ + ^ builder +] + +{ #category : #accessing } +PyramidPluginOpenInWindow >> button [ + + ^ button +] + +{ #category : #connecting } +PyramidPluginOpenInWindow >> connectOn: aPyramidEditor [ + spacePlugin := aPyramidEditor plugins + detect: [ :p | p isKindOf: PyramidSpacePlugin ] + ifNone: [ ]. + spacePlugin ifNotNil: [ builder := spacePlugin builder ]. + projectModel := aPyramidEditor projectModel. + savePlugin := aPyramidEditor plugins + detect: [ :p | p isKindOf: PyramidSavePlugin ] + ifNone: [ ] +] + +{ #category : #initialization } +PyramidPluginOpenInWindow >> initialize [ + button := SpButtonPresenter new + icon: self openInWindowIcon; + help: 'Open interface in a separate window.'; + action: [ self openSpaceInWindow ]; + yourself +] + +{ #category : #'as yet unclassified' } +PyramidPluginOpenInWindow >> openInWindowIcon [ + + ^ Smalltalk ui icons iconNamed: #glamorousInspect +] + +{ #category : #'as yet unclassified' } +PyramidPluginOpenInWindow >> openSpaceInWindow [ + + | elements stash newElements space | + projectModel ifNil: [ ^ self inform: 'No project found.' ]. + + elements := projectModel firstLevelElements asOrderedCollection. + elements ifEmpty: [ ^ self inform: 'Nothing to display.' ]. + + elements size = 1 + ifTrue: [ + stash := BlSerializer + serialize: elements first + with: BlStashSerializer. + newElements := { stash materializeAsBlElement } ] + ifFalse: [ + | container | + container := BlElement new + extent: 4000 @ 2000; + yourself. + elements do: [ :each | + stash := BlSerializer serialize: each with: BlStashSerializer. + container addChild: stash materializeAsBlElement ]. + newElements := { container } ]. + + space := newElements first openInNewSpace. + newElements size > 1 ifTrue: [ + space root addChildren: newElements allButFirst ] +] + +{ #category : #accessing } +PyramidPluginOpenInWindow >> projectModel [ + ^ projectModel +] diff --git a/src/Pyramid/PyramidDynamicLayoutStrategy.class.st b/src/Pyramid/PyramidDynamicLayoutStrategy.class.st index 8503c2a0..3865f975 100644 --- a/src/Pyramid/PyramidDynamicLayoutStrategy.class.st +++ b/src/Pyramid/PyramidDynamicLayoutStrategy.class.st @@ -59,6 +59,6 @@ PyramidDynamicLayoutStrategy >> topLayoutFor: aWindow [ layout add: SpNullPresenter new expand: true. layout add: (aWindow services at: #topCenter) presenter expand: true. layout add: SpNullPresenter new expand: true. - layout add: (aWindow services at: #topRight) presenter expand: false. + layout add: (aWindow services at: #topRight) presenter expand: true. ^ layout ] diff --git a/src/Pyramid/PyramidPanelModel.class.st b/src/Pyramid/PyramidPanelModel.class.st index b9485ade..2008dc09 100644 --- a/src/Pyramid/PyramidPanelModel.class.st +++ b/src/Pyramid/PyramidPanelModel.class.st @@ -42,6 +42,17 @@ PyramidPanelModel class >> toolbarHorizontal [ yourself ] +{ #category : #'as yet unclassified' } +PyramidPanelModel class >> toolbarHorizontalEnd [ + + ^ self new + builder: (PyramidToolbarPanelBuilder new + isHorizontal: true; + alignEnd: true; + yourself); + yourself +] + { #category : #'as yet unclassified' } PyramidPanelModel class >> toolbarVertical [ diff --git a/src/Pyramid/PyramidToolbarPanelBuilder.class.st b/src/Pyramid/PyramidToolbarPanelBuilder.class.st index cb40c62d..d412d69d 100644 --- a/src/Pyramid/PyramidToolbarPanelBuilder.class.st +++ b/src/Pyramid/PyramidToolbarPanelBuilder.class.st @@ -3,11 +3,24 @@ Class { #superclass : #PyramidPanelBuilder, #instVars : [ 'item', - 'isHorizontal' + 'isHorizontal', + 'alignEnd' ], #category : #'Pyramid-views' } +{ #category : #accessing } +PyramidToolbarPanelBuilder >> alignEnd [ + + ^ alignEnd ifNil: [ false ] +] + +{ #category : #accessing } +PyramidToolbarPanelBuilder >> alignEnd: aBoolean [ + +alignEnd := aBoolean +] + { #category : #accessing } PyramidToolbarPanelBuilder >> height [ @@ -69,6 +82,7 @@ PyramidToolbarPanelBuilder >> presenterOf: aCollectionOfItems [ | layout | layout := self layout. + self alignEnd ifTrue: [ layout hAlignEnd ]. aCollectionOfItems sorted do: [ :each | each addOnLayout: layout ]. ^ SpPresenter new layout: layout; diff --git a/src/Pyramid/PyramidWindow.class.st b/src/Pyramid/PyramidWindow.class.st index 17d650ef..230862c4 100644 --- a/src/Pyramid/PyramidWindow.class.st +++ b/src/Pyramid/PyramidWindow.class.st @@ -70,11 +70,11 @@ PyramidWindow >> close [ PyramidWindow >> initialize [ title := self class defaultTitle. - whenClosedDo := [ ]. + whenClosedDo := [ ]. PyramidPanelModel toolbarHorizontal installOn: self at: #topLeft. PyramidPanelModel toolbarHorizontal installOn: self at: #topCenter. - PyramidPanelModel toolbarHorizontal installOn: self at: #topRight. + PyramidPanelModel toolbarHorizontalEnd installOn: self at: #topRight. PyramidPanelModel presenter installOn: self at: #space. PyramidPanelModel tab installOn: self at: #tabLeft. PyramidPanelModel tab installOn: self at: #tabRight. 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 28/58] 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 009fe3d1d27b80d0e73d9eecb7190d69c6a874f4 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Mon, 8 Jun 2026 10:07:36 +0200 Subject: [PATCH 29/58] update the button icon and apply the theme to the new window + arrange the methods --- .../PyramidPluginOpenInWindow.class.st | 45 +++++++++---------- .../TPyramidEditorExtension.trait.st | 12 ++--- 2 files changed, 26 insertions(+), 31 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st b/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st index 91d853dd..3d49ec86 100644 --- a/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st +++ b/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st @@ -53,40 +53,35 @@ PyramidPluginOpenInWindow >> initialize [ yourself ] -{ #category : #'as yet unclassified' } +{ #category : #private } PyramidPluginOpenInWindow >> openInWindowIcon [ - ^ Smalltalk ui icons iconNamed: #glamorousInspect + | svgString coloredSvg blElement | + svgString := ToMaterialDesignIconProvider sharp_openinnew. + coloredSvg := svgString + copyReplaceAll: '> openSpaceInWindow [ - | elements stash newElements space | + | elements container stash space currentTheme | projectModel ifNil: [ ^ self inform: 'No project found.' ]. - elements := projectModel firstLevelElements asOrderedCollection. elements ifEmpty: [ ^ self inform: 'Nothing to display.' ]. - - elements size = 1 - ifTrue: [ - stash := BlSerializer - serialize: elements first - with: BlStashSerializer. - newElements := { stash materializeAsBlElement } ] - ifFalse: [ - | container | - container := BlElement new - extent: 4000 @ 2000; - yourself. - elements do: [ :each | - stash := BlSerializer serialize: each with: BlStashSerializer. - container addChild: stash materializeAsBlElement ]. - newElements := { container } ]. - - space := newElements first openInNewSpace. - newElements size > 1 ifTrue: [ - space root addChildren: newElements allButFirst ] + currentTheme := builder space root localTheme. + container := BlElement new + extent: 4000 @ 2000; + yourself. + elements do: [ :each | + stash := BlSerializer serialize: each with: BlStashSerializer. + container addChild: stash materializeAsBlElement ]. + space := container openInNewSpace. + currentTheme ifNotNil: [ space toTheme: currentTheme ] ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/TPyramidEditorExtension.trait.st b/src/Pyramid-Bloc/TPyramidEditorExtension.trait.st index 231adbff..6dcdca47 100644 --- a/src/Pyramid-Bloc/TPyramidEditorExtension.trait.st +++ b/src/Pyramid-Bloc/TPyramidEditorExtension.trait.st @@ -11,37 +11,37 @@ TPyramidEditorExtension >> currentTransformTranslation [ ^ matrix x @ matrix y ] -{ #category : #'as yet unclassified' } +{ #category : #displaying } TPyramidEditorExtension >> elementAtDisplays [ ^ (self builder elementAt: #displays) ] -{ #category : #'as yet unclassified' } +{ #category : #displaying } TPyramidEditorExtension >> elementAtDisplaysAddons [ ^ self elementAtDisplays childWithId: #displaysAddons ] -{ #category : #'as yet unclassified' } +{ #category : #displaying } TPyramidEditorExtension >> elementAtEvents [ ^ self builder elementAt: #events ] -{ #category : #'as yet unclassified' } +{ #category : #displaying } TPyramidEditorExtension >> elementAtMain [ ^ self builder elementAt: #main ] -{ #category : #'as yet unclassified' } +{ #category : #displaying } TPyramidEditorExtension >> elementAtTransforms [ ^ (self builder elementAt: #transforms) ] -{ #category : #'as yet unclassified' } +{ #category : #displaying } TPyramidEditorExtension >> elementAtWidgets [ ^ self builder elementAt: #widgets From 8ee8a1e05e8ac7a7b7807d7a6916fd677057a39a Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 9 Jun 2026 09:15:35 +0200 Subject: [PATCH 30/58] 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 4f2b11028737e9baa49385f9a4c4b3e1c704e3a2 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 30 Jun 2026 11:14:55 +0200 Subject: [PATCH 31/58] add 'metadata' method and add some tests --- .../PyramidMainExtension.class.st | 22 ++++ .../PyramidPluginOpenInWindow.class.st | 61 +++++++--- src/Pyramid-Bloc/PyramidSavePlugin.class.st | 83 ++++++++------ .../PyramidSavingService.class.st | 65 +++++++++-- .../PyramidMetaDataTest.class.st | 66 +++++++++++ .../PyramidOpenInWindowTest.class.st | 105 ++++++++++++++++++ 6 files changed, 341 insertions(+), 61 deletions(-) create mode 100644 src/Pyramid-Tests/PyramidMetaDataTest.class.st create mode 100644 src/Pyramid-Tests/PyramidOpenInWindowTest.class.st diff --git a/src/Pyramid-Bloc/PyramidMainExtension.class.st b/src/Pyramid-Bloc/PyramidMainExtension.class.st index 22978ac1..e28d815f 100644 --- a/src/Pyramid-Bloc/PyramidMainExtension.class.st +++ b/src/Pyramid-Bloc/PyramidMainExtension.class.st @@ -17,9 +17,30 @@ Class { 'gridColor', 'selectionWidgetExtension' ], + #classInstVars : [ + 'currentGridWindowSize' + ], #category : #'Pyramid-Bloc-plugin-space-extensions' } +{ #category : #accessing } +PyramidMainExtension class >> currentGridWindowSize [ + + ^ currentGridWindowSize +] + +{ #category : #accessing } +PyramidMainExtension class >> currentGridWindowSize: aPoint [ + + currentGridWindowSize := aPoint. + +] + +{ #category : #'class initialization' } +PyramidMainExtension class >> initialize [ + currentGridWindowSize := 800 @ 600 +] + { #category : #accessing } PyramidMainExtension >> borderElement [ @@ -104,6 +125,7 @@ PyramidMainExtension >> extent: aPoint [ self elementAtWidgets extent: aPoint. self sizeElement extent: aPoint. self gridWindowSize: aPoint. + self class currentGridWindowSize: aPoint.workplacePropertiesView workplaceSizeValue: aPoint. self createGrid ] diff --git a/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st b/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st index 3d49ec86..f92f899b 100644 --- a/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st +++ b/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st @@ -8,7 +8,8 @@ Class { 'spacePlugin', 'builder', 'projectModel', - 'savePlugin' + 'savePlugin', + 'space' ], #category : #'Pyramid-Bloc-plugin-openinwindow' } @@ -26,6 +27,12 @@ PyramidPluginOpenInWindow >> builder [ ^ builder ] +{ #category : #accessing } +PyramidPluginOpenInWindow >> builder: anObject [ + +builder := anObject +] + { #category : #accessing } PyramidPluginOpenInWindow >> button [ @@ -68,23 +75,49 @@ PyramidPluginOpenInWindow >> openInWindowIcon [ { #category : #private } PyramidPluginOpenInWindow >> openSpaceInWindow [ + | elements container stash currentTheme windowSize | + elements := projectModel firstLevelElements asOrderedCollection. + currentTheme := nil. + builder ifNotNil: [ :aBuilder | + aBuilder space ifNotNil: [ :aSpace | + aSpace root ifNotNil: [ :aRoot | currentTheme := aRoot localTheme ] ] ]. - | elements container stash space currentTheme | - projectModel ifNil: [ ^ self inform: 'No project found.' ]. - elements := projectModel firstLevelElements asOrderedCollection. - elements ifEmpty: [ ^ self inform: 'Nothing to display.' ]. - currentTheme := builder space root localTheme. - container := BlElement new - extent: 4000 @ 2000; - yourself. - elements do: [ :each | - stash := BlSerializer serialize: each with: BlStashSerializer. - container addChild: stash materializeAsBlElement ]. - space := container openInNewSpace. - currentTheme ifNotNil: [ space toTheme: currentTheme ] +windowSize := [ + | mainExtension | + mainExtension := builder extensions + detect: [ :e | e isKindOf: PyramidMainExtension ] + ifNone: [ nil ]. + mainExtension sizeElement extent ] + on: Error + do: [ PyramidMainExtension currentGridWindowSize ]. + + container := BlElement new + constraintsDo: [ :c | + c horizontal matchParent. + c vertical matchParent ]; + yourself. + elements do: [ :each | + stash := BlSerializer serialize: each with: BlStashSerializer. + container addChild: stash materializeAsBlElement ]. + space := container openInNewSpace. + space extent: windowSize. + currentTheme ifNotNil: [ space toTheme: currentTheme ]. + ^ space ] { #category : #accessing } PyramidPluginOpenInWindow >> projectModel [ ^ projectModel ] + +{ #category : #accessing } +PyramidPluginOpenInWindow >> projectModel: anObject [ + +projectModel := anObject +] + +{ #category : #accessing } +PyramidPluginOpenInWindow >> space [ + +^ space +] diff --git a/src/Pyramid-Bloc/PyramidSavePlugin.class.st b/src/Pyramid-Bloc/PyramidSavePlugin.class.st index f80c61ad..d61c10a5 100644 --- a/src/Pyramid-Bloc/PyramidSavePlugin.class.st +++ b/src/Pyramid-Bloc/PyramidSavePlugin.class.st @@ -17,17 +17,36 @@ Class { { #category : #'instance creation' } PyramidSavePlugin class >> openOn: aCollectionOfBlElement saveModel: aSaveModel [ - - | editor savePlugin | - editor := PyramidEditor buildEditor. - savePlugin := editor plugins select: [ :each | each class = self ]. - savePlugin size = 1 ifFalse: [ - Error signal: - 'Wrong installation of SavePlugin. Should only be one instance.' ]. - savePlugin := savePlugin asArray first. - editor projectModel firstLevelElements addAll: aCollectionOfBlElement. - savePlugin openOn: aSaveModel. - editor open + | editor savePlugin windowSize mainExtension spacePlugin | + editor := PyramidEditor buildEditor. + savePlugin := editor plugins select: [ :each | each class = self ]. + savePlugin size = 1 ifFalse: [ + Error signal: + 'Wrong installation of SavePlugin. Should only be one instance.' ]. + savePlugin := savePlugin asArray first. + editor projectModel firstLevelElements addAll: aCollectionOfBlElement. + + windowSize := [ + | metaDataSelector savingClass | + metaDataSelector := (aSaveModel savingMethodName , 'MetaData') asSymbol. + savingClass := self class environment classNamed: aSaveModel savingClassName. + savingClass perform: metaDataSelector. + PyramidSavingService currentProjectWindowSize ] + on: Error + do: [ nil ]. + + windowSize ifNotNil: [ + spacePlugin := editor plugins + detect: [ :p | p isKindOf: PyramidSpacePlugin ] + ifNone: [ nil ]. + spacePlugin ifNotNil: [ + mainExtension := spacePlugin builder extensions + detect: [ :e | e isKindOf: PyramidMainExtension ] + ifNone: [ nil ]. + mainExtension ifNotNil: [ mainExtension extent: windowSize ] ] ]. + + savePlugin openOn: aSaveModel. + editor open ] { #category : #adding } @@ -135,31 +154,23 @@ PyramidSavePlugin >> projectModel: aPyramidProjectModel [ { #category : #actions } PyramidSavePlugin >> saveAction [ - "Action executed by a save button from UI, this method catch exceptions when needed to doesn't expose directly a debugger but an info window" - - [ - self savingService save. - self inputsController isSaved. - ] - on: Error - do: [ :e | - - "Pyramid level error" - (e isKindOf: PyramidSaveError) ifTrue:[ - ^ UIManager default - alert: 'Cannot save the project, open project configuration to setup a valid saving location.' - title: 'Project configuration problem' - ]. - - "Serializer level error" - (e isKindOf: BlocSerializationError) ifTrue:[ - (UIManager default - confirm: 'Error when saving the project: ', e messageText asString, ' - Debug this error ?' - label: 'Error') - ifTrue:[e debug] ifFalse:[^ self]. - ]. - ] + [ + self savingService save. + self inputsController isSaved. + PyramidSavingService currentSaveModel: self saveModel ] + on: Error + do: [ :e | + (e isKindOf: PyramidSaveError) ifTrue: [ + ^ UIManager default + alert: 'Cannot save the project, open project configuration to setup a valid saving location.' + title: 'Project configuration problem' ]. + (e isKindOf: BlocSerializationError) ifTrue: [ + (UIManager default + confirm: 'Error when saving the project: ' , e messageText asString , ' + Debug this error ?' + label: 'Error') + ifTrue: [ e debug ] + ifFalse: [ ^ self ] ] ] ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidSavingService.class.st b/src/Pyramid-Bloc/PyramidSavingService.class.st index e158c9b0..e5a1a54e 100644 --- a/src/Pyramid-Bloc/PyramidSavingService.class.st +++ b/src/Pyramid-Bloc/PyramidSavingService.class.st @@ -9,7 +9,9 @@ Class { 'currentMethodBuilder', 'stash', 'ston', - 'currentMethodBuilderSelector' + 'currentMethodBuilderSelector', + 'currentSaveModel', + 'currentProjectWindowSize' ], #category : #'Pyramid-Bloc-plugin-save' } @@ -41,6 +43,26 @@ PyramidSavingService class >> currentMethodBuilderSelector: anObject [ currentMethodBuilderSelector := anObject ] +{ #category : #accessing } +PyramidSavingService class >> currentProjectWindowSize [ + ^ currentProjectWindowSize +] + +{ #category : #accessing } +PyramidSavingService class >> currentProjectWindowSize: aPoint [ + currentProjectWindowSize := aPoint +] + +{ #category : #accessing } +PyramidSavingService class >> currentSaveModel [ + ^ currentSaveModel +] + +{ #category : #accessing } +PyramidSavingService class >> currentSaveModel: aSaveModel [ + currentSaveModel := aSaveModel +] + { #category : #'as yet unclassified' } PyramidSavingService class >> saveMethodBuilderSettingOn: aBuilder [ @@ -91,6 +113,17 @@ PyramidSavingService class >> ston [ yourself ] +{ #category : #'as yet unclassified' } +PyramidSavingService >> buildMetaDataMethod [ + | methodName windowSize | + methodName := self saveModel savingMethodName , 'MetaData'. + windowSize := PyramidMainExtension currentGridWindowSize. + ^ '<1s>"Pyramid project metadata"%PyramidSavingService currentProjectWindowSize: <2p> @ <3p>' + expandMacrosWith: methodName + with: windowSize x + with: windowSize y +] + { #category : #testing } PyramidSavingService >> canSave [ "Verify: @@ -114,22 +147,32 @@ PyramidSavingService >> methodBuilder [ ^ self class currentMethodBuilder ] -{ #category : #testing } +{ #category : #'as yet unclassified' } PyramidSavingService >> save [ + | class | + self canSave ifFalse: [ self errorCannotSave ]. + class := self saveModel isClassSide + ifTrue: [ self savingClass classSide ] + ifFalse: [ self savingClass ]. + self methodBuilder classifier + ifNil: [ class compile: self savingMethod ] + ifNotNil: [ + class + compile: self savingMethod + classified: self methodBuilder classifier ]. + self saveMetaData +] - | class | - self canSave ifFalse: [ self errorCannotSave ]. +{ #category : #'as yet unclassified' } +PyramidSavingService >> saveMetaData [ + | class metaDataMethod | + self canSave ifFalse: [ self errorCannotSave ]. class := self saveModel isClassSide ifTrue: [ self savingClass classSide ] ifFalse: [ self savingClass ]. - - self methodBuilder classifier - ifNil: [ class compile: self savingMethod ] - ifNotNil: [ - class - compile: self savingMethod - classified: self methodBuilder classifier ] + metaDataMethod := self buildMetaDataMethod. + class compile: metaDataMethod classified: #'pyramid-metadata' ] { #category : #accessing } diff --git a/src/Pyramid-Tests/PyramidMetaDataTest.class.st b/src/Pyramid-Tests/PyramidMetaDataTest.class.st new file mode 100644 index 00000000..009a0f54 --- /dev/null +++ b/src/Pyramid-Tests/PyramidMetaDataTest.class.st @@ -0,0 +1,66 @@ +Class { + #name : #PyramidMetaDataTest, + #superclass : #TestCase, + #instVars : [ + 'testClass', + 'service' + ], + #category : #'Pyramid-Tests-cases-MetaData' +} + +{ #category : #running } +PyramidMetaDataTest >> setUp [ + testClass := self class classInstaller make: [ :aClassBuilder | + aClassBuilder + name: 'PyramidMetaDataTestClass'; + package: 'Pyramid-Tests-cases-plugin-save' ]. + service := PyramidSavingService new + saveModel: (PyramidSaveModel new + savingMethodName: 'testInterface'; + savingClassName: 'PyramidMetaDataTestClass'; + savingPackageName: 'Pyramid-Tests-cases-plugin-save'; + projectModel: PyramidProjectModel new; + yourself); + yourself. +] + +{ #category : #running } +PyramidMetaDataTest >> tearDown [ + testClass ifNotNil: [ testClass removeFromSystem ]. + PyramidSavingService currentProjectWindowSize: nil. +] + +{ #category : #tests } +PyramidMetaDataTest >> testBuildMetaDataMethod [ + | service saveModel result | + saveModel := PyramidSaveModel new + savingMethodName: 'testInterface'; + yourself. + service := PyramidSavingService new + saveModel: saveModel; + yourself. + result := service buildMetaDataMethod. + self assert: (result includesSubstring: 'testInterfaceMetaData'). + self assert: (result includesSubstring: 'pyMetaData'). + self assert: (result includesSubstring: 'PyramidSavingService currentProjectWindowSize:') +] + +{ #category : #tests } +PyramidMetaDataTest >> testMetaDataSetsWindowSize [ + + | expectedSize metaDataSelector | + "1. Fixe la taille courante dans Pyramid" + expectedSize := PyramidMainExtension currentGridWindowSize. + + "2. Génère et compile la méthode metaData via saveMetaData" + service saveMetaData. + + "3. Performe la méthode générée comme le ferait openOn:saveModel:" + metaDataSelector := (#testInterface , 'MetaData') asSymbol. + testClass perform: metaDataSelector. + + "4. Vérifie que la taille lue est bien celle qui était dans Pyramid" + self + assert: PyramidSavingService currentProjectWindowSize + equals: expectedSize +] diff --git a/src/Pyramid-Tests/PyramidOpenInWindowTest.class.st b/src/Pyramid-Tests/PyramidOpenInWindowTest.class.st new file mode 100644 index 00000000..c898ae47 --- /dev/null +++ b/src/Pyramid-Tests/PyramidOpenInWindowTest.class.st @@ -0,0 +1,105 @@ +Class { + #name : #PyramidOpenInWindowTest, + #superclass : #TestCase, + #instVars : [ + 'window', + 'windowSize', + 'projectModel', + 'openedSpaces' + ], + #category : #'Pyramid-Tests-cases-plugin-openInWindow' +} + +{ #category : #running } +PyramidOpenInWindowTest >> setUp [ + + super setUp. + projectModel := PyramidProjectModel new. + window := PyramidPluginOpenInWindow new. + window projectModel: projectModel. + window builder: PyramidSpaceBuilder new. + windowSize := PyramidMainExtension currentGridWindowSize. +] + +{ #category : #running } +PyramidOpenInWindowTest >> tearDown [ + + PyramidMainExtension currentGridWindowSize: windowSize. + super tearDown +] + +{ #category : #tests } +PyramidOpenInWindowTest >> testOpenSpaceInWindowAddsProjectElements [ + + | space | + + space := window openSpaceInWindow. + self assert: space root children size equals: 1. + self + assert: space root children first children size + equals: window projectModel firstLevelElements size +] + +{ #category : #tests } +PyramidOpenInWindowTest >> testOpenSpaceInWindowContainerMatchesParent [ + | space container | + space := window openSpaceInWindow. + container := space root children first. + self assert: container constraints horizontal resizer equals: BlLayoutResizer matchParent. + self assert: container constraints vertical resizer equals: BlLayoutResizer matchParent. +] + +{ #category : #tests } +PyramidOpenInWindowTest >> testOpenSpaceInWindowUsesBuilderTheme [ + + | initialSpace rootElement theme openedSpace | + theme := ToRawDarkTheme new. + rootElement := BlElement new. + rootElement localTheme: theme. + + initialSpace := BlSpace new. + initialSpace root: rootElement. + + window builder: (PyramidSpaceBuilder new space: initialSpace). + + openedSpace := window openSpaceInWindow. + + self assert: openedSpace root localTheme equals: theme +] + +{ #category : #tests } +PyramidOpenInWindowTest >> testOpenSpaceInWindowWithBuilderHavingNilSpace [ + | space | + window builder: (PyramidSpaceBuilder new space: nil). + space := window openSpaceInWindow. + self assert: space isNotNil +] + +{ #category : #tests } +PyramidOpenInWindowTest >> testOpenSpaceInWindowWithBuilderSpaceHavingNilRoot [ + + | initialSpace space | + initialSpace := BlSpace new. + window builder: (PyramidSpaceBuilder new space: initialSpace). + space := window openSpaceInWindow. + self assert: space isNotNil +] + +{ #category : #tests } +PyramidOpenInWindowTest >> testWindowDefaultExtent [ + + | space | + PyramidMainExtension defaultExtent. + space := window openSpaceInWindow. + self assert: space extent equals: 800 @ 600 +] + +{ #category : #tests } +PyramidOpenInWindowTest >> testWindowExtentUsesConfiguredGridSize [ + + | space | + PyramidMainExtension currentGridWindowSize: 2000 @ 1000. + space := window openSpaceInWindow. + + self assert: space extent equals: 2000 @ 1000 +] From cd65cc67bf56668cb126ac82f4af0da5ee754013 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 7 Jul 2026 15:30:31 +0200 Subject: [PATCH 32/58] Add properties to metadata method --- .../PyramidMainExtension.class.st | 175 ++++++++++++------ .../PyramidPluginOpenInWindow.class.st | 75 +++++--- src/Pyramid-Bloc/PyramidSavePlugin.class.st | 80 +++++--- .../PyramidSavingService.class.st | 49 +++-- .../PyramidVisualPystonForCly.class.st | 35 +++- src/Pyramid-IDE/PyramidWorld.class.st | 3 +- .../AnObsoletePyramidMetaDataTest.class.st | 9 + .../PyramidOpenInWindowTest.class.st | 3 +- 8 files changed, 285 insertions(+), 144 deletions(-) create mode 100644 src/Pyramid-Tests/AnObsoletePyramidMetaDataTest.class.st diff --git a/src/Pyramid-Bloc/PyramidMainExtension.class.st b/src/Pyramid-Bloc/PyramidMainExtension.class.st index e28d815f..ac62f49c 100644 --- a/src/Pyramid-Bloc/PyramidMainExtension.class.st +++ b/src/Pyramid-Bloc/PyramidMainExtension.class.st @@ -18,27 +18,68 @@ Class { 'selectionWidgetExtension' ], #classInstVars : [ - 'currentGridWindowSize' + 'currentGridWindowSize', + 'currentGridVisibility', + 'currentGridSpacing', + 'currentGridColor' ], #category : #'Pyramid-Bloc-plugin-space-extensions' } +{ #category : #accessing } +PyramidMainExtension class >> currentGridColor [ + +^ currentGridColor +] + +{ #category : #accessing } +PyramidMainExtension class >> currentGridColor: aColor [ + +currentGridColor := aColor +] + +{ #category : #accessing } +PyramidMainExtension class >> currentGridSpacing [ + +^ currentGridSpacing +] + +{ #category : #accessing } +PyramidMainExtension class >> currentGridSpacing: anInteger [ + + currentGridSpacing := anInteger +] + +{ #category : #accessing } +PyramidMainExtension class >> currentGridVisibility [ + ^ currentGridVisibility + + +] + +{ #category : #accessing } +PyramidMainExtension class >> currentGridVisibility: aBoolean [ + currentGridVisibility := aBoolean +] + { #category : #accessing } PyramidMainExtension class >> currentGridWindowSize [ + ^ currentGridWindowSize + - ^ currentGridWindowSize ] { #category : #accessing } PyramidMainExtension class >> currentGridWindowSize: aPoint [ - - currentGridWindowSize := aPoint. - + currentGridWindowSize := aPoint ] { #category : #'class initialization' } PyramidMainExtension class >> initialize [ - currentGridWindowSize := 800 @ 600 + + currentGridWindowSize := nil. + currentGridVisibility := nil. + currentGridSpacing:= nil ] { #category : #accessing } @@ -61,23 +102,23 @@ PyramidMainExtension >> containerElement [ { #category : #'as yet unclassified' } PyramidMainExtension >> createGrid [ - "Remove the current all the line of the grid" + self gridElement removeChildWithId: #gridHorizontal. self gridElement removeChildWithId: #gridVertical. self gridElement removeChildWithId: #pixelGrid. "Create the grid if gridVisibility is true" - gridVisibility ifTrue: [ self grid: self gridElement - cellSpacing: self gridSpacing - color: self gridColor - width: (self gridWindowSize x) - height: (self gridWindowSize y). - self selectionWidgetExtension movingLap: self gridSpacing - ] - ifFalse: [ self selectionWidgetExtension movingLap: 1 ]. - - + gridVisibility + ifTrue: [ + self + grid: self gridElement + cellSpacing: self gridSpacing + color: self gridColor + width: self gridWindowSize x + height: self gridWindowSize y. + self selectionWidgetExtension movingLap: self gridSpacing ] + ifFalse: [ self selectionWidgetExtension movingLap: 1 ] ] { #category : #accessing } @@ -101,22 +142,27 @@ PyramidMainExtension >> defaultGridColor [ { #category : #'as yet unclassified' } PyramidMainExtension >> defaultGridSpacing [ "Default spacing value of the grid" + ^ 10 ] { #category : #'as yet unclassified' } PyramidMainExtension >> defaultGridVisibility [ - "Default visibility value of the grid" - ^ false + "Default visibility value of the grid" + ^ (PyramidSavingService currentProjectMetaData + ifNotNil: [ :md | md at: #gridVisibility ifAbsent: [ nil ] ]) + ifNil: [ false ] ] { #category : #accessing } PyramidMainExtension >> editor: aPyramidEditor [ aPyramidEditor window at: #topRight addItem: [ :buttonBuilder | - buttonBuilder makeButtonWithIcon: self workplacePropertiesButton order: 10 ]. - + buttonBuilder + makeButtonWithIcon: self workplacePropertiesButton + order: 10 ]. self getSelectionWidgetExtension: aPyramidEditor. + ] { #category : #geometry } @@ -125,7 +171,7 @@ PyramidMainExtension >> extent: aPoint [ self elementAtWidgets extent: aPoint. self sizeElement extent: aPoint. self gridWindowSize: aPoint. - self class currentGridWindowSize: aPoint.workplacePropertiesView workplaceSizeValue: aPoint. + self class currentGridWindowSize: aPoint. self createGrid ] @@ -207,6 +253,12 @@ PyramidMainExtension >> gridColor [ ^ gridColor ] +{ #category : #accessing } +PyramidMainExtension >> gridColor: aColor [ + +gridColor := aColor +] + { #category : #'as yet unclassified' } PyramidMainExtension >> gridDefaultValueInitializer [ @@ -228,9 +280,22 @@ PyramidMainExtension >> gridSpacing [ ^ gridSpacing ] +{ #category : #accessing } +PyramidMainExtension >> gridSpacing: anInteger [ + + gridSpacing := anInteger. +] + { #category : #accessing } PyramidMainExtension >> gridVisibility [ - ^ gridVisibility + + ^ gridVisibility +] + +{ #category : #accessing } +PyramidMainExtension >> gridVisibility: aBoolean [ + + gridVisibility := aBoolean ] { #category : #accessing } @@ -265,24 +330,34 @@ PyramidMainExtension >> initialize [ whenWorkplaceValuesChangedDo: [ :point | self extent: point ]; whenVisibilityChangedDo: [ - self switchGridvisibility. - self createGrid ]; + gridVisibility := workplacePropertiesView + visibilityButton + state. + self class currentGridVisibility: + gridVisibility. + self createGrid ]; spacingTextValue: self defaultGridSpacing; whenSpacingTextChangedDo: [ :value | - (self checkZeroOrSubZeroGridSpacingValue: value) - ifTrue: [ - self defaultGridSpacing <= 0 ifTrue: [ - gridSpacing := 1. - ^ self ]. - gridSpacing := self defaultGridSpacing ] - ifFalse: [ gridSpacing := value ]. - self createGrid ]; + (self + checkZeroOrSubZeroGridSpacingValue: + value) + ifTrue: [ + self defaultGridSpacing <= 0 + ifTrue: [ + gridSpacing := 1. + ^ self ]. + gridSpacing := self + defaultGridSpacing ] + ifFalse: [ gridSpacing := value ]. + self class currentGridSpacing: + gridSpacing. + self createGrid ]; gridColorValue: self defaultGridColor; whenColorValuesChangedDo: [ :color | - gridColor := color. - self createGrid ]; + gridColor := color. self class currentGridColor: color. + self createGrid ]; yourself. - + self defaultGridSpacing <= 0 ifTrue: [ gridSpacing := 1 ]. workplacePropertiesView spacingText value: gridSpacing. @@ -293,8 +368,8 @@ PyramidMainExtension >> initialize [ help: 'Edit the properties of the workplace'; action: [ - self workplacePropertiesPopover popup. - self refreshPopupWorkplaceProperties ]; + self workplacePropertiesPopover popup. + self refreshPopupWorkplaceProperties ]; yourself. "Creation of the pop-up" @@ -308,8 +383,8 @@ PyramidMainExtension >> initialize [ containerElement := BlElement new id: #MainExtension_containerElement; constraintsDo: [ :c | - c vertical matchParent. - c horizontal matchParent ]; + c vertical matchParent. + c horizontal matchParent ]; clipChildren: false; zIndex: 0; yourself. @@ -320,8 +395,8 @@ PyramidMainExtension >> initialize [ border: self defaultBorder; outskirts: BlOutskirts outside; constraintsDo: [ :c | - c vertical matchParent. - c horizontal matchParent ]; + c vertical matchParent. + c horizontal matchParent ]; clipChildren: false; zIndex: 1; preventMeAndChildrenMouseEvents; @@ -331,10 +406,10 @@ PyramidMainExtension >> initialize [ gridElement := BlElement new id: #MainExtension_gridElement; constraintsDo: [ :c | - c vertical matchParent. - c horizontal matchParent ]; + c vertical matchParent. + c horizontal matchParent ]; zIndex: 2. - + borderElement addChild: gridElement. sizeElement := BlElement new @@ -342,7 +417,7 @@ PyramidMainExtension >> initialize [ extent: self defaultExtent; clipChildren: false; addChildren: { - containerElement . + containerElement. borderElement } yourself ] @@ -405,14 +480,6 @@ PyramidMainExtension >> sizeElement [ ^ sizeElement ] -{ #category : #'as yet unclassified' } -PyramidMainExtension >> switchGridvisibility [ - "Switch the visibility from true to false or false to true" - gridVisibility := self gridVisibility not. - - ^ self gridVisibility -] - { #category : #accessing } PyramidMainExtension >> workplacePropertiesButton [ diff --git a/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st b/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st index f92f899b..2329ebe9 100644 --- a/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st +++ b/src/Pyramid-Bloc/PyramidPluginOpenInWindow.class.st @@ -11,9 +11,24 @@ Class { 'savePlugin', 'space' ], + #classInstVars : [ + 'currentTheme' + ], #category : #'Pyramid-Bloc-plugin-openinwindow' } +{ #category : #accessing } +PyramidPluginOpenInWindow class >> currentTheme [ + + ^ currentTheme +] + +{ #category : #accessing } +PyramidPluginOpenInWindow class >> currentTheme: aTheme [ + + currentTheme := aTheme +] + { #category : #adding } PyramidPluginOpenInWindow >> addPanelsOn: aPyramidSimpleWindow [ @@ -75,34 +90,38 @@ PyramidPluginOpenInWindow >> openInWindowIcon [ { #category : #private } PyramidPluginOpenInWindow >> openSpaceInWindow [ - | elements container stash currentTheme windowSize | - elements := projectModel firstLevelElements asOrderedCollection. - currentTheme := nil. - builder ifNotNil: [ :aBuilder | - aBuilder space ifNotNil: [ :aSpace | - aSpace root ifNotNil: [ :aRoot | currentTheme := aRoot localTheme ] ] ]. - -windowSize := [ - | mainExtension | - mainExtension := builder extensions - detect: [ :e | e isKindOf: PyramidMainExtension ] - ifNone: [ nil ]. - mainExtension sizeElement extent ] - on: Error - do: [ PyramidMainExtension currentGridWindowSize ]. - - container := BlElement new - constraintsDo: [ :c | - c horizontal matchParent. - c vertical matchParent ]; - yourself. - elements do: [ :each | - stash := BlSerializer serialize: each with: BlStashSerializer. - container addChild: stash materializeAsBlElement ]. - space := container openInNewSpace. - space extent: windowSize. - currentTheme ifNotNil: [ space toTheme: currentTheme ]. - ^ space + + | elements container stash currentTheme windowSize | + elements := projectModel firstLevelElements asOrderedCollection. + currentTheme := nil. + builder ifNotNil: [ :aBuilder | + aBuilder space ifNotNil: [ :aSpace | + aSpace root ifNotNil: [ :aRoot | currentTheme := aRoot localTheme ] ] ]. + + windowSize := [ + | mainExtension | + mainExtension := builder extensions + detect: [ :e | + e isKindOf: PyramidMainExtension ] + ifNone: [ nil ]. + mainExtension + ifNotNil: [ mainExtension sizeElement extent ] + ifNil: [ 800 @ 600 ] ] + on: Error + do: [ 800 @ 600 ]. + + container := BlElement new + constraintsDo: [ :c | + c horizontal matchParent. + c vertical matchParent ]; + yourself. + elements do: [ :each | + stash := BlSerializer serialize: each with: BlStashSerializer. + container addChild: stash materializeAsBlElement ]. + space := container openInNewSpace. + space extent: windowSize. + currentTheme ifNotNil: [ space toTheme: currentTheme ]. + ^ space ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidSavePlugin.class.st b/src/Pyramid-Bloc/PyramidSavePlugin.class.st index d61c10a5..d7c1600d 100644 --- a/src/Pyramid-Bloc/PyramidSavePlugin.class.st +++ b/src/Pyramid-Bloc/PyramidSavePlugin.class.st @@ -17,36 +17,56 @@ Class { { #category : #'instance creation' } PyramidSavePlugin class >> openOn: aCollectionOfBlElement saveModel: aSaveModel [ - | editor savePlugin windowSize mainExtension spacePlugin | - editor := PyramidEditor buildEditor. - savePlugin := editor plugins select: [ :each | each class = self ]. - savePlugin size = 1 ifFalse: [ - Error signal: - 'Wrong installation of SavePlugin. Should only be one instance.' ]. - savePlugin := savePlugin asArray first. - editor projectModel firstLevelElements addAll: aCollectionOfBlElement. - - windowSize := [ - | metaDataSelector savingClass | - metaDataSelector := (aSaveModel savingMethodName , 'MetaData') asSymbol. - savingClass := self class environment classNamed: aSaveModel savingClassName. - savingClass perform: metaDataSelector. - PyramidSavingService currentProjectWindowSize ] - on: Error - do: [ nil ]. - - windowSize ifNotNil: [ - spacePlugin := editor plugins - detect: [ :p | p isKindOf: PyramidSpacePlugin ] - ifNone: [ nil ]. - spacePlugin ifNotNil: [ - mainExtension := spacePlugin builder extensions - detect: [ :e | e isKindOf: PyramidMainExtension ] - ifNone: [ nil ]. - mainExtension ifNotNil: [ mainExtension extent: windowSize ] ] ]. - - savePlugin openOn: aSaveModel. - editor open + + | 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: [ + Error signal: + 'Wrong installation of SavePlugin. Should only be one instance.' ]. + savePlugin := savePlugin asArray first. + editor projectModel firstLevelElements addAll: aCollectionOfBlElement. + + [ + | metaDataSelector savingClass | + metaDataSelector := (aSaveModel savingMethodName , 'MetaData') + asSymbol. + savingClass := self class environment classNamed: + aSaveModel savingClassName. + savingClass perform: metaDataSelector ] + on: Error + do: [ nil ]. + + metaData := PyramidSavingService currentProjectMetaData. + savePlugin openOn: aSaveModel. + editor open. + + metaData ifNotNil: [ + spacePlugin := editor plugins + detect: [ :p | p isKindOf: PyramidSpacePlugin ] + ifNone: [ nil ]. + spacePlugin ifNotNil: [ + mainExtension := spacePlugin builder extensions + detect: [ :e | + e isKindOf: PyramidMainExtension ] + ifNone: [ nil ]. + mainExtension ifNotNil: [ + (metaData at: #windowSize ifAbsent: [ nil ]) ifNotNil: [ :size | + mainExtension extent: size. + mainExtension workplacePropertiesView workplaceSizeValue: size. ]. + (metaData at: #gridVisibility ifAbsent: [ nil ]) ifNotNil: [ + :visibility | mainExtension gridVisibility: visibility ]. + (metaData at: #gridSpacing ifAbsent: [ nil ]) ifNotNil: [ + :spacing | + mainExtension gridSpacing: spacing. + mainExtension workplacePropertiesView spacingText value: + spacing ]. + (metaData at: #gridColor ifAbsent: [ nil ]) ifNotNil: [ :color | + mainExtension gridColor: color. + mainExtension workplacePropertiesView gridColorValue: color. + mainExtension createGrid ] ] ] ] ] { #category : #adding } diff --git a/src/Pyramid-Bloc/PyramidSavingService.class.st b/src/Pyramid-Bloc/PyramidSavingService.class.st index e5a1a54e..92aa230a 100644 --- a/src/Pyramid-Bloc/PyramidSavingService.class.st +++ b/src/Pyramid-Bloc/PyramidSavingService.class.st @@ -11,7 +11,7 @@ Class { 'ston', 'currentMethodBuilderSelector', 'currentSaveModel', - 'currentProjectWindowSize' + 'currentProjectMetaData' ], #category : #'Pyramid-Bloc-plugin-save' } @@ -44,13 +44,15 @@ PyramidSavingService class >> currentMethodBuilderSelector: anObject [ ] { #category : #accessing } -PyramidSavingService class >> currentProjectWindowSize [ - ^ currentProjectWindowSize +PyramidSavingService class >> currentProjectMetaData [ + +^ currentProjectMetaData ] { #category : #accessing } -PyramidSavingService class >> currentProjectWindowSize: aPoint [ - currentProjectWindowSize := aPoint +PyramidSavingService class >> currentProjectMetaData: aDictionary [ + +currentProjectMetaData := aDictionary ] { #category : #accessing } @@ -115,13 +117,21 @@ PyramidSavingService class >> ston [ { #category : #'as yet unclassified' } PyramidSavingService >> buildMetaDataMethod [ - | methodName windowSize | - methodName := self saveModel savingMethodName , 'MetaData'. - windowSize := PyramidMainExtension currentGridWindowSize. - ^ '<1s>"Pyramid project metadata"%PyramidSavingService currentProjectWindowSize: <2p> @ <3p>' - expandMacrosWith: methodName - with: windowSize x - with: windowSize y + + | methodName windowSize gridVisibility gridSpacing gridColor | + methodName := self saveModel savingMethodName , 'MetaData'. + windowSize := PyramidMainExtension currentGridWindowSize. + gridVisibility := PyramidMainExtension currentGridVisibility. + gridSpacing := PyramidMainExtension currentGridSpacing. + gridColor := PyramidMainExtension currentGridColor. + ^ '<1s>"Pyramid project metadata"%PyramidSavingService currentProjectMetaData: (Dictionary newat: #windowSize put: <2p> @ <3p>;at: #gridVisibility put: <4p>;at: #gridSpacing put: <5p>;at: #gridColor put: <6p>;yourself)' + expandMacrosWithArguments: { + methodName. + windowSize x. + windowSize y. + gridVisibility. + gridSpacing. + gridColor } ] { #category : #testing } @@ -165,14 +175,13 @@ PyramidSavingService >> save [ { #category : #'as yet unclassified' } PyramidSavingService >> saveMetaData [ - - | class metaDataMethod | - self canSave ifFalse: [ self errorCannotSave ]. - class := self saveModel isClassSide - ifTrue: [ self savingClass classSide ] - ifFalse: [ self savingClass ]. - metaDataMethod := self buildMetaDataMethod. - class compile: metaDataMethod classified: #'pyramid-metadata' + | class metaDataMethod | + self canSave ifFalse: [ self errorCannotSave ]. + class := self saveModel isClassSide + ifTrue: [ self savingClass classSide ] + ifFalse: [ self savingClass ]. + metaDataMethod := self buildMetaDataMethod. + class compile: metaDataMethod classified: #'pyramid-metadata' ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidVisualPystonForCly.class.st b/src/Pyramid-Bloc/PyramidVisualPystonForCly.class.st index bd92ec7f..9549ef2d 100644 --- a/src/Pyramid-Bloc/PyramidVisualPystonForCly.class.st +++ b/src/Pyramid-Bloc/PyramidVisualPystonForCly.class.st @@ -207,21 +207,38 @@ PyramidVisualPystonForCly >> openEditor [ { #category : #accessing } PyramidVisualPystonForCly >> openInNewSpace [ - | class elements space | + | class elements space theme windowSize | class := method classBinding value. elements := class isMeta ifTrue: [ - (method classBinding value instanceSide perform: - method selector) materializeAsBlElement ] + (method classBinding value instanceSide perform: + method selector) materializeAsBlElement ] ifFalse: [ - (method classBinding value new perform: method selector) - materializeAsBlElement ]. - + (method classBinding value new perform: + method selector) materializeAsBlElement ]. elements isCollection ifFalse: [ elements := { elements } ]. - elements ifEmpty: [ ^ self ]. - space := elements first openInNewSpace. - space root addChildren: elements allButFirst + + windowSize := [ + | metaDataSelector | + metaDataSelector := (method selector , 'MetaData') + asSymbol. + method classBinding value instanceSide perform: + metaDataSelector. + PyramidSavingService currentProjectMetaData + at: #windowSize + ifAbsent: [ nil ] ] + on: Error + do: [ nil ]. + windowSize ifNil: [ windowSize := 800 @ 600 ]. + + space := BlSpace new. + space extent: windowSize. + theme := PyramidPluginOpenInWindow currentTheme. + theme ifNotNil: [ space toTheme: theme ]. + space root addChildren: elements. + space show. + ^ space ] { #category : #initialization } diff --git a/src/Pyramid-IDE/PyramidWorld.class.st b/src/Pyramid-IDE/PyramidWorld.class.st index 6866c0ce..c0dbb7ea 100644 --- a/src/Pyramid-IDE/PyramidWorld.class.st +++ b/src/Pyramid-IDE/PyramidWorld.class.st @@ -1101,8 +1101,9 @@ PyramidWorld class >> startBrowseSources [ { #category : #actions } PyramidWorld class >> startNewDesign [ -