From VisualWorks®, Pre-Release 7.5 (feb07.4) of February 26, 2007 on March 14, 2007 at 12:12:33 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <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>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> <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>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>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>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> <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.CTSession <category>initialization</category>
initialize super initialize. handlers := Dictionary new
initializeWithApplication: anApplication super initializeWithApplication: anApplication. 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
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.CTChatSession <category>accessing</category>
username "Answer the value of username" ^ username
username: anObject "Set the value of username" username := anObject
</methods> <methods> Seaside.CTChat <category>private</category>
event: aString self push: aString class: 'event'
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>'
htmlStringClass: aCssClass with: aString ^ '<div class="message message-' , self class messageClass , '">' , '<span class="username">' , self username , '</span>' , '<span class="' , aCssClass , '">' , aString , '</span>' , '</div>'
message: aString self push: aString class: 'message'
otherHandlers ^self pusher handlers reject: [:h | h session == self session or: [h session username isNil]]
push: aString class: cssClass self class push: aString class: cssClass fromUser: self username
</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)
renderContentOn: html html div class: 'chat'; with: [ html heading: 'Seaside Chat' level: 3. self isLoggedIn ifFalse: [self renderLoginOn: html] ifTrue: [self renderChatOn: html] ]
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'. ]
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>accessing</category>
pusher ^ self class pusher
username ^self session username
username: aString self session username: aString
</methods> <methods> Seaside.CTChat <category>testing</category>
isLoggedIn ^self username notNil
</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)
push: aString class: cssClass fromUser: userName self push: aString class: cssClass fromUser: userName divClass: self messageClass
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>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>
messageClass | result | messageClass isNil ifTrue: [messageClass := 'odd']. result := messageClass. messageClass := messageClass = 'odd' ifTrue: ['even'] ifFalse: ['odd']. ^result.
pusher ^ pusher
</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>' ])
ping "Ping all the associated handlers." self mutex critical: [ handlers := handlers select: [ :each | each push: ' ' ] ]
push: aString "Push aString to all associated handlers." handlers do: [ :each | each push: aString ]
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>accessing</category>
handlers "Answer the current list of handlers." ^ handlers
mutex "Answer the mutex in use with the reciever." ^ mutex
</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
shutDown process ifNil: [ ^ self ]. SeasidePlatformSupport terminateProcess: process. process := nil
startUp self shutDown. delay := Delay forSeconds: 15. process := SeasidePlatformSupport withName: 'ping' withPriority: 20 fork: [ [ self pingProcess ] repeat ]
</methods> <methods> Seaside.CTPusher class <category>instance creation</category>
new ^self basicNew initialize
</methods> <methods> Seaside.CTCounter <category>accessing</category>
count ^ self class count contents
count: anInteger ^ self class count contents: anInteger
pusher ^ self class pusher
</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 class <category>private</category>
count ^ count
pusher ^ pusher
update: anAspect pusher javascript: (SUElement new id: 'count'; update: self count contents asString)
</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.CTHandler <category>actions</category>
connect: aRequest self basicDisconnect; basicConnect: aRequest. self pusher register: self. self basicTerminate
push: aString socket ifNil: [ ^ false ]. ^ socket pushData: aString
</methods> <methods> Seaside.CTHandler <category>accessing</category>
id ^ id
pusher ^ pusher
session ^ session
</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 ])
basicDisconnect socket ifNil: [ ^ self ]. socket destroy. socket := nil
basicTerminate thisContext swapSender: nil. Processor activeProcess terminate
</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.CTHandler class <category>instance creation</category>
on: aPusher session: aSession context: aContext ^ self basicNew initializeOn: aPusher session: aSession context: aContext
</methods> <methods> Seaside.CTComet <category>initialization</category>
initialize super initialize. self create
setPusher: aPusher pusher := aPusher
</methods> <methods> Seaside.CTComet <category>accessing</category>
pusher ^ pusher
pusher: aPusher self url: (self canvas context actionUrl withParameter: self class headerField value: (self session registerPusher: (pusher := aPusher) context: self canvas context))
url ^ url ifNil: [ url := self defaultUrl ]
url: anUrl url := anUrl
</methods> <methods> Seaside.CTComet <category>private</category>
defaultArguments ^ (Array with: self url) , super defaultArguments
defaultPrototype ^ 'Comet'
defaultUrl ^ self canvas context actionUrl addParameter: self class headerField value: self pusher id
</methods> <methods> Seaside.CTComet <category>actions</category>
connect self call: 'connect'
disconnect self call: 'disconnect'
</methods> <methods> Seaside.CTComet <category>options</category>
reconnect: aBoolean self optionAt: 'reconnect' put: aBoolean
</methods> <methods> Seaside.CTComet class <category>configuration</category>
headerField ^ '_c'
terminator ^ Character value: 0
</methods> <methods> Seaside.CTComet class <category>instance-creation</category>
new ^self basicNew initialize
</methods> <methods> Seaside.WARenderCanvas <category>*comet</category>
comet ^ Seaside.CTComet on: self
</methods> <initialize> Seaside.CTChat </initialize> <initialize> Seaside.CTPusher </initialize> <initialize> Seaside.CTCounter </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>WARenderCanvas</name> <environment>Seaside</environment> <super>Seaside.WAHtmlCanvas</super> <private>false</private> none context callbacks <imports></imports> <category>Seaside-Canvas</category> <attributes> <package>Seaside-Canvas</package> </attributes> </class> <class> <name>WASession</name> <environment>Seaside</environment> <super>Seaside.WAExpiringHandler</super> <private>false</private> none continuations application escapeContinuation monitor state currentRequest scripts jumpTo internalError cookiesEnabled <imports></imports> <category>Seaside-Session</category> <attributes> <package>Seaside-Session</package> </attributes> </class> <class> <name>SUFunctionalTest</name> <environment>Seaside</environment> <super>Seaside.SUComponent</super> <private>false</private> none <imports></imports> <category>Scriptaculous-Testing</category> <attributes> <package>Scriptaculous-Testing</package> </attributes> </class> <class> <name>SUPrototype</name> <environment>Seaside</environment> <super>Seaside.SUObject</super> <private>false</private> none options <imports></imports> <category>Scriptaculous-Core</category> <attributes> <package>Scriptaculous-Core</package> </attributes> </class> <class> <name>WAScriptLibrary</name> <environment>Seaside</environment> <super>Seaside.WAStringLibrary</super> <private>false</private> none <imports></imports> <category>Seaside-Libraries</category> <attributes> <package>Seaside-Libraries</package> </attributes> </class>