[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
|