From Squeak3.9 on 14 March 2007 at 11:49:06 am <version>Comet-mb.18.mcz 14 March 2007 11:47:44 am</version> <class> <name>CTChat</name> <environment>Seaside</environment> <super>Seaside.SUFunctionalTest</super> <private>false</private> none username message pusher messageClass <imports></imports> <category>Comet-Examples</category> <attributes> <package>Comet-Examples</package> </attributes> </class> <class> <name>CTComet</name> <environment>Seaside</environment> <super>Seaside.SUPrototype</super> <private>false</private> none pusher url <imports></imports> <category>Comet-Core</category> <attributes> <package>Comet-Core</package> </attributes> </class> <class> <name>CTCounter</name> <environment>Seaside</environment> <super>Seaside.SUFunctionalTest</super> <private>false</private> none pusher count <imports></imports> <category>Comet-Examples</category> <attributes> <package>Comet-Examples</package> </attributes> </class> <class> <name>CTHandler</name> <environment>Seaside</environment> <super>Core.Object</super> <private>false</private> none id pusher socket session context <imports></imports> <category>Comet-Core</category> <attributes> <package>Comet-Core</package> </attributes> </class> <class> <name>CTLibrary</name> <environment>Seaside</environment> <super>Seaside.WAScriptLibrary</super> <private>false</private> none <imports></imports> <category>Comet-Core</category> <attributes> <package>Comet-Core</package> </attributes> </class> <class> <name>CTPusher</name> <environment>Seaside</environment> <super>Core.Object</super> <private>false</private> none mutex handlers process delay <imports></imports> <category>Comet-Core</category> <attributes> <package>Comet-Core</package> </attributes> </class> <class> <name>CTSession</name> <environment>Seaside</environment> <super>Seaside.WASession</super> <private>false</private> none handlers <imports></imports> <category>Comet-Core</category> <attributes> <package>Comet-Core</package> </attributes> </class> <class> <name>CTChatSession</name> <environment>Seaside</environment> <super>Seaside.CTSession</super> <private>false</private> none username <imports></imports> <category>Comet-Examples</category> <attributes> <package>Comet-Examples</package> </attributes> </class> <methods> Seaside.WARenderCanvas <category>*comet</category>
comet ^ Seaside.CTComet on: self
</methods> <methods> Seaside.CTChat <category>private</category>
otherHandlers ^self pusher handlers reject: [:h | h session == self session or: [h session username isNil]]
</methods> <methods> Seaside.CTChat <category>rendering</category>
renderChatOn: html html div id: 'status'; with: [ html text: 'Currently logged in as ', self username , '.'. html space. html anchor callback: [self event: 'is saying bye, bye...'. self username: nil]; text: 'Logout' ]. html div id: 'messages'. html textArea id: 'message'; callback: [ :value | self message: value ]; onEnter: (html request triggerFormElement: 'message'; onSuccess: (SUStream on: '$("message").value = ""')). html script: (html comet pusher: self pusher; connect). html script: (SUInsertion bottom id: 'messages'; with: self htmlChatMembers)
</methods> <methods> Seaside.CTChat <category>accessing</category>
username: aString self session username: aString
</methods> <methods> Seaside.CTChat <category>private</category>
push: aString class: cssClass self class push: aString class: cssClass fromUser: self username
</methods> <methods> Seaside.CTChat <category>private</category>
message: aString self push: aString class: 'message'
</methods> <methods> Seaside.CTChat <category>accessing</category>
username ^self session username
</methods> <methods> Seaside.CTChat <category>rendering</category>
renderContentOn: html html div class: 'chat'; with: [ html heading: 'Seaside Chat' level: 3. self isLoggedIn ifFalse: [self renderLoginOn: html] ifTrue: [self renderChatOn: html] ]
</methods> <methods> Seaside.CTChat <category>private</category>
htmlStringClass: aCssClass with: aString ^ '<div class="message message-' , self class messageClass , '">' , '<span class="username">' , self username , '</span>' , '<span class="' , aCssClass , '">' , aString , '</span>' , '</div>'
</methods> <methods> Seaside.CTChat <category>rendering</category>
style ^ ' div.chat { font-family: Tahoma; } div.message { margin-top: 3px; margin-bottom: 3px; } div.message-admin { border: 2px solid red; background-color: yellow; } div.message-odd { background-color: #dddddd; } div.message-even { background-color: #eeeeee; } span.username { margin-right: 1em; font-weight: bold; } span.event { font-style: italic; } #message { width: 80%; height: 5em; margin: 1em; } #messages { height: 16em; overflow: auto; } #status { width: 100%; padding: 2em; background-color: #lightblue; } '
</methods> <methods> Seaside.CTChat <category>private</category>
htmlChatMembers | aStream aString | aStream := String new writeStream. self otherHandlers do: [:h | aStream nextPutAll: h session username] separatedBy: [aStream nextPutAll: ', ']. aString := aStream contents. aString := aString isEmpty ifTrue: ['You are the only one there'] ifFalse: ['Also there: ' , aStream contents]. ^ '<div class="message message-' , self class messageClass , '">' , '<span class="message">' , aString , '</span>' , '</div>'
</methods> <methods> Seaside.CTChat <category>accessing</category>
pusher ^ self class pusher
</methods> <methods> Seaside.CTChat <category>rendering</category>
renderLoginOn: html html form: [ html textInput id: 'username'; value: self username; callback: [ :value | self username: value. value notNil ifTrue: [self event: 'joined' ] ]. html submitButton text: 'Login'. ]
</methods> <methods> Seaside.CTChat <category>testing</category>
isLoggedIn ^self username notNil
</methods> <methods> Seaside.CTChat <category>private</category>
event: aString self push: aString class: 'event'
</methods> <methods> Seaside.CTChatSession <category>accessing</category>
username "Answer the value of username" ^ username
</methods> <methods> Seaside.CTChatSession <category>accessing</category>
username: anObject "Set the value of username" username := anObject
</methods> <methods> Seaside.CTComet <category>initialization</category>
initialize super initialize. self create
</methods> <methods> Seaside.CTComet <category>accessing</category>
url: anUrl url := anUrl
</methods> <methods> Seaside.CTComet <category>private</category>
defaultArguments ^ (Array with: self url) , super defaultArguments
</methods> <methods> Seaside.CTComet <category>actions</category>
connect self call: 'connect'
</methods> <methods> Seaside.CTComet <category>initialization</category>
setPusher: aPusher pusher := aPusher
</methods> <methods> Seaside.CTComet <category>private</category>
defaultUrl ^ self canvas context actionUrl addParameter: self class headerField value: self pusher id
</methods> <methods> Seaside.CTComet <category>actions</category>
disconnect self call: 'disconnect'
</methods> <methods> Seaside.CTComet <category>accessing</category>
pusher: aPusher self url: (self canvas context actionUrl withParameter: self class headerField value: (self session registerPusher: (pusher := aPusher) context: self canvas context))
</methods> <methods> Seaside.CTComet <category>accessing</category>
url ^ url ifNil: [ url := self defaultUrl ]
</methods> <methods> Seaside.CTComet <category>accessing</category>
pusher ^ pusher
</methods> <methods> Seaside.CTComet <category>private</category>
defaultPrototype ^ 'Comet'
</methods> <methods> Seaside.CTComet <category>options</category>
reconnect: aBoolean self optionAt: 'reconnect' put: aBoolean
</methods> <methods> Seaside.CTCounter <category>accessing</category>
count: anInteger ^ self class count contents: anInteger
</methods> <methods> Seaside.CTCounter <category>rendering</category>
renderContentOn: html html heading id: 'count'; with: self count. html anchor onClick: (html request callback: [ self count: self count + 1 ]); with: '++'. html space. html anchor onClick: (html request callback: [ self count: self count - 1 ]); with: '--'. html script: (html comet pusher: self pusher; connect)
</methods> <methods> Seaside.CTCounter <category>accessing</category>
count ^ self class count contents
</methods> <methods> Seaside.CTCounter <category>accessing</category>
pusher ^ self class pusher
</methods> <methods> Seaside.CTHandler <category>actions</category>
connect: aRequest self basicDisconnect; basicConnect: aRequest. self pusher register: self. self basicTerminate
</methods> <methods> Seaside.CTHandler <category>accessing</category>
session ^ session
</methods> <methods> Seaside.CTHandler <category>actions</category>
push: aString socket ifNil: [ ^ false ]. ^ socket pushData: aString
</methods> <methods> Seaside.CTHandler <category>private</category>
basicConnect: aRequest | root | socket := aRequest responseStream socket. socket pushData: (String streamContents: [ :stream | root := WARenderedHtmlRoot context: context. WAResponse new contentType: 'text/html; charset=utf-8'; headerAt: 'Expires' put: 'Thu, 11 Jun 1980 12:00:00 GMT'; headerAt: 'Cache-Control' put: 'no-cache, must-revalidate'; headerAt: 'Pragma' put: 'no-cache'; contents: (String streamContents: [ :contents | WACurrentSession use: session during: [ session updateRoot: root. root writeOn: contents ]. contents nextPutAll: (String new: 1024 withAll: Character space) ]); writeOn: stream ])
</methods> <methods> Seaside.CTHandler <category>accessing</category>
pusher ^ pusher
</methods> <methods> Seaside.CTHandler <category>accessing</category>
id ^ id
</methods> <methods> Seaside.CTHandler <category>private</category>
basicTerminate thisContext swapSender: nil. Processor activeProcess terminate
</methods> <methods> Seaside.CTHandler <category>private</category>
basicDisconnect socket ifNil: [ ^ self ]. socket destroy. socket := nil
</methods> <methods> Seaside.CTHandler <category>initialization</category>
initializeOn: aPusher session: aSession context: aContext id := WAExternalID new asString. pusher := aPusher. session := aSession. context := aContext
</methods> <methods> Seaside.CTLibrary <category>scripts</category>
comet ^ '/* Seaside Comet API * (c) 2006 Lukas Renggli (renggli@iam.unibe.ch) */ Comet = Class.create(); Comet.prototype = { initialize: function (url, options) { this.url = url; this.options = Object.extend({ reconnect: false }, options || {}); this.iframe = document.createElement("iframe"); this.iframe.style.visibility = "hidden"; this.iframe.style.width = this.iframe.style.height = this.iframe.style.border = "0"; document.getElementsByTagName("body")[0].appendChild(this.iframe); }, connect: function() { this.iframe.onLoad = this.onLoad.bind(this); this.iframe.src = this.url; }, disconnect: function() { this.iframe.onLoad = Prototype.emptyFunction; this.iframe.src = "about:blank"; }, onLoad: function() { this.disconnect(); if (this.options.reconnect) this.connect(); } }; Comet.eval = function(code) { return eval(code); };'
</methods> <methods> Seaside.CTPusher <category>public</category>
register: aHandler "Register a new handler into this pusher." mutex critical: [ handlers := handlers copyWith: aHandler ]
</methods> <methods> Seaside.CTPusher <category>initialization</category>
initialize mutex := Semaphore forMutualExclusion. handlers := Array new
</methods> <methods> Seaside.CTPusher <category>public</category>
javascript: anObject "Push aString to all associated handlers." self push: (String streamContents: [ :stream | stream nextPutAll: '<script type="text/javascript">parent.Comet.eval('; javascript: anObject asJavascript; nextPutAll: ')</script>' ])
</methods> <methods> Seaside.CTPusher <category>public</category>
ping "Ping all the associated handlers." self mutex critical: [ handlers := handlers select: [ :each | each push: ' ' ] ]
</methods> <methods> Seaside.CTPusher <category>accessing</category>
mutex "Answer the mutex in use with the reciever." ^ mutex
</methods> <methods> Seaside.CTPusher <category>public</category>
push: aString "Push aString to all associated handlers." handlers do: [ :each | each push: aString ]
</methods> <methods> Seaside.CTPusher <category>accessing</category>
handlers "Answer the current list of handlers." ^ handlers
</methods> <methods> Seaside.CTSession <category>initialization</category>
initializeWithApplication: anApplication super initializeWithApplication: anApplication. handlers := Dictionary new
</methods> <methods> Seaside.CTSession <category>initialization</category>
initialize super initialize. handlers := Dictionary new
</methods> <methods> Seaside.CTSession <category>public</category>
registerPusher: aPusher context: aContext | handler | handler := CTHandler on: aPusher session: self context: aContext. handlers at: handler id put: handler. ^ handler id
</methods> <methods> Seaside.CTSession <category>processing</category>
cometRequest: aRequest ^ (handlers at: (aRequest fields at: CTComet headerField ifAbsent: [ ^ nil ]) ifAbsent: [ ^ nil ]) connect: aRequest
</methods> <methods> Seaside.CTSession <category>processing</category>
incomingRequest: aRequest aRequest responseStream ifNil: [ self error: 'Streaming-server required.' ]. ^ (aRequest fields includesKey: CTComet headerField) ifTrue: [ self cometRequest: aRequest ] ifFalse: [ super incomingRequest: aRequest ]
</methods> <methods> Seaside.CTChat class <category>pushing</category>
push: aString class: cssClass fromUser: userName self push: aString class: cssClass fromUser: userName divClass: self messageClass
</methods> <methods> Seaside.CTChat class <category>initialization</category>
initialize | application | pusher := CTPusher new. application := self registerAsApplication: 'comet/chat'. application preferenceAt: #sessionClass put: CTChatSession. application libraries add: SULibrary; add: CTLibrary
</methods> <methods> Seaside.CTChat class <category>utilities</category>
adminMessage: aString "(( CTChat adminMessage: 'Please logoff as soon as possible !' ))" self push: aString class: 'message' fromUser: 'Administrator' divClass: 'message-admin'
</methods> <methods> Seaside.CTChat class <category>accessing</category>
pusher ^ pusher
</methods> <methods> Seaside.CTChat class <category>pushing</category>
push: aString class: cssClass fromUser: userName divClass: divClass self push: [:r | r div class: 'message'; class: divClass; with: [ r span class: 'username'; with: userName. r span class: cssClass; with: aString]]
</methods> <methods> Seaside.CTChat class <category>pushing</category>
push: aBlock | htmlFragment document context renderer | document := (WAHtmlStreamDocument new) bodyStream; yourself. context := WARenderingContext new document: document. renderer := WARenderCanvas context: context callbacks: nil. renderer render: aBlock. htmlFragment := document stream contents. self pusher javascript: ((SUInsertion bottom) id: 'messages'; with: htmlFragment)
</methods> <methods> Seaside.CTChat class <category>accessing</category>
messageClass | result | messageClass isNil ifTrue: [messageClass := 'odd']. result := messageClass. messageClass := messageClass = 'odd' ifTrue: ['even'] ifFalse: ['odd']. ^result.
</methods> <methods> Seaside.CTComet class <category>configuration</category>
terminator ^ Character value: 0
</methods> <methods> Seaside.CTComet class <category>instance-creation</category>
new ^self basicNew initialize
</methods> <methods> Seaside.CTComet class <category>configuration</category>
headerField ^ '_c'
</methods> <methods> Seaside.CTCounter class <category>private</category>
count ^ count
</methods> <methods> Seaside.CTCounter class <category>initialization</category>
initialize | application | pusher := CTPusher new. count := ValueHolder new contents: 0. count addDependent: self. application := self registerAsApplication: 'comet/counter'. application preferenceAt: #sessionClass put: CTSession. application libraries add: SULibrary; add: CTLibrary
</methods> <methods> Seaside.CTCounter class <category>private</category>
update: anAspect pusher javascript: (SUElement new id: 'count'; update: self count contents asString)
</methods> <methods> Seaside.CTCounter class <category>private</category>
pusher ^ pusher
</methods> <methods> Seaside.CTHandler class <category>instance creation</category>
on: aPusher session: aSession context: aContext ^ self basicNew initializeOn: aPusher session: aSession context: aContext
</methods> <methods> Seaside.CTPusher class <category>private</category>
pingProcess self allInstancesDo: [ :each | each ping ]. delay wait
</methods> <methods> Seaside.CTPusher class <category>initialization</category>
initialize SeasidePlatformSupport addToStartUpList: self after: WAListener; addToShutDownList: self. self startUp
</methods> <methods> Seaside.CTPusher class <category>instance creation</category>
new ^self basicNew initialize
</methods> <methods> Seaside.CTPusher class <category>initialization</category>
startUp self shutDown. delay := Delay forSeconds: 15. process := SeasidePlatformSupport withName: 'ping' withPriority: 20 fork: [ [ self pingProcess ] repeat ]
</methods> <methods> Seaside.CTPusher class <category>initialization</category>
shutDown process ifNil: [ ^ self ]. SeasidePlatformSupport terminateProcess: process. process := nil
</methods> <initialize> Seaside.CTChat </initialize> <initialize> Seaside.CTCounter </initialize> <initialize> Seaside.CTPusher </initialize>