add ToCheckbox

OpenSmock · Jan 23, 2024 · 2460bcc · 2460bcc
1 parent 4d5756f
commit 2460bcc
Show file tree

Hide file tree

Showing 3 changed files with 157 additions and 0 deletions.
diff --git a/src/Toplo-Serialization/ToCheckableGroup.extension.st b/src/Toplo-Serialization/ToCheckableGroup.extension.st
@@ -0,0 +1,24 @@
+Extension { #name : #ToCheckableGroup }
+
+{ #category : #'*Toplo-Serialization' }
+ToCheckableGroup >> fromSton: stonReader [
+
+	stonReader parseMapDo: [ :key :value |
+		key = #checkingStrategy ifTrue: [ self checkingStrategy: value ] ]
+]
+
+{ #category : #'*Toplo-Serialization' }
+ToCheckableGroup >> stonOn: stonWriter [
+
+	stonWriter writeObject: self streamMap: [ :dictionary |
+		dictionary
+			at: #checkingStrategy put: self checkingStrategy ]
+]
+
+{ #category : #'*Toplo-Serialization' }
+ToCheckableGroup >> stonProcessSubObjects: block [
+
+	self
+		instVarNamed: #checkingStrategy
+		put: (block value: (self instVarNamed: #checkingStrategy)).
+]
diff --git a/src/Toplo-Serialization/ToCheckbox.extension.st b/src/Toplo-Serialization/ToCheckbox.extension.st
@@ -0,0 +1,21 @@
+Extension { #name : #ToCheckbox }
+
+{ #category : #'*Toplo-Serialization' }
+ToCheckbox >> stonPostReferenceResolution [
+
+	super stonPostReferenceResolution.
+	self userData at: #stonChecked ifPresent: [ :aCheckValue |
+		self checked: aCheckValue.
+		self userData removeKey: #stonChecked ].
+	self userData at: #stonGroup ifPresent: [ :aGroup |
+		aGroup add: self.
+		self userData removeKey: #stonGroup ]
+]
+
+{ #category : #'*Toplo-Serialization' }
+ToCheckbox >> stonUserDataOn: aIdentityDictionary [
+
+	super stonUserDataOn: aIdentityDictionary.
+	aIdentityDictionary at: #stonChecked put: self checked.
+	self group ifNotNil: [ aIdentityDictionary at: #stonGroup put: self group. ]
+]
diff --git a/src/Toplo-Serialization/ToSerializerTest.class.st b/src/Toplo-Serialization/ToSerializerTest.class.st
@@ -151,6 +151,118 @@ ToSerializerTest >> testToButton4 [
 			equals: nil ]
 ]
 
+{ #category : #tests }
+ToSerializerTest >> testToCheckbox1 [
+
+	| origin |
+	origin := ToCheckbox new
+		          labelText: 'hello';
+		          yourself.
+
+	self test: origin on: [ :element |
+		self assert: element labelText asString equals: 'hello'.
+		self assert: element checked equals: false ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testToCheckbox2 [
+
+	| origin |
+	origin := ToCheckbox new
+		          labelText: 'hello';
+		          check;
+		          yourself.
+
+	self test: origin on: [ :element |
+		self assert: element labelText asString equals: 'hello'.
+		self assert: element isChecked ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testToCheckbox3 [
+
+	| button1 button2 button3 pane |
+	pane := ToPane new.
+	button1 := ToCheckbox new
+		           id: #button1;
+		           labelText: 'button1';
+		           yourself.
+	button2 := ToCheckbox new
+		           id: #button2;
+		           labelText: 'button2';
+		           yourself.
+	button3 := ToCheckbox new
+		           id: #button3;
+		           labelText: 'button3';
+		           yourself.
+	pane addChildren: {
+			button1.
+			button2.
+			button3 }.
+	button2 check.
+
+	self test: pane on: [ :element |
+		self assert: element childrenCount equals: 3.
+		self assert: (element childAt: 1) id equals: #button1.
+		self assert: (element childAt: 2) id equals: #button2.
+		self assert: (element childAt: 3) id equals: #button3.
+		self assert: (element childAt: 1) isUnchecked.
+		self assert: (element childAt: 2) isChecked.
+		self assert: (element childAt: 3) isUnchecked ]
+]
+
+{ #category : #tests }
+ToSerializerTest >> testToCheckbox4 [
+
+	| button1 button2 button3 pane group |
+	pane := ToPane new.
+	group := ToCheckableGroup new.
+	button1 := ToCheckbox new
+		           id: #button1;
+		           labelText: 'button1';
+		           addToGroup: group;
+		           yourself.
+	button2 := ToCheckbox new
+		           id: #button2;
+		           labelText: 'button2';
+		           addToGroup: group;
+		           yourself.
+	button3 := ToCheckbox new
+		           id: #button3;
+		           labelText: 'button3';
+		           addToGroup: group;
+		           yourself.
+	pane addChildren: {
+			button1.
+			button2.
+			button3 }.
+	button2 check.
+
+	self test: pane on: [ :element |
+		self assert: element childrenCount equals: 3.
+		self assert: (element childAt: 1) id equals: #button1.
+		self assert: (element childAt: 2) id equals: #button2.
+		self assert: (element childAt: 3) id equals: #button3.
+		self assert: (element childAt: 1) isUnchecked.
+		self assert: (element childAt: 2) isChecked.
+		self assert: (element childAt: 3) isUnchecked.
+		self assert: (element childAt: 1) group isNotNil.
+		self
+			assert: (element childAt: 1) group
+			equals: (element childAt: 2) group.
+		self
+			assert: (element childAt: 2) group
+			equals: (element childAt: 3) group.
+		self
+			assert: (element childAt: 1) group buttons size equals: 3.
+			self
+			assert: ((element childAt: 1) group buttons includes: (element childAt: 1)).
+			self
+			assert: ((element childAt: 1) group buttons includes: (element childAt: 2)).
+			self
+			assert: ((element childAt: 1) group buttons includes: (element childAt: 3)). ]
+]
+
 { #category : #tests }
 ToSerializerTest >> testToLabel [