Add Toplo serializer

src/Toplo-Serializer/BlElement.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #BlElement }
+
+{ #category : #'*Toplo-Serializer' }
+BlElement >> isLeaf [
+
+	^ false
+]

src/Toplo-Serializer/TToElementWithPlaceholder.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #TToElementWithPlaceholder }
+
+{ #category : #'*Toplo-Serializer' }
+TToElementWithPlaceholder >> isLeaf [
+
+	^ false
+]

src/Toplo-Serializer/ToElement.extension.st

@@ -0,0 +1,55 @@
+Extension { #name : #ToElement }
+
+{ #category : #'*Toplo-Serializer' }
+ToElement >> isLeaf [
+
+	^ true.
+]
+
+{ #category : #'*Toplo-Serializer' }
+ToElement >> stonPostReferenceResolution [
+
+	super stonPostReferenceResolution.
+	self userData at: #tooltipContent ifPresent: [ :anElement |
+		self tooltipContent: anElement.
+		self userData removeKey: #tooltipContent ].
+	self userData at: #stonLabeledIcon ifPresent: [ :anElement |
+		self labeledIcon label: anElement label.
+		self labeledIcon icon: anElement icon.
+		self labeledIcon interspace: anElement interspace.
+		self labeledIcon iconContainerWidth: anElement iconContainerWidth.
+		self labeledIcon iconContainerHeight: anElement iconContainerHeight.
+		self labeledIcon flexible: anElement flexible.
+		self labeledIcon orientation: anElement orientation.
+		self labeledIcon direction: anElement direction.
+
+		self userData removeKey: #stonLabeledIcon
+		 ]
+]
+
+{ #category : #'*Toplo-Serializer' }
+ToElement >> stonUserDataOn: aIdentityDictionary [
+
+	super stonUserDataOn: aIdentityDictionary.
+	"TToEnableable"
+	self userData
+		at: #enabled
+		ifPresent: [ :id | aIdentityDictionary at: #enabled put: id ].
+
+	"LabeledIcon"
+	(self class usesTrait: TToElementWithLabeledIcon) ifTrue: [ aIdentityDictionary at: #stonLabeledIcon put: self labeledIcon ].
+
+	"TToElementWithTooltip"
+	self hasTooltip ifTrue: [
+		aIdentityDictionary
+			at: #tooltipContent
+			put: (self rawTooltipWindowManager builder asContext tempAt: 3).
+		self userData at: #tooltipPopupDelay ifPresent: [ :aDuration |
+			aIdentityDictionary at: #tooltipPopupDelay put: aDuration ].
+		self userData
+			at: #closeTooltipWindowOnMouseLeave
+			ifPresent: [ :aBoolean |
+				aIdentityDictionary
+					at: #closeTooltipWindowOnMouseLeave
+					put: aBoolean ] ]
+]

src/Toplo-Serializer/ToLabel.extension.st

@@ -0,0 +1,19 @@
+Extension { #name : #ToLabel }
+
+{ #category : #'*Toplo-Serializer' }
+ToLabel >> stonPostReferenceResolution [
+
+	super stonPostReferenceResolution.
+	self userData at: #stonToLabelText ifPresent: [ :aText |
+		self text: aText.
+		self userData removeKey: #stonToLabelText ]
+]
+
+{ #category : #'*Toplo-Serializer' }
+ToLabel >> stonUserDataOn: aIdentityDictionary [
+
+	super stonUserDataOn: aIdentityDictionary.
+	aIdentityDictionary
+		at: #stonToLabelText
+		put: self text.
+]

src/Toplo-Serializer/ToSerializerTest.class.st

@@ -0,0 +1,191 @@
+Class {
+	#name : #ToSerializerTest,
+	#superclass : #BlocSerializationTests,
+	#category : #'Toplo-Serializer'
+}
+
+{ #category : #tests }
+ToSerializerTest >> testEnabled1 [
+
+	| origin |
+	origin := ToElement new.
+
+	self test: origin on: [ :element |
+		self assert: element isEnabled equals: true ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testEnabled2 [
+
+	| origin |
+	origin := ToElement new enabled: true; yourself.
+
+	self
+		test: origin
+		on: [ :element | self assert: element isEnabled equals: true ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testEnabled3 [
+
+	| origin |
+	origin := ToElement new
+		          enabled: false;
+		          yourself.
+
+	self
+		test: origin
+		on: [ :element | self assert: element isEnabled equals: false ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testIsLeaf1 [
+
+	| b1 b2 |
+	b1 := BlElement new
+		      id: #b1;
+		      yourself.
+	b2 := BlElement new
+		      id: #b2;
+		      yourself.
+	b1 addChild: b2.
+
+	self test: b1 on: [ :element |
+		self assert: element isLeaf equals: false.
+		self assert: element id equals: #b1.
+		self assert: element childrenCount equals: 1.
+		self assert: (element childAt: 1) id equals: #b2 ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testIsLeaf2 [
+
+	| b1 b2 |
+	b1 := ToElement new
+		      id: #b1;
+		      yourself.
+	b2 := ToElement new
+		      id: #b2;
+		      yourself.
+	b1 addChild: b2.
+
+	  [ :element |
+		self assert: element isLeaf equals: true.
+		self assert: element id equals: #b1.
+		self assert: element childrenCount equals: 0 ] value: b1 serialize materializeAsBlElement 
+]
+
+{ #category : #tests }
+ToSerializerTest >> testIsLeaf3 [
+
+	| b1 b2 |
+	b1 := ToPane new
+		      id: #b1;
+		      yourself.
+	b2 := BlElement new
+		      id: #b2;
+		      yourself.
+	b1 addChild: b2.
+
+	self test: b1 on: [ :element |
+		self assert: element isLeaf equals: false.
+		self assert: element id equals: #b1.
+		self assert: element childrenCount equals: 1.
+		self assert: (element childAt: 1) id equals: #b2 ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testToButton [
+
+	| origin |
+	origin := ToButton new
+		          labelText: 'hello';
+		          yourself.
+
+	self
+		test: origin
+		on: [ :element | self assert: element labelText asString equals: 'hello' ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testToLabel [
+
+	| origin |
+	origin := ToLabel new text: 'hello' asRopedText; yourself.
+
+	self
+		test: origin
+		on: [ :element | self assert: element text asString equals: 'hello' ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testTooltip1 [
+
+	| origin |
+	origin := ToElement new.
+
+	self
+		test: origin
+		on: [ :element | self assert: element hasTooltip equals: false ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testTooltip2 [
+
+	| origin tooltip |
+	tooltip := BlElement new id: #tooltip; yourself.
+	origin := ToElement new tooltipContent: tooltip; yourself.
+
+	self
+		test: origin
+		on: [ :element | self assert: element hasTooltip.
+			element newTooltipWindowEvent: nil.
+			self assert: element hasOpenedTooltip.
+			self assert: ((element currentTooltipWindow childAt: 1 ) childAt: 1) id equals: #tooltip
+			]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testTooltip3 [
+
+	| origin |
+	origin := ToElement new
+		          tooltipText: 'hello tooltip';
+		          yourself.
+
+	self test: origin on: [ :element |
+		self assert: element hasTooltip.
+		element newTooltipWindowEvent: nil.
+		self assert: element hasOpenedTooltip.
+		self
+			assert: ((element currentTooltipWindow childAt: 1) childAt: 1) text asString
+			equals: 'hello tooltip' ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testTooltip4 [
+
+	| origin |
+	origin := ToElement new
+		          tooltipText: 'hello tooltip';
+		          closeTooltipWindowOnMouseLeave: false;
+		          yourself.
+
+	self test: origin on: [ :element |
+		self assert: element hasTooltip.
+		self deny: element closeTooltipWindowOnMouseLeave. ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testTooltip5 [
+
+	| origin |
+	origin := ToElement new
+		          tooltipText: 'hello tooltip';
+		          tooltipPopupDelay: 5;
+		          yourself.
+
+	self test: origin on: [ :element |
+		self assert: element hasTooltip.
+		self assert: element tooltipPopupDelay equals: 5 ]
+]

src/Toplo-Serializer/package.st

@@ -0,0 +1 @@
+Package { #name : #'Toplo-Serializer' }