'From Squeak 1.23 of October 4, 1997 on 18 October 1997 at 9:36:52 am'! Object subclass: #Basket instanceVariableNames: 'products ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! Object subclass: #BrowserModel instanceVariableNames: 'modelClass browseMeta ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! Object subclass: #Department instanceVariableNames: 'id description products ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! Object subclass: #FormCheckBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #FormComboBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #FormEntryField instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #FormListBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #FormRadioButton instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #FormRadioList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #FormResetButton instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #FormSubmitButton instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #Graphic instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #HTMLForm instanceVariableNames: 'body action ' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! HTMLForm subclass: #ButtonLink instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! HTMLForm subclass: #ButtonPageLink instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #HTMLPage instanceVariableNames: 'title body code session ' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! HTMLPage subclass: #HTMLPreformattedPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #Log instanceVariableNames: 'fileName ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk'! Object subclass: #PageLink instanceVariableNames: 'session value label page target ' classVariableNames: '' poolDictionaries: '' category: 'HTML Generation'! Object subclass: #Product instanceVariableNames: 'id name description price ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! EventManager subclass: #RPNCalculator instanceVariableNames: 'stack ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! Object subclass: #Shopper instanceVariableNames: 'department basket store lookingInBasket lookingAt ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! Object subclass: #Store instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! Store subclass: #SqueakStore instanceVariableNames: 'departments ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! Store class instanceVariableNames: 'instance '! Error subclass: #TimeoutError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk'! Object subclass: #WebBrowserRequest instanceVariableNames: 'verb url protocol fields headerFields ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk'! Object subclass: #WebtalkPage instanceVariableNames: 'formDictionary ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk'! WebtalkPage subclass: #AddToBasketPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! WebtalkPage subclass: #AnotherFormTestPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #AnotherFormTestResultPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #BasketPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! WebtalkPage subclass: #BrowserPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! WebtalkPage subclass: #CheckoutPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! BrowserPage subclass: #ClassCategoriesPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #ClassCommentBrowserPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #ClassCommentPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #ClassDefinitionPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #ClassesPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #ClassHierarchyPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #ClassOptionPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! WebtalkPage subclass: #DepartmentPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! WebtalkPage subclass: #EmptyBasketPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! WebtalkPage subclass: #FactorialPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #FactorialResultPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #FormTestPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #FormTestResultPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #GuestbookAddEntryPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #GuestbookPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #InfoPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! BrowserPage subclass: #InstanceOptionPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! WebtalkPage subclass: #MainTestPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #MainTestPageTop instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #MetaOptionPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #MethodCategoriesPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #MethodPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! BrowserPage subclass: #MethodsPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! WebtalkPage subclass: #ProductPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! WebtalkPage subclass: #RemoveFromBasketPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! WebtalkPage subclass: #RPNCalculatorPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Testing'! WebtalkPage subclass: #StorePage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! StorePage subclass: #SqueakStorePage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Store'! BrowserPage subclass: #SystemBrowserPage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Webtalk Browser'! WebtalkPage subclass: #WebtalkErrorPage instanceVariableNames: 'errorMessage ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk'! Connection subclass: #WebtalkServer instanceVariableNames: 'log ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk'! Object subclass: #WebtalkSession instanceVariableNames: 'id lastAccessTime data usageCount address ' classVariableNames: 'ForsakenKilledAt Id InstanceDictionary UntouchedKilledAt ' poolDictionaries: '' category: 'Webtalk'! WebtalkSession class instanceVariableNames: 'id instanceDictionary untouchedKilledAt '! StringConnection subclass: #WebtalkWebServer instanceVariableNames: 'lines log ' classVariableNames: '' poolDictionaries: '' category: 'Webtalk'! !Object methodsFor: 'HTML generation' stamp: 'taj 8/14/97 08:25'! asString ^self printString! ! !Basket methodsFor: 'as yet unclassified' stamp: 'taj 7/27/97 20:39'! add: aProduct products add: aProduct ! ! !Basket methodsFor: 'as yet unclassified' stamp: 'taj 7/27/97 20:40'! beEmpty products := OrderedCollection new! ! !Basket methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 07:44'! htmlInvoice |bag stream n p| bag := self products asBag. stream := WriteStream on: ''. (bag asSet asSortedCollection: [:a :b| a name '! ! !FormComboBox class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:08'! name: n values: values selection: selection ^ FormListBox name: n values: values selection: selection size: 1! ! !FormEntryField class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 06:18'! name: n value: v length: l ^ ''! ! !FormListBox class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:08'! name: n values: values selection: selection size: size ^ self name: n values: values selections: (Array with: selection) size: size multiple: false! ! !FormListBox class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 06:19'! name: n values: values selections: selections size: size multiple: multiple | stream | stream _ WriteStream on: ''. stream nextPutAll: ''. ^ stream contents! ! !FormRadioButton class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:08'! name: n value: v ^ ''! ! !FormRadioButton class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:08'! name: n valueChecked: v ^ ''! ! !FormRadioList class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:08'! name: n values: values selection: selection ^ self name: n values: values selection: selection vertical: false! ! !FormRadioList class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:08'! name: n values: values selection: selection vertical: vertical | stream | stream _ WriteStream on: ''. values do: [:value | value = selection ifTrue: [stream nextPutAll: (FormRadioButton name: n valueChecked: value)] ifFalse: [stream nextPutAll: (FormRadioButton name: n value: value)]. stream nextPutAll: value. vertical ifTrue: [stream nextPutAll: NewLine]]. ^ stream contents! ! !FormResetButton class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:08'! label: v ^ ''! ! !FormSubmitButton class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:09'! label: l ^ self name: 'submit' label: l! ! !FormSubmitButton class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:09'! name: n label: v ^ ''! ! !Graphic class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 06:22'! from: f standIn: s alignment: a ^ '' , s , ''! ! !HTMLForm methodsFor: 'initialization' stamp: 'taj 8/14/97 05:09'! initialize body _ WriteStream on: ''. action _ '/cgi/webtalk.pl.cgi'! ! !HTMLForm methodsFor: 'other' stamp: 'taj 8/14/97 05:09'! add: aString body nextPutAll: aString asHTMLCode; cr! ! !HTMLForm methodsFor: 'other' stamp: 'taj 10/18/97 03:30'! asHTMLCode | stream | stream _ WriteStream on: ''. stream nextPutAll: '
'; cr; nextPutAll: body contents; nextPutAll: '
'. ^ stream contents! ! !HTMLForm methodsFor: 'other' stamp: 'taj 8/14/97 08:26'! hiddenName: n value: v self add: ''! ! !HTMLForm methodsFor: 'other' stamp: 'taj 8/1/97 20:32'! session: session session notNil ifTrue: [self hiddenName: 'webtalkSession' value: session id printString]. ! ! !HTMLForm class methodsFor: 'private' stamp: 'taj 8/14/97 05:09'! new ^ super new initialize! ! !HTMLForm class methodsFor: 'instance creation' stamp: 'taj 8/1/97 20:33'! nextPage: aString | i | i _ self new. i hiddenName: 'webtalkClass' value: aString. ^ i! ! !HTMLForm class methodsFor: 'instance creation' stamp: 'taj 8/18/97 03:51'! nextPage: aString session: session | i | i _ self new. i hiddenName: 'webtalkClass' value: aString. session notNil ifTrue: [i hiddenName: 'webtalkSession' value: session id printString]. ^ i! ! !ButtonLink class methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 02:56'! label: option nextPage: page ^self name: 'submit' label: option nextPage: page ! ! !ButtonLink class methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 03:21'! name: aname label: option nextPage: page |form| form _ self nextPage: page. form add: (FormSubmitButton name: aname label: option). form hiddenName: 'buttonLink' value: aname. ^form ! ! !ButtonPageLink class methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:02'! label: option nextPage: page ^self label: option nextPage: page value: 'submit'! ! !ButtonPageLink class methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:18'! label: option nextPage: page value: value |form| form _ self nextPage: page. form add: (FormSubmitButton name: value label: option). form hiddenName: 'linkValue' value: value. ^form ! ! !HTMLPage methodsFor: 'initialization' stamp: 'taj 8/14/97 05:10'! initialize body _ WriteStream on: ''. title _ ''! ! !HTMLPage methodsFor: 'initialization' stamp: 'taj 8/1/97 20:29'! session ^session! ! !HTMLPage methodsFor: 'initialization' stamp: 'taj 8/1/97 20:29'! session: s session := s! ! !HTMLPage methodsFor: 'other' stamp: 'taj 8/1/97 20:36'! add: anObject (anObject respondsTo: #session:) ifTrue: [anObject session: self session]. body nextPutAll: anObject asHTMLCode; cr ! ! !HTMLPage methodsFor: 'other' stamp: 'taj 10/15/97 15:46'! bodyHTML ^body contents! ! !HTMLPage methodsFor: 'other' stamp: 'taj 10/15/97 15:46'! code | stream | stream _ WriteStream on: ''. stream nextPutAll: ''; cr; nextPutAll: '';cr; nextPutAll: '';cr; nextPutAll: ''; nextPutAll: title; nextPutAll: '';cr; nextPutAll: ''; cr; nextPutAll: self bodyHTML; nextPutAll: '';cr; nextPutAll: '';cr. ^ stream contents! ! !HTMLPage methodsFor: 'other' stamp: 'taj 8/14/97 05:10'! title: aString title _ aString! ! !HTMLPage class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 07:55'! initialize Smalltalk at: #EndParagraph put: '

'. Smalltalk at: #HorizontalRule put: '

'. Smalltalk at: #NewLine put: '
' ! ! !HTMLPage class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:10'! new ^ super new initialize! ! !HTMLPage class methodsFor: 'as yet unclassified' stamp: 'taj 8/14/97 05:10'! title: title ^ self new title: title; yourself! ! !HTMLPage class methodsFor: 'as yet unclassified' stamp: 'taj 8/1/97 20:30'! title: title session: session ^(self title: title) session: session! ! !HTMLPreformattedPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 06:01'! add: anObject (anObject respondsTo: #session:) ifTrue: [anObject session: self session]. body nextPutAll: anObject asHTMLCode! ! !HTMLPreformattedPage methodsFor: 'as yet unclassified' stamp: 'taj 10/15/97 15:47'! bodyHTML ^ super bodyHTML preformatted! ! !Log methodsFor: 'private' stamp: 'taj 8/14/97 04:50'! onFileName: aString fileName := aString! ! !Log methodsFor: 'logging' stamp: 'taj 8/14/97 05:02'! add: aString | stream ts | ts _ '(' , Date today printString , ' ' , Time now printString , ') '. Transcript show: ts , aString; cr. [stream _ FileStream fileNamed: fileName. stream setToEnd. stream nextPutAll: ts , aString; cr] ifCurtailed: [Transcript show: ts , 'cannot write to log file'; cr]. stream notNil ifTrue: [stream close] ! ! !Log class methodsFor: 'instance creation' stamp: 'taj 8/14/97 05:00'! to: aString ^ self new onFileName: aString ! ! !PageLink methodsFor: 'as yet unclassified' stamp: 'taj 10/15/97 14:33'! asHTMLCode ^label linkTo: 'webtalk.pl.cgi?webtalkClass=',page, '&webtalkSession=',session id printString, '&linkValue=', (self fix: value) target: target ! ! !PageLink methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 19:36'! fix: aString |r| ^aString collect: [:c| r := c. c = $ ifTrue: [r := $+]. r] ! ! !PageLink methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:25'! label: aString label := aString! ! !PageLink methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:26'! page: aString page := aString! ! !PageLink methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:14'! session ^session! ! !PageLink methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:26'! session: aSession session := aSession! ! !PageLink methodsFor: 'as yet unclassified' stamp: 'taj 10/15/97 14:18'! target: aStringOrNil target := aStringOrNil! ! !PageLink methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:26'! value: aString value := aString! ! !PageLink class methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 19:16'! label: option nextPage: page ^self label: option nextPage: page value: 'submit'! ! !PageLink class methodsFor: 'as yet unclassified' stamp: 'taj 10/16/97 19:26'! label: label nextPage: page value: value ^self label: label nextPage: page value: value target: nil ! ! !PageLink class methodsFor: 'as yet unclassified' stamp: 'taj 10/15/97 14:16'! label: label nextPage: page value: value target: target ^self new label: label; page: page; value: value; target: target; yourself ! ! !Product methodsFor: 'as yet unclassified' stamp: 'taj 7/27/97 20:31'! description ^description ! ! !Product methodsFor: 'as yet unclassified' stamp: 'taj 7/27/97 20:31'! description: aString description := aString ! ! !Product methodsFor: 'as yet unclassified' stamp: 'taj 7/27/97 20:33'! id ^id! ! !Product methodsFor: 'as yet unclassified' stamp: 'taj 7/27/97 20:32'! id: aString id := aString! ! !Product methodsFor: 'as yet unclassified' stamp: 'taj 7/27/97 20:30'! name ^name! ! !Product methodsFor: 'as yet unclassified' stamp: 'taj 7/27/97 20:31'! name: aString name := aString! ! !Product methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:14'! price ^price! ! !Product methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:14'! price: aNumber price := aNumber! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! add self stackSize >= 2 ifTrue: [self push: self llpop + self llpop]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! chs self stackSize >= 1 ifTrue: [self push: self llpop * -1]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! divide | n d | (self stackSize >= 2 and: [self peek ~= 0]) ifTrue: [d _ self llpop. n _ self llpop. self push: n / d]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! drop self stackSize >= 1 ifTrue: [self pop]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! dup self stackSize >= 1 ifTrue: [self push: self peek]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! float self stackSize >= 1 ifTrue: [self push: self llpop asFloat]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! multiply self stackSize >= 2 ifTrue: [self push: self llpop * self llpop]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! push: aNumber stack addFirst: aNumber. self triggerEvent: #changed! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 08:50'! rational self stackSize >= 1 ifTrue: [self push: self llpop asFraction]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! subtract | a b | self stackSize >= 2 ifTrue: [a _ self llpop. b _ self llpop. self push: b - a]! ! !RPNCalculator methodsFor: 'operations' stamp: 'taj 8/14/97 05:33'! swap | a b | self stackSize >= 2 ifTrue: [a _ self llpop. b _ self llpop. self llpush: a. self push: b]! ! !RPNCalculator methodsFor: 'queries' stamp: 'taj 8/14/97 05:33'! peek self stackSize > 0 ifTrue: [^ stack first] ifFalse: [^ nil]! ! !RPNCalculator methodsFor: 'queries' stamp: 'taj 8/14/97 05:33'! stack ^ stack copy! ! !RPNCalculator methodsFor: 'queries' stamp: 'taj 8/14/97 05:33'! stackSize ^ stack size! ! !RPNCalculator methodsFor: 'private' stamp: 'taj 8/14/97 05:33'! initialize super initialize. stack _ OrderedCollection new! ! !RPNCalculator methodsFor: 'private' stamp: 'taj 8/14/97 05:33'! llpop | rv | self stackSize > 0 ifTrue: [rv _ stack removeFirst. ^ rv] ifFalse: [^ nil]! ! !RPNCalculator methodsFor: 'private' stamp: 'taj 8/14/97 05:33'! llpush: aNumber stack addFirst: aNumber! ! !RPNCalculator methodsFor: 'private' stamp: 'taj 8/14/97 05:33'! pop | rv | self stackSize > 0 ifTrue: [rv _ stack removeFirst. self triggerEvent: #changed. ^ rv] ifFalse: [^ nil]! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:09'! basket ^basket! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:10'! department ^department! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:10'! department: aDepartment department := aDepartment! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 05:47'! initialize basket := Basket new. lookingInBasket := false! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 07:09'! inventoryDescription |count worth| count := self basket itemCount. worth := self basket worth. ^count = 0 ifTrue: ['You are holding an empty basket.'] ifFalse: [count = 1 ifTrue: ['You are holding a basket with 1 item inside worth $',worth printString] ifFalse: ['You are holding a basket wih ',count printString,' items inside worth $',worth printString]].! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 05:46'! isLookingInBasket ^lookingInBasket! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 06:13'! lookingAt ^lookingAt! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 06:12'! lookingAt: aProduct lookingAt := aProduct! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 05:47'! lookingInBasket: aBoolean lookingInBasket := aBoolean! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:36'! store ^store! ! !Shopper methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:36'! store: aStore store := aStore! ! !Shopper class methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:11'! new ^super new initialize! ! !Store methodsFor: 'as yet unclassified' stamp: 'taj 7/28/97 08:23'! checkOut: aShopper! ! !Store methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 09:31'! departments self subclassResponsibility! ! !Store methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 03:40'! departmentUsingId: aString ^self departments detect: [:i| i id = aString]! ! !Store methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 09:31'! description self subclassResponsibility! ! !Store methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 09:32'! pageClass |name| name := self class printString,'Page'. ^Smalltalk at: name asSymbol! ! !Store methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 06:51'! productUsingId: aString |product| self departments do: [:d| product := d productUsingId: aString. product notNil ifTrue: [^product]]. ^nil! ! !SqueakStore methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 09:29'! departments ^departments! ! !SqueakStore methodsFor: 'as yet unclassified' stamp: 'taj 8/1/97 19:22'! description ^'Squeak Book/Music Store'! ! !SqueakStore methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 09:29'! initialize |music books| departments := OrderedCollection new. music := Department new id: 'music'; description: 'Music Department'; add: (Product new id: 'SBK 46330'; name: 'Brahms Symphony No. 4'; description: 'Cleveland Orchestra, George Szell. Total Time: 41:12'; price: 9.99; yourself); add: (Product new id: 'HMX 2901326'; name: 'J.S. Bach Magnificat'; description: 'La Chapelle Royale, Collegium Vocale, Philippe Herreweghe.', ' Total Time: 53:00'; price: 15.99; yourself); add: (Product new id: 'DG 435 162'; name: 'Mahler Symphonies'; description: 'Wiener Philharmoniker. Leonard Bernstein.', ' Total Time: 13:53:00'; price: 99.99; yourself). books := Department new id: 'books'; description: 'Book Department'; add: (Product new id: 'Dover 0-486-20236-4'; name: 'Scepticism and Animal Faith'; description: 'George Santayana, 1923, 314 pages'; price: 8.95; yourself); add: (Product new id: 'AW 13688'; name: 'Smalltalk-80 The Language'; description: 'Goldberg and Robson, 1989, 585 pages.'; price: 34.75; yourself); add: (Product new id: 'ISBN 0-525-93418-9'; name: 'Atlas Shrugged'; description: 'Ayn Rand, 1957, 1168 pages'; price: 39.95; yourself). departments add: music. departments add: books.! ! !SqueakStore methodsFor: 'as yet unclassified' stamp: 'taj 8/1/97 21:42'! pageClass ^SqueakStorePage! ! !Store class methodsFor: 'as yet unclassified' stamp: 'taj 7/29/97 08:47'! current instance isNil ifTrue: [instance := self new]. ^instance! ! !SqueakStore class methodsFor: 'as yet unclassified' stamp: 'taj 7/29/97 08:27'! new ^super new initialize! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:55'! address ^self tagged: 'ADDRESS'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:55'! anchorAs: name ^'',self,''.! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 08:01'! asFormDictionary | dictionary index key value | dictionary _ Dictionary new. (self findTokens: '~') do: [:pair | index _ pair findFirst: [:c | c = $=]. key _ pair copyFrom: 1 to: index - 2. value _ pair copyFrom: index + 2 to: pair size. dictionary at: key put: value]. ^ dictionary ! ! !String methodsFor: 'HTML generation' stamp: 'taj 10/15/97 15:20'! asHTML2 | temp | temp _ self copyReplaceAll: '&' with: '&'. temp _ temp copyReplaceAll: '<' with: '<'. temp _ temp copyReplaceAll: '>' with: '>'. "temp := temp copyReplaceAll: ' ' with: ' ' preformatted." temp _ temp copyReplaceAll: ' ' with: '
'. ^ temp! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:56'! asHTMLCode ^self! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 08:25'! asString ^self! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:56'! bold ^self tagged: 'B'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/1/97 20:46'! buttonLinkTo: url ^ButtonLink label: self nextPage: url! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/2/97 02:57'! buttonLinkTo: url name: aname ^ButtonLink name: aname label: self nextPage: url! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/3/97 17:45'! buttonLinkToPage: url ^ButtonPageLink label: self nextPage: url! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/3/97 18:01'! buttonLinkToPage: url value: value ^ButtonPageLink label: self nextPage: url value: value! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:56'! centered ^self tagged: 'CENTER'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:56'! code ^self tagged: 'CODE'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:56'! emphasized ^self tagged: 'EM'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:56'! endParagraph ^self,'

' ! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! heading1 ^self tagged: 'H1'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! heading2 ^self tagged: 'H2'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! heading3 ^self tagged: 'H3'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! horizontalRule ^self , '

'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! italic ^self tagged: 'I'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! keyboard ^self tagged: 'KBD'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! leftAligned ^'
',self,'
'.! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! linkTo: url ^'',self,''.! ! !String methodsFor: 'HTML generation' stamp: 'taj 10/15/97 14:23'! linkTo: url target: target ^target isNil ifTrue: ['',self,''] ifFalse: ['',self,'']! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:57'! linkToAnchor: anchor ^'',self,''.! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:58'! linkToDownload: file from: site ^ '' , self , '' ! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:58'! linkToMail: person subject: subject ^ '' , self , '' ! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/3/97 19:20'! linkToPage: url ^PageLink label: self nextPage: url! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/3/97 19:22'! linkToPage: url value: value ^PageLink label: self nextPage: url value: value! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:58'! newLine ^self,'
' ! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:58'! preformatted ^self tagged: 'PRE'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:58'! quoted ^self tagged: 'BLOCKQUOTE'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:58'! rightAligned ^'
',self,'
'.! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:59'! sample ^self tagged: 'SAMPLE'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:59'! strong ^self tagged: 'STRONG'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:59'! tagged: tag ^'<' , tag , '>' , self , ''! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:59'! typed ^self tagged: 'TT'! ! !String methodsFor: 'HTML generation' stamp: 'taj 8/14/97 05:59'! underscore ^self tagged: 'U'! ! !WebBrowserRequest methodsFor: 'private' stamp: 'taj 8/19/97 15:15'! addField: aString |index| index := aString findDelimiters: '=' startingAt: 1. fields at: (aString copyFrom: 1 to: index-1) put: (aString copyFrom: index + 1 to: aString size)! ! !WebBrowserRequest methodsFor: 'private' stamp: 'taj 8/3/97 18:39'! addHeaderField: aString |index| index := aString findDelimiters: ':' startingAt: 1. headerFields at: (aString copyFrom: 1 to: index - 1) put: (aString copyFrom: index + 2 to: aString size)! ! !WebBrowserRequest methodsFor: 'private' stamp: 'taj 8/19/97 15:01'! fix: aString |readStream writeStream c number| readStream := ReadStream on: aString. writeStream := WriteStream on: (String new: aString size). [readStream atEnd] whileFalse: [c := readStream next. (c = $+ or: [c = $~]) ifTrue: [writeStream nextPut: $ ] ifFalse: [ c = $% ifTrue: [number := Number readFrom: '16r',(String with: readStream next with: readStream next). writeStream nextPut: (Character value: number)] ifFalse: [writeStream nextPut: c]]]. ^writeStream contents ! ! !WebBrowserRequest methodsFor: 'private' stamp: 'taj 10/18/97 03:35'! postFields: aString |string parsed| string := self fix: aString. "replace +~ and hex tokens" parsed := string findTokens: '&'. parsed do: [:pair| self addField: pair]. ! ! !WebBrowserRequest methodsFor: 'private' stamp: 'taj 10/18/97 05:50'! request: anOrderedCollection |lineParsed| fields := Dictionary new. headerFields := Dictionary new. lineParsed := anOrderedCollection removeFirst findTokens: ' '. verb := lineParsed at: 1. url := lineParsed at: 2. self urlFields: url. url := self fix: url. protocol := lineParsed at: 3. anOrderedCollection do: [:line| self addHeaderField: line]. ! ! !WebBrowserRequest methodsFor: 'private' stamp: 'taj 8/3/97 18:59'! urlFields: aString |index size| index := aString indexOf: $? ifAbsent: [^self]. size := aString size. index = size ifTrue: [^self]. ^self postFields: (aString copyFrom: index+1 to: size) ! ! !WebBrowserRequest methodsFor: 'queries' stamp: 'taj 10/18/97 07:15'! description ^self url,' ',(self headerFieldValue: 'User-Agent') ! ! !WebBrowserRequest methodsFor: 'queries' stamp: 'taj 8/19/97 15:09'! fields ^fields! ! !WebBrowserRequest methodsFor: 'queries' stamp: 'taj 8/3/97 19:08'! fieldValue: aString ^fields at: aString ifAbsent: [nil]! ! !WebBrowserRequest methodsFor: 'queries' stamp: 'taj 8/19/97 15:22'! headerFields ^headerFields! ! !WebBrowserRequest methodsFor: 'queries' stamp: 'taj 8/19/97 15:23'! headerFieldValue: aString ^headerFields at: aString ifAbsent: ['unknown']! ! !WebBrowserRequest methodsFor: 'queries' stamp: 'taj 8/19/97 13:32'! isGet ^verb = 'GET'! ! !WebBrowserRequest methodsFor: 'queries' stamp: 'taj 8/19/97 13:32'! isPost ^verb = 'POST'! ! !WebBrowserRequest methodsFor: 'queries' stamp: 'taj 8/19/97 14:50'! url ^url! ! !WebBrowserRequest class methodsFor: 'instance creation' stamp: 'taj 8/19/97 13:23'! parse: request ^self new request: request! ! WebtalkPage comment: '"process: dictionary "'! !WebtalkPage methodsFor: 'private' stamp: 'taj 8/18/97 00:16'! doesNotUnderstand: message ^ self formDictionary at: message selector printString ifAbsent: [Error signal: 'does not understand: ',message printString]! ! !WebtalkPage methodsFor: 'private' stamp: 'taj 8/14/97 05:44'! formDictionary ^ formDictionary! ! !WebtalkPage methodsFor: 'private' stamp: 'taj 8/16/97 22:31'! formDictionary: d formDictionary _ d! ! !WebtalkPage methodsFor: 'private' stamp: 'taj 8/16/97 21:24'! processAndCatchErrors | page | ^[self process: self session] on: Error do: [:x | page _ HTMLPage title: 'Webtalk Processing Error'. page add: 'Webtalk Processing Error:' heading2. page add: x description. ^ page code] ! ! !WebtalkPage methodsFor: 'private' stamp: 'taj 8/19/97 17:01'! session | id | id _ self formDictionary at: 'webtalkSession' ifAbsent: []. id isNil ifTrue: [^WebtalkSession newForAddress: self userAddress] ifFalse: [^WebtalkSession id: id asNumber address: self userAddress]. ! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/3/97 18:17'! clicked: aString (self formDictionary includesKey: 'linkValue') ifTrue: [self buttonLink=aString ifTrue: [^true]]. ^ self formDictionary includesKey: aString! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 10/18/97 07:14'! description ^self class printString ,' ', self userBrowser, ' ', self userAddress ! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 10/18/97 06:22'! file: filename ^(FileStream concreteStream isAFileNamed: filename) ifTrue: [(FileStream fileNamed: filename) contentsOfEntireFile] ifFalse: [filename,' not found'] ! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/14/97 05:44'! gatewayInterface ^ self formDictionary at: 'GATEWAY_INTERFACE'! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/2/97 08:03'! includes: aString ^self formDictionary includesKey: aString ! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/14/97 05:44'! isChecked: aString ^ self formDictionary includesKey: aString! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/19/97 17:11'! isEnabled ^self class isEnabled! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/14/97 05:44'! serverName ^ self formDictionary at: 'SERVER_NAME'! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/14/97 05:44'! serverPort ^ self formDictionary at: 'SERVER_PORT'! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/14/97 05:44'! serverProtocol ^ self formDictionary at: 'SERVER_PROTOCOL'! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/14/97 05:44'! serverSoftware ^ self formDictionary at: 'SERVER_SOFTWARE'! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 10/18/97 07:13'! userAddress ^ self formDictionary at: 'REMOTE_ADDR' ifAbsent: ['unknown']! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/14/97 05:44'! userBrowser ^ self formDictionary at: 'HTTP_USER_AGENT'! ! !WebtalkPage methodsFor: 'queries' stamp: 'taj 8/14/97 05:44'! userHost ^ self formDictionary at: 'REMOTE_HOST'! ! !WebtalkPage methodsFor: 'override in subclasses' stamp: 'taj 8/18/97 03:15'! process: session self subclassResponsibility! ! !AddToBasketPage methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:04'! process: session |page shopper basket product| shopper := session data. basket := shopper basket. product := shopper lookingAt. basket add: product. page := HTMLPage title: product name,' selected' session: session. page add: 'You place a copy of ', product name,' in your basket.'. page add: ('OK' buttonLinkToPage: 'ProductPage' value: product id). ^page code.! ! !AnotherFormTestPage methodsFor: 'from WebtalkPage' stamp: 'taj 8/1/97 20:37'! process: session | page form | page _ HTMLPage title: 'Internal Test' session: session. page add: (Graphic from: '/logo.gif' standIn: 'Thregecy' alignment: #center). page add: 'this is left' leftAligned. page add: 'this is right' rightAligned. page add: 'this is center' centered. page add: 'Thregecy Software' bold newLine. page add: HorizontalRule. form _ HTMLForm nextPage: 'AnotherFormTestResultPage'. form add: 'EntryField: ' newLine , (FormEntryField name: 'entry' value: '3' length: 6) newLine. form add: 'CheckBox: ' newLine , (FormCheckBox name: 'check' value: false) newLine. form add: 'Radio Buttons: ' newLine. form add: (FormRadioButton name: 'radio' value: 'a') , 'a' newLine. form add: (FormRadioButton name: 'radio' valueChecked: 'b') , 'b' newLine. form add: (FormRadioButton name: 'radio' value: 'c') , 'c' newLine. form add: 'ListBox: ' newLine , (FormListBox name: 'listBox' values: #('one' 'two' 'three' ) selection: 'two' size: 3) newLine. form add: 'ComboBox: ' newLine , (FormComboBox name: 'comboBox' values: #('aaay' 'beee' 'seee' ) selection: 'beee') newLine. form add: NewLine. form add: (FormSubmitButton label: 'submit'). page add: form. ^ page code ! ! !AnotherFormTestResultPage methodsFor: 'from WebtalkPage' stamp: 'taj 8/18/97 04:47'! process: session | page | page _ HTMLPage title: 'Internal Test Results'. page add: 'radio button: '. self radio isNil ifTrue: [page add: 'none selected'] ifFalse: [page add: self radio]. page add: NewLine. page add: 'list box: ',self listBox newLine. page add: 'combo box: ',self comboBox newLine. ^ page code! ! !BasketPage methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 20:13'! process: session |page shopper basket | shopper := session data. basket := shopper basket. shopper lookingInBasket: true. page := HTMLPage title: 'Your Basket' session: session. page add: shopper inventoryDescription; add: NewLine; add: 'You can:'; add: NewLine; add: NewLine. basket products do: [:i| page add: ('Look at ', i name linkToPage: 'ProductPage' value: i id); add: NewLine]. page add: NewLine. page add: ('Return from Inventory' linkToPage: shopper store pageClass printString). ^page code ! ! !BrowserPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 05:57'! fix: aString |result| result := aString copyReplaceAll: '&' with: '&'. result := result copyReplaceAll: '<' with: '<'. result := result copyReplaceAll: '>' with: '>'. result := result copyReplaceAll: ' ' with: '
'. result := result copyReplaceAll: ' ' with: '    '. result := result copyReplaceAll: ' ' with: '  '. ^result! ! !CheckoutPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 06:48'! process: session |shopper page| shopper := session data. page := HTMLPage title: 'Your invoice' session: session. page add: shopper basket htmlInvoice newLine newLine. shopper basket beEmpty. "page add: ('OK' buttonLinkToPage: shopper store pageClass printString)." ^page code ! ! !ClassCategoriesPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 05:22'! process: aSession |page pageLink| page := HTMLPreformattedPage title: 'Class Categories' session: aSession. pageLink := PageLink new page: 'ClassesPage'; target: 'classes'; yourself. SystemOrganization categories do: [:i| pageLink label: i ; value: i. page add: pageLink; add: NewLine]. ^page code ! ! !ClassCommentBrowserPage methodsFor: 'as yet unclassified' stamp: 'taj 10/16/97 22:25'! process: aSession ^' > System Browser <BODY> <P>This page is designed to be viewed by a browser which supports Netscapes Frames extension. This text will be shown by browsers which do not support the Frames extension.</P> </BODY> '! ! !ClassCommentPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 05:35'! process: aSession |page| page := HTMLPage title: 'Lower' session: aSession. page add: (self fix: (Smalltalk at: self linkValue asSymbol) comment). ^page code ! ! !ClassDefinitionPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 06:22'! process: aSession |page class| page := HTMLPage title: 'Lower' session: aSession. class := Smalltalk at: self linkValue asSymbol. page add: (self fix: class definition). page add: NewLine. page add: NewLine. page add: (self fix: class class definition). ^page code ! ! !ClassesPage methodsFor: 'as yet unclassified' stamp: 'taj 10/18/97 02:00'! process: aSession |pageLink commentPageLink hierarchyPageLink definitionPageLink page | page := HTMLPreformattedPage title: 'Class Categories' session: aSession. pageLink := PageLink new page: 'MethodCategoriesPage'; target: 'methodCategories'; yourself. commentPageLink := PageLink new label: 'C'; page: 'ClassCommentPage'; target: 'lowerPane'; yourself. hierarchyPageLink := PageLink new label: 'H'; page: 'ClassHierarchyPage'; target: 'lowerPane'; yourself. definitionPageLink := PageLink new label: 'D'; page: 'ClassDefinitionPage'; target: 'lowerPane'; yourself. page add: self linkValue,NewLine,NewLine. (SystemOrganization listAtCategoryNamed: self linkValue asSymbol) do: [:i| commentPageLink value: i. hierarchyPageLink value: i. definitionPageLink value: i. pageLink label: i ; value: i. page add: commentPageLink; add: ' '; add: hierarchyPageLink; add: ' '; add: definitionPageLink; add: ' '; add: pageLink; add: NewLine] . ^page code ! ! !ClassHierarchyPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 05:41'! process: aSession |page| page := HTMLPage title: 'Lower' session: aSession. page add: (self fix: (Smalltalk at: self linkValue asSymbol) printHierarchy). ^page code ! ! !ClassOptionPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 04:56'! process: aSession | page pageLink | page := HTMLPage title: 'Class Categories' session: aSession. pageLink := PageLink new page: 'MethodCategoriesPage'; target: 'methodCategories'; yourself. page add: (pageLink label: 'class' centered; value: '1class'; yourself). ^page code ! ! !DepartmentPage methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 19:56'! process: session |page shopper department | shopper := session data. shopper department: (shopper store departmentUsingId: self linkValue). department := shopper department. page := HTMLPage title: department description session: session. page add: 'You are standing in the ',department description,'.'; add: NewLine; add: shopper inventoryDescription; add: NewLine; add: 'What would you like to do now?' newLine newLine. department products do: [:i| page add: ('Look at ', i name linkToPage: 'ProductPage' value: i id); add: NewLine]. page add: NewLine. page add: ('Leave this department' linkToPage: shopper store pageClass printString). ^page code ! ! !EmptyBasketPage methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 17:48'! process: session |page| session data basket beEmpty. page := HTMLPage title: 'Basket Emptied' session: session. page add: 'Showing great consideration, you return all of the items in your basket to where you found them.'. page add: ('OK' buttonLinkToPage: session data store pageClass printString). ^page code.! ! !FactorialPage methodsFor: 'from WebtalkPage' stamp: 'taj 8/2/97 09:41'! process: session | page form | page _ HTMLPage title: 'Smalltalk Factorial Calculator' session: session. page add: 'Smalltalk Factorial Calculator' heading2. page add: HorizontalRule. page add: NewLine. form _ HTMLForm nextPage: 'FactorialResultPage'. form add: 'Number: ' newLine , (FormEntryField name: 'number' value: '100' length: 3) newLine newLine. form add: (FormSubmitButton label: 'Calculate Factorial'). page add: form. ^ page code! ! !FactorialResultPage methodsFor: 'from WebtalkPage' stamp: 'taj 8/1/97 20:38'! process: session | page form number | page _ HTMLPage title: 'Smalltalk Factorial Calculator Result' session: session. number := self number asNumber. number < 301 ifTrue: [page add: 'The factorial of ' , self number , ' is ' , number factorial printString , '.'] ifFalse: [page add: 'sorry, that would take too long']. form _ HTMLForm nextPage: 'FactorialPage'. form add: (FormSubmitButton label: 'Calculate Another'). page add: form. ^ page code! ! !FormTestPage methodsFor: 'as yet unclassified' stamp: 'taj 10/18/97 03:34'! process: session ^ ' Webtalk Form Test

Webtalk Test

Your name:

Your address:

City, State, and Zip Code:

 email address:

Please enter your secret password:

Comments:

 this  that  her  him
 arms  legs  fingers  nostrils

'! ! !FormTestResultPage methodsFor: 'from WebtalkPage' stamp: 'taj 10/18/97 03:34'! process: session | page form | page _ HTMLPage title: 'Webtalk Test Results' session: session. page add: 'Webtalk Request Processed' heading2. page add: (Date today printString,' ',Time now printString) heading3. page add: HorizontalRule. page add: NewLine. page add: 'form info' heading3 underscore. page add: 'name: ' , self xname bold newLine. page add: 'address: ' , self address bold newLine. page add: 'city state zip: ' , self cityStateZip bold newLine. page add: 'email: ' , self email bold newLine. page add: 'form parts: ' , self parts bold newLine. page add: 'password: ' , self password bold newLine. page add: 'comments: ' , self comments bold newLine. page add: 'arms: ' , (self isChecked: 'arms') printString bold newLine. page add: 'legs: ' , (self isChecked: 'legs') printString bold newLine. page add: 'fingers: ' , (self isChecked: 'fingers') printString bold newLine. page add: 'nostrils: ' , (self isChecked: 'nostrils') printString bold newLine. form _ HTMLForm nextPage: 'InfoPage'. form add: (FormSubmitButton label: 'More Info'). page add: form. ^ page code! ! !GuestbookAddEntryPage methodsFor: 'as yet unclassified' stamp: 'taj 10/18/97 04:00'! process: session ^' Webtalk Guestbook

Name:

(required)

Email:

Comments:

'! ! !GuestbookPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 06:55'! process: session |page fileStream| "handle new entry (if present)" (self includes: 'aname') ifTrue: "in other words, sent here by GuestbookAddEntryPage" [fileStream := FileStream fileNamed: 'guestbook'. fileStream setToEnd. fileStream nextPutAll: (self email isEmpty ifTrue: [self aname] ifFalse: [self aname linkToMail: self email subject: 'hi from guestbook']). fileStream nextPutAll: (self comments isEmpty ifTrue: [NewLine] ifFalse: [' commented:', self comments quoted]). fileStream cr. fileStream close]. "generate html" page _ HTMLPage title: 'Webtalk Guestbook'. page add: 'Please feel free to ', ('add your own entry' linkTo: 'webtalk.pl.cgi?webtalkClass=GuestbookAddEntryPage'),'.'. page add: NewLine. page add: NewLine. fileStream := FileStream fileNamed: 'guestbook'. page add: fileStream contentsOfEntireFile. ^page code ! ! !InfoPage methodsFor: 'from WebtalkPage' stamp: 'taj 10/18/97 04:08'! process: session | page | page _ HTMLPage title: 'Webtalk Request Info'. page add: 'Webtalk Request Info' heading2. page add: (Date today printString, ' ',Time now printString) heading3. page add: HorizontalRule. page add: NewLine. page add: 'gateway interface:' , self gatewayInterface bold newLine. page add: NewLine. page add: 'server info' heading3 underscore. page add: 'name: ' , self serverName bold newLine. page add: 'port: ' , self serverPort bold newLine. "page add: 'protocol: ' , self serverProtocol bold newLine." page add: 'software: ' , self serverSoftware bold newLine. page add: NewLine. page add: 'user info' heading3 underscore. page add: 'address: ' , self userAddress bold newLine. page add: 'browser: ' , self userBrowser bold newLine. page add: 'host: ' , self userHost bold newLine. page add: NewLine. page add: 'smalltalk info' heading3 underscore. page add: 'image name: ' , Smalltalk imageName bold newLine. page add: 'bvtes left: ' , Smalltalk bytesLeft printString bold newLine. ^ page code! ! !InstanceOptionPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 04:56'! process: aSession | page pageLink | page := HTMLPage title: 'Class Categories' session: aSession. pageLink := PageLink new page: 'MethodCategoriesPage'; target: 'methodCategories'; yourself. page add: (pageLink label: 'instance' centered; value: '1instance'; yourself). ^page code ! ! !MainTestPage methodsFor: 'as yet unclassified' stamp: 'taj 10/18/97 01:48'! process: aSession ^' System Browser <P>This page is designed to be viewed by a browser which supports Netscapes Frames extension. This text will be shown by browsers which do not support the Frames extension.</P> '. ! ! !MainTestPageTop methodsFor: 'as yet unclassified' stamp: 'taj 10/18/97 09:34'! process: session ^' Webtalk Test

Welcome the Webtalk demonstration page!! Webtalk allows you to write web applications using Squeak smalltalk.

Squeak Browser   RPN   Guestbook   Store   Form   System Info   Factorial

Please email me comments!!

'! ! !MetaOptionPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 04:04'! process: aSession | page pageLink | page := HTMLPreformattedPage title: 'Class Categories' session: aSession. pageLink := PageLink new page: 'MethodCategoriesPage'; target: 'methodCategories'; yourself. page add: (pageLink label: 'instance'; value: '#instance'; yourself). page add: (pageLink label: 'class'; value: '#class'; yourself). ^page code ! ! !MethodCategoriesPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 06:19'! process: aSession |pageLink page model metaOptionSet classToBrowse n| model := aSession data. metaOptionSet := false. self linkValue = '1instance' ifTrue: [model browseMeta: false. metaOptionSet := true]. self linkValue = '1class' ifTrue: [model browseMeta: true. metaOptionSet := true]. page := HTMLPreformattedPage title: 'Method Categories' session: aSession. pageLink := PageLink new page: 'MethodsPage'; target: 'methods'; yourself. metaOptionSet ifFalse: [ model modelClass: (Smalltalk at: self linkValue asSymbol) ]. classToBrowse := model classToBrowse. page add: classToBrowse printString,NewLine,NewLine. n := 1. classToBrowse organization categories do: [:i| pageLink label: i ; value: i,',',10000 atRandom printString. n := n + 1. page add: pageLink; add: NewLine]. ^page code! ! !MethodPage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 05:52'! process: aSession |page model| model := aSession data. page := HTMLPage title: 'Methods' session: aSession. page add: (self fix: (model classToBrowse sourceCodeAt: self linkValue asSymbol)). ^page code! ! !MethodsPage methodsFor: 'as yet unclassified' stamp: 'taj 10/18/97 01:59'! process: aSession |pageLink page model classString fixed| model := aSession data. classString := (self linkValue findTokens: ',') at: 1. page := HTMLPreformattedPage title: 'Methods' session: aSession. pageLink := PageLink new page: 'MethodPage'; target: 'lowerPane'; yourself. page add: classString,NewLine,NewLine. (model classToBrowse organization listAtCategoryNamed: classString asSymbol) do: [:i| fixed := self fix: i. pageLink label: fixed ; value: fixed. page add: pageLink; add: NewLine]. ^page code ! ! !ProductPage methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 19:57'! process: session |page shopper department product basket| shopper := session data. basket := shopper basket. department := shopper department. product := shopper store productUsingId: self linkValue. shopper lookingAt: product. page := HTMLPage title: product name session: session. page add: product name newLine; add: product description newLine; add: product id,' $',product price printString newLine newLine; add: 'What would you like to do now?' newLine newLine. (basket includes: product) ifTrue: [page add: ('Put another copy in your basket' linkToPage: 'AddToBasketPage' value: product id); add: NewLine; add: ('Return a copy to the shelf' linkToPage: 'RemoveFromBasketPage' value: product id); add: NewLine] ifFalse: [page add: ('Put a copy in your basket' linkToPage: 'AddToBasketPage' value: product id); add: NewLine]. page add: NewLine. shopper isLookingInBasket ifTrue: [page add: ('Back to Inventory' linkToPage: 'BasketPage')] ifFalse: [page add: ('Continue browsing the ',department description linkToPage: 'DepartmentPage' value: department id); add: NewLine. page add: ('Leave this department' linkToPage: shopper store pageClass printString). ]. ^page code ! ! !RemoveFromBasketPage methodsFor: 'as yet unclassified' stamp: 'taj 8/3/97 18:07'! process: session |page shopper basket product| shopper := session data. basket := shopper basket. product := shopper lookingAt. basket remove: product. page := HTMLPage title: product name,' rejected' session: session. page add: 'You place a copy of ', product name,' back on the shelf.'. page add: ('OK' buttonLinkToPage: 'ProductPage' value: product id). ^page code.! ! !RPNCalculatorPage methodsFor: 'from WebtalkPage' stamp: 'taj 10/17/97 06:44'! process: session "this method should be broken up, but has remained monolithic so that i can have a complete demo in one method" | page form calculator | "process keystroke" session isNew ifTrue: [calculator _ RPNCalculator new. session data: calculator.] ifFalse: [calculator _ session data. self entry ~= '' ifTrue: [calculator push: self entry asNumber]. (self clicked: 'enter') ifTrue: [self entry = '' ifTrue: [calculator dup]]. (self clicked: 'drop') ifTrue: [calculator drop]. (self clicked: 'add') ifTrue: [calculator add]. (self clicked: 'subtract') ifTrue: [calculator subtract]. (self clicked: 'divide') ifTrue: [calculator divide]. (self clicked: 'multiply') ifTrue: [calculator multiply]. (self clicked: 'float') ifTrue: [calculator float]. (self clicked: 'rational') ifTrue: [calculator rational]]. "generate new html page, add header" page _ HTMLPage title: 'Smalltalk RPN Calculator' session: session. page add: 'Smalltalk RPN Calculator' heading2. page add: HorizontalRule newLine. "add the stack" calculator stack reversed do: [:line | page add: line printString rightAligned]. page add: HorizontalRule newLine. "add the buttons (with a form)" form _ HTMLForm nextPage: 'RPNCalculatorPage'. form add: (FormEntryField name: 'entry' value: '' length: 20) rightAligned newLine. form add: ((FormSubmitButton name: 'enter' label: 'Enter'), (FormSubmitButton name: 'drop' label: 'Drop') , ' ' , (FormSubmitButton name: 'add' label: ' + ') , (FormSubmitButton name: 'subtract' label: ' - ') , (FormSubmitButton name: 'multiply' label: ' * ') , (FormSubmitButton name: 'divide' label: ' / ') , ' ' , (FormSubmitButton name: 'float' label: 'Float') , (FormSubmitButton name: 'rational' label: 'Rational')) rightAligned. page add: form. page add: NewLine. ^ page code! ! !StorePage methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 02:22'! pageToExitTo ^self subclassResponsibility! ! !StorePage methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 06:49'! process: session |page shopper| shopper := self shopper: session. shopper department: nil. shopper lookingInBasket: false. page := HTMLPage title: shopper store description session: session. page add: 'You are standing in the ',shopper store description,'.'; add: NewLine; add: shopper inventoryDescription; add: NewLine; add: 'What would you like to do now?' newLine newLine. shopper store departments do: [:dep| page add: ('Enter the ', dep description linkToPage: 'DepartmentPage' value: dep id ); add: NewLine]. page add: NewLine. shopper basket itemCount > 0 ifTrue: [page add: ('Look in your basket' linkToPage: 'BasketPage'); add: NewLine; add: ('Empty your basket' linkToPage: 'EmptyBasketPage'); add: NewLine; add: NewLine; add: ('Check out' linkToPage: 'CheckoutPage')] ifFalse: ["page add: ('Leave the store' linkToPage: self pageToExitTo)"]. ^page code ! ! !StorePage methodsFor: 'as yet unclassified' stamp: 'taj 7/29/97 09:21'! shopper: aSession self subclassResponsibility! ! !SqueakStorePage methodsFor: 'as yet unclassified' stamp: 'taj 8/2/97 02:21'! pageToExitTo ^'MainTestPage' ! ! !SqueakStorePage methodsFor: 'as yet unclassified' stamp: 'taj 7/29/97 09:22'! shopper: session |shopper| session isNew ifTrue: [shopper := Shopper new store: SqueakStore current; yourself. session data: shopper] ifFalse: [shopper := session data]. ^shopper ! ! !SystemBrowserPage methodsFor: 'as yet unclassified' stamp: 'taj 10/18/97 07:08'! process: aSession |response| aSession isNew ifTrue: [aSession data: BrowserModel new]. response := ' System Browser '. ^response copyReplaceAll: '###' with: aSession id printString! ! !WebtalkErrorPage methodsFor: 'private' stamp: 'taj 8/17/97 13:51'! errorMessage: aString errorMessage := aString! ! !WebtalkErrorPage methodsFor: 'from WebtalkPage' stamp: 'taj 8/17/97 13:53'! process: aSession |html| html := HTMLPage title: 'Webtalk Processing Error'. html add: errorMessage. ^html code! ! !WebtalkPage class methodsFor: 'instance creation' stamp: 'taj 10/17/97 06:41'! default ^MainTestPage ! ! !WebtalkPage class methodsFor: 'instance creation' stamp: 'taj 8/18/97 04:00'! process: aDictionary log: aLog |page| page := self for: aDictionary. aLog add: page description. ^page processAndCatchErrors "returns HTML code" ! ! !WebtalkPage class methodsFor: 'queries' stamp: 'taj 8/19/97 17:10'! isEnabled ^true! ! !WebtalkPage class methodsFor: 'private' stamp: 'taj 8/19/97 17:28'! for: aDictionary |webtalkClass instance| webtalkClass := aDictionary at: 'webtalkClass' ifAbsent: []. webtalkClass notNil ifTrue: [webtalkClass := Smalltalk at: webtalkClass asSymbol ifAbsent: []]. webtalkClass isNil ifTrue: [instance := WebtalkErrorPage errorMessage: 'webtalk class ',webtalkClass,' not available'] ifFalse: [((webtalkClass inheritsFrom: WebtalkPage) and: [webtalkClass isEnabled]) ifFalse: [instance := WebtalkErrorPage errorMessage: 'webtalk class ',webtalkClass,' not available']]. instance isNil ifTrue: [instance := webtalkClass new]. instance formDictionary: aDictionary. ^instance ! ! !WebtalkErrorPage class methodsFor: 'instance creation' stamp: 'taj 8/17/97 13:51'! errorMessage: errorMessage ^self new errorMessage: errorMessage! ! WebtalkServer comment: 'needed: dependence on general execption handling; need to add it to the system (Object>>error) permanent connection list and table HTML generation'! !WebtalkServer methodsFor: 'from Connection' stamp: 'taj 8/18/97 02:25'! eventRead: aString self nextPut: (WebtalkPage process: aString asFormDictionary log: self log). self close ! ! !WebtalkServer methodsFor: 'from Connection' stamp: 'taj 8/18/97 02:38'! nextPut: aString ^self write: aString! ! !WebtalkServer methodsFor: 'from Connection' stamp: 'taj 8/18/97 23:48'! readObjects |buffer| buffer:=self llRead: 1. (buffer at: bufferDataSize) ~= $& ifTrue: [remnant := buffer copyFrom: 1 to: bufferDataSize] ifFalse: [readObjects add: (buffer copyFrom: 1 to: bufferDataSize - 1)]. ^self. ! ! !WebtalkServer methodsFor: 'private' stamp: 'taj 8/14/97 05:46'! log log isNil ifTrue: [log _ Log to: 'log.txt']. ^ log! ! !WebtalkServer class methodsFor: 'port servicing' stamp: 'taj 10/17/97 07:54'! listeningPortsCount ^5! ! !WebtalkServer class methodsFor: 'port servicing' stamp: 'taj 8/14/97 08:34'! startService self service: 4248. ! ! !WebtalkServer class methodsFor: 'webserver cgi script' stamp: 'taj 8/18/97 05:11'! webtalkPlCgi ^ '#!!/usr/bin/perl require 5.001; # webtalk.pl.cgi - the webtalk cgi interface # (c) 1996 by tim jones # based on examples by William E. Weinman and Larry Wall ################# # configuration ################# $hostname = ''warmspot''; $webtalkServer = ''wotan''; $port = 4248; ############################### # connect to smalltalk server ############################### use Socket; $sockaddr = ''S n a4 x8''; #chop($hostname = `hostname`); ($name, $aliases, $proto) = getprotobyname(''tcp''); ($name, $aliases, $port) = getservbyname($port, ''tcp'') unless $port =~ /^\d+$/; ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname); ($name, $aliases, $type, $len, $thataddr) = gethostbyname($webtalkServer); $this = pack($sockaddr, AF_INET, 0, $thisaddr); $that = pack($sockaddr, AF_INET, $port, $thataddr); if (!!socket(S, PF_INET, SOCK_STREAM, $proto)) { $em = "webtalk cgi interface couldn''t create socket"; &quit_with_error; } if (!!bind(S, $this)) { $em = "webtalk cgi interface couldn''t bind socket"; &quit_with_error; } if (!!connect(S, $that)) { $em = "webtalk cgi interface couldn''t connect socket"; &quit_with_error; } select(S); $| = 1; select(STDOUT); ###################################################### # send all standard CGI variables to the smalltalk server ###################################################### print S "~GATEWAY_INTERFACE = $ENV{''GATEWAY_INTERFACE''}"; print S "~SERVER_SOFTWARE = $ENV{''SERVER_SOFTWARE''}"; print S "~SERVER_NAME = $ENV{''SERVER_NAME''}"; print S "~SERVER_PROTOCOL = $ENV{''SERVER_PROTOCOL''}"; print S "~SERVER_PORT = $ENV{''SERVER_PORT''}"; print S "~HTTP_USER_AGENT = $ENV{''HTTP_USER_AGENT''}"; print S "~REMOTE_HOST = $ENV{''REMOTE_HOST''}"; print S "~REMOTE_ADDR = $ENV{''REMOTE_ADDR''}"; ################################################### # now handle standard input - # parse it, and pass the variables to the smalltalk server ################################################### read(STDIN, $qs, $ENV{"CONTENT_LENGTH"}); &parse_and_send; ################################################### # now handle the QUERY_STRING environment variable - # parse it, and pass the variables to the smalltalk server #################################################### $qs = $ENV{''QUERY_STRING''}; &parse_and_send; ################################################ # now get the smalltalk server''s html page response # and pass it on ################################################ print S "&"; print "Content-type: text/html\n\n"; while() { print; } exit 0; ############################################################### # subroutine to parse qs and print the variables to the socket ################################################################ sub parse_and_send { # split it up into an array by the ''&'' character @array = split(/&/,$qs); foreach $i (0 .. $#array) { # convert the plus chars to spaces $array[$i] =~ s/\+/ /g; # convert the wiggle chars to spaces #$array[$i] =~ s/~/ /g; # convert the hex tokens to characters $array[$i] =~ s/%(..)/pack("c",hex($1))/ge; # split into name and value ($name, $value) = split(/=/,$array[$i],2); # create the associative element $array{$name} = $value; } foreach $name (sort keys(%array)) { printf S "~$name = %s", $array{$name} } } ############################################################### # subroutine to abort with an error page ################################################################ sub quit_with_error { # Send the MIME header print "Content-type: text/plain\n\n"; print $em; exit 1; }'! ! !WebtalkServer class methodsFor: 'documentation' stamp: 'taj 8/19/97 16:29'! installation ^ ' If you wish for squeak to be your webserver, just type: WebtalkWebServer startService and in your browse the address of the machine running Squeak. To stop it, type: WebtalkWebServer stopService. Otherwise, copy the webtalk cgi script into a file called webtalk.pl.cgi and place it on your webserver with your other CGI scripts (for your convenience, I have also supplied this file as a separate download). Edit the following lines near the top of the script: $hostname = ''webserver.machine''; $webtalkServer = ''webtalk.machine''; The first value is the machine the webserver runs on; the second is the machine that Webtalk will run on. If you dont currently use any CGI, be sure to configure your webserver to handle it. I had to add the following to my /etc/httpd.conf: Exec /cgi/* /usr/web/http/* Webtalk relies on the VSExceptions, VSEvents, and Connections packages. Make sure they are installed and working before you try Webtalk. To start Webtalk, type the following in a workspace: WebtalkServer startService (to stop it again, type WebtalkServer stopService) Go to your browser, and access the following URL: http://your.server.here/cgi/webtalk.pl.cgi?webtalkClass=MainTestPage You should see a menu offering a selection of demo applications. ' ! ! !WebtalkServer class methodsFor: 'documentation' stamp: 'taj 8/18/97 05:49'! license ^ ' Webtalk is (c) 1997 by Thregecy Inc.. Webtalk may be used for any purpose on the Squeak platform, However, using webtalk on any other Smalltalk system is not permitted. ' ! ! !WebtalkServer class methodsFor: 'documentation' stamp: 'taj 8/19/97 16:31'! overview ^' WHAT IT IS Webtalk allows one to write interactive web applications using Squeak. HOW IT WORKS Webtalk works either as its own webserver or thru a CGI - capable web server. The next two paragraphs assume you are working thru a separate web server. The web client invokes the Webtalk CGI script on the web server, either by POSTing or GETing a form, or by explicitly calling it by URL. The Webtalk CGI script, written in Perl, gathers information from the systemÕs evironment variables and standard input (provided by the web server), parses, packages and sends this information to the Smalltalk image running on another machine using TCP/IP sockets. The Smalltalk image receives the information, parses it, and instantiates a subclass of WebtalkPage as determined by the value of the hidden field webtalkClass passed from the server and embedded originally in the HTML form or the URL. All of the form data and standard environment variables can be accessed from this object by using as selectors the NAME paramter specified for the fields in the HTML file. The newly created object processes the form information (if any) and generates a HTML page (using the supplied classes) that is passed back to the Perl script, and then ultimately to the web client. State information between screens is maintained by instances of WebtalkSession. An initial session is created for you which you can store data in. To make this session information available to other screens, you must specify the session when creating the form that will contain the buttons that will lead to another screen. The RPN calculator application uses sessions. COMPARISONS TO COMMERCIAL PRODUCTS I believe this is the same basic capability provide by the IBM and ParcPlace products, with four major differences: 1.I donÕt generate HTML screens from a GUI painter (which I think is of dubious value anyway). I do include classes to generate HTML, though. 2.Webtalk costs nothing, as opposed to 1-n thousand dollars 3.Webtalk has not been tested / performance tuned for servers handling jillions of hits per second. 4.If you have to use Squeak, I donÕt think there is any other available option (yet). Oh, the joys of monopoly!!!! WHAT IT WORKS WITH I imagine one should be able to get this system working on any web server that supports CGI scripts and Perl, but I have only tested it on Linux using the CERN 3.0A server. Also, I have only tested the Smalltalk portion on the Macintosh and Windows versions of Squeak. ' ! ! !WebtalkSession methodsFor: 'private' stamp: 'taj 8/14/97 05:44'! id ^ id! ! !WebtalkSession methodsFor: 'private' stamp: 'taj 8/19/97 17:05'! id: i address: a id _ i. address := a. usageCount := 0. self use. ! ! !WebtalkSession methodsFor: 'private' stamp: 'taj 8/19/97 17:07'! isAddressOk: a ^address = a ! ! !WebtalkSession methodsFor: 'private' stamp: 'taj 8/18/97 02:42'! isForsaken ^ (Time now subtractTime: lastAccessTime) asSeconds > self class idleSecondsAllowed! ! !WebtalkSession methodsFor: 'private' stamp: 'taj 8/17/97 13:19'! release self class release: self. self data release. ^super release.! ! !WebtalkSession methodsFor: 'private' stamp: 'taj 8/17/97 13:10'! use usageCount := usageCount + 1. lastAccessTime _ Time now! ! !WebtalkSession methodsFor: 'queries' stamp: 'taj 8/17/97 13:07'! isNew ^ self usageCount = 1! ! !WebtalkSession methodsFor: 'queries' stamp: 'taj 8/17/97 13:08'! usageCount ^usageCount! ! !WebtalkSession methodsFor: 'associated data' stamp: 'taj 8/14/97 05:44'! data ^ data! ! !WebtalkSession methodsFor: 'associated data' stamp: 'taj 8/14/97 05:44'! data: d data _ d! ! !WebtalkSession class methodsFor: 'existing instance' stamp: 'taj 8/19/97 17:03'! id: i address: a |instance| self releaseAllForsakenIfEnoughTimeHasPassed. instance := InstanceDictionary at: i ifAbsent: [TimeoutError signal: 'Your session has timed out.']. (instance isAddressOk: a) ifFalse: [TimeoutError signal: 'Your session has timed out.']. instance use. ^instance! ! !WebtalkSession class methodsFor: 'initialization' stamp: 'taj 8/17/97 12:59'! initialize Id _ 0. InstanceDictionary _ Dictionary new. ForsakenKilledAt _ Time now! ! !WebtalkSession class methodsFor: 'instance creation' stamp: 'taj 8/19/97 17:02'! newForAddress: a | instance | self releaseAllForsakenIfEnoughTimeHasPassed. Id _ Id + 1. instance _ super new. instance id: Id address: a. InstanceDictionary at: Id put: instance. ^ instance ! ! !WebtalkSession class methodsFor: 'forsaken handling' stamp: 'taj 8/17/97 03:39'! idleSecondsAllowed ^60*5! ! !WebtalkSession class methodsFor: 'forsaken handling' stamp: 'taj 8/17/97 13:15'! release: i InstanceDictionary removeKey: i id! ! !WebtalkSession class methodsFor: 'forsaken handling' stamp: 'taj 8/17/97 14:45'! releaseAllForsaken (InstanceDictionary select: [:i | i isForsaken]) do: [:i | i release]. ForsakenKilledAt _ Time now ! ! !WebtalkSession class methodsFor: 'forsaken handling' stamp: 'taj 8/17/97 13:16'! releaseAllForsakenIfEnoughTimeHasPassed (Time now subtractTime: ForsakenKilledAt ) asSeconds > self idleSecondsAllowed ifTrue: [self releaseAllForsaken]! ! !WebtalkWebServer methodsFor: 'from StringConnection' stamp: 'taj 10/18/97 03:39'! eventRead: aString aString isEmpty ifTrue: [ self handleRequest: lines. lines := OrderedCollection new ] ifFalse: [ lines add: aString ].! ! !WebtalkWebServer methodsFor: 'private' stamp: 'taj 10/18/97 05:41'! basicHandleRequest: requestLines |request| request := WebBrowserRequest parse: requestLines. request isGet ifTrue: [^self handleGet: request]. request isPost ifTrue: [request postFields: self next. ^self handlePost: request]. self respond: 'this server can only handle get and post requests'. ! ! !WebtalkWebServer methodsFor: 'private' stamp: 'taj 10/18/97 07:15'! handleFileRequest: request |filename directoryCharacter url| url := request url. self log add: request description,' ',self remoteAddress. url := url copyFrom: 2 to: url size. directoryCharacter := FileDirectory activeDirectoryClass pathNameDelimiter. filename := self class baseDirectory,url. filename := filename collect: [:c| c = $/ ifTrue:[directoryCharacter] ifFalse:[c]]. self respond: ((FileStream concreteStream isAFileNamed: filename) ifTrue: [(FileStream fileNamed: filename) contentsOfEntireFile] ifFalse: [url,' not found']) ! ! !WebtalkWebServer methodsFor: 'private' stamp: 'taj 10/18/97 06:31'! handleGet: request |url| url := request url. url = '/' ifTrue: [request addField: 'webtalkClass=',WebtalkPage default printString. ^self handleWebtalkRequest: request]. (url includes: $?) ifTrue: [self handlePost: request] ifFalse: [self handleFileRequest: request] ! ! !WebtalkWebServer methodsFor: 'private' stamp: 'taj 10/18/97 05:08'! handlePost: request "right now, only webtalk requests are processed" self handleWebtalkRequest: request. ! ! !WebtalkWebServer methodsFor: 'private' stamp: 'taj 10/18/97 06:34'! handleRequest: requestLines [self basicHandleRequest: requestLines] on: Error do: [:x| self respond: x description] ! ! !WebtalkWebServer methodsFor: 'private' stamp: 'taj 10/18/97 04:27'! handleWebtalkRequest: request |dictionary| dictionary := Dictionary new. dictionary at: 'GATEWAY_INTERFACE' put: 'Webtalk Web Server Interface'. dictionary at: 'SERVER_SOFTWARE' put: 'Webtalk Web Server'. dictionary at: 'SERVER_NAME' put: Connection localAddress. dictionary at: 'SERVER_PROTOCOL' put: 'HTTP/1.0'. dictionary at: 'SERVER_PORT' put: 'unknown'. dictionary at: 'HTTP_USER_AGENT' put: (request headerFieldValue: 'User-Agent'). dictionary at: 'REMOTE_HOST' put: self remoteAddress. dictionary at: 'REMOTE_ADDR' put: self remoteAddress. request fields associationsDo: [:a| dictionary at: a key put: a value]. self respond: (WebtalkPage process: dictionary log: self log). ! ! !WebtalkWebServer methodsFor: 'private' stamp: 'taj 10/18/97 05:14'! log log isNil ifTrue: [log _ Log to: self class logFilename]. ^ log ! ! !WebtalkWebServer methodsFor: 'private' stamp: 'taj 10/18/97 06:33'! respond: aString self isClosed ifFalse: [self nextPut: aString. self close] ifTrue: [Transcript show: 'connection closed, could not respond: ',aString;cr]! ! !WebtalkWebServer methodsFor: 'initialization' stamp: 'taj 8/19/97 12:03'! initialize super initialize. lines := OrderedCollection new. ! ! !WebtalkWebServer class methodsFor: 'configuration' stamp: 'taj 10/18/97 05:18'! baseDirectory ^''! ! !WebtalkWebServer class methodsFor: 'configuration' stamp: 'taj 10/17/97 07:53'! listeningPortsCount ^5! ! !WebtalkWebServer class methodsFor: 'configuration' stamp: 'taj 10/18/97 05:13'! logFilename ^'log.txt'! ! !WebtalkWebServer class methodsFor: 'configuration' stamp: 'taj 8/19/97 15:10'! startService ^self service: 80! ! HTMLPage initialize! WebtalkSession initialize!