Add pharo contact book

This commit is contained in:
2025-11-21 22:26:28 +01:00
parent c03c9f8b88
commit 8568518b57
9 changed files with 394 additions and 0 deletions

View File

@@ -0,0 +1,3 @@
{
'srcDirectory' : 'src'
}

View File

@@ -0,0 +1,3 @@
{
#format : #tonel
}

View File

@@ -0,0 +1,62 @@
"
I represent a person with a name and an email address. I'm usually
part of a contact book.
"
Class {
#name : 'Contact',
#superclass : 'Object',
#instVars : [
'fullname',
'email'
],
#category : 'ContactBook',
#package : 'ContactBook'
}
{ #category : 'instance creation' }
Contact class >> newNamed: aNameString email: anEmailString [
^ self new
fullname: aNameString;
email: anEmailString;
yourself
]
{ #category : 'accessing' }
Contact >> email [
^ email
]
{ #category : 'accessing' }
Contact >> email: anObject [
email := anObject
]
{ #category : 'accessing' }
Contact >> fullname [
^ fullname
]
{ #category : 'accessing' }
Contact >> fullname: aString [
fullname := aString
]
{ #category : 'as yet unclassified' }
Contact >> gravatarUrl [
^ 'http://www.gravatar.com/avatar/',
(MD5 hashMessage: email asString trimBoth asLowercase) hex,
'.jpg'
]
{ #category : 'accessing' }
Contact >> printOn: aStream [
aStream
nextPutAll: self fullname;
nextPutAll: ' <';
nextPutAll: self email;
nextPutAll: '>'
]

View File

@@ -0,0 +1,45 @@
Class {
#name : 'ContactBook',
#superclass : 'Object',
#instVars : [
'contacts'
],
#category : 'ContactBook',
#package : 'ContactBook'
}
{ #category : 'demos' }
ContactBook class >> createDefault [
^ self new
addContact: (Contact newNamed: 'Damien Cassou' email: 'damien@cassou.me');
addContact: (Contact newNamed: 'Marcus Denker' email: 'marcus.denker@inria.fr');
addContact: (Contact newNamed: 'Tudor Girba' email: 'tudor@tudorgirba.com');
addContact: (Contact newNamed: 'Clara Allende' email: 'clari.allende@gmail.com');
yourself
]
{ #category : 'writing' }
ContactBook >> addContact: aContact [
self contacts add: aContact
]
{ #category : 'reading' }
ContactBook >> contacts [
^ contacts
]
{ #category : 'initialization' }
ContactBook >> initialize [
super initialize.
contacts := OrderedCollection new
]
{ #category : 'deleting' }
ContactBook >> removeContact: aContact [
self contacts remove: aContact
]
{ #category : 'initialization' }
ContactBook >> size [
^ contacts size
]

View File

@@ -0,0 +1,41 @@
Class {
#name : 'ContactBookTest',
#superclass : 'TestCase',
#instVars : [
'blog',
'post'
],
#category : 'ContactBook',
#package : 'ContactBook'
}
{ #category : 'running' }
ContactBookTest >> setUp [
blog := ContactBook new.
blog addContact: (Contact newNamed: 'Tudor Girba' email: 'tudor@tudorgirba.com').
post := Contact newNamed: 'Clara Allende' email: 'clari.allende@gmail.com'
]
{ #category : 'tests' }
ContactBookTest >> testAddContact [
blog addContact: post.
self assert: blog size equals: 2
]
{ #category : 'tests' }
ContactBookTest >> testContacts [
blog addContact: post.
self assert: blog contacts size equals: 2
]
{ #category : 'tests' }
ContactBookTest >> testRemoveContact [
blog removeContact: blog contacts first.
self assert: blog size equals: 0
]
{ #category : 'tests' }
ContactBookTest >> testSize [
self assert: blog size equals: 1
]

View File

@@ -0,0 +1,27 @@
Class {
#name : 'ContactTest',
#superclass : 'TestCase',
#category : 'ContactBook',
#package : 'ContactBook'
}
{ #category : 'tests' }
ContactTest >> testCreation [
| contact |
contact := Contact
newNamed: 'Marcus Denker'
email: 'marcus.denker@inria.fr'.
self assert: contact fullname equals: 'Marcus Denker'.
self assert: contact email equals: 'marcus.denker@inria.fr'
]
{ #category : 'tests' }
ContactTest >> testPrinting [
| contact |
contact := Contact
newNamed: 'Marcus Denker'
email: 'marcus.denker@inria.fr'.
self assert: contact asString equals: 'Marcus Denker <marcus.denker@inria.fr>'
]

View File

@@ -0,0 +1,96 @@
Class {
#name : 'WAContact',
#superclass : 'SBSRootComponent',
#instVars : [
'contact'
],
#category : 'ContactBook',
#package : 'ContactBook'
}
{ #category : 'as yet unclassified' }
WAContact class >> editContact: aContact [
^ self new
setContact: aContact;
yourself
]
{ #category : 'initialization' }
WAContact >> contact [
^ contact
]
{ #category : 'initialization' }
WAContact >> initialize [
super initialize.
contact := Contact new
]
{ #category : 'as yet unclassified' }
WAContact >> renderButtonsOn: html [
html formGroup: [
html buttonGroup: [
self
renderSubmitButtonOn: html;
renderCancelButtonOn: html ] ]
]
{ #category : 'as yet unclassified' }
WAContact >> renderCancelButtonOn: html [
html outlineButton
beDanger;
cancelCallback: [ self answer: nil ];
with: 'Cancel'
]
{ #category : 'as yet unclassified' }
WAContact >> renderContentOn: html [
html container: [
html heading with: 'Contact Editing'.
html form with: [
self renderFieldsOn: html.
self renderButtonsOn: html ] ]
]
{ #category : 'as yet unclassified' }
WAContact >> renderEmailFieldOn: html [
html formGroup: [
html label: 'Email'.
html emailInput
formControl;
placeholder: 'your@email.eu';
callback: [ :value | self contact email: value address ];
value: (self contact email ifNil: '') ]
]
{ #category : 'as yet unclassified' }
WAContact >> renderFieldsOn: html [
self renderFullnameFieldOn: html.
self renderEmailFieldOn: html
]
{ #category : 'as yet unclassified' }
WAContact >> renderFullnameFieldOn: html [
html formGroup: [
html label: 'Fullname'.
html textInput
formControl;
placeholder: 'fullname';
callback: [ :value | self contact fullname: value ];
value: (self contact fullname ifNil: '') ]
]
{ #category : 'as yet unclassified' }
WAContact >> renderSubmitButtonOn: html [
html formButton
beSubmit;
beSuccess;
bePrimary;
callback: [ self answer: self contact ];
with: 'Save'
]
{ #category : 'initialization' }
WAContact >> setContact: aContact [
contact := aContact
]

View File

@@ -0,0 +1,116 @@
Class {
#name : 'WAContactBook',
#superclass : 'SBSRootComponent',
#instVars : [
'contactBook'
],
#category : 'ContactBook',
#package : 'ContactBook'
}
{ #category : 'initialization' }
WAContactBook class >> initialize [
(WAAdmin register: self asApplicationAt: 'contacts')
addLibrary: JQDeploymentLibrary;
addLibrary: SBSDeploymentLibrary
]
{ #category : 'rendering' }
WAContactBook >> addContact [
(self call: WAContact new)
ifNotNil: [ :contact | contactBook addContact: contact ]
]
{ #category : 'accessing' }
WAContactBook >> contactBook [
^ contactBook ifNil: [ contactBook := ContactBook createDefault ]
]
{ #category : 'accessing' }
WAContactBook >> contacts [
^ self contactBook contacts
]
{ #category : 'iterating' }
WAContactBook >> contactsDo: aBlock [
self contacts do: aBlock
]
{ #category : 'rendering' }
WAContactBook >> renderButtonsForContact: aContact on: html [
html buttonGroup: [
self
renderEditButtonForContact: aContact on: html;
renderRemoveButtonForContact: aContact on: html ]
]
{ #category : 'rendering' }
WAContactBook >> renderContact: aContact on: html [
html tableRow: [
html
tableData: aContact fullname;
tableData: aContact email;
tableData: [ self renderPhotoOf: aContact on: html ];
tableData: [ self renderButtonsForContact: aContact on: html ] ]
]
{ #category : 'rendering' }
WAContactBook >> renderContactsOn: html [
html table: [
html tableHead: [
html
tableHeading: 'Name';
tableHeading: 'Email';
tableHeading: 'Photo' ].
self contactsDo: [ :contact | self renderContact: contact on: html ] ]
]
{ #category : 'rendering' }
WAContactBook >> renderContentOn: html [
"Main entry point of the view. Render both a title and the list of contacts."
html
container: [
html heading
level: 1;
with: 'My Contact Book'.
html form: [
self renderContactsOn: html.
self renderGlobalButtonsOn: html ] ]
]
{ #category : 'rendering' }
WAContactBook >> renderEditButtonForContact: aContact on: html [
html outlineButton
beSuccess;
callback: [ self call: (WAContact editContact: aContact) ];
with: 'Edit'
]
{ #category : 'rendering' }
WAContactBook >> renderGlobalButtonsOn: html [
html buttonGroup: [
html outlineButton
beSuccess;
callback: [ self addContact ];
with: 'New contact' ]
]
{ #category : 'rendering' }
WAContactBook >> renderPhotoOf: aContact on: html [
html image url: aContact gravatarUrl
]
{ #category : 'rendering' }
WAContactBook >> renderRemoveButtonForContact: aContact on: html [
html outlineButton
beDanger;
callback: [ self contactBook removeContact: aContact ];
with: 'Remove'
]
{ #category : 'updating' }
WAContactBook >> updateRoot: anHtmlRoot [
super updateRoot: anHtmlRoot.
anHtmlRoot title: 'Contact Book'
]

View File

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