Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Wafer web log as a Seaside implementation
Last updated at 9:46 pm UTC on 11 July 2018
A historical page of 2003.

Note: Todd Blanchard wrote a simple web logging application using the Squeak Seaside web framework.

The reason for the Wafer weblog spec was to compare different Java frameworks for Web applications.

Examination of Squeak/Seaside implementation metrics versus a standard Java implementation, as well as links to a Squeak image (broken) with the implementation are available at: http://lists.squeakfoundation.org/pipermail/seaside/2003-September/002143.html

Copy of the Seaside based code below.
Jim Benson
9-30-2003

The Seaside based code

Smalltalk organization addCategory: 'Wafer-Domain'!

Smalltalk organization addCategory: 'Wafer-Persistence'!

Smalltalk organization addCategory: 'Wafer-WebApp'!

Object subclass: #SmartFileDictionary
	instanceVariableNames: 'state index file '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-Persistence'!

SmartFileDictionary class
	instanceVariableNames: ''!

WAComponent subclass: #WaferCommentViewer
	instanceVariableNames: 'story owner '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-WebApp'!

WaferCommentViewer class
	instanceVariableNames: ''!

WAComponent subclass: #WaferMain
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-WebApp'!

WaferMain class
	instanceVariableNames: ''!

WaferMain subclass: #WaferAddStory
	instanceVariableNames: 'parentStory story previewSubject previewStory '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-WebApp'!

WaferAddStory class
	instanceVariableNames: ''!

WaferMain subclass: #WaferLogin
	instanceVariableNames: 'username password errorMessage '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-WebApp'!

WaferLogin class
	instanceVariableNames: ''!

Object subclass: #WaferObject
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-Domain'!

WaferObject class
	instanceVariableNames: ''!

WaferMain subclass: #WaferRegister
	instanceVariableNames: 'waferUser errorMessage '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-WebApp'!

WaferRegister class
	instanceVariableNames: ''!

WAControllerSession subclass: #WaferSession
	instanceVariableNames: 'waferLogin home stories logins '
	classVariableNames: 'DataDictionary '
	poolDictionaries: ''
	category: 'Wafer-WebApp'!

WaferSession class
	instanceVariableNames: ''!

WaferMain subclass: #WaferShowUser
	instanceVariableNames: 'user '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-WebApp'!

WaferShowUser class
	instanceVariableNames: ''!

WaferObject subclass: #WaferStory
	instanceVariableNames: 'title contents timestamp author comments '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-Domain'!

WaferStory class
	instanceVariableNames: ''!

WaferObject subclass: #WaferUser
	instanceVariableNames: 'username password firstName lastName email '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-Domain'!

WaferUser class
	instanceVariableNames: ''!

WaferMain subclass: #WaferViewComments
	instanceVariableNames: 'story '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wafer-WebApp'!

WaferViewComments class
	instanceVariableNames: ''!

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/6/2003 22:03'!
addComment: aComment

	comments ifNil: [comments := OrderedCollection new].
	comments add: aComment.! !

!WaferMain methodsFor: 'call/answer' stamp: 'tb 8/8/2003 15:58'!
addCommentToStory: aStory
	
	self session waferLogin isNil ifTrue: [self login].
	self session isolate: [self call: (WaferAddStory new parentStory: aStory)].! !

!WaferMain methodsFor: 'call/answer' stamp: 'tb 8/8/2003 10:49'!
addStory

	self session waferLogin isNil ifTrue: [self login].
	self session isolate: [self call: (WaferAddStory new)].
	! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/8/2003 16:44'!
addToLogins: aLogin

	logins at: aLogin username put: aLogin.
	DataDictionary at: 'logins' put: logins.
	DataDictionary close.
	DataDictionary open.! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/8/2003 16:40'!
addToStories: aStory

	|  |
	stories add: aStory.
	DataDictionary at: 'stories' put: stories.
	DataDictionary close.
	DataDictionary open.! !

!WaferCommentViewer methodsFor: 'call/answer' stamp: 'tb 8/8/2003 17:38'!
answer: anObject

	owner answer: anObject! !

!SmartFileDictionary methodsFor: 'access' stamp: 'mjg 3/17/98 16:32'!
at: key	^self at: key ifAbsent: [self error: 'key not found'].! !

!SmartFileDictionary methodsFor: 'access' stamp: 'mjg 10/19/1998 13:20'!
at: key ifAbsent: aBlock	| data savedStream coords |	self checkOpen.	coords _ index at: key ifAbsent: [nil].	coords isNil ifTrue: [^aBlock value].	data _ FileStream fileNamed: file.	"data binary."	data position: (coords at: 1).	savedStream _ (RWBinaryOrTextStream with: (data next: (coords at: 2) copy)) reset.	data close.	^ savedStream fileInObjectAndCode! !

!SmartFileDictionary methodsFor: 'access' stamp: 'mjg 10/19/1998 12:43'!
at: key put: value	| data pos saveStream|	self checkOpen.	"Flatten the object value"	saveStream _ RWBinaryOrTextStream on: (String new).	(SmartRefStream on: saveStream) nextPut: value.		"Now, store it and remember the position and size."	data _ FileStream fileNamed: file.	data binary.	data setToEnd.	pos _ data position.	data nextPutAll: saveStream contents.	index at: key put: (Array with: pos with: saveStream contents size).	data close.! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/6/2003 22:04'!
author

	^author! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/6/2003 22:02'!
author: username

	author := username! !

!WaferSession class methodsFor: 'class initialization' stamp: 'tb 8/8/2003 19:29'!
baseDirectory

	self portable
		ifTrue: [^'/tmp/']
		ifFalse: [^'/Users/todd/Library/Magma/']! !

!SmartFileDictionary class methodsFor: 'examples' stamp: 'mjg 10/19/1998 12:42'!
basicExamples"Write stuff out| fd |fd _ SmartFileDictionary fileNamed: 'testfd'.fd open.fd at: 'fred' put: 'ethel'.fd at: 'tim' put: #(0 1 2 3).fd close.Write more complicated stuff out| fd newDict |fd _ SmartFileDictionary fileNamed: 'testfd'.fd open.newDict _ Dictionary new.newDict at: 'mary' put: 'poppins'.newDict at: 'fred' put: 'astaire'.fd at: 'names' put: newDict.fd closeRead stuff in|fd|fd _ SmartFileDictionary fileNamed: 'testfd'.fd open.Transcript show: 'Fred: ', (fd at: 'fred') printString ; cr.Transcript show: 'Tim: ', (fd at: 'tim') printString ; cr.Transcript show: 'Fred: ', (fd at: 'fred') printString ; cr.fd do: [:anAssoc | Transcript show: anAssoc printString ; cr].fd close."! !

!WaferCommentViewer methodsFor: 'call/answer' stamp: 'tb 8/8/2003 17:38'!
call: aComponent

	owner call: aComponent! !

!SmartFileDictionary methodsFor: 'initialize/creation' stamp: 'mjg 3/17/98 16:29'!
checkOpen	state = 'open' ifFalse: [self error: 'File is not open'].! !

!SmartFileDictionary methodsFor: 'initialize/creation' stamp: 'mjg 10/19/1998 12:42'!
close	| output |	file size > 0 ifFalse: [self error: 'No file specified.'].	output _ DataStream fileNamed: file,'.toc'.	output nextPut: index.	output close.	state _ 'closed'.! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/8/2003 19:11'!
commentCount

	| count |

	count := self comments size.
	comments do: [:each | count := count + (each commentCount)].
	^count! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/8/2003 16:25'!
comments

	^comments ! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/6/2003 22:04'!
contents

	^contents! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/6/2003 22:02'!
contents: aString

	contents := aString! !

!WaferSession class methodsFor: 'class initialization' stamp: 'tb 8/7/2003 17:23'!
dataDictionary

	^DataDictionary! !

!SmartFileDictionary methodsFor: 'enumeration' stamp: 'mjg 3/17/98 16:41'!
do: aBlock	| a |	index keysDo: [:i | a _ Association new key: i value: (self at: i).		aBlock value: a].! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:52'!
email

	^self waferUser email! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/4/2003 08:47'!
email

	^email! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:54'!
email: aString

	self waferUser email: aString! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/6/2003 20:43'!
email: aString

	email := aString ! !

!WaferLogin methodsFor: 'accessing' stamp: 'tb 8/6/2003 20:16'!
errorMessage: aString

	errorMessage := aString! !

!SmartFileDictionary methodsFor: 'access' stamp: 'mjg 3/17/98 15:56'!
file	^file! !

!SmartFileDictionary methodsFor: 'access' stamp: 'mjg 3/17/98 15:56'!
file: aFile	file _ aFile.! !

!SmartFileDictionary class methodsFor: 'create' stamp: 'mjg 3/17/98 16:36'!
fileNamed: dataFile	"dataFile.toc is the index. dataFile is the data source."	| newFD |	newFD _ super new initialize.	newFD file: dataFile.	^newFD	! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:52'!
firstName

	^self waferUser firstName! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/4/2003 08:47'!
firstName

	^firstName! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:54'!
firstName: aString

	self waferUser firstName: aString! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/6/2003 20:43'!
firstName: aString

	firstName := aString ! !

!WaferSession methodsFor: 'responding' stamp: 'tb 8/8/2003 15:04'!
goHome

	self home notNil ifTrue: [self home clearDelegate]! !

!WaferMain methodsFor: 'call/answer' stamp: 'tb 6/29/2003 00:28'!
help! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/8/2003 15:15'!
home

	^home ! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/8/2003 15:15'!
home: aWaferMain

	home := aWaferMain! !

!SmartFileDictionary methodsFor: 'access' stamp: 'mjg 3/17/98 15:57'!
index	^index! !

!SmartFileDictionary methodsFor: 'initialize/creation' stamp: 'mjg 3/17/98 15:52'!
initialize	index _ Dictionary new.	state _ 'closed'.	file _ ''.! !

!WaferAddStory methodsFor: 'initialization' stamp: 'tb 8/8/2003 18:07'!
initialize

	story := WaferStory new.
	story author: self session waferLogin.! !

!WaferObject methodsFor: 'initialization' stamp: 'tb 8/8/2003 13:24'!
initialize! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/8/2003 15:15'!
initialize
	super initialize.
	waferLogin _ WAStateHolder new.
	DataDictionary state = 'open' ifFalse: [ DataDictionary open].
! !

!WaferSession class methodsFor: 'class initialization' stamp: 'tb 8/8/2003 18:17'!
initialize

	DataDictionary _ SmartFileDictionary fileNamed:( self baseDirectory , 'data').
	DataDictionary open.! !

!WaferStory methodsFor: 'initialization' stamp: 'tb 8/8/2003 16:22'!
initialize

	super initialize.
	timestamp := TimeStamp current asString.
	comments := OrderedCollection new.! !

!SmartFileDictionary methodsFor: 'access' stamp: 'mjg 3/25/98 15:26'!
keys	^index keys! !

!SmartFileDictionary methodsFor: 'enumeration' stamp: 'mjg 3/23/98 12:53'!
keysDo: aBlock	index keysDo: [:i | aBlock value: i].! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:52'!
lastName

	^self waferUser lastName! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/4/2003 08:47'!
lastName

	^lastName! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:53'!
lastName: aString

	self waferUser lastName: aString! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/6/2003 20:44'!
lastName: aString

	lastName := aString ! !

!WaferLogin methodsFor: 'call/answer' stamp: 'tb 8/8/2003 11:01'!
login
	| logins user |
	logins _ self session logins.
	user _ logins at: username ifAbsent: [nil].
	(user isNil or: [user password ~= password])
		ifTrue: [self errorMessage: 'Invalid login']
		ifFalse: [self answer: user].! !

!WaferMain methodsFor: 'call/answer' stamp: 'tb 8/4/2003 20:27'!
login

	self session isolate: [ self session waferLogin: (self call: (WaferLogin new)) ].! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/8/2003 16:44'!
logins


	logins ifNil: 
	[
		logins := DataDictionary at: 'logins' ifAbsent: 
		[
			DataDictionary at: 'logins' put: Dictionary new. 
			DataDictionary close.  
			DataDictionary open.
			DataDictionary at: 'logins' 
		]
	].
	^logins! !

!WaferMain methodsFor: 'call/answer' stamp: 'tb 8/6/2003 21:36'!
logout
	self session waferLogin: nil.! !

!WaferObject class methodsFor: 'instance creation' stamp: 'tb 8/8/2003 13:24'!
new

	^self basicNew initialize.! !

!WaferShowUser class methodsFor: 'instance creation' stamp: 'tb 8/8/2003 13:57'!
on: username

	self new username: username.! !

!SmartFileDictionary methodsFor: 'initialize/creation' stamp: 'mjg 4/30/98 16:15'!
open	| input |	state = 'open' ifTrue: [self close].	file size > 0 ifFalse: [self error: 'No file specified.'].	input _ DataStream fileNamed: file,'.toc'.	input size > 0 ifTrue:		[index _ input next.		input close.]	ifFalse: [index _ Dictionary new. input close.].	state _ 'open'.! !

!WaferCommentViewer methodsFor: 'accessing' stamp: 'tb 8/8/2003 17:37'!
owner: anOwner

	owner := anOwner.! !

!WaferAddStory methodsFor: 'accessing' stamp: 'tb 8/8/2003 15:54'!
parentStory
	^parentStory! !

!WaferAddStory methodsFor: 'accessing' stamp: 'tb 8/8/2003 15:54'!
parentStory: aStory

	parentStory := aStory! !

!WaferLogin methodsFor: 'accessing' stamp: 'tb 6/29/2003 20:38'!
password

	^password! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:52'!
password

	^self waferUser password! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/4/2003 08:47'!
password

	^password! !

!WaferLogin methodsFor: 'accessing' stamp: 'tb 6/29/2003 01:03'!
password: p
	
	password := p.! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:53'!
password: aString

	self waferUser password: aString! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/6/2003 20:44'!
password: aString

	password := aString ! !

!WaferSession class methodsFor: 'class initialization' stamp: 'tb 8/8/2003 19:31'!
portable

	^true! !

!WaferAddStory methodsFor: 'call/answer' stamp: 'tb 8/8/2003 10:44'!
preview

	previewSubject := self story title.
	previewStory := self story contents.! !

!WaferRegister methodsFor: 'call/answer' stamp: 'tb 8/7/2003 17:34'!
register

	| logins other |
	errorMessage := self waferUser validationMessage.
	errorMessage isNil ifTrue: 
	[
		logins := self session logins.
		other := logins at: waferUser username ifAbsent: [nil].
		other isNil
			ifTrue:	
			[
				self session addToLogins: waferUser.
				self answer: waferUser
			]
			ifFalse:
			[
				errorMessage := 'Login already exists'.
			]
			
			  
		 
	].	! !

!WaferCommentViewer methodsFor: 'rendering' stamp: 'tb 8/8/2003 19:08'!
renderContentOn: html

	html table:
	[
		html tableRowWith:
		[
			html bold: [ html text: story title]; 
				text: (' [Posted on: ', (story timestamp asString), ' by ');
				anchorWithAction: [self showUser: (story author) ] 
					text: (story author username);
				text: ' | ', (story commentCount asString), ' comments ]';
				break; break.

				html text: (story contents); break; break.

				(self session stories includes: story)
					ifTrue:
					[
						html anchorWithAction: 
							[
								| answer |  
								self session waferLogin ifNil: [ self session waferLogin: (self call: (WaferLogin new))].
								answer := (self call: (WaferAddStory new parentStory: story)).
								self answer: answer.
							] 
							text: 'Add Comment'. 
						html tag: 'hr'.
						html heading: 'Comments' level: 2.
					]
					ifFalse:
					[
						html anchorWithAction: 
						[
								| answer |  
								self session waferLogin ifNil: [self session waferLogin: (self call: (WaferLogin new))].
								answer := (self call: (WaferAddStory new parentStory: story)).
								self answer: answer.
						]  
						text: 'Reply'; break; break.
					].

		].
		story comments notEmpty ifTrue:
		[
			
			html table:
			[
				html tableRowWith: [html text: ' '] with:
				[
					story comments do:
					[:comment |
						| commentRenderer |
						commentRenderer := WaferCommentViewer new owner: self.
						commentRenderer story: comment.
						html render: commentRenderer.
					]
				]
			]
		]
	]! !

!WaferMain methodsFor: 'rendering' stamp: 'tb 8/8/2003 14:49'!
renderContentOn: aRenderer

	aRenderer title: (self title).
	aRenderer attributeAt: 'width' put: '100%'.
	aRenderer table: 
	[
		
		aRenderer tableRow: 
		[
			aRenderer attributeAt: 'colspan' put: 2.
			aRenderer attributeAt: 'align' put: 'center'. 
			aRenderer tableData: [self renderHeaderBarOn: aRenderer] 
		].

			aRenderer tableRow:
		[
			aRenderer attributeAt: 'width' put: '150'.
			aRenderer attributeAt: 'valign' put: 'top'.
			aRenderer tableData: [self renderLeftColumnOn: aRenderer ].

			aRenderer attributeAt: 'valign' put: 'top'.
			aRenderer tableData: [self renderMainColumnOn: aRenderer ].
		]
	].! !

!WaferMain methodsFor: 'rendering' stamp: 'tb 8/8/2003 19:21'!
renderHeaderBarOn: aRenderer

	aRenderer text: (self session class titleImageLink); break.
	aRenderer text: '['.
	self session waferLogin isNil 
		ifTrue: [aRenderer anchorWithAction: [ self login ] text: 'Login']
		ifFalse: [aRenderer anchorWithAction: [ self logout ] text: 'Logout'].
	aRenderer text: ' | '; anchorWithAction: [ self help ] text: 'Help'; text: ']'.! !

!WaferMain methodsFor: 'rendering' stamp: 'tb 8/8/2003 14:50'!
renderLeftColumnOn: aRenderer

	aRenderer anchorWithAction: [self session goHome] text: 'Home'.! !

!WaferAddStory methodsFor: 'rendering' stamp: 'tb 8/8/2003 15:57'!
renderMainColumnOn: html

	previewStory isNil ifFalse:
	[
		html text: 'Preview: '; paragraph.
		html bold: [html text: previewSubject]; paragraph.
		html text: previewStory; paragraph.
	].

	html form: [
	html table:
	[
		html tableRowWithLabel: 'Subject:' 
				column: 
			[
				html attributeAt: 'size' put: 40.
				html attributeAt: 'maxlength' put: 160.
				html textInputOn: #title of: self story
			].
		html tableRowWithLabel: 'Story:' 
				column: 
			[
				html attributeAt: 'cols' put: 40.
				html attributeAt: 'rows' put: 12.
				html textAreaOn: #contents of: self story
			].
		html tableRowWithLabel: ' '
				column:
			[
				html tag: 'center' do:
				[
					html submitButtonWithAction: [self preview] text: 'Preview'.
					html submitButtonWithAction: [self save] text: 'Save'.
				]
			]
		]
	].

	parentStory isNil ifFalse:
	[
		html text: 'Respond To: '; paragraph.
		html bold: [html text: parentStory title]; paragraph.
		html text: parentStory contents; paragraph.
	].! !

!WaferLogin methodsFor: 'rendering' stamp: 'tb 8/6/2003 22:41'!
renderMainColumnOn: aRenderer



	aRenderer text: 'Enter your username and password to log in. New users must '.

	aRenderer anchorWithAction: [self answer: (self call: (WaferRegister new))] text: 'register first.'.

	aRenderer form:

	[
		errorMessage isNil ifFalse: 
		[ 
			aRenderer tag: 'center' do: 
			[ 
				aRenderer attributeAt: 'color' put: 'red'.
				aRenderer tag: 'font' do: [ aRenderer heading: errorMessage level: 3]
			]
		].

		aRenderer table: 

		[

			aRenderer tableRowWithLabel: 'Username:' 

				column: [aRenderer textInputOn: #username of: self].

			aRenderer tableRowWithLabel: 'Password:' 

				column: [aRenderer passwordInputWithCallback: [:v | self password: v]].

		].

		aRenderer submitButtonWithAction: [self login] text: 'Login'.

	]! !

!WaferMain methodsFor: 'rendering' stamp: 'tb 8/8/2003 19:07'!
renderMainColumnOn: html

	self session home: self.
	self session waferLogin isNil ifFalse:
	[
		self session waferLogin firstName notNil 
			ifTrue: [html text: 'Welcome, ', self session waferLogin firstName]
			ifFalse: [html text: 'Welcome, ', self session waferLogin username].
		html paragraph.
	].

	html anchorWithAction: [self addStory] text: 'Add A Story'; paragraph.

		html table:
		[
			self session stories reverseDo:

			[:story |

			html tableRowWith:
			[
				
				html bold: [ html text: story title]; text: (' [Posted on: ', (story timestamp asString), ' by ').
				html anchorWithAction: [self showUser: (story author) ] text: (story author username).
				html text: ' | ', (story commentCount asString), ' comments ]'.
				html break; break.
				html text: (story contents); break; break.
				html text: '['; 
					anchorWithAction: [self viewCommentsInStory: story] text: 'View Comments'.
				 html text: ' | ';
					anchorWithAction: [self addCommentToStory: story] text: 'Add Comment'.
				html text: ']'.
			].
			html tableRowWith: [html text: ' '].
		]
	]! !

!WaferRegister methodsFor: 'rendering' stamp: 'tb 8/6/2003 20:37'!
renderMainColumnOn: aRenderer

	aRenderer text: 'Please fill in the following information to create a new account. All fields are required.'.
	aRenderer form:
	[
		aRenderer table: 
		[
			aRenderer tableRowWithLabel: 'Username:' 
				column: [aRenderer textInputOn: #username of: self waferUser].
			aRenderer tableRowWithLabel: 'Email:' 
				column: [aRenderer textInputOn: #email of: self waferUser].
			aRenderer tableRowWithLabel: 'First Name:' 
				column: [aRenderer textInputOn: #firstName of: self waferUser].
			aRenderer tableRowWithLabel: 'Last Name:' 
				column: [aRenderer textInputOn: #lastName of: self waferUser].		
			aRenderer tableRowWithLabel: 'Password:' 
				column: [aRenderer passwordInputWithCallback: [:v | self waferUser password: v]].
		].
		aRenderer submitButtonWithAction: [self register] text: 'Create User'.
	].
	errorMessage isNil ifFalse: 
		[ 
			aRenderer tag: 'center' do: 
			[ 
				aRenderer attributeAt: 'color' put: 'red'.
				aRenderer tag: 'font' do: [ aRenderer heading: errorMessage level: 3]
			]
		].! !

!WaferShowUser methodsFor: 'rendering' stamp: 'tb 8/8/2003 14:07'!
renderMainColumnOn: html


	html table:
	[
		html tableRowWith: [html bold: [html text: 'Login:']] with: [html text: user username].
		html tableRowWith: [html bold: [html text: 'First Name:']] with: [html text: user firstName].
		html tableRowWith: [html bold: [html text: 'Last Name:']] with: [html text: user lastName].
		html tableRowWith: [html bold: [html text: 'Email:']] with: [html text: ('<a href="mailto:',user email,'">', user email, '</a>')].
	]! !

!WaferViewComments methodsFor: 'rendering' stamp: 'tb 8/8/2003 17:38'!
renderMainColumnOn: html

	html break.
	html render: (WaferCommentViewer new story: story; owner: self)! !

!WaferAddStory methodsFor: 'accessing' stamp: 'tb 8/8/2003 16:03'!
save

	parentStory isNil 
		ifTrue: [self session addToStories: self story]
		ifFalse: [parentStory addComment: story. self session touchStories].
	self answer: self story.! !

!WaferMain methodsFor: 'call/answer' stamp: 'tb 8/8/2003 14:04'!
showUser: aWaferLogin

	self call: (WaferShowUser new user: aWaferLogin).	
	! !

!SmartFileDictionary methodsFor: 'access' stamp: 'mjg 3/17/98 15:57'!
state	^state! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/8/2003 16:39'!
stories

	stories ifNil: 
	[
		stories := DataDictionary at: 'stories' ifAbsent: 
		[
			DataDictionary at: 'stories' put: OrderedCollection new.
			DataDictionary close.
			DataDictionary open.
			DataDictionary at: 'stories'
		]
	].
	^stories! !

!WaferAddStory methodsFor: 'accessing' stamp: 'tb 8/8/2003 09:54'!
story

	^story! !

!WaferCommentViewer methodsFor: 'accessing' stamp: 'tb 8/8/2003 18:06'!
story: aStory

	story := aStory.! !

!WaferViewComments methodsFor: 'accessing' stamp: 'tb 8/8/2003 17:09'!
story: aStory

	story := aStory! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/8/2003 15:13'!
timestamp

	^timestamp! !

!WaferLogin methodsFor: 'rendering' stamp: 'tb 6/29/2003 00:52'!
title

	^super title, ' : Login' ! !

!WaferMain methodsFor: 'rendering' stamp: 'tb 6/29/2003 00:31'!
title

	^'Wafer Weblog'! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/6/2003 22:05'!
title

	^title! !

!WaferStory methodsFor: 'accessing' stamp: 'tb 8/6/2003 22:05'!
title: aString

	title := aString! !

!WaferSession class methodsFor: 'class initialization' stamp: 'tb 8/8/2003 19:28'!
titleImageLink

	self portable 
		ifTrue: [^'<img src="http://www.waferproject.org/weblog-prototype/images/title.gif">']
		ifFalse: [^'<img src="http://localhost/wafer/title.gif">'].
! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/8/2003 16:41'!
touchStories

	DataDictionary at: 'stories' put: stories.
	DataDictionary close.
	DataDictionary open.! !

!WaferShowUser methodsFor: 'accessing' stamp: 'tb 8/8/2003 13:57'!
user

	^user! !

!WaferShowUser methodsFor: 'accessing' stamp: 'tb 8/8/2003 13:57'!
user: aUser

	user := aUser! !

!WaferLogin methodsFor: 'accessing' stamp: 'tb 6/29/2003 20:38'!
username

	^username! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:52'!
username

	^self waferUser username! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/7/2003 16:50'!
username

	^self waferUser ifNil: [ 'Guest' ] ifNotNil: [ self waferUser username ]	! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/4/2003 08:45'!
username

	^username! !

!WaferLogin methodsFor: 'accessing' stamp: 'tb 6/29/2003 01:03'!
username: u
	
	username := u.! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:53'!
username: aString

	self waferUser username: aString! !

!WaferShowUser methodsFor: 'accessing' stamp: 'tb 8/8/2003 13:57'!
username: username

	user := self session logins at: username.! !

!WaferUser methodsFor: 'accessing' stamp: 'tb 8/6/2003 20:44'!
username: aString

	username := aString ! !

!WaferUser methodsFor: 'validation' stamp: 'tb 8/6/2003 20:33'!
validationMessage

	(username isNil or: [username size = 0]) ifTrue: [^'Invalid Username'].
	(email isNil or: [email size = 0 or: [(email includes: $@) not]]) ifTrue: [^'Invalid email address'].
	(password isNil or: [password size < 4]) ifTrue: [^'Password too short'].
	^nil! !

!WaferMain methodsFor: 'call/answer' stamp: 'tb 8/8/2003 17:07'!
viewCommentsInStory: aStory

	self call: (WaferViewComments new story: aStory).! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/3/2003 13:05'!
waferLogin

	^waferLogin contents	! !

!WaferSession methodsFor: 'accessing' stamp: 'tb 8/3/2003 13:04'!
waferLogin: aWaferLogin

	waferLogin contents: aWaferLogin
	! !

!WaferRegister methodsFor: 'accessing' stamp: 'tb 8/6/2003 19:52'!
waferUser

	waferUser ifNil: [ waferUser := WaferUser new ].
	^waferUser.! !

WaferSession initialize!

Smalltalk at: #FilePackageManager ifPresent: [:p | p registerPackage: 'Wafer'].!