From f752f471619ec2e72a8f30ee0f14645465727a35 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Mon, 29 Jul 2024 18:25:57 +0200 Subject: [PATCH 01/11] Add new nav and library --- src/Pyramid-Bloc/BlElement.extension.st | 8 + .../PyramidLibraryCategory.class.st | 52 +++++ .../PyramidLibraryDefault.class.st | 88 +++++++++ .../PyramidLibraryElement.class.st | 58 ++++++ .../PyramidLibraryPresenter.class.st | 133 +++++++++++++ .../PyramidNavigationDefaultColumns.class.st | 100 ++++++++++ .../PyramidNavigationModel.class.st | 30 +++ .../PyramidNavigationPanelPresenter.class.st | 5 + .../PyramidNavigationPlugin.class.st | 40 ++++ .../PyramidNavigationPresenter.class.st | 64 ++++++ .../PyramidNavigationToolsPresenter.class.st | 105 ++++++++++ .../PyramidNavigationTreePresenter.class.st | 186 ++++++++++++++++++ .../PyramidTreeBaseColumnsBuilder.class.st | 5 +- .../TPyramidSelectionPanelExtension.trait.st | 4 + .../PyramidToploExamples.class.st | 10 +- src/Pyramid-Toplo-Examples/package.st | 2 +- 16 files changed, 882 insertions(+), 8 deletions(-) create mode 100644 src/Pyramid-Bloc/PyramidLibraryCategory.class.st create mode 100644 src/Pyramid-Bloc/PyramidLibraryDefault.class.st create mode 100644 src/Pyramid-Bloc/PyramidLibraryElement.class.st create mode 100644 src/Pyramid-Bloc/PyramidLibraryPresenter.class.st create mode 100644 src/Pyramid-Bloc/PyramidNavigationDefaultColumns.class.st create mode 100644 src/Pyramid-Bloc/PyramidNavigationModel.class.st create mode 100644 src/Pyramid-Bloc/PyramidNavigationPanelPresenter.class.st create mode 100644 src/Pyramid-Bloc/PyramidNavigationPlugin.class.st create mode 100644 src/Pyramid-Bloc/PyramidNavigationPresenter.class.st create mode 100644 src/Pyramid-Bloc/PyramidNavigationToolsPresenter.class.st create mode 100644 src/Pyramid-Bloc/PyramidNavigationTreePresenter.class.st create mode 100644 src/Pyramid-Bloc/TPyramidSelectionPanelExtension.trait.st diff --git a/src/Pyramid-Bloc/BlElement.extension.st b/src/Pyramid-Bloc/BlElement.extension.st index 90e1b6dc..c32abca1 100644 --- a/src/Pyramid-Bloc/BlElement.extension.st +++ b/src/Pyramid-Bloc/BlElement.extension.st @@ -24,3 +24,11 @@ BlElement >> editWithPyramid [ editor window open. ^ editor ] + +{ #category : #'*Pyramid-Bloc' } +BlElement >> parentsShouldSerializeChildren [ + + self parent ifNil: [ ^ true ]. + self parent shouldSerializedChildren ifFalse: [ ^ false ]. + ^ self parent parentsShouldSerializeChildren +] diff --git a/src/Pyramid-Bloc/PyramidLibraryCategory.class.st b/src/Pyramid-Bloc/PyramidLibraryCategory.class.st new file mode 100644 index 00000000..fdb93b0a --- /dev/null +++ b/src/Pyramid-Bloc/PyramidLibraryCategory.class.st @@ -0,0 +1,52 @@ +Class { + #name : #PyramidLibraryCategory, + #superclass : #Object, + #instVars : [ + 'elements', + 'name', + 'icon' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #accessing } +PyramidLibraryCategory >> elements [ + + ^ elements +] + +{ #category : #accessing } +PyramidLibraryCategory >> elements: anObject [ + + elements := anObject +] + +{ #category : #accessing } +PyramidLibraryCategory >> icon [ + + ^ icon +] + +{ #category : #accessing } +PyramidLibraryCategory >> icon: anObject [ + + icon := anObject +] + +{ #category : #initialization } +PyramidLibraryCategory >> initialize [ + + elements := { } +] + +{ #category : #accessing } +PyramidLibraryCategory >> name [ + + ^ name +] + +{ #category : #accessing } +PyramidLibraryCategory >> name: anObject [ + + name := anObject +] diff --git a/src/Pyramid-Bloc/PyramidLibraryDefault.class.st b/src/Pyramid-Bloc/PyramidLibraryDefault.class.st new file mode 100644 index 00000000..61d41d26 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidLibraryDefault.class.st @@ -0,0 +1,88 @@ +Class { + #name : #PyramidLibraryDefault, + #superclass : #Object, + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #accessing } +PyramidLibraryDefault >> defaultCategory [ + + + ^ {PyramidLibraryCategory new + icon: (Smalltalk ui icons iconNamed: #box); + name: 'Default'; + elements: { + (PyramidLibraryElement new + name: 'Simple element'; + icon: (Smalltalk ui icons iconNamed: #blank); + block: [ BlElement new background: Color random ]; + yourself). + (PyramidLibraryElement new + name: 'Text element'; + icon: (Smalltalk ui icons iconNamed: #smallFonts); + block: [ 'Change me' asRopedText asElement ]; + yourself) }; + yourself} +] + +{ #category : #accessing } +PyramidLibraryDefault >> pystashCategory [ + + + | pragmas methods packages categories | + pragmas := Pragma allNamed: #pyStash. + methods := (pragmas collect: #method) asSet. + packages := (methods collect: #package) asSet. + + categories := OrderedCollection new. + + ^ packages collect: [ :package | + | elements | + elements := methods + select: [ :method | method package = package ] + thenCollect: [ :method | + PyramidLibraryElement new + icon: (Smalltalk ui icons iconNamed: + method methodClass soleInstance systemIconName); + name: method selector; + block: [ + (method methodClass soleInstance perform: + method selector) materializeAsBlElement ]; + yourself ]. + PyramidLibraryCategory new + name: package name; + icon: (Smalltalk ui icons iconNamed: #smallSave); + elements: elements asArray; + yourself ] +] + +{ #category : #accessing } +PyramidLibraryDefault >> pystonCategory [ + + + | pragmas methods packages categories | + pragmas := Pragma allNamed: #pySTON. + methods := (pragmas collect: #method) asSet. + packages := (methods collect: #package) asSet. + + categories := OrderedCollection new. + + ^ packages collect: [ :package | + | elements | + elements := methods + select: [ :method | method package = package ] + thenCollect: [ :method | + PyramidLibraryElement new + icon: (Smalltalk ui icons iconNamed: + method methodClass soleInstance systemIconName); + name: method selector; + block: [ + (method methodClass soleInstance perform: + method selector) materializeAsBlElement ]; + yourself ]. + PyramidLibraryCategory new + name: package name; + icon: (Smalltalk ui icons iconNamed: #smallSave); + elements: elements; + yourself ] +] diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st new file mode 100644 index 00000000..f4012a70 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidLibraryElement.class.st @@ -0,0 +1,58 @@ +Class { + #name : #PyramidLibraryElement, + #superclass : #Object, + #instVars : [ + 'name', + 'icon', + 'block' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #converting } +PyramidLibraryElement >> asArray [ + + ^ self block value +] + +{ #category : #converting } +PyramidLibraryElement >> asForm [ + + ^ BlElement new clipChildren: false; size: 800 @ 600; addChildren: (self asArray); exportAsForm +] + +{ #category : #accessing } +PyramidLibraryElement >> block [ + + ^ block +] + +{ #category : #accessing } +PyramidLibraryElement >> block: anObject [ + + block := anObject +] + +{ #category : #accessing } +PyramidLibraryElement >> icon [ + + ^ icon +] + +{ #category : #accessing } +PyramidLibraryElement >> icon: anObject [ + + icon := anObject +] + +{ #category : #accessing } +PyramidLibraryElement >> name [ + + ^ name +] + +{ #category : #accessing } +PyramidLibraryElement >> name: anObject [ + + name := anObject +] diff --git a/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st b/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st new file mode 100644 index 00000000..995cebb1 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st @@ -0,0 +1,133 @@ +Class { + #name : #PyramidLibraryPresenter, + #superclass : #SpPresenter, + #instVars : [ + 'categoryPresenter', + 'elementPresenter', + 'imagePresenter', + 'addButtonPresenter' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #accessing } +PyramidLibraryPresenter >> addButtonPresenter [ + + ^ addButtonPresenter +] + +{ #category : #adding } +PyramidLibraryPresenter >> addCategories: aCollection [ + + self categoryPresenter items = aCollection ifTrue: [ ^ self ]. + self categoryPresenter + items: aCollection; + selectIndex: 1 +] + +{ #category : #accessing } +PyramidLibraryPresenter >> categoryPresenter [ + + ^ categoryPresenter +] + +{ #category : #initialization } +PyramidLibraryPresenter >> connectPresenters [ + + categoryPresenter + transmitTo: elementPresenter + transform: [ :category | + category ifNil: [ #( ) ] ifNotNil: [ category elements ] ] + postTransmission: [ :destination | destination selectIndex: 1 ] +] + +{ #category : #layout } +PyramidLibraryPresenter >> defaultLayout [ + + | panedSelection imageAndButton | + panedSelection := SpPanedLayout newHorizontal + add: self categoryPresenter; + add: self elementPresenter; + yourself. + imageAndButton := SpBoxLayout newVertical + add: self imagePresenter expand: true; + add: self addButtonPresenter expand: false; + yourself. + ^ SpPanedLayout newHorizontal + positionOfSlider: 2/3; + add: panedSelection; + add: imageAndButton; + yourself +] + +{ #category : #accessing } +PyramidLibraryPresenter >> elementPresenter [ + + ^ elementPresenter +] + +{ #category : #accessing } +PyramidLibraryPresenter >> imagePresenter [ + + ^ imagePresenter +] + +{ #category : #initialization } +PyramidLibraryPresenter >> initializeCategories [ + + | pragmas sorted | + pragmas := Pragma allNamed: #pyramidLibraryCategory:. + sorted := pragmas sorted: [ :a :b | + a arguments first < b arguments first ]. + self addCategories: (sorted flatCollect: [ :each | + each method + receiver: self + withArguments: #( ) + executeMethod: each method ]) +] + +{ #category : #initialization } +PyramidLibraryPresenter >> initializePresenters [ + + categoryPresenter := SpTablePresenter new + hideColumnHeaders; + addColumn: ((SpImageTableColumn + title: 'Category-Icon' + evaluated: [ :each | each icon ]) width: 20); + addColumn: (SpStringTableColumn + title: 'Category-Name' + evaluated: [ :each | each name ]); + yourself. + elementPresenter := SpTablePresenter new + hideColumnHeaders; + addColumn: ((SpImageTableColumn + title: 'Element-Icon' + evaluated: [ :each | each icon ]) width: 20); + addColumn: (SpStringTableColumn + title: 'Element-Name' + evaluated: [ :each | each name ]); + whenSelectedItemChangedDo: [ :e | + self addButtonPresenter enabled: e isNotNil. + self addButtonPresenter action: [ + self addNewElement: e ]. + e + ifNil: [ + self imagePresenter image: + (Form extent: 1 asPoint) ] + ifNotNil: [ + self imagePresenter image: e asForm ] ]. + imagePresenter := SpImagePresenter new + autoScale: true; + yourself. + addButtonPresenter := SpButtonPresenter new + label: 'Add new element'; + icon: (Smalltalk ui icons iconNamed: #add); + enabled: false; + yourself. + self focusOrder + add: categoryPresenter; + add: elementPresenter; + add: addButtonPresenter. + + self initializeCategories +] diff --git a/src/Pyramid-Bloc/PyramidNavigationDefaultColumns.class.st b/src/Pyramid-Bloc/PyramidNavigationDefaultColumns.class.st new file mode 100644 index 00000000..664173d1 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidNavigationDefaultColumns.class.st @@ -0,0 +1,100 @@ +Class { + #name : #PyramidNavigationDefaultColumns, + #superclass : #Object, + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #column } +PyramidNavigationDefaultColumns >> columnElevation [ + + + ^ SpStringTableColumn new + title: 'z'; + evaluated: [ :aBlElement | + aBlElement elevation elevation = 0 + ifTrue: [ '' ] + ifFalse: [ aBlElement elevation elevation printString ] ]; + width: 16; + yourself +] + +{ #category : #column } +PyramidNavigationDefaultColumns >> columnHash [ + + + ^ SpStringTableColumn new + title: 'Hash'; + evaluated: [ :aBlElement | aBlElement identityHash printString ]; + displayColor: [ :aBlElement | + aBlElement parentsShouldSerializeChildren + ifTrue: [ self theme disabledTextColor ] + ifFalse: [ self theme dangerTextColor ] ]; + width: 60; + yourself. +] + +{ #category : #column } +PyramidNavigationDefaultColumns >> columnIconAndName [ + + + ^ SpCompositeTableColumn new + title: 'Elements'; + addColumn: + (SpImageTableColumn evaluated: [ :aBlElement | aBlElement asIcon ]); + addColumn: (SpStringTableColumn new + title: 'Identifier'; + displayColor: [ :aBlElement | + aBlElement parentsShouldSerializeChildren + ifTrue: [ self theme textColor ] + ifFalse: [ self theme dangerTextColor ] ]; + evaluated: [ :aBlElement | + aBlElement elementId isNoId + ifTrue: [ '@\no name\' ] + ifFalse: [ aBlElement id asSymbol ] ]; + yourself); + addColumn: (SpStringTableColumn new + title: 'Class'; + evaluated: [ :aBlElement | aBlElement class name ]; + displayColor: [ :aBlElement | self theme disabledTextColor ]; + displayItalic: [ :aBlElement | true ]; + yourself); + yourself +] + +{ #category : #column } +PyramidNavigationDefaultColumns >> columnVisibility [ + + + ^ SpCompositeTableColumn new + title: 'Visibility'; + width: 80; + addColumn: (SpImageTableColumn evaluated: [ :aBlElement | + aBlElement + allParentsDetect: [ :parent | parent isVisible not ] + ifFound: [ :parent | + Smalltalk ui icons iconNamed: #uncommentedClass ] + ifNone: [ Smalltalk ui icons iconNamed: #blank16 ] ]); + addColumn: (SpImageTableColumn evaluated: [ :aBlElement | + aBlElement visibility asIcon ]); + addColumn: (SpLinkTableColumn new + title: 'Visible'; + url: [ :aBlElement | '' ]; + action: [ :aBlElement | + self flag: #explanations. + "self editor is present on the class that will recover the pragma . + This class should be: PyramidNavigationTreePresenter." + self editor ifNotNil: [ :e | + e propertiesManager commandExecutor + use: PyramidVisibilityCommand new + on: { aBlElement } + with: aBlElement visibility nextVisibilityForTree ] ]; + evaluated: [ :aBlElement | aBlElement visibility asString ]; + yourself); + yourself +] + +{ #category : #accessing } +PyramidNavigationDefaultColumns >> editor [ + + ^ nil +] diff --git a/src/Pyramid-Bloc/PyramidNavigationModel.class.st b/src/Pyramid-Bloc/PyramidNavigationModel.class.st new file mode 100644 index 00000000..94e971d3 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidNavigationModel.class.st @@ -0,0 +1,30 @@ +Class { + #name : #PyramidNavigationModel, + #superclass : #Object, + #traits : 'TObservable', + #classTraits : 'TObservable classTrait', + #instVars : [ + '#displayAllChildren => ObservableSlot' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #accessing } +PyramidNavigationModel >> displayAllChildren [ + + ^ displayAllChildren +] + +{ #category : #accessing } +PyramidNavigationModel >> displayAllChildren: anObject [ + + displayAllChildren := anObject +] + +{ #category : #initialization } +PyramidNavigationModel >> initialize [ + + super initialize. + self class initializeSlots: self. + self property: #displayAllChildren rawValue: false +] diff --git a/src/Pyramid-Bloc/PyramidNavigationPanelPresenter.class.st b/src/Pyramid-Bloc/PyramidNavigationPanelPresenter.class.st new file mode 100644 index 00000000..14ddcd84 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidNavigationPanelPresenter.class.st @@ -0,0 +1,5 @@ +Class { + #name : #PyramidNavigationPanelPresenter, + #superclass : #SpPresenter, + #category : #'Pyramid-Bloc-plugin-navigation' +} diff --git a/src/Pyramid-Bloc/PyramidNavigationPlugin.class.st b/src/Pyramid-Bloc/PyramidNavigationPlugin.class.st new file mode 100644 index 00000000..190c8d78 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidNavigationPlugin.class.st @@ -0,0 +1,40 @@ +Class { + #name : #PyramidNavigationPlugin, + #superclass : #Object, + #traits : 'TPyramidPlugin', + #classTraits : 'TPyramidPlugin classTrait', + #instVars : [ + 'navigation' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #adding } +PyramidNavigationPlugin >> addPanelsOn: aPyramidSimpleWindow [ + + aPyramidSimpleWindow at: #tabLeft addItem: [ :builder | + builder + makeTab: self navigation + label: 'Navigation' + icon: (Smalltalk ui icons iconNamed: #catalog) + order: 2 ] +] + +{ #category : #connecting } +PyramidNavigationPlugin >> connectOn: aPyramidEditor [ + + self navigation editor: aPyramidEditor +] + +{ #category : #initialization } +PyramidNavigationPlugin >> initialize [ + + super initialize. + navigation := PyramidNavigationPresenter new. +] + +{ #category : #initialization } +PyramidNavigationPlugin >> navigation [ + + ^ navigation +] diff --git a/src/Pyramid-Bloc/PyramidNavigationPresenter.class.st b/src/Pyramid-Bloc/PyramidNavigationPresenter.class.st new file mode 100644 index 00000000..48b38f4c --- /dev/null +++ b/src/Pyramid-Bloc/PyramidNavigationPresenter.class.st @@ -0,0 +1,64 @@ +Class { + #name : #PyramidNavigationPresenter, + #superclass : #SpPresenter, + #instVars : [ + 'libraryPanel', + 'selectionPanel', + 'navigationModel' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #layout } +PyramidNavigationPresenter >> defaultLayout [ + + ^ SpBoxLayout newVertical + spacing: 4; + add: self libraryPanel expand: false; + add: self selectionPanel expand: true; + yourself +] + +{ #category : #accessing } +PyramidNavigationPresenter >> editor: aPyramidEditor [ + + self libraryPanel editor: aPyramidEditor. + self selectionPanel editor: aPyramidEditor +] + +{ #category : #initialization } +PyramidNavigationPresenter >> initializePresenters [ + + navigationModel := PyramidNavigationModel new. + + libraryPanel := PyramidNavigationToolsPresenter new + navigationModel: self navigationModel; + yourself. + selectionPanel := PyramidNavigationTreePresenter new + navigationModel: self navigationModel; + yourself +] + +{ #category : #accessing } +PyramidNavigationPresenter >> libraryPanel [ + + ^ libraryPanel +] + +{ #category : #accessing } +PyramidNavigationPresenter >> navigationModel [ + + ^ navigationModel +] + +{ #category : #api } +PyramidNavigationPresenter >> roots: aCollection [ + + self selectionPanel roots: aCollection +] + +{ #category : #accessing } +PyramidNavigationPresenter >> selectionPanel [ + + ^ selectionPanel +] diff --git a/src/Pyramid-Bloc/PyramidNavigationToolsPresenter.class.st b/src/Pyramid-Bloc/PyramidNavigationToolsPresenter.class.st new file mode 100644 index 00000000..f1b613b1 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidNavigationToolsPresenter.class.st @@ -0,0 +1,105 @@ +Class { + #name : #PyramidNavigationToolsPresenter, + #superclass : #SpPresenter, + #instVars : [ + 'navigationModel', + 'addRootButton', + 'displayChildrenOptions', + 'editor' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #accessing } +PyramidNavigationToolsPresenter >> addRootButton [ + + ^ addRootButton +] + +{ #category : #layout } +PyramidNavigationToolsPresenter >> defaultLayout [ + + ^ SpBoxLayout newHorizontal + spacing: 4; + add: self addRootButton expand: false; + add: self displayChildrenOptions expand: true; + yourself +] + +{ #category : #accessing } +PyramidNavigationToolsPresenter >> displayChildrenOptions [ + + ^ displayChildrenOptions +] + +{ #category : #accessing } +PyramidNavigationToolsPresenter >> editor [ + + ^ editor +] + +{ #category : #accessing } +PyramidNavigationToolsPresenter >> editor: anObject [ + + editor := anObject +] + +{ #category : #initialization } +PyramidNavigationToolsPresenter >> initializePresenters [ + + addRootButton := SpButtonPresenter new + label: 'Add new root'; + icon: (Smalltalk ui iconNamed: #add); + yourself. + displayChildrenOptions := SpButtonPresenter new + help: + 'Show / Hide not serializable children.'; + yourself +] + +{ #category : #accessing } +PyramidNavigationToolsPresenter >> navigationModel [ + + ^ navigationModel +] + +{ #category : #accessing } +PyramidNavigationToolsPresenter >> navigationModel: anObject [ + + navigationModel := anObject. + self updateDisplayChildrenButton +] + +{ #category : #'as yet unclassified' } +PyramidNavigationToolsPresenter >> updateDisplayChildrenButton [ + + self navigationModel displayAllChildren ifTrue: [ + self updateDisplayChildrenButtonActivate. + ^ self ]. + self updateDisplayChildrenButtonDeactivate. + +] + +{ #category : #'as yet unclassified' } +PyramidNavigationToolsPresenter >> updateDisplayChildrenButtonActivate [ + + self displayChildrenOptions state: true. + self displayChildrenOptions icon: + (Smalltalk ui icons iconNamed: #checkboxSelected). + self displayChildrenOptions label: 'Show children'. + self displayChildrenOptions action: [ + self navigationModel displayAllChildren: false. + self updateDisplayChildrenButton ] +] + +{ #category : #'as yet unclassified' } +PyramidNavigationToolsPresenter >> updateDisplayChildrenButtonDeactivate [ + + self displayChildrenOptions state: false. + self displayChildrenOptions icon: + (Smalltalk ui icons iconNamed: #checkboxUnselected). + self displayChildrenOptions label: 'Hide children'. + self displayChildrenOptions action: [ + self navigationModel displayAllChildren: true. + self updateDisplayChildrenButton ] +] diff --git a/src/Pyramid-Bloc/PyramidNavigationTreePresenter.class.st b/src/Pyramid-Bloc/PyramidNavigationTreePresenter.class.st new file mode 100644 index 00000000..31ae702c --- /dev/null +++ b/src/Pyramid-Bloc/PyramidNavigationTreePresenter.class.st @@ -0,0 +1,186 @@ +Class { + #name : #PyramidNavigationTreePresenter, + #superclass : #SpPresenter, + #instVars : [ + 'navigationModel', + 'treeTable', + 'editor', + 'shouldUpdateSelection' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #'as yet unclassified' } +PyramidNavigationTreePresenter >> actionEditorMenu [ + + | builder | + self editor ifNil: [ ^ SpMenuPresenter new ]. + builder := (self editor window services at: #selectionMenu) builder. + ^ builder menuFor: self editor projectModel selection +] + +{ #category : #'as yet unclassified' } +PyramidNavigationTreePresenter >> actionSelectionChanged: aSelection [ + + self editor ifNil: [ ^ self ]. + self shouldUpdateSelection ifFalse: [ ^ self ]. + self shouldUpdateSelection: false. + [ self editor projectModel setSelection: aSelection selectedItems ] + ensure: [ self shouldUpdateSelection: true ] +] + +{ #category : #initialization } +PyramidNavigationTreePresenter >> allTreeColumns [ + + | pragmas sorted | + pragmas := Pragma allNamed: #pyramidNavigationColumn:. + sorted := pragmas sorted: [ :a :b | + a arguments first < b arguments first ]. + ^ sorted collect: [ :each | + each method + receiver: self + withArguments: #( ) + executeMethod: each method ] +] + +{ #category : #private } +PyramidNavigationTreePresenter >> childrenFor: aBlElement [ + + self displayAllChildren ifTrue: [ ^ aBlElement children ]. + aBlElement shouldSerializedChildren ifTrue: [ ^ aBlElement children ]. + ^ { } +] + +{ #category : #layout } +PyramidNavigationTreePresenter >> defaultLayout [ + + ^ SpBoxLayout newVertical + spacing: 4; + add: self treeTable; + yourself +] + +{ #category : #accessing } +PyramidNavigationTreePresenter >> displayAllChildren [ + + ^ self navigationModel displayAllChildren +] + +{ #category : #accessing } +PyramidNavigationTreePresenter >> editor [ + + ^ editor +] + +{ #category : #accessing } +PyramidNavigationTreePresenter >> editor: anObject [ + + editor := anObject. + editor projectModel announcer + when: PyramidElementsChangedEvent + do: [ :evt | self updateRoots. self updateSelection ] + for: self. + editor projectModel announcer + when: PyramidFirstLevelElementsChangedEvent + do: [ :evt | self updateRoots. ] + for: self. + editor projectModel announcer + when: PyramidSelectionChangedEvent + do: [ :evt | self updateSelection ] + for: self +] + +{ #category : #initialization } +PyramidNavigationTreePresenter >> initializePresenters [ + + shouldUpdateSelection := true. + + treeTable := SpTreeTablePresenter new. + treeTable + beMultipleSelection; + beResizable; + roots: { }; + children: [ :aBlElement | self childrenFor: aBlElement ]; + contextMenu: [ self actionEditorMenu ]; + whenSelectionChangedDo: [ :aSelection | + self actionSelectionChanged: aSelection ]; + expandAll. + self allTreeColumns do: [ :each | treeTable addColumn: each ] +] + +{ #category : #accessing } +PyramidNavigationTreePresenter >> navigationModel [ + + ^ navigationModel +] + +{ #category : #accessing } +PyramidNavigationTreePresenter >> navigationModel: anObject [ + + navigationModel := anObject. + navigationModel property: #displayAllChildren whenChangedDo: [ + (self treeTable selection selectedItems + allSatisfy: [ :each | each parentsShouldSerializeChildren ]) + ifTrue: [ + self treeTable updateRootsKeepingSelection: self treeTable roots ] + ifFalse: [ self treeTable roots: self treeTable roots ]. + self treeTable expandAll ] +] + +{ #category : #api } +PyramidNavigationTreePresenter >> roots: aCollection [ + + self treeTable roots: aCollection +] + +{ #category : #accessing } +PyramidNavigationTreePresenter >> shouldUpdateSelection [ + + ^ shouldUpdateSelection +] + +{ #category : #accessing } +PyramidNavigationTreePresenter >> shouldUpdateSelection: anObject [ + + shouldUpdateSelection := anObject +] + +{ #category : #accessing } +PyramidNavigationTreePresenter >> treeTable [ + + ^ treeTable +] + +{ #category : #'as yet unclassified' } +PyramidNavigationTreePresenter >> updateRoots [ + + | roots parent shouldOrder | + self shouldUpdateSelection: false. + + roots := self editor projectModel firstLevelElements asArray. + parent := nil. + + "If roots all have the same parent then it should be ordered by the parent children order." + shouldOrder := (roots allSatisfy: [ :each | + parent ifNil: [ parent := each parent ]. + each parent = parent ]) and: [ + parent notNil and: [ + parent childrenCount = roots size ] ]. + shouldOrder ifTrue: [ roots := parent children asArray ]. + + [ self treeTable roots: roots ] ensure: [ + self shouldUpdateSelection: true ] +] + +{ #category : #selection } +PyramidNavigationTreePresenter >> updateSelection [ + + self editor projectModel ifNil: [ ^ self ]. + self shouldUpdateSelection ifFalse: [ ^ self ]. + self shouldUpdateSelection: false. + [ + self treeTable unselectAll. + self editor projectModel selection ifNotEmpty: [ :e | + self treeTable selectItems: e ] ] ensure: [ + self shouldUpdateSelection: true ] +] diff --git a/src/Pyramid-Bloc/PyramidTreeBaseColumnsBuilder.class.st b/src/Pyramid-Bloc/PyramidTreeBaseColumnsBuilder.class.st index cbeb387e..fd904682 100644 --- a/src/Pyramid-Bloc/PyramidTreeBaseColumnsBuilder.class.st +++ b/src/Pyramid-Bloc/PyramidTreeBaseColumnsBuilder.class.st @@ -39,7 +39,10 @@ PyramidTreeBaseColumnsBuilder >> nameAndTypeColumn [ addColumn: (SpStringTableColumn new title: 'Class'; evaluated: [ :aBlElement | aBlElement class name ]; - displayColor: [ :aBlElement | Color gray ]; + displayColor: [ :aBlElement | + aBlElement parentsShouldSerializeChildren + ifTrue: [ Color gray ] + ifFalse: [ Color red ] ]; displayItalic: [ :aBlElement | true ]; yourself); yourself diff --git a/src/Pyramid-Bloc/TPyramidSelectionPanelExtension.trait.st b/src/Pyramid-Bloc/TPyramidSelectionPanelExtension.trait.st new file mode 100644 index 00000000..2aabf418 --- /dev/null +++ b/src/Pyramid-Bloc/TPyramidSelectionPanelExtension.trait.st @@ -0,0 +1,4 @@ +Trait { + #name : #TPyramidSelectionPanelExtension, + #category : #'Pyramid-Bloc-plugin-navigation' +} diff --git a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st index 1991336c..bf32e850 100644 --- a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st +++ b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st @@ -1,11 +1,10 @@ Class { - #name : 'PyramidToploExamples', - #superclass : 'Object', - #category : 'Pyramid-Toplo-Examples', - #package : 'Pyramid-Toplo-Examples' + #name : #PyramidToploExamples, + #superclass : #Object, + #category : #'Pyramid-Toplo-Examples' } -{ #category : 'pyramid-serialized-bloc' } +{ #category : #'pyramid-serialized-bloc' } PyramidToploExamples class >> buttons [ ^ [ "BlStashSerializer" @@ -54,7 +53,6 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; diff --git a/src/Pyramid-Toplo-Examples/package.st b/src/Pyramid-Toplo-Examples/package.st index 992899b5..a1c8a7af 100644 --- a/src/Pyramid-Toplo-Examples/package.st +++ b/src/Pyramid-Toplo-Examples/package.st @@ -1 +1 @@ -Package { #name : 'Pyramid-Toplo-Examples' } +Package { #name : #'Pyramid-Toplo-Examples' } From 459032434da5d696d72d449bb3e727280e81ffa7 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Tue, 30 Jul 2024 17:56:27 +0200 Subject: [PATCH 02/11] commit before losing all --- .../PyramidAbstractBlocCommand.class.st | 2 +- .../PyramidAbstractColumnsBuilder.class.st | 34 -- ...amidBackgroundImageModalPresenter.class.st | 9 +- .../PyramidBlocTextCommand.class.st | 3 +- .../PyramidElementToAddCategory.class.st | 78 ----- .../PyramidElementToAddFactory.class.st | 77 ----- .../PyramidElementToAddFactoryEmpty.class.st | 17 - ...ramidElementToAddFactoryPresenter.class.st | 126 -------- .../PyramidElementToAddModel.class.st | 41 --- .../PyramidElementToAddPresenter.class.st | 105 ------ .../PyramidLibraryContainerPresenter.class.st | 98 ------ .../PyramidLibraryController.class.st | 152 +++++++++ .../PyramidLibraryDefault.class.st | 135 ++++---- .../PyramidLibraryElement.class.st | 28 +- .../PyramidLibraryPresenter.class.st | 74 +++-- .../PyramidNavigationPlugin.class.st | 78 ++++- .../PyramidNavigationPresenter.class.st | 32 +- .../PyramidNavigationToolsPresenter.class.st | 20 ++ ...oundedRectangleCornerRadiiCommand.class.st | 4 +- .../PyramidTreeBaseColumnsBuilder.class.st | 97 ------ src/Pyramid-Bloc/PyramidTreePlugin.class.st | 302 ------------------ .../PyramidTreePresenter.class.st | 227 ------------- .../TPyramidElementToAdd.trait.st | 10 - .../PyramidSimpleExamples.class.st | 25 +- .../PyramidLibraryControllerTest.class.st | 80 +++++ .../PyramidLibraryPresenterTest.class.st | 41 --- .../PyramidNavigationPluginTest.class.st | 33 ++ .../PyramidTreePluginTest.class.st | 49 --- .../PyramidToploExamples.class.st | 63 ++-- ...dContainsValidSelectorInterpreter.class.st | 42 ++- ...amidElementThemeSelectorPresenter.class.st | 34 +- .../PyramidSelectorPossibleStamps.class.st | 18 +- ...yramidSpaceThemeSelectorPresenter.class.st | 16 +- .../PyramidStampCommand.class.st | 16 +- .../PyramidStyleSheetEditorPresenter.class.st | 16 +- .../PyramidThemeCommand.class.st | 12 +- .../PyramidThemeFromSpaceExtension.class.st | 34 +- .../PyramidThemePresenter.class.st | 22 +- .../PyramidThemePropertyStrategy.class.st | 14 +- .../PyramidThemeSelectorPresenter.class.st | 34 +- .../PyramidToploThemePlugin.class.st | 122 +++++-- src/Pyramid-Toplo/package.st | 2 +- src/Pyramid/Object.extension.st | 7 + .../PyramidExternalRessourceProxy.class.st | 297 ++++++++++++++++- 44 files changed, 1088 insertions(+), 1638 deletions(-) delete mode 100644 src/Pyramid-Bloc/PyramidAbstractColumnsBuilder.class.st delete mode 100644 src/Pyramid-Bloc/PyramidElementToAddCategory.class.st delete mode 100644 src/Pyramid-Bloc/PyramidElementToAddFactory.class.st delete mode 100644 src/Pyramid-Bloc/PyramidElementToAddFactoryEmpty.class.st delete mode 100644 src/Pyramid-Bloc/PyramidElementToAddFactoryPresenter.class.st delete mode 100644 src/Pyramid-Bloc/PyramidElementToAddModel.class.st delete mode 100644 src/Pyramid-Bloc/PyramidElementToAddPresenter.class.st delete mode 100644 src/Pyramid-Bloc/PyramidLibraryContainerPresenter.class.st create mode 100644 src/Pyramid-Bloc/PyramidLibraryController.class.st delete mode 100644 src/Pyramid-Bloc/PyramidTreeBaseColumnsBuilder.class.st delete mode 100644 src/Pyramid-Bloc/PyramidTreePlugin.class.st delete mode 100644 src/Pyramid-Bloc/PyramidTreePresenter.class.st delete mode 100644 src/Pyramid-Bloc/TPyramidElementToAdd.trait.st create mode 100644 src/Pyramid-Tests/PyramidLibraryControllerTest.class.st delete mode 100644 src/Pyramid-Tests/PyramidLibraryPresenterTest.class.st create mode 100644 src/Pyramid-Tests/PyramidNavigationPluginTest.class.st delete mode 100644 src/Pyramid-Tests/PyramidTreePluginTest.class.st create mode 100644 src/Pyramid/Object.extension.st diff --git a/src/Pyramid-Bloc/PyramidAbstractBlocCommand.class.st b/src/Pyramid-Bloc/PyramidAbstractBlocCommand.class.st index 51b17228..ba35436a 100644 --- a/src/Pyramid-Bloc/PyramidAbstractBlocCommand.class.st +++ b/src/Pyramid-Bloc/PyramidAbstractBlocCommand.class.st @@ -13,5 +13,5 @@ PyramidAbstractBlocCommand class >> isAbstract [ { #category : #testing } PyramidAbstractBlocCommand >> canBeUsedFor: anObject [ - ^ anObject class = BlElement or: [anObject class inheritsFrom: BlElement] + ^ anObject isKindOf: BlElement ] diff --git a/src/Pyramid-Bloc/PyramidAbstractColumnsBuilder.class.st b/src/Pyramid-Bloc/PyramidAbstractColumnsBuilder.class.st deleted file mode 100644 index afe4b59d..00000000 --- a/src/Pyramid-Bloc/PyramidAbstractColumnsBuilder.class.st +++ /dev/null @@ -1,34 +0,0 @@ -Class { - #name : #PyramidAbstractColumnsBuilder, - #superclass : #Object, - #instVars : [ - 'editor' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #testing } -PyramidAbstractColumnsBuilder class >> isAbstract [ - - ^ self == PyramidAbstractColumnsBuilder -] - -{ #category : #'as yet unclassified' } -PyramidAbstractColumnsBuilder >> buildOn: aPyramidTreePlugin [ -"aPyramidTreePlugin addColumns: { }" - self shouldBeImplemented - -] - -{ #category : #accessing } -PyramidAbstractColumnsBuilder >> editor [ - - editor ifNil: [ Error signal: 'Editor should not be nil.' ]. - ^ editor -] - -{ #category : #accessing } -PyramidAbstractColumnsBuilder >> editor: anObject [ - - editor := anObject -] diff --git a/src/Pyramid-Bloc/PyramidBackgroundImageModalPresenter.class.st b/src/Pyramid-Bloc/PyramidBackgroundImageModalPresenter.class.st index 54f94d9e..10becb00 100644 --- a/src/Pyramid-Bloc/PyramidBackgroundImageModalPresenter.class.st +++ b/src/Pyramid-Bloc/PyramidBackgroundImageModalPresenter.class.st @@ -137,9 +137,16 @@ PyramidBackgroundImageModalPresenter >> defaultLayout [ { #category : #action } PyramidBackgroundImageModalPresenter >> image: aForm [ + | source | self codeBitmap beForObject: aForm. self codeBitmap text: self textBitmap , 'self -' +'. + (aForm isPyramidProxy) ifFalse: [ ^ self ]. + source := aForm pyramidExternalRessourceSource. + self inputReceiverProxy text: (Stash new serialize: source target). + self inputSelectorProxy text: (Stash new serialize: source selector). + self inputArgumentsProxy text: + (Stash new serialize: source arguments) ] { #category : #initialization } diff --git a/src/Pyramid-Bloc/PyramidBlocTextCommand.class.st b/src/Pyramid-Bloc/PyramidBlocTextCommand.class.st index b0af6eb8..03600e58 100644 --- a/src/Pyramid-Bloc/PyramidBlocTextCommand.class.st +++ b/src/Pyramid-Bloc/PyramidBlocTextCommand.class.st @@ -13,8 +13,7 @@ PyramidBlocTextCommand class >> isAbstract [ { #category : #testing } PyramidBlocTextCommand >> canBeUsedFor: anObject [ - ^ anObject class = BlTextElement or: [ - anObject class inheritsFrom: BlTextElement ] + ^ anObject isKindOf: BlTextElement ] { #category : #'as yet unclassified' } diff --git a/src/Pyramid-Bloc/PyramidElementToAddCategory.class.st b/src/Pyramid-Bloc/PyramidElementToAddCategory.class.st deleted file mode 100644 index 89edacc6..00000000 --- a/src/Pyramid-Bloc/PyramidElementToAddCategory.class.st +++ /dev/null @@ -1,78 +0,0 @@ -Class { - #name : #PyramidElementToAddCategory, - #superclass : #Object, - #instVars : [ - 'name', - 'icon', - 'factories' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #comparing } -PyramidElementToAddCategory >> <= aPyramidLibraryCategory [ - - ^ self name <= aPyramidLibraryCategory name -] - -{ #category : #converting } -PyramidElementToAddCategory >> asNotebookPage [ - - ^ SpNotebookPage - title: self name - icon: self icon - provider: [self makeProvider] -] - -{ #category : #accessing } -PyramidElementToAddCategory >> factories [ - - ^ factories -] - -{ #category : #accessing } -PyramidElementToAddCategory >> factories: anObject [ - - factories := anObject -] - -{ #category : #accessing } -PyramidElementToAddCategory >> icon [ - - ^ icon -] - -{ #category : #accessing } -PyramidElementToAddCategory >> icon: anObject [ - - icon := anObject -] - -{ #category : #'as yet unclassified' } -PyramidElementToAddCategory >> makeProvider [ - - ^ - SpTablePresenter new - addColumn: ((SpImageTableColumn - title: 'Icon' - evaluated: [ :aFactory | aFactory elementIcon ]) - width: 50; - yourself); - addColumn: - (SpStringTableColumn title: 'Name' evaluated: #elementName); - items: self factories; - beResizable; - yourself -] - -{ #category : #accessing } -PyramidElementToAddCategory >> name [ - - ^ name -] - -{ #category : #accessing } -PyramidElementToAddCategory >> name: anObject [ - - name := anObject -] diff --git a/src/Pyramid-Bloc/PyramidElementToAddFactory.class.st b/src/Pyramid-Bloc/PyramidElementToAddFactory.class.st deleted file mode 100644 index 0e34afb9..00000000 --- a/src/Pyramid-Bloc/PyramidElementToAddFactory.class.st +++ /dev/null @@ -1,77 +0,0 @@ -Class { - #name : #PyramidElementToAddFactory, - #superclass : #Object, - #instVars : [ - 'elementIcon', - 'elementName', - 'elementBlock' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #comparing } -PyramidElementToAddFactory >> <= aPyramidLibraryCategory [ - - ^ self elementName <= aPyramidLibraryCategory elementName -] - -{ #category : #testing } -PyramidElementToAddFactory >> canMakeNewElement [ - - [self elementBlock value] on: Error do: [ ^ false ]. - ^ true -] - -{ #category : #accessing } -PyramidElementToAddFactory >> elementBlock [ - - ^ elementBlock -] - -{ #category : #accessing } -PyramidElementToAddFactory >> elementBlock: anObject [ - - elementBlock := anObject -] - -{ #category : #accessing } -PyramidElementToAddFactory >> elementIcon [ - - ^ elementIcon -] - -{ #category : #accessing } -PyramidElementToAddFactory >> elementIcon: anObject [ - - elementIcon := anObject -] - -{ #category : #accessing } -PyramidElementToAddFactory >> elementName [ - - ^ elementName -] - -{ #category : #accessing } -PyramidElementToAddFactory >> elementName: anObject [ - - elementName := anObject -] - -{ #category : #'as yet unclassified' } -PyramidElementToAddFactory >> makeElement [ - - ^ self elementBlock value -] - -{ #category : #'as yet unclassified' } -PyramidElementToAddFactory >> makeForm [ - - | array | - array := self elementBlock value. - ^ BlElement new - size: 800 @ 600; - addChildren: array; - clipChildren: false; - asForm -] diff --git a/src/Pyramid-Bloc/PyramidElementToAddFactoryEmpty.class.st b/src/Pyramid-Bloc/PyramidElementToAddFactoryEmpty.class.st deleted file mode 100644 index a85d38b2..00000000 --- a/src/Pyramid-Bloc/PyramidElementToAddFactoryEmpty.class.st +++ /dev/null @@ -1,17 +0,0 @@ -Class { - #name : #PyramidElementToAddFactoryEmpty, - #superclass : #PyramidElementToAddFactory, - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #testing } -PyramidElementToAddFactoryEmpty >> canMakeNewElement [ - - ^ false -] - -{ #category : #'as yet unclassified' } -PyramidElementToAddFactoryEmpty >> makeForm [ - - ^ BlElement new asForm -] diff --git a/src/Pyramid-Bloc/PyramidElementToAddFactoryPresenter.class.st b/src/Pyramid-Bloc/PyramidElementToAddFactoryPresenter.class.st deleted file mode 100644 index 32c72f49..00000000 --- a/src/Pyramid-Bloc/PyramidElementToAddFactoryPresenter.class.st +++ /dev/null @@ -1,126 +0,0 @@ -Class { - #name : #PyramidElementToAddFactoryPresenter, - #superclass : #SpPresenter, - #instVars : [ - 'categoryPresenter', - 'factoryPresenter', - 'categories', - 'selectedCategory', - 'selectedFactory', - 'whenItemChangeDo' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> categories [ - - ^ categories -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> categories: anObject [ - - categories := anObject. - self categoryPresenter items: anObject -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> categoryPresenter [ - - ^ categoryPresenter -] - -{ #category : #layout } -PyramidElementToAddFactoryPresenter >> defaultLayout [ - - ^ SpPanedLayout newHorizontal add: self categoryPresenter; add: self factoryPresenter ; yourself. -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> factoryPresenter [ - - ^ factoryPresenter -] - -{ #category : #'initialization - deprecated' } -PyramidElementToAddFactoryPresenter >> initialize [ - - super initialize. - whenItemChangeDo := [ :e | ]. - -] - -{ #category : #'initialization - deprecated' } -PyramidElementToAddFactoryPresenter >> initializePresenter [ - - whenItemChangeDo := [ :e | ]. - categoryPresenter := SpTablePresenter new - addColumn: ((SpImageTableColumn - title: 'Icon' - evaluated: [ :aCategory | aCategory icon ]) - width: 20; - yourself); - addColumn: - (SpStringTableColumn - title: 'Name' - evaluated: #name); - whenSelectedItemChangedDo: [ :category | - self selectedCategory: category ]; - beResizable; - yourself. - factoryPresenter := SpTablePresenter new - addColumn: ((SpImageTableColumn - title: 'Icon' - evaluated: [ :aFactory | - aFactory elementIcon ]) - width: 20; - yourself); - addColumn: - (SpStringTableColumn - title: 'Name' - evaluated: #elementName); - whenSelectedItemChangedDo: [ :factory | - self selectedFactory: factory ]; - beResizable; - yourself -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> selectedCategory [ - - ^ selectedCategory -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> selectedCategory: anObject [ - - selectedCategory := anObject. - anObject ifNil: [ ^ self ]. - self factoryPresenter items: anObject factories -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> selectedFactory [ - - ^ selectedFactory -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> selectedFactory: anObject [ - - selectedFactory := anObject. - self whenItemChangeDo value: anObject -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> whenItemChangeDo [ - - ^ whenItemChangeDo -] - -{ #category : #accessing } -PyramidElementToAddFactoryPresenter >> whenItemChangeDo: anObject [ - - whenItemChangeDo := anObject -] diff --git a/src/Pyramid-Bloc/PyramidElementToAddModel.class.st b/src/Pyramid-Bloc/PyramidElementToAddModel.class.st deleted file mode 100644 index 80fec9f0..00000000 --- a/src/Pyramid-Bloc/PyramidElementToAddModel.class.st +++ /dev/null @@ -1,41 +0,0 @@ -Class { - #name : #PyramidElementToAddModel, - #superclass : #Object, - #instVars : [ - 'categories' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #'as yet unclassified' } -PyramidElementToAddModel class >> defaultLibrary [ - - | library | - library := self new. - TPyramidElementToAdd users do: [ :class | class addOnLibrary: library ]. - ^ library -] - -{ #category : #adding } -PyramidElementToAddModel >> addCategoryWithName: aCategoryName withIcon: aCategoryIcon withAllFactories: aCollection [ - - | newCategory | - newCategory := PyramidElementToAddCategory new - name: aCategoryName; - icon: aCategoryIcon; - factories: aCollection; - yourself. - categories add: newCategory -] - -{ #category : #initialization } -PyramidElementToAddModel >> allCategories [ - - ^ categories -] - -{ #category : #initialization } -PyramidElementToAddModel >> initialize [ - - categories := OrderedCollection new. -] diff --git a/src/Pyramid-Bloc/PyramidElementToAddPresenter.class.st b/src/Pyramid-Bloc/PyramidElementToAddPresenter.class.st deleted file mode 100644 index 7800828e..00000000 --- a/src/Pyramid-Bloc/PyramidElementToAddPresenter.class.st +++ /dev/null @@ -1,105 +0,0 @@ -Class { - #name : #PyramidElementToAddPresenter, - #superclass : #SpPresenter, - #instVars : [ - 'selector', - 'preview', - 'addButton', - 'libraryModel', - 'currentFactory' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #'as yet unclassified' } -PyramidElementToAddPresenter class >> defaultEmptyFactory [ - - ^ PyramidElementToAddFactoryEmpty new -] - -{ #category : #accessing } -PyramidElementToAddPresenter >> addButton [ - - ^ addButton -] - -{ #category : #accessing } -PyramidElementToAddPresenter >> currentFactory [ - - currentFactory ifNil: [ currentFactory := self class defaultEmptyFactory ]. - ^ currentFactory -] - -{ #category : #accessing } -PyramidElementToAddPresenter >> currentFactory: anObject [ - - currentFactory := anObject. - self preview image: self currentFactory makeForm. - self addButton enabled: self currentFactory canMakeNewElement -] - -{ #category : #layout } -PyramidElementToAddPresenter >> defaultLayout [ - - ^ SpPanedLayout newHorizontal - add: self selector; - add: (SpBoxLayout newVertical - spacing: 4; - add: self preview expand: true; - add: self addButton expand: false; - yourself); - yourself -] - -{ #category : #requirements } -PyramidElementToAddPresenter >> elementToAdd [ - - ^ self currentFactory makeElement -] - -{ #category : #'initialization - deprecated' } -PyramidElementToAddPresenter >> initializePresenter [ - - addButton := SpButtonPresenter new - label: 'Add'; - icon: (Smalltalk ui icons iconNamed: #add); - enabled: false; - yourself. - selector := PyramidElementToAddFactoryPresenter new whenItemChangeDo: [ - :aFactory | self currentFactory: aFactory ]. - preview := SpImagePresenter new autoScale: true. - libraryModel := PyramidElementToAddModel defaultLibrary. - self refresh -] - -{ #category : #accessing } -PyramidElementToAddPresenter >> libraryModel [ - - ^ libraryModel -] - -{ #category : #accessing } -PyramidElementToAddPresenter >> libraryModel: anObject [ - - libraryModel := anObject. - self refresh -] - -{ #category : #accessing } -PyramidElementToAddPresenter >> preview [ - - ^ preview -] - -{ #category : #accessing } -PyramidElementToAddPresenter >> refresh [ - - self currentFactory: nil. - self selector categories: self libraryModel allCategories -] - -{ #category : #accessing } -PyramidElementToAddPresenter >> selector [ - - ^ selector -] diff --git a/src/Pyramid-Bloc/PyramidLibraryContainerPresenter.class.st b/src/Pyramid-Bloc/PyramidLibraryContainerPresenter.class.st deleted file mode 100644 index 8bbb4deb..00000000 --- a/src/Pyramid-Bloc/PyramidLibraryContainerPresenter.class.st +++ /dev/null @@ -1,98 +0,0 @@ -Class { - #name : #PyramidLibraryContainerPresenter, - #superclass : #SpPresenter, - #instVars : [ - 'library', - 'idGenerator' - ], - #classVars : [ - 'IdGenerator' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #accessing } -PyramidLibraryContainerPresenter class >> makeIdGenerator [ -^ Generator on: [ :generator | - | index | - index := 1. - [ - Character alphabet do: [ :each | - | next suffix | - next := each asUppercase asString. - suffix := index = 1 - ifTrue: [ '' ] - ifFalse: [ index asString ]. - generator yield: next , suffix ]. - index := index + 1 ] repeat ] -] - -{ #category : #'as yet unclassified' } -PyramidLibraryContainerPresenter >> buttonAction: aBlock [ - - library addButton action: aBlock -] - -{ #category : #'as yet unclassified' } -PyramidLibraryContainerPresenter >> buttonLabel: aString [ - - library addButton label: aString -] - -{ #category : #initialization } -PyramidLibraryContainerPresenter >> defaultLayout [ - - ^ SpBoxLayout newVertical - spacing: 4; - add: (SpLabelPresenter new - label: 'Library'; - displayBold: [ :a | true ]; - yourself) - expand: false; - add: (SpBoxLayout newHorizontal - add: library width: 800; - yourself) - height: 400; - yourself. -] - -{ #category : #requirements } -PyramidLibraryContainerPresenter >> elementToAdd [ - - | array | - array := self library elementToAdd. - array do: [:each | each id: self idGenerator next; yourself]. - ^ array -] - -{ #category : #accessing } -PyramidLibraryContainerPresenter >> idGenerator [ - - idGenerator ifNil: [ idGenerator := self class makeIdGenerator ]. - ^ idGenerator -] - -{ #category : #accessing } -PyramidLibraryContainerPresenter >> idGenerator: anObject [ - - idGenerator := anObject -] - -{ #category : #initialization } -PyramidLibraryContainerPresenter >> initializePresenters [ - - library := PyramidElementToAddPresenter new. - -] - -{ #category : #requirements } -PyramidLibraryContainerPresenter >> library [ - - ^ library -] - -{ #category : #requirements } -PyramidLibraryContainerPresenter >> library: aLibrary [ - - library := aLibrary -] diff --git a/src/Pyramid-Bloc/PyramidLibraryController.class.st b/src/Pyramid-Bloc/PyramidLibraryController.class.st new file mode 100644 index 00000000..cefa8eb3 --- /dev/null +++ b/src/Pyramid-Bloc/PyramidLibraryController.class.st @@ -0,0 +1,152 @@ +Class { + #name : #PyramidLibraryController, + #superclass : #Object, + #instVars : [ + 'library', + 'popoverOrigin', + 'editor', + 'addElementsBlock', + 'idGenerator' + ], + #category : #'Pyramid-Bloc-plugin-navigation' +} + +{ #category : #adding } +PyramidLibraryController >> addCategories: aCollection [ + + self library categoryPresenter items = aCollection ifTrue: [ ^ self ]. + self library categoryPresenter + items: aCollection; + selectIndex: 1 +] + +{ #category : #accessing } +PyramidLibraryController >> addElementsBlock [ + + ^ addElementsBlock +] + +{ #category : #accessing } +PyramidLibraryController >> addElementsBlock: anObject [ + + addElementsBlock := anObject +] + +{ #category : #adding } +PyramidLibraryController >> addNewElement: aLibraryElement [ + + self addElementsBlock value: aLibraryElement asArray +] + +{ #category : #accessing } +PyramidLibraryController >> editor [ + + ^ editor +] + +{ #category : #accessing } +PyramidLibraryController >> editor: anObject [ + + editor := anObject +] + +{ #category : #'as yet unclassified' } +PyramidLibraryController >> idGenerator [ + + ^ idGenerator +] + +{ #category : #initialization } +PyramidLibraryController >> initialize [ + + addElementsBlock := [ :e | ]. + idGenerator := Generator on: [ :generator | + | index | + index := 1. + [ + Character alphabet do: [ :each | + | next suffix | + next := each asUppercase asString. + suffix := index = 1 + ifTrue: [ '' ] + ifFalse: [ index asString ]. + generator yield: next , suffix ]. + index := index + 1 ] repeat ] +] + +{ #category : #initialization } +PyramidLibraryController >> initializeCategories [ + + | pragmas sorted | + pragmas := Pragma allNamed: #pyramidLibraryCategory:. + sorted := pragmas sorted: [ :a :b | + a arguments first < b arguments first ]. + self addCategories: (sorted flatCollect: [ :each | + each method + receiver: self + withArguments: #( ) + executeMethod: each method ]) +] + +{ #category : #accessing } +PyramidLibraryController >> library [ + + ^ library +] + +{ #category : #accessing } +PyramidLibraryController >> library: anObject [ + + library := anObject +] + +{ #category : #'as yet unclassified' } +PyramidLibraryController >> openForRoot [ + + self addElementsBlock: [ :arrayOfElement | + self renameElements: arrayOfElement. + self editor propertiesManager commandExecutor + use: PyramidAddAllToCollectionCommand new + on: { self editor projectModel firstLevelElements } + with: arrayOfElement ]. + self openInPopover +] + +{ #category : #'as yet unclassified' } +PyramidLibraryController >> openForSelection [ + + self addElementsBlock: [ :arrayOfElement | + self editor propertiesManager commandExecutor + use: PyramidAddChildrenCommand new + on: self editor projectModel selection + with: arrayOfElement ]. + self openInPopover +] + +{ #category : #'as yet unclassified' } +PyramidLibraryController >> openInPopover [ + + self popoverOrigin ifNil: [ ^ self ]. + (PyramidPopoverFactory + makeWithPresenter: self library + relativeTo: self popoverOrigin + position: SpPopoverPosition right) popup +] + +{ #category : #accessing } +PyramidLibraryController >> popoverOrigin [ + + ^ popoverOrigin +] + +{ #category : #accessing } +PyramidLibraryController >> popoverOrigin: anObject [ + + popoverOrigin := anObject +] + +{ #category : #'as yet unclassified' } +PyramidLibraryController >> renameElements: aCollection [ + + aCollection do: [ :each | each id: self idGenerator next ] +] diff --git a/src/Pyramid-Bloc/PyramidLibraryDefault.class.st b/src/Pyramid-Bloc/PyramidLibraryDefault.class.st index 61d41d26..6e347581 100644 --- a/src/Pyramid-Bloc/PyramidLibraryDefault.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryDefault.class.st @@ -8,81 +8,96 @@ Class { PyramidLibraryDefault >> defaultCategory [ - ^ {PyramidLibraryCategory new - icon: (Smalltalk ui icons iconNamed: #box); - name: 'Default'; - elements: { - (PyramidLibraryElement new - name: 'Simple element'; - icon: (Smalltalk ui icons iconNamed: #blank); - block: [ BlElement new background: Color random ]; - yourself). - (PyramidLibraryElement new - name: 'Text element'; - icon: (Smalltalk ui icons iconNamed: #smallFonts); - block: [ 'Change me' asRopedText asElement ]; - yourself) }; - yourself} + ^ { (PyramidLibraryCategory new + icon: (Smalltalk ui icons iconNamed: #box); + name: 'Default'; + elements: { + (PyramidLibraryElement new + name: 'Simple element'; + icon: (Smalltalk ui icons iconNamed: #blank); + block: [ {BlElement new background: Color random} ]; + yourself). + (PyramidLibraryElement new + name: 'Text element'; + icon: (Smalltalk ui icons iconNamed: #smallFonts); + block: [ {'Change me' asRopedText asElement} ]; + yourself) }; + yourself) } ] { #category : #accessing } -PyramidLibraryDefault >> pystashCategory [ +PyramidLibraryDefault >> pragmaCategory: aSymbol withIcon: anIcon [ - | pragmas methods packages categories | - pragmas := Pragma allNamed: #pyStash. + pragmas := Pragma allNamed: aSymbol. methods := (pragmas collect: #method) asSet. packages := (methods collect: #package) asSet. categories := OrderedCollection new. - ^ packages collect: [ :package | - | elements | - elements := methods - select: [ :method | method package = package ] - thenCollect: [ :method | - PyramidLibraryElement new - icon: (Smalltalk ui icons iconNamed: - method methodClass soleInstance systemIconName); - name: method selector; - block: [ - (method methodClass soleInstance perform: - method selector) materializeAsBlElement ]; - yourself ]. - PyramidLibraryCategory new - name: package name; - icon: (Smalltalk ui icons iconNamed: #smallSave); - elements: elements asArray; - yourself ] + ^ (packages collect: [ :package | + | elements | + elements := methods + select: [ :method | method package = package ] + thenCollect: [ :method | + PyramidLibraryElement new + icon: (Smalltalk ui icons iconNamed: + method methodClass soleInstance systemIconName); + name: method selector; + block: [ + (method methodClass soleInstance perform: + method selector) materializeAsBlElement ]; + yourself ]. + PyramidLibraryCategory new + name: package name; + icon: anIcon; + elements: (elements sorted: [ :a :b | a name < b name ]); + yourself ]) sorted: [ :a :b | a name < b name ] +] + +{ #category : #accessing } +PyramidLibraryDefault >> pystashCategory [ + + + ^ PyramidLibraryDefault new + pragmaCategory: #pyStash + withIcon: (Smalltalk ui icons iconNamed: #smallSave) ] { #category : #accessing } PyramidLibraryDefault >> pystonCategory [ - - | pragmas methods packages categories | - pragmas := Pragma allNamed: #pySTON. - methods := (pragmas collect: #method) asSet. - packages := (methods collect: #package) asSet. + + ^ PyramidLibraryDefault new + pragmaCategory: #pySTON + withIcon: (Smalltalk ui icons iconNamed: #smallSave) +] - categories := OrderedCollection new. +{ #category : #accessing } +PyramidLibraryDefault >> smalltalkIconsCategory [ - ^ packages collect: [ :package | - | elements | - elements := methods - select: [ :method | method package = package ] - thenCollect: [ :method | - PyramidLibraryElement new - icon: (Smalltalk ui icons iconNamed: - method methodClass soleInstance systemIconName); - name: method selector; - block: [ - (method methodClass soleInstance perform: - method selector) materializeAsBlElement ]; - yourself ]. - PyramidLibraryCategory new - name: package name; - icon: (Smalltalk ui icons iconNamed: #smallSave); - elements: elements; - yourself ] + + | elements | + elements := OrderedCollection new. + elements := Smalltalk ui icons icons associations collect: [ :each | + PyramidLibraryElement new + icon: each value; + name: each key; + block: [ + { (BlElement new + size: each value extent; + background: + (BlImageBackground image: + (PyramidExternalRessourceProxy fromSource: + (PyramidExternalRessourceSource + target: Object + selector: #iconNamed: + arguments: { each key }))); + yourself) } ]; + yourself ]. + ^ { (PyramidLibraryCategory new + name: 'Smalltalk Icons'; + icon: (Smalltalk ui icons iconNamed: #image); + elements: (elements sorted: [ :a :b | a name < b name ]); + yourself) } ] diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index f4012a70..d61f2148 100644 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryElement.class.st @@ -18,7 +18,33 @@ PyramidLibraryElement >> asArray [ { #category : #converting } PyramidLibraryElement >> asForm [ - ^ BlElement new clipChildren: false; size: 800 @ 600; addChildren: (self asArray); exportAsForm + | elements bounds formElement extent bound possibleSizes | + elements := self asArray. + bounds := elements collect: [ :each | each boundsInLocal ]. + + formElement := BlElement new + clipChildren: false; + size: 800 @ 600; + addChildren: self asArray; + background: Color white; + yourself. + formElement forceLayout. + extent := formElement invalidationBoundsInParent extent. + bound := BlBounds + left: 0 + top: 0 + right: 0 + bottom: 0. + formElement childrenDo: [ :each | + bound merge: each invalidationBoundsInParent ]. + extent := bound extent. + possibleSizes := { + (50 @ 50). + (240 @ 240). + (480 @ 480) } select: [ :each | each >= extent ]. + possibleSizes ifNotEmpty: [ formElement size: possibleSizes first ]. + + ^ formElement exportAsForm ] { #category : #accessing } diff --git a/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st b/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st index 995cebb1..74b66c54 100644 --- a/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryPresenter.class.st @@ -5,7 +5,8 @@ Class { 'categoryPresenter', 'elementPresenter', 'imagePresenter', - 'addButtonPresenter' + 'addButtonPresenter', + 'libraryController' ], #category : #'Pyramid-Bloc-plugin-navigation' } @@ -16,15 +17,6 @@ PyramidLibraryPresenter >> addButtonPresenter [ ^ addButtonPresenter ] -{ #category : #adding } -PyramidLibraryPresenter >> addCategories: aCollection [ - - self categoryPresenter items = aCollection ifTrue: [ ^ self ]. - self categoryPresenter - items: aCollection; - selectIndex: 1 -] - { #category : #accessing } PyramidLibraryPresenter >> categoryPresenter [ @@ -38,13 +30,22 @@ PyramidLibraryPresenter >> connectPresenters [ transmitTo: elementPresenter transform: [ :category | category ifNil: [ #( ) ] ifNotNil: [ category elements ] ] - postTransmission: [ :destination | destination selectIndex: 1 ] + postTransmission: [ :destination | destination selectIndex: 1 ]. + + categoryPresenter items ifEmpty: [ ^ self ]. + categoryPresenter selectFirst. +] + +{ #category : #accessing } +PyramidLibraryPresenter >> defaultExtent [ + + ^ 600 @ 400 ] { #category : #layout } PyramidLibraryPresenter >> defaultLayout [ - | panedSelection imageAndButton | + | panedSelection imageAndButton panedLayout | panedSelection := SpPanedLayout newHorizontal add: self categoryPresenter; add: self elementPresenter; @@ -53,11 +54,14 @@ PyramidLibraryPresenter >> defaultLayout [ add: self imagePresenter expand: true; add: self addButtonPresenter expand: false; yourself. - ^ SpPanedLayout newHorizontal - positionOfSlider: 2/3; - add: panedSelection; - add: imageAndButton; - yourself + panedLayout := SpPanedLayout newHorizontal + positionOfSlider: 2 / 3; + add: panedSelection; + add: imageAndButton; + yourself. + ^ SpBoxLayout newVertical + add: (SpBoxLayout newHorizontal add: panedLayout width: self defaultExtent x) + height: self defaultExtent y ] { #category : #accessing } @@ -72,23 +76,12 @@ PyramidLibraryPresenter >> imagePresenter [ ^ imagePresenter ] -{ #category : #initialization } -PyramidLibraryPresenter >> initializeCategories [ - - | pragmas sorted | - pragmas := Pragma allNamed: #pyramidLibraryCategory:. - sorted := pragmas sorted: [ :a :b | - a arguments first < b arguments first ]. - self addCategories: (sorted flatCollect: [ :each | - each method - receiver: self - withArguments: #( ) - executeMethod: each method ]) -] - { #category : #initialization } PyramidLibraryPresenter >> initializePresenters [ + libraryController := PyramidLibraryController new + library: self; + yourself. categoryPresenter := SpTablePresenter new hideColumnHeaders; addColumn: ((SpImageTableColumn @@ -109,7 +102,7 @@ PyramidLibraryPresenter >> initializePresenters [ whenSelectedItemChangedDo: [ :e | self addButtonPresenter enabled: e isNotNil. self addButtonPresenter action: [ - self addNewElement: e ]. + self libraryController addNewElement: e ]. e ifNil: [ self imagePresenter image: @@ -127,7 +120,18 @@ PyramidLibraryPresenter >> initializePresenters [ self focusOrder add: categoryPresenter; add: elementPresenter; - add: addButtonPresenter. - - self initializeCategories + add: addButtonPresenter +] + +{ #category : #accessing } +PyramidLibraryPresenter >> libraryController [ + + ^ libraryController +] + +{ #category : #accessing } +PyramidLibraryPresenter >> libraryController: anObject [ + + libraryController := anObject. + libraryController library: self. ] diff --git a/src/Pyramid-Bloc/PyramidNavigationPlugin.class.st b/src/Pyramid-Bloc/PyramidNavigationPlugin.class.st index 190c8d78..38a6285b 100644 --- a/src/Pyramid-Bloc/PyramidNavigationPlugin.class.st +++ b/src/Pyramid-Bloc/PyramidNavigationPlugin.class.st @@ -4,7 +4,8 @@ Class { #traits : 'TPyramidPlugin', #classTraits : 'TPyramidPlugin classTrait', #instVars : [ - 'navigation' + 'navigation', + 'editor' ], #category : #'Pyramid-Bloc-plugin-navigation' } @@ -17,13 +18,26 @@ PyramidNavigationPlugin >> addPanelsOn: aPyramidSimpleWindow [ makeTab: self navigation label: 'Navigation' icon: (Smalltalk ui icons iconNamed: #catalog) - order: 2 ] + order: 2 ]. + + aPyramidSimpleWindow + at: #selectionMenu + addItem: [ :builder | self menuAddAndDeleteOn: builder ] ] { #category : #connecting } PyramidNavigationPlugin >> connectOn: aPyramidEditor [ - self navigation editor: aPyramidEditor + editor := aPyramidEditor. + self navigation editor: aPyramidEditor. + self libraryController popoverOrigin: + (aPyramidEditor window services at: #tabLeft) presenter. +] + +{ #category : #initialization } +PyramidNavigationPlugin >> editor [ + + ^ editor ] { #category : #initialization } @@ -33,8 +47,66 @@ PyramidNavigationPlugin >> initialize [ navigation := PyramidNavigationPresenter new. ] +{ #category : #accessing } +PyramidNavigationPlugin >> libraryController [ + + ^ self navigation library libraryController +] + +{ #category : #'as yet unclassified' } +PyramidNavigationPlugin >> menuAddAndDeleteOn: aBuilder [ + + aBuilder + addGroupEmptySelection: [ :group :empty | + group addItem: [ :anItem | + anItem + name: 'Add element...'; + help: 'Add a new element on the roots of the design.'; + icon: (Smalltalk ui icons iconNamed: #add); + action: [ self libraryController openForRoot ] ] ] + order: 10. + + aBuilder + addGroupSingleSelection: [ :group :single | + group addItem: [ :anItem | + anItem + name: 'Add child element...'; + help: 'Add a new element as a child of the selected element.'; + icon: (Smalltalk ui icons iconNamed: #add); + action: [ self libraryController openForSelection ] ]. + group addItem: [ :anItem | + anItem + name: 'Remove element'; + help: 'Delete the selected element and its content'; + icon: (Smalltalk ui icons iconNamed: #delete); + action: [ self removeSelectedElements ] ] ] + order: 10. + + aBuilder + addGroupMultiSelection: [ :group :multi | + group addItem: [ :anItem | + anItem + name: 'Remove selection'; + help: 'Delete all selected elements and their contents'; + icon: (Smalltalk ui icons iconNamed: #delete); + action: [ self removeSelectedElements ] ] ] + order: 10 +] + { #category : #initialization } PyramidNavigationPlugin >> navigation [ ^ navigation ] + +{ #category : #removing } +PyramidNavigationPlugin >> removeSelectedElements [ + + self editor propertiesManager commandExecutor + use: PyramidRemoveSelectedElementsCommand new + on: self editor projectModel selection + with: self editor projectModel firstLevelElements. + + "Update the selection after remove" + self editor projectModel updateSelection +] diff --git a/src/Pyramid-Bloc/PyramidNavigationPresenter.class.st b/src/Pyramid-Bloc/PyramidNavigationPresenter.class.st index 48b38f4c..1251b351 100644 --- a/src/Pyramid-Bloc/PyramidNavigationPresenter.class.st +++ b/src/Pyramid-Bloc/PyramidNavigationPresenter.class.st @@ -2,9 +2,10 @@ Class { #name : #PyramidNavigationPresenter, #superclass : #SpPresenter, #instVars : [ - 'libraryPanel', + 'toolPanel', 'selectionPanel', - 'navigationModel' + 'navigationModel', + 'library' ], #category : #'Pyramid-Bloc-plugin-navigation' } @@ -14,7 +15,7 @@ PyramidNavigationPresenter >> defaultLayout [ ^ SpBoxLayout newVertical spacing: 4; - add: self libraryPanel expand: false; + add: self toolPanel expand: false; add: self selectionPanel expand: true; yourself ] @@ -22,27 +23,30 @@ PyramidNavigationPresenter >> defaultLayout [ { #category : #accessing } PyramidNavigationPresenter >> editor: aPyramidEditor [ - self libraryPanel editor: aPyramidEditor. - self selectionPanel editor: aPyramidEditor + self toolPanel editor: aPyramidEditor. + self selectionPanel editor: aPyramidEditor. + self library libraryController editor: aPyramidEditor. ] { #category : #initialization } PyramidNavigationPresenter >> initializePresenters [ + library := PyramidLibraryPresenter new. + library libraryController initializeCategories. navigationModel := PyramidNavigationModel new. - - libraryPanel := PyramidNavigationToolsPresenter new - navigationModel: self navigationModel; - yourself. + toolPanel := PyramidNavigationToolsPresenter new + navigationModel: self navigationModel; + library: self library; + yourself. selectionPanel := PyramidNavigationTreePresenter new navigationModel: self navigationModel; yourself ] { #category : #accessing } -PyramidNavigationPresenter >> libraryPanel [ +PyramidNavigationPresenter >> library [ - ^ libraryPanel + ^ library ] { #category : #accessing } @@ -62,3 +66,9 @@ PyramidNavigationPresenter >> selectionPanel [ ^ selectionPanel ] + +{ #category : #accessing } +PyramidNavigationPresenter >> toolPanel [ + + ^ toolPanel +] diff --git a/src/Pyramid-Bloc/PyramidNavigationToolsPresenter.class.st b/src/Pyramid-Bloc/PyramidNavigationToolsPresenter.class.st index f1b613b1..0ef0ba54 100644 --- a/src/Pyramid-Bloc/PyramidNavigationToolsPresenter.class.st +++ b/src/Pyramid-Bloc/PyramidNavigationToolsPresenter.class.st @@ -2,6 +2,7 @@ Class { #name : #PyramidNavigationToolsPresenter, #superclass : #SpPresenter, #instVars : [ + 'library', 'navigationModel', 'addRootButton', 'displayChildrenOptions', @@ -10,6 +11,12 @@ Class { #category : #'Pyramid-Bloc-plugin-navigation' } +{ #category : #accessing } +PyramidNavigationToolsPresenter >> actionAddToRoot [ + + self library libraryController openForRoot +] + { #category : #accessing } PyramidNavigationToolsPresenter >> addRootButton [ @@ -50,6 +57,7 @@ PyramidNavigationToolsPresenter >> initializePresenters [ addRootButton := SpButtonPresenter new label: 'Add new root'; icon: (Smalltalk ui iconNamed: #add); + action: [ self actionAddToRoot ]; yourself. displayChildrenOptions := SpButtonPresenter new help: @@ -57,6 +65,18 @@ PyramidNavigationToolsPresenter >> initializePresenters [ yourself ] +{ #category : #accessing } +PyramidNavigationToolsPresenter >> library [ + + ^ library +] + +{ #category : #accessing } +PyramidNavigationToolsPresenter >> library: anObject [ + + library := anObject +] + { #category : #accessing } PyramidNavigationToolsPresenter >> navigationModel [ diff --git a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st b/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st index 52bc71c4..f239660b 100644 --- a/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st +++ b/src/Pyramid-Bloc/PyramidRoundedRectangleCornerRadiiCommand.class.st @@ -7,8 +7,8 @@ Class { { #category : #testing } PyramidRoundedRectangleCornerRadiiCommand >> canBeUsedFor: anObject [ - ^ (anObject class = BlElement or: [ - anObject class inheritsFrom: BlElement ]) and: [ anObject geometry class = BlRoundedRectangleGeometry ] + ^ (super canBeUsedFor: anObject) and: [ + anObject geometry class = BlRoundedRectangleGeometry ] ] { #category : #'as yet unclassified' } diff --git a/src/Pyramid-Bloc/PyramidTreeBaseColumnsBuilder.class.st b/src/Pyramid-Bloc/PyramidTreeBaseColumnsBuilder.class.st deleted file mode 100644 index fd904682..00000000 --- a/src/Pyramid-Bloc/PyramidTreeBaseColumnsBuilder.class.st +++ /dev/null @@ -1,97 +0,0 @@ -Class { - #name : #PyramidTreeBaseColumnsBuilder, - #superclass : #PyramidAbstractColumnsBuilder, - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #'as yet unclassified' } -PyramidTreeBaseColumnsBuilder >> buildOn: aPyramidTreePlugin [ - - aPyramidTreePlugin addColumns: { self nameAndTypeColumn . self hashColumn . self zIndexColumn . self visibilityColumn } -] - -{ #category : #accessing } -PyramidTreeBaseColumnsBuilder >> hashColumn [ - - ^ SpStringTableColumn new - title: 'Hash'; - evaluated: [ :aBlElement | - aBlElement identityHash printString ]; - displayColor: [ :aBlElement | Color gray ]; - width: 60; - yourself -] - -{ #category : #accessing } -PyramidTreeBaseColumnsBuilder >> nameAndTypeColumn [ - - ^ SpCompositeTableColumn new - title: 'Elements'; - addColumn: - (SpImageTableColumn evaluated: [ :aBlElement | aBlElement asIcon ]); - addColumn: (SpStringTableColumn new - title: 'Identifier'; - evaluated: [ :aBlElement | - aBlElement elementId isNoId - ifTrue: [ '@\no name\' ] - ifFalse: [ aBlElement id asSymbol ] ]; - yourself); - addColumn: (SpStringTableColumn new - title: 'Class'; - evaluated: [ :aBlElement | aBlElement class name ]; - displayColor: [ :aBlElement | - aBlElement parentsShouldSerializeChildren - ifTrue: [ Color gray ] - ifFalse: [ Color red ] ]; - displayItalic: [ :aBlElement | true ]; - yourself); - yourself -] - -{ #category : #initialization } -PyramidTreeBaseColumnsBuilder >> setVisibility: aBlVisibility of: aBlElement onEditor: aPyramidEditor [ - - aPyramidEditor propertiesManager commandExecutor - use: PyramidVisibilityCommand new - on: { aBlElement } - with: aBlVisibility -] - -{ #category : #accessing } -PyramidTreeBaseColumnsBuilder >> visibilityColumn [ - - ^ SpCompositeTableColumn new - title: 'Visibility'; - width: 80; - addColumn: (SpImageTableColumn evaluated: [ :aBlElement | - aBlElement - allParentsDetect: [ :parent | parent isVisible not ] - ifFound: [ :parent | Smalltalk ui icons iconNamed: #uncommentedClass ] - ifNone: [ Smalltalk ui icons iconNamed: #blank16 ] ]); - addColumn: (SpImageTableColumn evaluated: [ :aBlElement | - aBlElement visibility asIcon ]); - addColumn: (SpLinkTableColumn new - title: 'Visible'; - url: [ :aBlElement | '' ]; - action: [ :aBlElement | - self - setVisibility: aBlElement visibility nextVisibilityForTree - of: aBlElement - onEditor: self editor ]; - evaluated: [ :aBlElement | aBlElement visibility asString ]; - yourself); - yourself -] - -{ #category : #accessing } -PyramidTreeBaseColumnsBuilder >> zIndexColumn [ - - ^ SpStringTableColumn new - title: 'z'; - evaluated: [ :aBlElement | - aBlElement elevation elevation = 0 - ifTrue: [ '' ] - ifFalse: [ aBlElement elevation elevation printString ] ]; - width: 16; - yourself -] diff --git a/src/Pyramid-Bloc/PyramidTreePlugin.class.st b/src/Pyramid-Bloc/PyramidTreePlugin.class.st deleted file mode 100644 index 7fd6ed24..00000000 --- a/src/Pyramid-Bloc/PyramidTreePlugin.class.st +++ /dev/null @@ -1,302 +0,0 @@ -Class { - #name : #PyramidTreePlugin, - #superclass : #Object, - #traits : 'TPyramidPlugin + TPyramidElementToAdd', - #classTraits : 'TPyramidPlugin classTrait + TPyramidElementToAdd classTrait', - #instVars : [ - 'treePresenter', - 'editor', - 'libraryPresenterForElement', - 'libraryPresenterForRoot' - ], - #classVars : [ - 'ColumnsBuildersClasses' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #'as yet unclassified' } -PyramidTreePlugin class >> addDefaultOnLibrary: library [ - - | factoryElement factoryTextElement | - - factoryElement := PyramidElementToAddFactory new - elementIcon: - (Smalltalk ui icons iconNamed: #class); - elementName: 'Simple Element'; - elementBlock: [ {BlElement new background: Color random; yourself} ]; - yourself. - factoryTextElement := PyramidElementToAddFactory new - elementIcon: - (Smalltalk ui icons iconNamed: #haloFontSize); - elementName: 'Simple Element'; - elementBlock: [ {BlTextElement new text: 'Change me' asRopedText; yourself} ]; - yourself. - - library - addCategoryWithName: '(Default)' - withIcon: (Smalltalk ui icons iconNamed: #box) - withAllFactories: { factoryElement . factoryTextElement } sorted. - - ^ library -] - -{ #category : #adding } -PyramidTreePlugin class >> addOnLibrary: aLibrary [ - - self addDefaultOnLibrary: aLibrary. - self addPystonOnLibrary: aLibrary. - self addPystashOnLibrary: aLibrary -] - -{ #category : #'as yet unclassified' } -PyramidTreePlugin class >> addPragma: aSymbol onLibrary: aLibrary withIcon: anIcon [ - - | pragmas methods packages | - pragmas := Pragma allNamed: aSymbol. - methods := (pragmas collect: #method) asSet. - packages := (methods collect: #package) asSet. - - packages do: [ :package | - | factories | - factories := self factoriesFromMethods: methods inPackage: package. - factories ifNotEmpty: [ aLibrary - addCategoryWithName: package name - withIcon: anIcon - withAllFactories: factories asArray sorted ] - ]. - - ^ aLibrary -] - -{ #category : #'as yet unclassified' } -PyramidTreePlugin class >> addPystashOnLibrary: library [ - - ^ self - addPragma: #pyStash - onLibrary: library - withIcon: (Smalltalk ui icons iconNamed: #smallSave). -] - -{ #category : #'as yet unclassified' } -PyramidTreePlugin class >> addPystonOnLibrary: library [ - - ^ self - addPragma: #pySTON - onLibrary: library - withIcon: (Smalltalk ui icons iconNamed: #smallSave) -] - -{ #category : #accessing } -PyramidTreePlugin class >> columnsBuildersClasses [ - - ColumnsBuildersClasses ifNil: [ - ColumnsBuildersClasses := Set new ]. - ^ ColumnsBuildersClasses -] - -{ #category : #'as yet unclassified' } -PyramidTreePlugin class >> factoriesFromMethods: methods inPackage: package [ - - package ifNil: [ ^ { } ]. - - ^ methods - select: [ :method | - method package = package and: [ - method methodClass isObsolete not ] ] - thenCollect: [ :method | - PyramidElementToAddFactory new - elementIcon: (Smalltalk ui icons iconNamed: - method methodClass soleInstance systemIconName); - elementName: method selector; - elementBlock: [ - (method methodClass soleInstance perform: method selector) - materializeAsBlElement ]; - yourself ] -] - -{ #category : #initialization } -PyramidTreePlugin class >> install [ - "Do some stuff here when the plugin used class oriented behavior" - - self columnsBuildersClasses add: PyramidTreeBaseColumnsBuilder -] - -{ #category : #initialization } -PyramidTreePlugin >> addColumns: aCollection [ - aCollection do: [ :each | self treePresenter columns add: each ]. - self treePresenter updateTree - - -] - -{ #category : #adding } -PyramidTreePlugin >> addPanelsOn: aPyramidSimpleWindow [ - - aPyramidSimpleWindow at: #tabLeft addItem: [ :builder | - builder - makeTab: self treePresenter - label: 'Tree' - icon: (Smalltalk ui icons iconNamed: #catalog) - order: 1 ]. - - aPyramidSimpleWindow - at: #selectionMenu - addItem: [ :builder | self menuAddAndDeleteOn: builder ] -] - -{ #category : #actions } -PyramidTreePlugin >> configureBuilder: aPyramidEditorBuilder [ - - self class columnsBuildersClasses do: [ :each | - each new - editor: aPyramidEditorBuilder editor; - buildOn: self ] -] - -{ #category : #connecting } -PyramidTreePlugin >> connectOn: aPyramidEditor [ - - self editor: aPyramidEditor. -] - -{ #category : #accessing } -PyramidTreePlugin >> editor [ - - ^ editor -] - -{ #category : #accessing } -PyramidTreePlugin >> editor: aPyramidEditor [ - - editor := aPyramidEditor. - self treePresenter projectModel: aPyramidEditor projectModel. - self treePresenter editorMenuBuilder: - (self editor window services at: #selectionMenu) builder -] - -{ #category : #initialization } -PyramidTreePlugin >> initialize [ - - self initializeLibraryPresenters. - treePresenter := PyramidTreePresenter new - libraryPresenterForRoot: - self libraryPresenterForRoot; - yourself -] - -{ #category : #initialization } -PyramidTreePlugin >> initializeLibraryPresenters [ - - | idGenerator | - idGenerator := PyramidLibraryContainerPresenter makeIdGenerator. - libraryPresenterForElement := PyramidLibraryContainerPresenter new - idGenerator: idGenerator; - library: PyramidElementToAddPresenter new; - buttonLabel: 'Add new child'; - buttonAction: [ - self editor propertiesManager - commandExecutor - use: PyramidAddChildrenCommand new - on: - self editor projectModel selection - with: - libraryPresenterForElement - elementToAdd ]; - yourself. - libraryPresenterForRoot := PyramidLibraryContainerPresenter new - idGenerator: idGenerator; - library: PyramidElementToAddPresenter new; - buttonLabel: 'Add new on first level'; - buttonAction: [ - self editor propertiesManager - commandExecutor - use: - PyramidAddAllToCollectionCommand new - on: - { self editor projectModel - firstLevelElements } - with: - libraryPresenterForRoot elementToAdd ]; - yourself -] - -{ #category : #'as yet unclassified' } -PyramidTreePlugin >> libraryPresenterForElement [ - - ^ libraryPresenterForElement -] - -{ #category : #'as yet unclassified' } -PyramidTreePlugin >> libraryPresenterForRoot [ - - ^ libraryPresenterForRoot -] - -{ #category : #'as yet unclassified' } -PyramidTreePlugin >> menuAddAndDeleteOn: aBuilder [ - - aBuilder - addGroupEmptySelection: [ :group :empty | - group addItem: [ :anItem | - anItem - name: 'Add element...'; - help: 'Add a new element on the roots of the design.'; - icon: (Smalltalk ui icons iconNamed: #add); - action: [ - (PyramidPopoverFactory - makeWithPresenter: self libraryPresenterForRoot - relativeTo: self treePresenter - position: SpPopoverPosition right) popup ] ] ] - order: 10. - - aBuilder - addGroupSingleSelection: [ :group :single | - group addItem: [ :anItem | - anItem - name: 'Add child element...'; - help: 'Add a new element as a child of the selected element.'; - icon: (Smalltalk ui icons iconNamed: #add); - action: [ - (PyramidPopoverFactory - makeWithPresenter: self libraryPresenterForElement - relativeTo: self treePresenter - position: SpPopoverPosition right) popup ] ]. - group addItem: [ :anItem | - anItem - name: 'Remove element'; - help: - 'Delete the selected element and its content'; - icon: (Smalltalk ui icons iconNamed: #delete); - action: [ self removeSelectedElements ] ] ] - order: 10. - - aBuilder - addGroupMultiSelection: [ :group :multi | - group addItem: [ :anItem | - anItem - name: 'Remove selection'; - help: - 'Delete all selected elements and their contents'; - icon: (Smalltalk ui icons iconNamed: #delete); - action: [ self removeSelectedElements ] ] ] - order: 10 -] - -{ #category : #removing } -PyramidTreePlugin >> removeSelectedElements [ - - self editor propertiesManager commandExecutor - use: PyramidRemoveSelectedElementsCommand new - on: self editor projectModel selection - with: self editor projectModel firstLevelElements. - - "Update the selection after remove" - self editor projectModel updateSelection -] - -{ #category : #accessing } -PyramidTreePlugin >> treePresenter [ - - ^ treePresenter -] diff --git a/src/Pyramid-Bloc/PyramidTreePresenter.class.st b/src/Pyramid-Bloc/PyramidTreePresenter.class.st deleted file mode 100644 index c673328a..00000000 --- a/src/Pyramid-Bloc/PyramidTreePresenter.class.st +++ /dev/null @@ -1,227 +0,0 @@ -Class { - #name : #PyramidTreePresenter, - #superclass : #SpPresenter, - #instVars : [ - 'tree', - 'columns', - 'libraryPresenterForRoot', - 'projectModel', - 'editorMenuBuilder', - 'shouldUpdateSelection', - 'buttonAddToFirstLevel' - ], - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> actionAddNewElement [ - - (PyramidPopoverFactory - makeWithPresenter: self libraryPresenterForRoot - relativeTo: self buttonAddToFirstLevel - position: SpPopoverPosition right) popup -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> actionEditorMenu [ - - ^ self editorMenuBuilder menuFor: self projectModel selection. -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> actionSelectionChanged: aCollection [ - - self projectModel ifNil: [ ^ self ]. - self shouldUpdateSelection ifFalse: [ ^ self ]. - self shouldUpdateSelection: false. - [self projectModel setSelection: aCollection selectedItems ] ensure: [ self shouldUpdateSelection: true ] -] - -{ #category : #accessing } -PyramidTreePresenter >> buttonAddToFirstLevel [ - - ^ buttonAddToFirstLevel -] - -{ #category : #accessing } -PyramidTreePresenter >> columns [ - - ^ columns -] - -{ #category : #layout } -PyramidTreePresenter >> defaultLayout [ - - ^ SpBoxLayout newVertical - spacing: 4; - add: self buttonAddToFirstLevel expand: false; - add: self tree expand: true; - yourself -] - -{ #category : #accessing } -PyramidTreePresenter >> editorMenuBuilder [ - - ^ editorMenuBuilder -] - -{ #category : #accessing } -PyramidTreePresenter >> editorMenuBuilder: anObject [ - - editorMenuBuilder := anObject -] - -{ #category : #initialization } -PyramidTreePresenter >> initializePresenters [ - - shouldUpdateSelection := true. - tree := SpTreeTablePresenter new - beMultipleSelection; - beResizable; - roots: { }; - children: [ :each | - each shouldSerializedChildren not - ifTrue: [ { } ] - ifFalse: [ each children ] ]; - contextMenu: [ self actionEditorMenu ]; - whenSelectionChangedDo: [ :selection | - self actionSelectionChanged: selection ]; - expandAll. - - columns := OrderedCollection new. - - buttonAddToFirstLevel := SpButtonPresenter new - label: 'Add new element'; - icon: (Smalltalk ui icons iconNamed: #add); - action: [ self actionAddNewElement ]; - help: - 'Add a new element on the first level of the design.'; - yourself -] - -{ #category : #accessing } -PyramidTreePresenter >> libraryPresenterForRoot [ - - ^ libraryPresenterForRoot -] - -{ #category : #accessing } -PyramidTreePresenter >> libraryPresenterForRoot: anObject [ - - libraryPresenterForRoot := anObject -] - -{ #category : #accessing } -PyramidTreePresenter >> projectModel [ - - ^ projectModel -] - -{ #category : #accessing } -PyramidTreePresenter >> projectModel: anObject [ - - projectModel := anObject. - projectModel announcer - when: PyramidElementsChangedEvent - do: [ :evt | self pyramidElementsChanged: evt ] - for: self. - projectModel announcer - when: PyramidFirstLevelElementsChangedEvent - do: [ :evt | self pyramidFirstLevelElementsChanged: evt ] - for: self. - projectModel announcer - when: PyramidSelectionChangedEvent - do: [ :evt | self pyramidSelectionChanged: evt ] - for: self. -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> pyramidElementsChanged: anEvent [ - - self updateRoots. - self selectionHaveChanged ifTrue: [ self updateSelection ] -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> pyramidFirstLevelElementsChanged: anEvent [ - - self updateRoots. - self updateSelection -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> pyramidSelectionChanged: anEvent [ - - self updateSelection -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> selectionHaveChanged [ - - self tree selectedItems size = self projectModel selection size ifFalse: [ - ^ true ]. - (self tree selectedItems includesAll: self projectModel selection) ifFalse: [ - ^ true ]. - (self projectModel selection includesAll: self tree selectedItems) ifFalse: [ - ^ true ]. - ^ false -] - -{ #category : #accessing } -PyramidTreePresenter >> shouldUpdateSelection [ - - ^ shouldUpdateSelection -] - -{ #category : #accessing } -PyramidTreePresenter >> shouldUpdateSelection: anObject [ - - shouldUpdateSelection := anObject -] - -{ #category : #accessing } -PyramidTreePresenter >> tree [ - - ^ tree -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> updateRoots [ - - | roots parent shouldOrder | - self shouldUpdateSelection: false. - - roots := self projectModel firstLevelElements asArray. - parent := nil. - - "If roots all have the same parent then it should be ordered by the parent children order." - shouldOrder := (roots allSatisfy: [ :each | - parent ifNil: [ parent := each parent ]. - each parent = parent ]) and: [ - parent notNil and: [ - parent childrenCount = roots size ] ]. - shouldOrder ifTrue: [ roots := parent children asArray ]. - - [ self tree roots: roots ] ensure: [ - self shouldUpdateSelection: true ] -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> updateSelection [ - - self projectModel ifNil: [ ^ self ]. - self shouldUpdateSelection ifFalse: [ ^ self ]. - self shouldUpdateSelection: false. - [ - self tree unselectAll. - self projectModel selection - ifNotEmpty: [ :e | self tree selectItems: e ] ] - ensure: [ self shouldUpdateSelection: true ] -] - -{ #category : #'as yet unclassified' } -PyramidTreePresenter >> updateTree [ - - self tree columns: { }. - self columns do: [ :each | tree addColumn: each ] -] diff --git a/src/Pyramid-Bloc/TPyramidElementToAdd.trait.st b/src/Pyramid-Bloc/TPyramidElementToAdd.trait.st deleted file mode 100644 index 5c1c6ea3..00000000 --- a/src/Pyramid-Bloc/TPyramidElementToAdd.trait.st +++ /dev/null @@ -1,10 +0,0 @@ -Trait { - #name : #TPyramidElementToAdd, - #category : #'Pyramid-Bloc-plugin-tree-library' -} - -{ #category : #adding } -TPyramidElementToAdd classSide >> addOnLibrary: aLibrary [ - - self shouldBeImplemented -] diff --git a/src/Pyramid-Examples/PyramidSimpleExamples.class.st b/src/Pyramid-Examples/PyramidSimpleExamples.class.st index cacc39c1..e8c2c0f0 100644 --- a/src/Pyramid-Examples/PyramidSimpleExamples.class.st +++ b/src/Pyramid-Examples/PyramidSimpleExamples.class.st @@ -9,15 +9,16 @@ PyramidSimpleExamples class >> imageProxy [ "This class has been generated using Pyramid. By: YannLEGOFF - 2024-07-23 09:32:34" + 2024-07-30 11:33:02" - ^ [ {(BlElement new - id: #A; + ^ [ | objectclass1 | +objectclass1 := Object. +{(BlElement new background: (BlImageBackground new image: (PyramidExternalRessourceProxy new pyramidExternalRessourceSource: (PyramidExternalRessourceSource new - target: Object; + target: objectclass1; selector: #iconNamed:; arguments: {#pharoBig}; yourself); @@ -26,6 +27,22 @@ PyramidSimpleExamples class >> imageProxy [ yourself); constraintsDo: [:constraints | constraints horizontal exact: 256.0. constraints vertical exact: 256.0 ]; + id: #A; + yourself) . +(BlElement new + background: (BlImageBackground new + image: (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: objectclass1; + selector: #iconNamed:; + arguments: {#abstract}; + yourself); + yourself); + opacity: 1.0; + yourself); + constraintsDo: [:constraints | constraints horizontal exact: 16.0. + constraints vertical exact: 16.0 ]; + id: #A; yourself)} ] value ] diff --git a/src/Pyramid-Tests/PyramidLibraryControllerTest.class.st b/src/Pyramid-Tests/PyramidLibraryControllerTest.class.st new file mode 100644 index 00000000..f6ff79b7 --- /dev/null +++ b/src/Pyramid-Tests/PyramidLibraryControllerTest.class.st @@ -0,0 +1,80 @@ +Class { + #name : #PyramidLibraryControllerTest, + #superclass : #TestCase, + #category : #'Pyramid-Tests-cases-plugin-navigation' +} + +{ #category : #tests } +PyramidLibraryControllerTest >> testOpenForRoot [ + "We generate a bunch of id and we verify that none are the same" + + | controller editor element | + controller := PyramidLibraryController new. + editor := PyramidEditor new. + controller editor: editor. + element := PyramidLibraryElement new + block: [ + { + BlElement new. + BlElement new. + BlElement new. + BlElement new. + BlElement new } ]; + yourself. + self assert: editor projectModel firstLevelElements size equals: 0. + self assert: editor projectModel selection size equals: 0. + + controller openForRoot. + controller addNewElement: element. + self assert: editor projectModel firstLevelElements size equals: 5. + self assert: editor projectModel selection size equals: 0. +] + +{ #category : #tests } +PyramidLibraryControllerTest >> testOpenForSelection [ + + | controller editor element selectedElement | + controller := PyramidLibraryController new. + editor := PyramidEditor new. + controller editor: editor. + element := PyramidLibraryElement new + block: [ + { + BlElement new. + BlElement new. + BlElement new. + BlElement new. + BlElement new } ]; + yourself. + selectedElement := BlElement new. + editor projectModel selection add: selectedElement. + self assert: editor projectModel firstLevelElements size equals: 0. + self assert: selectedElement children size equals: 0. + + controller openForRoot. + controller addNewElement: element. + self assert: editor projectModel firstLevelElements size equals: 5. + self assert: selectedElement children size equals: 0 +] + +{ #category : #tests } +PyramidLibraryControllerTest >> testRenameElements [ + "We generate a bunch of id and we verify that none are the same" + + | controller elementIds elements | + controller := PyramidLibraryController new. + elements := { + BlElement new. + BlElement new. + BlElement new. + BlElement new. + BlElement new }. + + elementIds := Bag new. + 1 to: 200 do: [ :i | + controller renameElements: elements. + elementIds addAll: (elements collect: [ :each | each id asSymbol ]) ]. + + self assert: elementIds size equals: 1000. + self assert: elementIds asSet size equals: 1000 +] diff --git a/src/Pyramid-Tests/PyramidLibraryPresenterTest.class.st b/src/Pyramid-Tests/PyramidLibraryPresenterTest.class.st deleted file mode 100644 index 217e2196..00000000 --- a/src/Pyramid-Tests/PyramidLibraryPresenterTest.class.st +++ /dev/null @@ -1,41 +0,0 @@ -Class { - #name : #PyramidLibraryPresenterTest, - #superclass : #TestCase, - #category : #'Pyramid-Tests-cases-plugin-tree-library' -} - -{ #category : #tests } -PyramidLibraryPresenterTest >> testIdGenerator [ - "We generate a bunch of id and we verify that none are the same" - - | treePlugin libraryPresForElements libraryPresForFirstLevel elementIds | - treePlugin := PyramidTreePlugin new. - libraryPresForElements := treePlugin libraryPresenterForElement. - libraryPresForFirstLevel := treePlugin libraryPresenterForRoot. - libraryPresForElements library currentFactory: - (PyramidElementToAddFactory new - elementBlock: [ - { - BlElement new. - BlElement new } ]; - yourself). - libraryPresForFirstLevel library currentFactory: - (PyramidElementToAddFactory new - elementBlock: [ - { - BlElement new. - BlElement new } ]; - yourself). - - elementIds := Bag new. - 1 to: 100 do: [ :i | - elementIds addAll: - (libraryPresForElements elementToAdd collect: [ :each | - each id asSymbol ]) ]. - 1 to: 100 do: [ :i | - elementIds addAll: - (libraryPresForFirstLevel elementToAdd collect: [ :each | - each id asSymbol ]) ]. - self assert: elementIds size equals: 400. - self assert: elementIds asSet size equals: 400. -] diff --git a/src/Pyramid-Tests/PyramidNavigationPluginTest.class.st b/src/Pyramid-Tests/PyramidNavigationPluginTest.class.st new file mode 100644 index 00000000..0cf17884 --- /dev/null +++ b/src/Pyramid-Tests/PyramidNavigationPluginTest.class.st @@ -0,0 +1,33 @@ +Class { + #name : #PyramidNavigationPluginTest, + #superclass : #TestCase, + #category : #'Pyramid-Tests-cases-plugin-navigation' +} + +{ #category : #tests } +PyramidNavigationPluginTest >> testRemoveSelectedElements [ + + | plugin editor e1 e2 e3 | + e1 := BlElement new. + e2 := BlElement new. + e3 := BlElement new. + editor := PyramidEditor new. + editor window: PyramidSimpleWindow new. + plugin := PyramidNavigationPlugin new. + plugin connectOn: editor. + editor projectModel firstLevelElements addAll: { + e1. + e2. + e3 }. + editor projectModel setSelection: { + e1. + e2 }. + self assert: plugin navigation selectionPanel treeTable selectedItems size equals: 2. + self assert: (plugin navigation selectionPanel treeTable selectedItems includes: e1). + self assert: (plugin navigation selectionPanel treeTable selectedItems includes: e2). + plugin removeSelectedElements. + self assert: plugin navigation selectionPanel treeTable selectedItems size equals: 0. + self assert: editor projectModel selection size equals: 0. + self assert: editor projectModel firstLevelElements size equals: 1. + self assert: editor projectModel firstLevelElements first equals: e3 +] diff --git a/src/Pyramid-Tests/PyramidTreePluginTest.class.st b/src/Pyramid-Tests/PyramidTreePluginTest.class.st deleted file mode 100644 index e3cae686..00000000 --- a/src/Pyramid-Tests/PyramidTreePluginTest.class.st +++ /dev/null @@ -1,49 +0,0 @@ -Class { - #name : #PyramidTreePluginTest, - #superclass : #TestCase, - #category : #'Pyramid-Tests-cases-plugin-tree-library' -} - -{ #category : #tests } -PyramidTreePluginTest >> testAddColumns [ - - | plugin | - plugin := PyramidTreePlugin new. - self assert: plugin treePresenter columns size equals: 0. - plugin addColumns: { SpStringTableColumn new - title: 'Test1'; - yourself. SpStringTableColumn new - title: 'Test2'; - yourself. SpStringTableColumn new - title: 'Test3'; - yourself }. - self assert: plugin treePresenter columns size equals: 3. -] - -{ #category : #tests } -PyramidTreePluginTest >> testRemoveSelectedElements [ - - | plugin editor e1 e2 e3 | - e1 := BlElement new. - e2 := BlElement new. - e3 := BlElement new. - editor := PyramidEditor new. - editor window: PyramidSimpleWindow new. - plugin := PyramidTreePlugin new. - plugin editor: editor. - editor projectModel firstLevelElements addAll: { - e1. - e2. - e3 }. - editor projectModel setSelection: { - e1. - e2 }. - self assert: plugin treePresenter tree selectedItems size equals: 2. - self assert: (plugin treePresenter tree selectedItems includes: e1). - self assert: (plugin treePresenter tree selectedItems includes: e2). - plugin removeSelectedElements. - self assert: plugin treePresenter tree selectedItems size equals: 0. - self assert: editor projectModel selection size equals: 0. - self assert: editor projectModel firstLevelElements size equals: 1. - self assert: editor projectModel firstLevelElements first equals: e3. -] diff --git a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st index bf32e850..8d119f63 100644 --- a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st +++ b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st @@ -57,7 +57,6 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -102,12 +101,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -141,12 +138,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -175,12 +170,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -206,12 +199,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -259,12 +250,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -292,12 +281,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -329,12 +316,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -365,12 +350,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -396,12 +379,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -442,12 +423,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -473,12 +452,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -512,12 +489,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -543,12 +518,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -574,12 +547,10 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. constraints vertical exact: 32.0. constraints padding: blinsets1 ]; beHorizontal; - beIconFirst; flexible: false; icon: nil; iconContainerHeight: 0.0; iconContainerWidth: 0.0; - interspace: 0.0 @ 0.0; label: (ToLabel new layout: blframelayout5; constraintsDo: [:constraints | constraints horizontal fitContent. @@ -610,3 +581,37 @@ blfontsizedefaultattribute21 := BlFontSizeDefaultAttribute new. yourself)} ] value ] + +{ #category : #'pyramid-serialized-bloc' } +PyramidToploExamples class >> icons [ + "This class has been generated using Pyramid. + + By: YannLEGOFF + 2024-07-30 17:40:45" + + + ^ [ + | toimage1 | + toimage1 := ToImage new. + { (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource new + target: (toimage1 + innerImage: (PyramidExternalRessourceProxy fromTarget: BlSvgConverter selector: #convertFromString: arguments: {(PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource new + target: ToAntDesignIconProvider; + selector: #twotone_like; + arguments: { }; + yourself); + yourself)}); + constraintsDo: [ :constraints | + constraints horizontal exact: 48.0. + constraints vertical exact: 48.0 ]; + layout: BlFrameLayout new; + yourself); + selector: #yourself; + arguments: { }; + yourself); + yourself) } ] value +] diff --git a/src/Pyramid-Toplo/PyramidContainsValidSelectorInterpreter.class.st b/src/Pyramid-Toplo/PyramidContainsValidSelectorInterpreter.class.st index 71d2a390..93a8c932 100644 --- a/src/Pyramid-Toplo/PyramidContainsValidSelectorInterpreter.class.st +++ b/src/Pyramid-Toplo/PyramidContainsValidSelectorInterpreter.class.st @@ -1,18 +1,16 @@ Class { - #name : 'PyramidContainsValidSelectorInterpreter', - #superclass : 'ToElementSelectorVisitor', + #name : #PyramidContainsValidSelectorInterpreter, + #superclass : #ToElementSelectorVisitor, #instVars : [ 'targetElement', 'validSelectors', 'invalidSelectors', 'ignoredSelectors' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'operating' } +{ #category : #operating } PyramidContainsValidSelectorInterpreter >> check: aSelector on: anElement [ targetElement := anElement. @@ -22,39 +20,39 @@ PyramidContainsValidSelectorInterpreter >> check: aSelector on: anElement [ aSelector accept: self. ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidContainsValidSelectorInterpreter >> ignoredSelectors [ ^ ignoredSelectors ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidContainsValidSelectorInterpreter >> invalidSelectors [ ^ invalidSelectors ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidContainsValidSelectorInterpreter >> result [ invalidSelectors ifNil: [ ^ false ]. ^ invalidSelectors isEmpty ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidContainsValidSelectorInterpreter >> targetElement [ ^ targetElement ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidContainsValidSelectorInterpreter >> validSelectors [ ^ validSelectors ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitActionSelector: aSelector [ (aSelector action value: self targetElement) @@ -62,7 +60,7 @@ PyramidContainsValidSelectorInterpreter >> visitActionSelector: aSelector [ ifFalse: [ self invalidSelectors add: aSelector ] ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitAndSelector: aSelector [ | interpreterForAndLeft interpreterForAndRight | @@ -85,7 +83,7 @@ PyramidContainsValidSelectorInterpreter >> visitAndSelector: aSelector [ self ignoredSelectors addAll: interpreterForAndRight ignoredSelectors ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitChildSelector: aSelector [ | parent interpreterForLeft interpreterForRight | @@ -109,7 +107,7 @@ PyramidContainsValidSelectorInterpreter >> visitChildSelector: aSelector [ self invalidSelectors add: aSelector ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitIdSelector: aSelector [ aSelector id = self targetElement id @@ -117,7 +115,7 @@ PyramidContainsValidSelectorInterpreter >> visitIdSelector: aSelector [ ifFalse: [ self invalidSelectors add: aSelector ] ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitNotSelector: aSelector [ | interpreterForNot | @@ -128,7 +126,7 @@ PyramidContainsValidSelectorInterpreter >> visitNotSelector: aSelector [ self ignoredSelectors addAll: interpreterForNot ignoredSelectors ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitOrSelector: aSelector [ | interpreterForOrLeft interpreterForOrRight | @@ -151,7 +149,7 @@ PyramidContainsValidSelectorInterpreter >> visitOrSelector: aSelector [ self validSelectors add: aSelector ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitParentSelector: aSelector [ | depth current interpreterForLeft interpreterForRight | @@ -184,7 +182,7 @@ PyramidContainsValidSelectorInterpreter >> visitParentSelector: aSelector [ ^ self ] ] ] repeat ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitSiblingSelector: aSelector [ | current interpreterForSiblingLeft interpreterForSiblingRight | @@ -210,13 +208,13 @@ PyramidContainsValidSelectorInterpreter >> visitSiblingSelector: aSelector [ self invalidSelectors add: aSelector ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitStyleStampSelector: aSelector [ self ignoredSelectors add: aSelector ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitTypeSelector: aSelector [ (aSelector selectType: self targetElement class) @@ -224,7 +222,7 @@ PyramidContainsValidSelectorInterpreter >> visitTypeSelector: aSelector [ ifFalse: [ self invalidSelectors add: aSelector ] ] -{ #category : 'visiting' } +{ #category : #visiting } PyramidContainsValidSelectorInterpreter >> visitUniversalSelector: aSelector [ "Must be valid for not" diff --git a/src/Pyramid-Toplo/PyramidElementThemeSelectorPresenter.class.st b/src/Pyramid-Toplo/PyramidElementThemeSelectorPresenter.class.st index e54aecc9..be82e5f7 100644 --- a/src/Pyramid-Toplo/PyramidElementThemeSelectorPresenter.class.st +++ b/src/Pyramid-Toplo/PyramidElementThemeSelectorPresenter.class.st @@ -1,6 +1,6 @@ Class { - #name : 'PyramidElementThemeSelectorPresenter', - #superclass : 'PyramidThemeSelectorPresenter', + #name : #PyramidElementThemeSelectorPresenter, + #superclass : #PyramidThemeSelectorPresenter, #instVars : [ 'projectModel', 'inheritSelector', @@ -8,12 +8,10 @@ Class { 'commandExecutor', 'themeCommand' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidElementThemeSelectorPresenter >> applyTheme [ | themeToApplied | @@ -28,19 +26,19 @@ PyramidElementThemeSelectorPresenter >> applyTheme [ self projectModel informElementsChanged ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidElementThemeSelectorPresenter >> commandExecutor [ ^ commandExecutor ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidElementThemeSelectorPresenter >> commandExecutor: aCommandExecutor [ commandExecutor := aCommandExecutor ] -{ #category : 'layout' } +{ #category : #layout } PyramidElementThemeSelectorPresenter >> defaultLayout [ ^ SpBoxLayout newVertical @@ -64,7 +62,7 @@ PyramidElementThemeSelectorPresenter >> defaultLayout [ yourself ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidElementThemeSelectorPresenter >> elementsOrSelectionChanged: anEvent [ self triggerThemeChangement: false. @@ -72,13 +70,13 @@ PyramidElementThemeSelectorPresenter >> elementsOrSelectionChanged: anEvent [ self triggerThemeChangement: true ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidElementThemeSelectorPresenter >> inheritSelector [ ^ inheritSelector ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidElementThemeSelectorPresenter >> initializePresenters [ super initializePresenters. @@ -96,19 +94,19 @@ PyramidElementThemeSelectorPresenter >> initializePresenters [ self triggerThemeChangement: true ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidElementThemeSelectorPresenter >> labelPresenter [ ^ labelPresenter ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidElementThemeSelectorPresenter >> projectModel [ ^ projectModel ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidElementThemeSelectorPresenter >> projectModel: aPyramidProjectModel [ projectModel := aPyramidProjectModel. @@ -122,7 +120,7 @@ PyramidElementThemeSelectorPresenter >> projectModel: aPyramidProjectModel [ for: self. ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidElementThemeSelectorPresenter >> setDefaultStateForPresenters [ self themeSelector enabled: false. @@ -130,13 +128,13 @@ PyramidElementThemeSelectorPresenter >> setDefaultStateForPresenters [ self inheritSelector state: true. ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidElementThemeSelectorPresenter >> themeCommand [ ^ themeCommand ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidElementThemeSelectorPresenter >> updatePresenterFor: aCollectionOfElement [ | collectionOfLocalThemes | diff --git a/src/Pyramid-Toplo/PyramidSelectorPossibleStamps.class.st b/src/Pyramid-Toplo/PyramidSelectorPossibleStamps.class.st index 8bdff1d7..34b51949 100644 --- a/src/Pyramid-Toplo/PyramidSelectorPossibleStamps.class.st +++ b/src/Pyramid-Toplo/PyramidSelectorPossibleStamps.class.st @@ -1,15 +1,13 @@ Class { - #name : 'PyramidSelectorPossibleStamps', - #superclass : 'Object', + #name : #PyramidSelectorPossibleStamps, + #superclass : #Object, #instVars : [ 'theme' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidSelectorPossibleStamps >> findAllSelectorFor: aBlElement [ ^ self theme styleSheet styleRules flatCollect: [ @@ -17,7 +15,7 @@ PyramidSelectorPossibleStamps >> findAllSelectorFor: aBlElement [ self findAllSelectorFor: aBlElement on: rule ]. ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidSelectorPossibleStamps >> findAllSelectorFor: aBlElement on: aToStyleRule [ | interpreter | @@ -31,7 +29,7 @@ PyramidSelectorPossibleStamps >> findAllSelectorFor: aBlElement on: aToStyleRule ifFalse: [ ^ { } ] ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidSelectorPossibleStamps >> findAllStampsFor: aBlElement [ | allValidSelectors allStampsSelectors | @@ -42,13 +40,13 @@ PyramidSelectorPossibleStamps >> findAllStampsFor: aBlElement [ sorted ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidSelectorPossibleStamps >> theme [ ^ theme ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidSelectorPossibleStamps >> theme: anObject [ theme := anObject diff --git a/src/Pyramid-Toplo/PyramidSpaceThemeSelectorPresenter.class.st b/src/Pyramid-Toplo/PyramidSpaceThemeSelectorPresenter.class.st index 2345119e..28df7ae8 100644 --- a/src/Pyramid-Toplo/PyramidSpaceThemeSelectorPresenter.class.st +++ b/src/Pyramid-Toplo/PyramidSpaceThemeSelectorPresenter.class.st @@ -1,24 +1,22 @@ Class { - #name : 'PyramidSpaceThemeSelectorPresenter', - #superclass : 'PyramidThemeSelectorPresenter', + #name : #PyramidSpaceThemeSelectorPresenter, + #superclass : #PyramidThemeSelectorPresenter, #traits : 'TPyramidSpaceExtension', #classTraits : 'TPyramidSpaceExtension classTrait', #instVars : [ 'projectModel' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidSpaceThemeSelectorPresenter >> applyTheme [ self builder space toTheme: self currentTheme. self projectModel informElementsChanged ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidSpaceThemeSelectorPresenter >> labelPresenter [ ^ SpLabelPresenter new @@ -27,13 +25,13 @@ PyramidSpaceThemeSelectorPresenter >> labelPresenter [ yourself ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidSpaceThemeSelectorPresenter >> projectModel [ ^ projectModel ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidSpaceThemeSelectorPresenter >> projectModel: anObject [ projectModel := anObject diff --git a/src/Pyramid-Toplo/PyramidStampCommand.class.st b/src/Pyramid-Toplo/PyramidStampCommand.class.st index 3fe41464..e26d219a 100644 --- a/src/Pyramid-Toplo/PyramidStampCommand.class.st +++ b/src/Pyramid-Toplo/PyramidStampCommand.class.st @@ -1,21 +1,19 @@ Class { - #name : 'PyramidStampCommand', - #superclass : 'PyramidAbstractBlocCommand', + #name : #PyramidStampCommand, + #superclass : #PyramidAbstractBlocCommand, #instVars : [ 'stamp' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidStampCommand >> getValueFor: anObject [ ^ anObject hasStamp: self stamp ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidStampCommand >> setValueFor: anObject with: aBoolean [ aBoolean @@ -23,13 +21,13 @@ PyramidStampCommand >> setValueFor: anObject with: aBoolean [ ifFalse: [ anObject removeStamp: self stamp ] ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidStampCommand >> stamp [ ^ stamp ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidStampCommand >> stamp: anObject [ stamp := anObject diff --git a/src/Pyramid-Toplo/PyramidStyleSheetEditorPresenter.class.st b/src/Pyramid-Toplo/PyramidStyleSheetEditorPresenter.class.st index a9fcf705..461b0a89 100644 --- a/src/Pyramid-Toplo/PyramidStyleSheetEditorPresenter.class.st +++ b/src/Pyramid-Toplo/PyramidStyleSheetEditorPresenter.class.st @@ -1,17 +1,15 @@ Class { - #name : 'PyramidStyleSheetEditorPresenter', - #superclass : 'SpPresenter', + #name : #PyramidStyleSheetEditorPresenter, + #superclass : #SpPresenter, #instVars : [ 'themeSelector', 'styleSheetEditor', 'stampPresenter' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'accessing' } +{ #category : #accessing } PyramidStyleSheetEditorPresenter >> defaultLayout [ ^ SpBoxLayout new @@ -24,19 +22,19 @@ PyramidStyleSheetEditorPresenter >> defaultLayout [ yourself ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidStyleSheetEditorPresenter >> initializePresenters [ stampPresenter := SpNullPresenter new ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidStyleSheetEditorPresenter >> stampPresenter [ ^ stampPresenter ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidStyleSheetEditorPresenter >> stampPresenter: anObject [ stampPresenter := anObject diff --git a/src/Pyramid-Toplo/PyramidThemeCommand.class.st b/src/Pyramid-Toplo/PyramidThemeCommand.class.st index f8e857bb..f7b52034 100644 --- a/src/Pyramid-Toplo/PyramidThemeCommand.class.st +++ b/src/Pyramid-Toplo/PyramidThemeCommand.class.st @@ -1,18 +1,16 @@ Class { - #name : 'PyramidThemeCommand', - #superclass : 'PyramidAbstractBlocCommand', - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #name : #PyramidThemeCommand, + #superclass : #PyramidAbstractBlocCommand, + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeCommand >> getValueFor: anObject [ ^ anObject localTheme ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeCommand >> setValueFor: anObject with: nilOrToTheme [ anObject localTheme: nilOrToTheme diff --git a/src/Pyramid-Toplo/PyramidThemeFromSpaceExtension.class.st b/src/Pyramid-Toplo/PyramidThemeFromSpaceExtension.class.st index 3136ea67..4fd98854 100644 --- a/src/Pyramid-Toplo/PyramidThemeFromSpaceExtension.class.st +++ b/src/Pyramid-Toplo/PyramidThemeFromSpaceExtension.class.st @@ -1,6 +1,6 @@ Class { - #name : 'PyramidThemeFromSpaceExtension', - #superclass : 'Object', + #name : #PyramidThemeFromSpaceExtension, + #superclass : #Object, #traits : 'TPyramidPlugin + TPyramidSpaceExtension + TPyramidEditorSpaceIsReadyObserver + TPyramidOpenFromSpacePluginExtension', #classTraits : 'TPyramidPlugin classTrait + TPyramidSpaceExtension classTrait + TPyramidEditorSpaceIsReadyObserver classTrait + TPyramidOpenFromSpacePluginExtension classTrait', #instVars : [ @@ -8,18 +8,16 @@ Class { 'themeSpaceSelector', 'spaceIsReady' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'asserting' } +{ #category : #asserting } PyramidThemeFromSpaceExtension class >> shouldInstall [ ^ false ] -{ #category : 'actions' } +{ #category : #actions } PyramidThemeFromSpaceExtension >> configureBuilder: aPyramidEditorBuilder [ (aPyramidEditorBuilder findPlugin: PyramidOpenFromSpacePlugin) @@ -30,14 +28,14 @@ PyramidThemeFromSpaceExtension >> configureBuilder: aPyramidEditorBuilder [ themePresenter themeSpaceSelector ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeFromSpaceExtension >> configureCloseOnSpace: aSpace [ aSpace toTheme: themeSpaceSelector currentTheme. aSpace root skinManager postponeRequestSkinIn: aSpace root ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeFromSpaceExtension >> configureOpenFromSpace: aSpace [ "Do something with the space" @@ -45,13 +43,13 @@ PyramidThemeFromSpaceExtension >> configureOpenFromSpace: aSpace [ aSpace root skinManager postponeRequestSkinIn: aSpace root ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeFromSpaceExtension >> defaultToTheme [ ^ defaultToTheme ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeFromSpaceExtension >> defaultToTheme: anObject [ defaultToTheme := anObject. @@ -59,45 +57,45 @@ PyramidThemeFromSpaceExtension >> defaultToTheme: anObject [ self spaceIsReady ifTrue: [ self informSpaceIsReady ]. ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeFromSpaceExtension >> informSpaceIsReady [ self defaultToTheme ifNil: [ self spaceIsReady: true. ^ self ]. self builder space toTheme: self defaultToTheme ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidThemeFromSpaceExtension >> initialize [ spaceIsReady := false. ] -{ #category : 'displaying' } +{ #category : #displaying } PyramidThemeFromSpaceExtension >> installOn: aBuilder [ self builder: aBuilder. aBuilder addSpaceIsReadyObserver: self. ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeFromSpaceExtension >> spaceIsReady [ ^ spaceIsReady ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeFromSpaceExtension >> spaceIsReady: anObject [ spaceIsReady := anObject ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeFromSpaceExtension >> themeSpaceSelector [ ^ themeSpaceSelector ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeFromSpaceExtension >> themeSpaceSelector: anObject [ themeSpaceSelector := anObject diff --git a/src/Pyramid-Toplo/PyramidThemePresenter.class.st b/src/Pyramid-Toplo/PyramidThemePresenter.class.st index abaeb1d2..d77c8367 100644 --- a/src/Pyramid-Toplo/PyramidThemePresenter.class.st +++ b/src/Pyramid-Toplo/PyramidThemePresenter.class.st @@ -1,17 +1,15 @@ Class { - #name : 'PyramidThemePresenter', - #superclass : 'SpPresenter', + #name : #PyramidThemePresenter, + #superclass : #SpPresenter, #instVars : [ 'styleSheetEditor', 'themeSpaceSelector', 'themeElementSelector' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'layout' } +{ #category : #layout } PyramidThemePresenter >> defaultLayout [ ^ SpBoxLayout newVertical @@ -22,7 +20,7 @@ PyramidThemePresenter >> defaultLayout [ yourself ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemePresenter >> editor: aPyramidEditor [ self themeSpaceSelector projectModel: aPyramidEditor projectModel. @@ -30,7 +28,7 @@ PyramidThemePresenter >> editor: aPyramidEditor [ self themeElementSelector commandExecutor: aPyramidEditor propertiesManager commandExecutor ] -{ #category : 'layout' } +{ #category : #layout } PyramidThemePresenter >> initializePresenters [ themeSpaceSelector := PyramidSpaceThemeSelectorPresenter new. @@ -38,25 +36,25 @@ PyramidThemePresenter >> initializePresenters [ styleSheetEditor := PyramidStyleSheetEditorPresenter new ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemePresenter >> pyramidSpaceBuilderConfigurationOn: aSpaceBuilder [ aSpaceBuilder addExtension: self themeSpaceSelector ] -{ #category : 'layout' } +{ #category : #layout } PyramidThemePresenter >> styleSheetEditor [ ^ styleSheetEditor ] -{ #category : 'layout' } +{ #category : #layout } PyramidThemePresenter >> themeElementSelector [ ^ themeElementSelector ] -{ #category : 'layout' } +{ #category : #layout } PyramidThemePresenter >> themeSpaceSelector [ ^ themeSpaceSelector diff --git a/src/Pyramid-Toplo/PyramidThemePropertyStrategy.class.st b/src/Pyramid-Toplo/PyramidThemePropertyStrategy.class.st index 8981bc46..59a0ac89 100644 --- a/src/Pyramid-Toplo/PyramidThemePropertyStrategy.class.st +++ b/src/Pyramid-Toplo/PyramidThemePropertyStrategy.class.st @@ -1,12 +1,10 @@ Class { - #name : 'PyramidThemePropertyStrategy', - #superclass : 'PyramidHideEmptyPropertyStrategy', - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #name : #PyramidThemePropertyStrategy, + #superclass : #PyramidHideEmptyPropertyStrategy, + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemePropertyStrategy >> buildPresenterFromCollection: aCollection andManager: aManager [ aManager removeAllProperties. @@ -14,7 +12,7 @@ PyramidThemePropertyStrategy >> buildPresenterFromCollection: aCollection andMan ^ super buildPresenterFromCollection: aCollection andManager: aManager ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemePropertyStrategy >> propertiesFor: aCollectionOfElements [ | elementsWithStyleSheetTheme allPossibleStamps allCommonStamps | @@ -35,7 +33,7 @@ PyramidThemePropertyStrategy >> propertiesFor: aCollectionOfElements [ ^ allCommonStamps collect: [ :each | self propertyForStamp: each ]. ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemePropertyStrategy >> propertyForStamp: aStamp [ | property | diff --git a/src/Pyramid-Toplo/PyramidThemeSelectorPresenter.class.st b/src/Pyramid-Toplo/PyramidThemeSelectorPresenter.class.st index 07bd7e57..6753c8a9 100644 --- a/src/Pyramid-Toplo/PyramidThemeSelectorPresenter.class.st +++ b/src/Pyramid-Toplo/PyramidThemeSelectorPresenter.class.st @@ -1,35 +1,33 @@ Class { - #name : 'PyramidThemeSelectorPresenter', - #superclass : 'SpPresenter', + #name : #PyramidThemeSelectorPresenter, + #superclass : #SpPresenter, #instVars : [ 'themeSelector', 'buttonRefreshTheme', 'triggerThemeChangement' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : 'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeSelectorPresenter >> applyTheme [ self shouldBeImplemented ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeSelectorPresenter >> buttonRefreshTheme [ ^ buttonRefreshTheme ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeSelectorPresenter >> currentTheme [ ^ self themeSelector selectedItem ] -{ #category : 'layout' } +{ #category : #layout } PyramidThemeSelectorPresenter >> defaultLayout [ ^ SpBoxLayout newVertical @@ -52,7 +50,7 @@ PyramidThemeSelectorPresenter >> defaultLayout [ yourself ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidThemeSelectorPresenter >> initializeAllPossibleThemes [ | allThemes previousTheme | @@ -72,7 +70,7 @@ PyramidThemeSelectorPresenter >> initializeAllPossibleThemes [ self triggerThemeChangement: true. ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidThemeSelectorPresenter >> initializePresenters [ triggerThemeChangement := false. @@ -88,13 +86,13 @@ PyramidThemeSelectorPresenter >> initializePresenters [ self initializeAllPossibleThemes ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidThemeSelectorPresenter >> labelPresenter [ ^ self shouldBeImplemented ] -{ #category : 'private' } +{ #category : #private } PyramidThemeSelectorPresenter >> selectTheme: aToTheme [ self triggerThemeChangement: false. @@ -103,7 +101,7 @@ PyramidThemeSelectorPresenter >> selectTheme: aToTheme [ ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeSelectorPresenter >> themeSelectionChanged: aThemeClass [ aThemeClass ifNil: [ ^ self ]. @@ -111,25 +109,25 @@ PyramidThemeSelectorPresenter >> themeSelectionChanged: aThemeClass [ ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeSelectorPresenter >> themeSelector [ ^ themeSelector ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeSelectorPresenter >> triggerThemeChangement [ ^ triggerThemeChangement ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidThemeSelectorPresenter >> triggerThemeChangement: anObject [ triggerThemeChangement := anObject ] -{ #category : 'as yet unclassified' } +{ #category : #'as yet unclassified' } PyramidThemeSelectorPresenter >> variantSelectionChanged: aVariantClass [ aVariantClass ifNil: [ ^ self ]. diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index c54d95ba..b320313d 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -1,45 +1,97 @@ Class { - #name : 'PyramidToploThemePlugin', - #superclass : 'Object', - #traits : 'TPyramidPlugin + TPyramidElementToAdd', - #classTraits : 'TPyramidPlugin classTrait + TPyramidElementToAdd classTrait', + #name : #PyramidToploThemePlugin, + #superclass : #Object, + #traits : 'TPyramidPlugin', + #classTraits : 'TPyramidPlugin classTrait', #instVars : [ 'themePresenter', 'themePropertyManager' ], - #category : 'Pyramid-Toplo-plugin-theme-management', - #package : 'Pyramid-Toplo', - #tag : 'plugin-theme-management' + #category : #'Pyramid-Toplo-plugin-theme-management' } -{ #category : 'adding' } -PyramidToploThemePlugin class >> addOnLibrary: aLibrary [ - - | classes factories | - classes := ToElement allSubclasses. - factories := classes - reject: [ :each | each isAbstract ] - thenCollect: [ :class | - PyramidElementToAddFactory new - elementIcon: - (Smalltalk ui icons iconNamed: class systemIconName); - elementName: class name; - elementBlock: [ { class new } ]; - yourself ]. - - aLibrary - addCategoryWithName: 'Toplo' - withIcon: (Smalltalk ui icons iconNamed: #smallInfo) - withAllFactories: factories asArray sorted. -] - -{ #category : 'asserting' } +{ #category : #asserting } PyramidToploThemePlugin class >> shouldInstall [ ^ false ] -{ #category : 'adding' } +{ #category : #adding } +PyramidToploThemePlugin class >> toploAntIconCategory [ + + + ^ PyramidToploThemePlugin toploIconThemeCategoryFromClass: ToAntDesignIconProvider +] + +{ #category : #adding } +PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass [ + + | categoriesMethods | + categoriesMethods := aClass class methods select: [ :m | + m selector first = $_ and: [ + ($_ split: m selector) last = 'loaded' ] ]. + + ^ categoriesMethods collect: [ :method | + | libraryCategory elements elementSelectors | + libraryCategory := PyramidLibraryCategory new + name: method selector allButFirst; + icon: (Smalltalk ui icons iconNamed: #image); + yourself. + + elementSelectors := (aClass perform: method selector) collect: [ + :suffix | + ($_ split: method selector) second , '_' + , suffix ]. + + elements := elementSelectors collect: [ :selector | + PyramidLibraryElement new + name: selector; + icon: (Smalltalk ui icons iconNamed: #blank); + block: [ + | image | + image := (PyramidExternalRessourceProxy fromTarget: ToImage selector: #inner: arguments: { + (PyramidExternalRessourceProxy + fromTarget: aClass + selector: selector asSymbol + arguments: { }) }). + image size: 48 asPoint. + { image } ]; + yourself ]. + libraryCategory elements: elements. + libraryCategory ] +] + +{ #category : #adding } +PyramidToploThemePlugin class >> toploLibraryCategory [ + + + | classes elements | + 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 | + PyramidLibraryElement new + icon: + (Smalltalk ui icons iconNamed: class systemIconName); + name: class name; + block: [ { class new } ]; + yourself ]. + + ^ { (PyramidLibraryCategory new + name: 'Toplo'; + icon: (Smalltalk ui icons iconNamed: #box); + elements: (elements sorted: [ :a :b | a name < b name ]); + yourself) } +] + +{ #category : #adding } PyramidToploThemePlugin >> addPanelsOn: aPyramidSimpleWindow [ aPyramidSimpleWindow at: #tabRight addItem: [ :builder | @@ -50,7 +102,7 @@ PyramidToploThemePlugin >> addPanelsOn: aPyramidSimpleWindow [ order: 1 ] ] -{ #category : 'actions' } +{ #category : #actions } PyramidToploThemePlugin >> configureBuilder: aPyramidEditorBuilder [ | spacePlugin | @@ -58,14 +110,14 @@ PyramidToploThemePlugin >> configureBuilder: aPyramidEditorBuilder [ self themePresenter pyramidSpaceBuilderConfigurationOn: spacePlugin builder ] -{ #category : 'connecting' } +{ #category : #connecting } PyramidToploThemePlugin >> connectOn: aPyramidEditor [ self themePresenter editor: aPyramidEditor. self themePropertyManager projectModel: aPyramidEditor projectModel ] -{ #category : 'initialization' } +{ #category : #initialization } PyramidToploThemePlugin >> initialize [ themePresenter := PyramidThemePresenter new. @@ -76,13 +128,13 @@ PyramidToploThemePlugin >> initialize [ themePresenter styleSheetEditor stampPresenter: themePropertyManager presenter ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidToploThemePlugin >> themePresenter [ ^ themePresenter ] -{ #category : 'accessing' } +{ #category : #accessing } PyramidToploThemePlugin >> themePropertyManager [ ^ themePropertyManager diff --git a/src/Pyramid-Toplo/package.st b/src/Pyramid-Toplo/package.st index f130d9ab..3788959f 100644 --- a/src/Pyramid-Toplo/package.st +++ b/src/Pyramid-Toplo/package.st @@ -1 +1 @@ -Package { #name : 'Pyramid-Toplo' } +Package { #name : #'Pyramid-Toplo' } diff --git a/src/Pyramid/Object.extension.st b/src/Pyramid/Object.extension.st new file mode 100644 index 00000000..30172d0c --- /dev/null +++ b/src/Pyramid/Object.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #Object } + +{ #category : #'*Pyramid' } +Object >> isPyramidProxy [ + + ^ false +] diff --git a/src/Pyramid/PyramidExternalRessourceProxy.class.st b/src/Pyramid/PyramidExternalRessourceProxy.class.st index 880cc1a3..cedddfcf 100644 --- a/src/Pyramid/PyramidExternalRessourceProxy.class.st +++ b/src/Pyramid/PyramidExternalRessourceProxy.class.st @@ -3,7 +3,8 @@ Class { #superclass : #Object, #instVars : [ 'object', - 'source' + 'source', + 'hasComputedObject' ], #category : #'Pyramid-external-ressources' } @@ -13,19 +14,32 @@ PyramidExternalRessourceProxy class >> fromSource: aSource [ ^ self new pyramidExternalRessourceSource: aSource; - pyramidExternalRessourceObject: aSource getRessource; yourself ] +{ #category : #'instance creation' } +PyramidExternalRessourceProxy class >> fromTarget: aTarget selector: aSelector arguments: aCollection [ + + ^ self fromSource: (PyramidExternalRessourceSource target: aTarget selector: aSelector arguments: aCollection) +] + +{ #category : #converting } +PyramidExternalRessourceProxy >> asStashConstructor [ + + ^ self class printString , ' new' +] + { #category : #'as yet unclassified' } PyramidExternalRessourceProxy >> doesNotUnderstand: aMessage [ - - ^ (self pyramidExternalRessourceObject respondsTo: aMessage selector) - ifTrue: [ - self pyramidExternalRessourceObject - perform: aMessage selector - withEnoughArguments: aMessage arguments ] - ifFalse: [ super doesNotUnderstand: aMessage ] + | returnValue | + (self pyramidExternalRessourceObject respondsTo: aMessage selector) ifFalse: [ ^ super doesNotUnderstand: aMessage ]. + + returnValue := self pyramidExternalRessourceObject + perform: aMessage selector + withEnoughArguments: aMessage arguments. + returnValue == object + ifTrue: [ ^ self ]. + ^ returnValue ] { #category : #'instance creation' } @@ -37,10 +51,265 @@ PyramidExternalRessourceProxy >> fromSton: stonReader [ ] ] ] +{ #category : #initialization } +PyramidExternalRessourceProxy >> initialize [ + + super initialize. + hasComputedObject := false. +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isArray [ + + ^ self pyramidExternalRessourceObject isArray +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isAssociation [ + + ^ self pyramidExternalRessourceObject isAssociation +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isBehavior [ + + ^ self pyramidExternalRessourceObject isBehavior +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isBlock [ + + ^ self pyramidExternalRessourceObject isBlock +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isCharacter [ + + ^ self pyramidExternalRessourceObject isCharacter +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isClass [ + + ^ self pyramidExternalRessourceObject isClass +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isClassOrTrait [ + + ^ self pyramidExternalRessourceObject isClassOrTrait +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isClosure [ + + ^ self pyramidExternalRessourceObject isClosure +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isCollection [ + + ^ self pyramidExternalRessourceObject isCollection +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isColor [ + + ^ self pyramidExternalRessourceObject isColor +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isColorForm [ + + ^ self pyramidExternalRessourceObject isColorForm +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isCompiledBlock [ + + ^ self pyramidExternalRessourceObject isCompiledBlock +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isCompiledMethod [ + + ^ self pyramidExternalRessourceObject isCompiledMethod +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isContext [ + + ^ self pyramidExternalRessourceObject isContext +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isDictionary [ + + ^ self pyramidExternalRessourceObject isDictionary +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isEmbeddedBlock [ + + ^ self pyramidExternalRessourceObject isEmbeddedBlock +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isFloat [ + + ^ self pyramidExternalRessourceObject isFloat +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isForm [ + + ^ self pyramidExternalRessourceObject isForm +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isFraction [ + + ^ self pyramidExternalRessourceObject isFraction +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isHeap [ + + ^ self pyramidExternalRessourceObject isHeap +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isInteger [ + + ^ self pyramidExternalRessourceObject isInteger +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isInterval [ + + ^ self pyramidExternalRessourceObject isInterval +] + +{ #category : #'class membership' } +PyramidExternalRessourceProxy >> isKindOf: aClass [ + + ^ self pyramidExternalRessourceObject isKindOf: aClass +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isLiteral [ + + ^ self pyramidExternalRessourceObject isLiteral +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isMessageSend [ + + ^ self pyramidExternalRessourceObject isMessageSend +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isMethodProperties [ + + ^ self pyramidExternalRessourceObject isMethodProperties +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isMorph [ + + ^ self pyramidExternalRessourceObject isMorph +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isMorphicEvent [ + + ^ self pyramidExternalRessourceObject isMorphicEvent +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isNotNil [ + + ^ self pyramidExternalRessourceObject isNotNil +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isNumber [ + + ^ self pyramidExternalRessourceObject isNumber +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isPoint [ + + ^ self pyramidExternalRessourceObject isPoint +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isPyramidProxy [ + + ^ true +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isRectangle [ + + ^ self pyramidExternalRessourceObject isRectangle +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isStream [ + + ^ self pyramidExternalRessourceObject isStream +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isString [ + + ^ self pyramidExternalRessourceObject isString +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isSymbol [ + + ^ self pyramidExternalRessourceObject isSymbol +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isSystemWindow [ + + ^ self pyramidExternalRessourceObject isSystemWindow +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isText [ + + ^ self pyramidExternalRessourceObject isText +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isTrait [ + + ^ self pyramidExternalRessourceObject isTrait +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> isVariableBinding [ + + ^ self pyramidExternalRessourceObject isVariableBinding +] + +{ #category : #testing } +PyramidExternalRessourceProxy >> notNil [ + + ^ self pyramidExternalRessourceObject notNil +] + { #category : #accessing } PyramidExternalRessourceProxy >> pyramidExternalRessourceObject [ - object ifNil: [ object := self pyramidExternalRessourceSource getRessource ]. + hasComputedObject ifFalse: [ + hasComputedObject := true. + object := self pyramidExternalRessourceSource getRessource ]. ^ object ] @@ -62,11 +331,17 @@ PyramidExternalRessourceProxy >> pyramidExternalRessourceSource: anObject [ source := anObject ] +{ #category : #accessing } +PyramidExternalRessourceProxy >> size [ + + ^ self pyramidExternalRessourceObject size +] + { #category : #'as yet unclassified' } PyramidExternalRessourceProxy >> stashAccessors [ - ^ { #pyramidExternalRessourceSource } + ^ { #pyramidExternalRessourceSource . #pyramidExternalRessourceObject onlyGetOnStash } ] { #category : #'as yet unclassified' } From 9689c34c7b9743a5210432b5c8dcd40151d85e04 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Tue, 30 Jul 2024 18:06:35 +0200 Subject: [PATCH 03/11] add stuff to serialize the icons --- .../PyramidToploExamples.class.st | 82 +++++++++++++------ .../PyramidToploThemePlugin.class.st | 27 ++++-- 2 files changed, 79 insertions(+), 30 deletions(-) diff --git a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st index 8d119f63..265b5aef 100644 --- a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st +++ b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st @@ -587,31 +587,63 @@ PyramidToploExamples class >> icons [ "This class has been generated using Pyramid. By: YannLEGOFF - 2024-07-30 17:40:45" + 2024-07-30 18:05:02" - ^ [ - | toimage1 | - toimage1 := ToImage new. - { (PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: - (PyramidExternalRessourceSource new - target: (toimage1 - innerImage: (PyramidExternalRessourceProxy fromTarget: BlSvgConverter selector: #convertFromString: arguments: {(PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: - (PyramidExternalRessourceSource new - target: ToAntDesignIconProvider; - selector: #twotone_like; - arguments: { }; - yourself); - yourself)}); - constraintsDo: [ :constraints | - constraints horizontal exact: 48.0. - constraints vertical exact: 48.0 ]; - layout: BlFrameLayout new; - yourself); - selector: #yourself; - arguments: { }; - yourself); - yourself) } ] value + ^ [ | toimage1 blsvgconverterclass2 pyramidexternalressourceproxy3 toimage4 toantdesigniconproviderclass5 | +toimage1 := ToImage new. +blsvgconverterclass2 := BlSvgConverter. +pyramidexternalressourceproxy3 := PyramidExternalRessourceProxy new. +toimage4 := ToImage new. +toantdesigniconproviderclass5 := ToAntDesignIconProvider. +{(PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: (toimage4 + innerImage: (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: blsvgconverterclass2; + selector: #convertFromString:; + arguments: {(PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: toantdesigniconproviderclass5; + selector: #twotone_like; + arguments: {}; + yourself); + yourself)}; + yourself); + yourself); + constraintsDo: [:constraints | constraints horizontal exact: 48.0. + constraints vertical exact: 48.0 ]; + layout: BlFrameLayout new; + yourself); + selector: #yourself; + arguments: {}; + yourself); + yourself) . +(PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: (toimage1 + innerImage: (pyramidexternalressourceproxy3 + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: blsvgconverterclass2; + selector: #convertFromString:; + arguments: {(PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: toantdesigniconproviderclass5; + selector: #twotone_switcher; + arguments: {}; + yourself); + yourself)}; + yourself); + yourself); + constraintsDo: [:constraints | constraints horizontal exact: 64.0. + constraints vertical exact: 64.0. + constraints position: 52.0 @ 30.0 ]; + layout: BlFrameLayout new; + id: #A; + yourself); + selector: #innerImage:; + arguments: {pyramidexternalressourceproxy3}; + yourself); + yourself)} ] value ] diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index b320313d..03947928 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -49,11 +49,28 @@ PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass [ icon: (Smalltalk ui icons iconNamed: #blank); block: [ | image | - image := (PyramidExternalRessourceProxy fromTarget: ToImage selector: #inner: arguments: { - (PyramidExternalRessourceProxy - fromTarget: aClass - selector: selector asSymbol - arguments: { }) }). + image := PyramidExternalRessourceProxy + fromTarget: ToImage new + selector: #innerImage: + arguments: + { (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource new + target: BlSvgConverter; + selector: #convertFromString:; + arguments: + { (PyramidExternalRessourceProxy + new + pyramidExternalRessourceSource: + (PyramidExternalRessourceSource + new + target: aClass; + selector: selector asSymbol; + arguments: { }; + yourself); + yourself) }; + yourself); + yourself) }. image size: 48 asPoint. { image } ]; yourself ]. From ed1496318404bffc7f9d8694c2c4fb002be2b6ac Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Tue, 30 Jul 2024 18:27:17 +0200 Subject: [PATCH 04/11] Better names --- .../PyramidToploExamples.class.st | 108 ++++++++++-------- .../PyramidToploThemePlugin.class.st | 51 +++++---- .../PyramidExternalRessourceProxy.class.st | 6 + 3 files changed, 96 insertions(+), 69 deletions(-) diff --git a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st index 265b5aef..2f37b1fe 100644 --- a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st +++ b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st @@ -587,63 +587,77 @@ PyramidToploExamples class >> icons [ "This class has been generated using Pyramid. By: YannLEGOFF - 2024-07-30 18:05:02" + 2024-07-30 18:24:19" - ^ [ | toimage1 blsvgconverterclass2 pyramidexternalressourceproxy3 toimage4 toantdesigniconproviderclass5 | -toimage1 := ToImage new. -blsvgconverterclass2 := BlSvgConverter. -pyramidexternalressourceproxy3 := PyramidExternalRessourceProxy new. -toimage4 := ToImage new. -toantdesigniconproviderclass5 := ToAntDesignIconProvider. -{(PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: (PyramidExternalRessourceSource new - target: (toimage4 - innerImage: (PyramidExternalRessourceProxy new + ^ [ | blsvgconverterclass1 toantdesigniconproviderclass2 | +blsvgconverterclass1 := BlSvgConverter. +toantdesigniconproviderclass2 := ToAntDesignIconProvider. +{(ToImage new + innerImage: (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: blsvgconverterclass1; + selector: #convertFromString:; + arguments: {(PyramidExternalRessourceProxy new pyramidExternalRessourceSource: (PyramidExternalRessourceSource new - target: blsvgconverterclass2; - selector: #convertFromString:; - arguments: {(PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: (PyramidExternalRessourceSource new - target: toantdesigniconproviderclass5; - selector: #twotone_like; - arguments: {}; - yourself); - yourself)}; + target: toantdesigniconproviderclass2; + selector: #twotone_sound; + arguments: {}; yourself); - yourself); - constraintsDo: [:constraints | constraints horizontal exact: 48.0. - constraints vertical exact: 48.0 ]; - layout: BlFrameLayout new; + yourself)}; yourself); - selector: #yourself; - arguments: {}; yourself); + constraintsDo: [:constraints | constraints horizontal exact: 200.0. + constraints vertical exact: 200.0 ]; + layout: BlFrameLayout new; + id: #A; yourself) . -(PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: (PyramidExternalRessourceSource new - target: (toimage1 - innerImage: (pyramidexternalressourceproxy3 +(ToImage new + innerImage: (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: blsvgconverterclass1; + selector: #convertFromString:; + arguments: {(PyramidExternalRessourceProxy new pyramidExternalRessourceSource: (PyramidExternalRessourceSource new - target: blsvgconverterclass2; - selector: #convertFromString:; - arguments: {(PyramidExternalRessourceProxy new - pyramidExternalRessourceSource: (PyramidExternalRessourceSource new - target: toantdesigniconproviderclass5; - selector: #twotone_switcher; - arguments: {}; - yourself); - yourself)}; + target: toantdesigniconproviderclass2; + selector: #outlined_code; + arguments: {}; yourself); - yourself); - constraintsDo: [:constraints | constraints horizontal exact: 64.0. - constraints vertical exact: 64.0. - constraints position: 52.0 @ 30.0 ]; - layout: BlFrameLayout new; - id: #A; + yourself)}; + yourself); + yourself); + constraintsDo: [:constraints | constraints horizontal exact: 48.0. + constraints vertical exact: 48.0 ]; + layout: BlFrameLayout new; + id: #B; + yourself)} ] value +] + +{ #category : #'pyramid-serialized-bloc' } +PyramidToploExamples class >> icons2 [ + "This class has been generated using Pyramid. + + By: YannLEGOFF + 2024-07-30 18:25:18" + + + ^ [ {(ToImage new + innerImage: (PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: BlSvgConverter; + selector: #convertFromString:; + arguments: {(PyramidExternalRessourceProxy new + pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + target: ToMaterialDesignIconProvider; + selector: #round_timelapse; + arguments: {}; + yourself); + yourself)}; yourself); - selector: #innerImage:; - arguments: {pyramidexternalressourceproxy3}; yourself); + constraintsDo: [:constraints | constraints horizontal exact: 200.0. + constraints vertical exact: 200.0 ]; + layout: BlFrameLayout new; + id: #A; yourself)} ] value ] diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index 03947928..28b23cdb 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -20,28 +20,25 @@ PyramidToploThemePlugin class >> shouldInstall [ PyramidToploThemePlugin class >> toploAntIconCategory [ - ^ PyramidToploThemePlugin toploIconThemeCategoryFromClass: ToAntDesignIconProvider + ^ PyramidToploThemePlugin + toploIconThemeCategoryFromClass: ToAntDesignIconProvider + withCategoryPrefix: 'Ant Design - ' ] { #category : #adding } -PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass [ +PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass withCategoryPrefix: aString [ | categoriesMethods | - categoriesMethods := aClass class methods select: [ :m | - m selector first = $_ and: [ - ($_ split: m selector) last = 'loaded' ] ]. + categoriesMethods := aClass class methods select: [ :method | + method selector first = $_ and: [ + ($_ split: method selector) last = 'loaded' ] ]. ^ categoriesMethods collect: [ :method | - | libraryCategory elements elementSelectors | - libraryCategory := PyramidLibraryCategory new - name: method selector allButFirst; - icon: (Smalltalk ui icons iconNamed: #image); - yourself. + | prefix elementSelectors elements | + prefix := ($_ split: method selector) second. elementSelectors := (aClass perform: method selector) collect: [ - :suffix | - ($_ split: method selector) second , '_' - , suffix ]. + :suffix | prefix , '_' , suffix ]. elements := elementSelectors collect: [ :selector | PyramidLibraryElement new @@ -49,11 +46,10 @@ PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass [ icon: (Smalltalk ui icons iconNamed: #blank); block: [ | image | - image := PyramidExternalRessourceProxy - fromTarget: ToImage new - selector: #innerImage: - arguments: - { (PyramidExternalRessourceProxy new + image := ToImage new + size: 48 asPoint; + innerImage: + (PyramidExternalRessourceProxy new pyramidExternalRessourceSource: (PyramidExternalRessourceSource new target: BlSvgConverter; @@ -70,12 +66,14 @@ PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass [ yourself); yourself) }; yourself); - yourself) }. - image size: 48 asPoint. + yourself). { image } ]; yourself ]. - libraryCategory elements: elements. - libraryCategory ] + PyramidLibraryCategory new + name: aString , prefix; + icon: (Smalltalk ui icons iconNamed: #image); + elements: elements; + yourself ] ] { #category : #adding } @@ -108,6 +106,15 @@ PyramidToploThemePlugin class >> toploLibraryCategory [ yourself) } ] +{ #category : #adding } +PyramidToploThemePlugin class >> toploMaterialIconCategory [ + + + ^ PyramidToploThemePlugin + toploIconThemeCategoryFromClass: ToMaterialDesignIconProvider + withCategoryPrefix: 'Material Design - ' +] + { #category : #adding } PyramidToploThemePlugin >> addPanelsOn: aPyramidSimpleWindow [ diff --git a/src/Pyramid/PyramidExternalRessourceProxy.class.st b/src/Pyramid/PyramidExternalRessourceProxy.class.st index cedddfcf..f8f7a822 100644 --- a/src/Pyramid/PyramidExternalRessourceProxy.class.st +++ b/src/Pyramid/PyramidExternalRessourceProxy.class.st @@ -331,6 +331,12 @@ PyramidExternalRessourceProxy >> pyramidExternalRessourceSource: anObject [ source := anObject ] +{ #category : #asserting } +PyramidExternalRessourceProxy >> shouldSerializedChildren [ + + ^ false +] + { #category : #accessing } PyramidExternalRessourceProxy >> size [ From b4175908876686cd133ba1c38840049ae9d0959d Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Wed, 31 Jul 2024 10:38:25 +0200 Subject: [PATCH 05/11] add postConstructionBlock for the proxies to fix material fix size image --- .../PyramidToploExamples.class.st | 10 +++--- .../PyramidToploThemePlugin.class.st | 5 +++ .../PyramidExternalRessourceSource.class.st | 32 ++++++++++++++++--- 3 files changed, 39 insertions(+), 8 deletions(-) diff --git a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st index 2f37b1fe..cfbbfe24 100644 --- a/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st +++ b/src/Pyramid-Toplo-Examples/PyramidToploExamples.class.st @@ -638,7 +638,7 @@ PyramidToploExamples class >> icons2 [ "This class has been generated using Pyramid. By: YannLEGOFF - 2024-07-30 18:25:18" + 2024-07-31 10:27:35" ^ [ {(ToImage new @@ -649,14 +649,16 @@ PyramidToploExamples class >> icons2 [ arguments: {(PyramidExternalRessourceProxy new pyramidExternalRessourceSource: (PyramidExternalRessourceSource new target: ToMaterialDesignIconProvider; - selector: #round_timelapse; + selector: #twotone_mediation; arguments: {}; yourself); yourself)}; + postConstructionBlock: [:obj | obj constraints horizontal matchParent. + obj constraints vertical matchParent ]; yourself); yourself); - constraintsDo: [:constraints | constraints horizontal exact: 200.0. - constraints vertical exact: 200.0 ]; + constraintsDo: [:constraints | constraints horizontal exact: 128.0. + constraints vertical exact: 128.0 ]; layout: BlFrameLayout new; id: #A; yourself)} ] value diff --git a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st index 28b23cdb..fa3f0d8a 100644 --- a/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st +++ b/src/Pyramid-Toplo/PyramidToploThemePlugin.class.st @@ -52,6 +52,11 @@ PyramidToploThemePlugin class >> toploIconThemeCategoryFromClass: aClass withCat (PyramidExternalRessourceProxy new pyramidExternalRessourceSource: (PyramidExternalRessourceSource new + postConstructionBlock: [ :obj | + obj constraints horizontal + matchParent. + obj constraints vertical + matchParent ]; target: BlSvgConverter; selector: #convertFromString:; arguments: diff --git a/src/Pyramid/PyramidExternalRessourceSource.class.st b/src/Pyramid/PyramidExternalRessourceSource.class.st index 562455dc..bc72ad73 100644 --- a/src/Pyramid/PyramidExternalRessourceSource.class.st +++ b/src/Pyramid/PyramidExternalRessourceSource.class.st @@ -4,7 +4,8 @@ Class { #instVars : [ 'target', 'selector', - 'arguments' + 'arguments', + 'postConstructionBlock' ], #category : #'Pyramid-external-ressources' } @@ -63,13 +64,31 @@ PyramidExternalRessourceSource >> fromSton: stonReader [ { #category : #'as yet unclassified' } PyramidExternalRessourceSource >> getRessource [ - ^ self target perform: self selector withArguments: self arguments + | ressource | + ressource := self target + perform: self selector + withArguments: self arguments. + self postConstructionBlock ifNotNil: [ :block | block value: ressource ]. + ^ ressource ] { #category : #initialization } PyramidExternalRessourceSource >> initialize [ - arguments := { } + arguments := { }. + postConstructionBlock := nil. +] + +{ #category : #accessing } +PyramidExternalRessourceSource >> postConstructionBlock [ + + ^ postConstructionBlock +] + +{ #category : #accessing } +PyramidExternalRessourceSource >> postConstructionBlock: anObject [ + + postConstructionBlock := anObject ] { #category : #accessing } @@ -88,7 +107,12 @@ PyramidExternalRessourceSource >> selector: anObject [ PyramidExternalRessourceSource >> stashAccessors [ - ^ { #target . #selector . #arguments } + | accessors | + accessors := OrderedCollection new. + accessors addAll: { #target. #selector. #arguments }. + self postConstructionBlock ifNotNil: [ + accessors add: #postConstructionBlock ]. + ^ accessors ] { #category : #'as yet unclassified' } From e6eace7dd4de3ae0060a06203cbfe0a43d34a774 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Wed, 31 Jul 2024 11:44:34 +0200 Subject: [PATCH 06/11] small improvment --- .../PyramidLibraryDefault.class.st | 4 ++- .../PyramidExternalRessourceProxy.class.st | 34 +++++++++++++------ .../PyramidExternalRessourceSource.class.st | 29 +++++++++++----- 3 files changed, 48 insertions(+), 19 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidLibraryDefault.class.st b/src/Pyramid-Bloc/PyramidLibraryDefault.class.st index 6e347581..80f1efb4 100644 --- a/src/Pyramid-Bloc/PyramidLibraryDefault.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryDefault.class.st @@ -43,7 +43,9 @@ PyramidLibraryDefault >> pragmaCategory: aSymbol withIcon: anIcon [ PyramidLibraryElement new icon: (Smalltalk ui icons iconNamed: method methodClass soleInstance systemIconName); - name: method selector; + name: ('<1s> (<2s>)' + expandMacrosWith: method selector + with: method methodClass name); block: [ (method methodClass soleInstance perform: method selector) materializeAsBlElement ]; diff --git a/src/Pyramid/PyramidExternalRessourceProxy.class.st b/src/Pyramid/PyramidExternalRessourceProxy.class.st index f8f7a822..049fdf16 100644 --- a/src/Pyramid/PyramidExternalRessourceProxy.class.st +++ b/src/Pyramid/PyramidExternalRessourceProxy.class.st @@ -20,7 +20,17 @@ PyramidExternalRessourceProxy class >> fromSource: aSource [ { #category : #'instance creation' } PyramidExternalRessourceProxy class >> fromTarget: aTarget selector: aSelector arguments: aCollection [ - ^ self fromSource: (PyramidExternalRessourceSource target: aTarget selector: aSelector arguments: aCollection) + ^ self fromTarget: aTarget selector: aSelector arguments: aCollection withPostConstructionBlock: nil +] + +{ #category : #'instance creation' } +PyramidExternalRessourceProxy class >> fromTarget: aTarget selector: aSelector arguments: aCollection withPostConstructionBlock: aBlock [ + + ^ self fromSource: (PyramidExternalRessourceSource + target: aTarget + selector: aSelector + arguments: aCollection + postConstructionBlock: aBlock) ] { #category : #converting } @@ -31,15 +41,19 @@ PyramidExternalRessourceProxy >> asStashConstructor [ { #category : #'as yet unclassified' } PyramidExternalRessourceProxy >> doesNotUnderstand: aMessage [ - | returnValue | - (self pyramidExternalRessourceObject respondsTo: aMessage selector) ifFalse: [ ^ super doesNotUnderstand: aMessage ]. - - returnValue := self pyramidExternalRessourceObject - perform: aMessage selector - withEnoughArguments: aMessage arguments. - returnValue == object - ifTrue: [ ^ self ]. - ^ returnValue + + | returnValue target | + target := self pyramidExternalRessourceObject. + self pyramidExternalRessourceObject isPyramidProxy ifTrue: [ ^ target doesNotUnderstand: aMessage ]. + + (target respondsTo: aMessage selector) + ifFalse: [ ^ super doesNotUnderstand: aMessage ]. + + returnValue := target + perform: aMessage selector + withEnoughArguments: aMessage arguments. + returnValue == object ifTrue: [ ^ self ]. + ^ returnValue ] { #category : #'instance creation' } diff --git a/src/Pyramid/PyramidExternalRessourceSource.class.st b/src/Pyramid/PyramidExternalRessourceSource.class.st index bc72ad73..9bf6ea03 100644 --- a/src/Pyramid/PyramidExternalRessourceSource.class.st +++ b/src/Pyramid/PyramidExternalRessourceSource.class.st @@ -21,21 +21,33 @@ PyramidExternalRessourceSource class >> formFromFileNamed: aFileReference [ ] { #category : #initialization } -PyramidExternalRessourceSource class >> target: aClass selector: aSelector [ +PyramidExternalRessourceSource class >> target: anObject selector: aSelector [ - ^ self new - target: aClass; - selector: aSelector; - yourself + ^ self + target: anObject + selector: aSelector + arguments: { } + postConstructionBlock: nil +] + +{ #category : #initialization } +PyramidExternalRessourceSource class >> target: anObject selector: aSelector arguments: anArray [ + + ^ self + target: anObject + selector: aSelector + arguments: anArray + postConstructionBlock: nil ] { #category : #initialization } -PyramidExternalRessourceSource class >> target: aClass selector: aSelector arguments: anArray [ +PyramidExternalRessourceSource class >> target: anObject selector: aSelector arguments: anArray postConstructionBlock: aBlock [ ^ self new - target: aClass; + target: anObject; selector: aSelector; arguments: anArray; + postConstructionBlock: aBlock; yourself ] @@ -68,7 +80,8 @@ PyramidExternalRessourceSource >> getRessource [ ressource := self target perform: self selector withArguments: self arguments. - self postConstructionBlock ifNotNil: [ :block | block value: ressource ]. + self postConstructionBlock ifNotNil: [ :block | + block value: ressource ]. ^ ressource ] From d5d9f8e7e0b4db827917d372db763b4c0975b0b4 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Wed, 31 Jul 2024 11:55:35 +0200 Subject: [PATCH 07/11] remove dev method --- src/Pyramid-Bloc/PyramidLibraryElement.class.st | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index d61f2148..d6180464 100644 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryElement.class.st @@ -29,7 +29,8 @@ PyramidLibraryElement >> asForm [ background: Color white; yourself. formElement forceLayout. - extent := formElement invalidationBoundsInParent extent. + extent := (formElement localBoundsToParent: + (BlBounds fromRectangle: formElement invalidationBounds)) extent. bound := BlBounds left: 0 top: 0 From 9a5e8dae596f0776397b7cb53c28ebe719b3c4e6 Mon Sep 17 00:00:00 2001 From: Yann Le Goff Date: Wed, 31 Jul 2024 11:59:50 +0200 Subject: [PATCH 08/11] this time it should work x) --- src/Pyramid-Bloc/PyramidLibraryElement.class.st | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Pyramid-Bloc/PyramidLibraryElement.class.st b/src/Pyramid-Bloc/PyramidLibraryElement.class.st index d6180464..188b0954 100644 --- a/src/Pyramid-Bloc/PyramidLibraryElement.class.st +++ b/src/Pyramid-Bloc/PyramidLibraryElement.class.st @@ -30,14 +30,16 @@ PyramidLibraryElement >> asForm [ yourself. formElement forceLayout. extent := (formElement localBoundsToParent: - (BlBounds fromRectangle: formElement invalidationBounds)) extent. + (BlBounds fromRectangle: formElement invalidationBounds)) + extent. bound := BlBounds left: 0 top: 0 right: 0 bottom: 0. formElement childrenDo: [ :each | - bound merge: each invalidationBoundsInParent ]. + bound merge: (each localBoundsToParent: + (BlBounds fromRectangle: each invalidationBounds)) ]. extent := bound extent. possibleSizes := { (50 @ 50). From 59e8727330b690908410170f80e4ac9c6b20e23a Mon Sep 17 00:00:00 2001 From: Yann LE GOFF <34318678+Nyan11@users.noreply.github.com> Date: Wed, 31 Jul 2024 16:42:19 +0200 Subject: [PATCH 09/11] Update README.md --- README.md | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 93807275..768bbf69 100644 --- a/README.md +++ b/README.md @@ -136,13 +136,14 @@ https://github.com/OpenSmock/Pyramid/assets/49183340/0c66a3ac-7bea-48c1-b1e8-0b0 ## Dependencies -![image](https://github.com/OpenSmock/Pyramid/assets/34318678/099f25fc-74bd-477f-bef0-2ad7d47db10d) - -- [Toplo](https://github.com/pharo-graphics/Toplo) -- [Toplo-Serialization](https://github.com/OpenSmock/Toplo-Serialization) -- [Bloc](https://github.com/pharo-graphics/Bloc) -- [Bloc-Serialization](https://github.com/OpenSmock/Bloc-Serialization) -- [Alexandrie](https://github.com/pharo-graphics/Alexandrie) +![image](https://github.com/user-attachments/assets/192ff62a-ce48-4801-a437-c9c83720eb5f) + +- [Bloc-Serialization](https://github.com/OpenSmock/Bloc-Serialization) - serializer project for Bloc (this project define the Bloc version of Pyramid). +- [Bloc](https://github.com/pharo-graphics/Bloc) - low-level UI infrastructure & framework for Pharo. +- [Toplo-Serialization](https://github.com/OpenSmock/Toplo-Serialization) - serializer project for Toplo (this project define the Toplo version of Pyramid). +- [Toplo](https://github.com/pharo-graphics/Toplo) - a widget framework on top of Bloc. +- [STON](https://github.com/svenvc/ston) - serializer for Pharo objects to Smalltalk Object Notation format. +- [Stash](https://github.com/Nyan11/Stash) - serializer for Pharo objects to source code format. ## License From f016b77a6d07bbb426e6df151b7d0444519a0a4f Mon Sep 17 00:00:00 2001 From: Yann LE GOFF <34318678+Nyan11@users.noreply.github.com> Date: Wed, 31 Jul 2024 16:49:29 +0200 Subject: [PATCH 10/11] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 768bbf69..82e51ebd 100644 --- a/README.md +++ b/README.md @@ -86,7 +86,7 @@ Then the project view appears in a new window. Use the create button to add graphical elements in your project view. -https://github.com/OpenSmock/Pyramid/assets/49183340/a02db9ad-314a-4caf-884c-9da4da809293 +https://github.com/user-attachments/assets/44796af0-95d7-4e29-b28b-fdedfdbe7a85 ### Test behavior in the editor From 03fc1ffbcefc8ed4072557b5a05d65de14c749fb Mon Sep 17 00:00:00 2001 From: Yann LE GOFF <34318678+Nyan11@users.noreply.github.com> Date: Wed, 31 Jul 2024 17:06:58 +0200 Subject: [PATCH 11/11] Update README.md --- README.md | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 82e51ebd..b75aed1b 100644 --- a/README.md +++ b/README.md @@ -84,7 +84,7 @@ Then the project view appears in a new window. ### Add and setup graphical elements -Use the create button to add graphical elements in your project view. +Use the add button to add graphical elements in your project view and edit them with the properties panel. https://github.com/user-attachments/assets/44796af0-95d7-4e29-b28b-fdedfdbe7a85 @@ -94,19 +94,17 @@ Use the test/edit button to switch between the edit mode and the test mode. https://github.com/OpenSmock/Pyramid/assets/49183340/a85d8c01-89dd-472c-ab4e-41d51a8629dd -### Save a project +### Save and Edit a project Setup the project to store your view into a Class. When your project is saved into a method, you can see the preview on the `Pyramid preview` tab. - -https://github.com/OpenSmock/Pyramid/assets/49183340/eb70004b-cfb4-43a0-8759-27d3bac75fd0 - -### Edit a saved project +By default the element will be saved as source code. Use the `Pyramid preview` tab to edit an existing project. +You can edit your project with Pyramid or use the code browser. -https://github.com/OpenSmock/Pyramid/assets/49183340/c4a18e51-5fb5-412c-90d4-0638cadb6bff +https://github.com/user-attachments/assets/14711a00-b31a-4915-a634-3685bfe141f7 ### Test a project