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 1/8] 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 009fe3d1d27b80d0e73d9eecb7190d69c6a874f4 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Mon, 8 Jun 2026 10:07:36 +0200 Subject: [PATCH 2/8] 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 4f2b11028737e9baa49385f9a4c4b3e1c704e3a2 Mon Sep 17 00:00:00 2001 From: Mathieu Magueres Date: Tue, 30 Jun 2026 11:14:55 +0200 Subject: [PATCH 3/8] 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 4/8] 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 [ -