[GOODIE] HTML Builder

Avi Bryant avi at beta4.com
Wed Jun 5 09:54:31 UTC 2002


This is just a quick offshoot of some ideas I'm playing with for Seaside.
It pulls DNU tricks to allow easy embedding of html within smalltalk
code (as opposed to SSP, which is the other way around).  For example,

h := HTMLBuilder new.

h form action: 'foo.cgi'.
  h input type: 'text'; name: 'amount'; close.
  h input type: submit; close.
h close form.

h stream contents
'<form action="foo.cgi"><input type="text" name="amount"></input>
 <input type="submit"></input></form>'

I think the 'h close form' is especially cute; you could also just write
'h close' but this way you get error checking.
Look at the test case for more examples.

Enjoy,
Avi
-------------- next part --------------
Object subclass: #HTMLBuilder
	instanceVariableNames: 'tagStack stream '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Seaside-Experimental'!

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 02:04'!
close
	|tag|
	self ensureLastTagOpened.
	tag _ tagStack removeLast.
	tag writeCloseTagToStream: stream.
	^ HTMLCloseTagChecker new name: tag tagName! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 02:01'!
doesNotUnderstand: aMessage
	^ aMessage selector numArgs = 0
		ifTrue: [self tagNamed: aMessage selector]
		ifFalse:
			[(aMessage selector numArgs = 1)
				ifTrue: [self tagNamed: aMessage selector allButLast
							  withText: aMessage argument]
				ifFalse: [super doesNotUnderstand: aMessage]]! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:56'!
end
	self ensureLastTagOpened.
	tagStack removeLast! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:55'!
ensureLastTagOpened
	(tagStack isEmpty not and: [tagStack last opened not])
		ifTrue: [tagStack last writeOpenTagToStream: stream]! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:15'!
initialize
	tagStack _ OrderedCollection new.
	stream _ WriteStream on: String new! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:15'!
stream
	^ stream! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:15'!
stream: aStream
	stream _ aStream! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 02:04'!
tagNamed: tagName
	|tag|
	self ensureLastTagOpened.
	tag _ HTMLBuilderTag new tagName: tagName; parent: self.
	tagStack addLast: tag.
	^ tag! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:59'!
tagNamed: tagName withText: aString
	self tagNamed: tagName.
	self text: aString.
	self close.! !

!HTMLBuilder methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:59'!
text: aString
	self ensureLastTagOpened.
	stream nextPutAll: aString asString! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HTMLBuilder class
	instanceVariableNames: ''!

!HTMLBuilder class methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 00:51'!
new
	^ super new initialize! !

!HTMLBuilder class methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 02:16'!
on: aStream
	^ self new stream: aStream! !


Object subclass: #HTMLBuilderTag
	instanceVariableNames: 'parent name attributes opened '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Seaside-Experimental'!

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:36'!
attributeAt: key put: value
	attributes ifNil: [attributes _ OrderedCollection new].
	attributes add: key -> value! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:20'!
close
	parent close! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:18'!
doesNotUnderstand: aMessage
	^ aMessage selector numArgs = 1
		ifTrue: [self attributeAt: aMessage selector allButLast put: aMessage argument]
		ifFalse: [super doesNotUnderstand: aMessage]! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:43'!
end
	parent end! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:44'!
opened
	^ opened ifNil: [opened _ false]! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 00:52'!
parent: aBuilder
	parent _ aBuilder! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:42'!
tagName
	^ name! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:42'!
tagName: tagName
	name _ tagName! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:32'!
writeCloseTagToStream: aStream
	aStream nextPutAll: '</'; nextPutAll: name; nextPut: $>! !

!HTMLBuilderTag methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:48'!
writeOpenTagToStream: aStream
	opened _ true.
	
	aStream nextPut: $<; nextPutAll: name.
	attributes ifNotNil:
		[attributes associationsDo:
			[:assoc |
			(assoc value = true)
				ifTrue: [aStream nextPutAll: ' ', assoc key]
				ifFalse:
					[assoc value = false ifFalse:
						[aStream nextPutAll: ' ';
							nextPutAll: assoc key;
							nextPutAll: '="';
							nextPutAll: assoc value asString;
							nextPut: $"]]]].
	aStream nextPut: $>.! !


TestCase subclass: #HTMLBuilderTest
	instanceVariableNames: 'b '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Seaside-Experimental'!

!HTMLBuilderTest methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:42'!
assertHtml: aString
	Transcript cr; show: aString; cr; show: b stream contents.
	self assert: aString = b stream contents! !

!HTMLBuilderTest methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 02:03'!
setUp
	b _ HTMLBuilder new! !

!HTMLBuilderTest methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:50'!
testCheckedClose	
	self shouldnt:
		[b form.
			b text: 'foo'.
		b close form]
		raise: Error.
	self should:
		[b form.
			b text: 'foo'.
			b ul.
		b close form]
		raise: Error.! !

!HTMLBuilderTest methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:41'!
testForm
	b form name: 'foo'; action: 'bar'.
		b input type: 'text'; value: 'foo'; end.
		b input type: 'checkbox'; checked: true; end.
	b close.
	
	self assertHtml: '<form name="foo" action="bar"><input type="text" value="foo"><input type="checkbox" checked></form>'.! !

!HTMLBuilderTest methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:39'!
testFormatting
	b b; i; text: 'foo'; close; close.
	
	self assertHtml: '<b><i>foo</i></b>'.! !

!HTMLBuilderTest methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 02:02'!
testOrderedList
	b ul.
	1 to: 3 do:
		[:i | b li: i].
	b close ul.
	
	self assertHtml: '<ul><li>1</li><li>2</li><li>3</li></ul>'! !

!HTMLBuilderTest methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:35'!
testSimpleAnchor
	b a href: 'foo'.
		b text: 'hello world'.
	b close.
	
	self assertHtml: '<a href="foo">hello world</a>'.! !


Object subclass: #HTMLCloseTagChecker
	instanceVariableNames: 'name '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Seaside-Experimental'!

!HTMLCloseTagChecker methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:23'!
checkCloseTag: aString
	name = aString ifFalse: [self error: 'Trying to close ', name, ' with ', aString].! !

!HTMLCloseTagChecker methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:26'!
doesNotUnderstand: aMessage
	aMessage selector numArgs = 0
		ifTrue: [self checkCloseTag: aMessage selector]
		ifFalse: [super doesNotUnderstand: aMessage]! !

!HTMLCloseTagChecker methodsFor: 'as yet unclassified' stamp: 'ab 6/5/2002 01:22'!
name: aString
	name _ aString! !


More information about the Squeak-dev mailing list