1WAFileLibrary subclass: WAFileLibraryDemo [
2
3    <comment: nil>
4    <category: 'Seaside-Examples-Misc'>
5
6    mainCss [
7	<category: 'accessing'>
8	^'/* Pier
9
10   Copyright (c) 2003-2006 Lukas Renggli
11   Copyright (c) 2005-2006 Software Composition Group, University of Berne
12*/
13
14* {
15	margin: 0px;
16	padding: 0px;
17}
18
19body {
20	font-family: Verdana, Arial, Helvetica, sans-serif;
21	font-size: 12px;
22	color: #111111;
23	margin: 10px;
24}
25
26img {
27	border: none;
28}
29
30td,
31th {
32	text-align: left;
33	vertical-align: top;
34}
35
36a {
37	text-decoration: none;
38	color: #092565;
39}
40
41a:hover {
42	text-decoration: underline;
43}
44
45.broken {
46    color: #aa0000;
47}
48
49.protected {
50    color: #aaaaaa;
51}'
52    ]
53
54    mainJpg [
55	<category: 'accessing'>
56	^#(255 216 255 224 0 16 74 70 73 70 0 1 1 1 0 72 0 72 0 0 255 225 0 22 69 120 105 102 0 0 77 77 0 42 0 0 0 8 0 0 0 0 0 0 255 219 0 67 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 255 219 0 67 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 255 192 0 17 8 0 4 2 152 3 1 34 0 2 17 1 3 17 1 255 196 0 24 0 1 0 3 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 7 9 10 255 196 0 38 16 0 2 3 0 1 1 8 3 1 0 0 0 0 0 0 0 0 1 17 81 145 7 2 6 8 9 40 49 54 116 195 65 103 129 183 255 196 0 20 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 196 0 20 17 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 218 0 12 3 1 0 2 17 3 17 0 63 0 235 191 191 103 181 250 190 7 87 216 85 254 17 73 62 9 229 249 83 230 63 181 191 230 188 74 0 26 177 10 150 33 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 132 42 88 128 1 10 150 33 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 132 42 88 128 1 10 150 33 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 132 42 88 128 1 10 150 33 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 132 42 88 128 1 10 150 33 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 132 42 88 128 1 10 150 33 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 132 42 88 128 1 10 150 33 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 132 42 88 128 1 10 150 33 10 150 32 0 66 94 137 47 225 32 0 0 0 0 0 132 253 84 145 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 132 42 88 128 1 10 150 33 10 150 32 0 66 165 136 66 165 136 0 16 169 98 16 169 98 0 4 42 88 140 168 241 117 73 112 55 16 66 75 204 143 100 255 0 31 173 121 108 0 44 254 226 126 215 233 248 29 63 88 0 15 255 217)
57	    asByteArray
58    ]
59]
60
61
62
63WAComponent subclass: WACounter [
64    | count |
65
66    <comment: 'A WACounter is component that displays a number. Additionally it has two links that allow the user to increase or decrease this number by 1.
67
68The lesson to learn here is how the Seaside callback mechanism is used, how anchors can be used to trigger actions.
69
70Instance Variables
71	count:		<Integer>
72
73count
74	- the number to display, default 0
75'>
76    <category: 'Seaside-Examples-Misc'>
77
78    WACounter class >> canBeRoot [
79	<category: 'testing'>
80	^true
81    ]
82
83    WACounter class >> description [
84	<category: 'accessing'>
85	^'A very simple Seaside application'
86    ]
87
88    WACounter class >> entryPointName [
89	<category: 'accessing'>
90	^'examples/counter'
91    ]
92
93    WACounter class >> example [
94	<category: 'examples'>
95	^self new
96    ]
97
98    WACounter class >> initialize [
99	<category: 'initialization'>
100	self registerAsApplication: self entryPointName
101    ]
102
103    count [
104	<category: 'accessing'>
105	^count
106    ]
107
108    count: anInteger [
109	<category: 'accessing'>
110	count := anInteger
111    ]
112
113    decrease [
114	<category: 'actions'>
115	count := count - 1
116    ]
117
118    increase [
119	<category: 'actions'>
120	count := count + 1
121    ]
122
123    initialize [
124	<category: 'initialization'>
125	super initialize.
126	self count: 0
127    ]
128
129    renderContentOn: html [
130	<category: 'rendering'>
131	html heading: count.
132	(html anchor)
133	    callback: [self increase];
134	    with: '++'.
135	html space.
136	(html anchor)
137	    callback: [self decrease];
138	    with: '--'
139    ]
140
141    states [
142	<category: 'accessing'>
143	^Array with: self
144    ]
145]
146
147
148
149WAComponent subclass: WAExampleBrowser [
150    | class selector component hasAnswer answer |
151
152    <comment: 'I browse all the examples available in the system ie all the results of class methods beginning with #example...
153
154point your browser to localhost:xxx/seaside/examples
155
156If you want to see these examples
157
158/seaside/config app:
159- add a new application named "examples"
160- choose WAExampleBrowser as the root component
161'>
162    <category: 'Seaside-Examples-Misc'>
163
164    WAExampleBrowser class >> canBeRoot [
165	<category: 'testing'>
166	^true
167    ]
168
169    WAExampleBrowser class >> description [
170	<category: 'accessing'>
171	^'Browse through Seaside examples'
172    ]
173
174    WAExampleBrowser class >> initialize [
175	<category: 'class initialization'>
176	self registerAsApplication: 'examples/examplebrowser'
177    ]
178
179    allClasses [
180	<category: 'helper'>
181	^(WAComponent allSubclasses select:
182		[:each |
183		each class selectors
184		    anySatisfy: [:sel | sel startsWith: self selectorPrefix]])
185	    asSortedCollection: [:a :b | a name < b name]
186    ]
187
188    allSelectors [
189	<category: 'helper'>
190	^(class class selectors
191	    select: [:each | each startsWith: self selectorPrefix]) asSortedCollection
192    ]
193
194    children [
195	<category: 'accessing'>
196	^Array with: component
197    ]
198
199    class: aClass [
200	<category: 'accessing'>
201	class := aClass.
202	self selector: self allSelectors first
203    ]
204
205    component: aComponent [
206	<category: 'accessing'>
207	component := aComponent.
208	hasAnswer := false.
209	answer := nil.
210	component onAnswer:
211		[:value |
212		hasAnswer := true.
213		answer := value]
214    ]
215
216    initialize [
217	<category: 'initialize'>
218	super initialize.
219	self class: self allClasses first
220    ]
221
222    renderChooserOn: html [
223	<category: 'rendering'>
224	(html div)
225	    class: 'chooser';
226	    with:
227		    [html form:
228			    [(html select)
229				beSubmitOnChange;
230				list: self allClasses;
231				selected: class;
232				callback: [:value | self class: value]].
233		    self allSelectors size > 1
234			ifTrue:
235			    [html form:
236				    [(html select)
237					beSubmitOnChange;
238					list: self allSelectors;
239					selected: selector;
240					callback: [:value | self selector: value]]]]
241    ]
242
243    renderComponentOn: html [
244	<category: 'rendering'>
245	(html heading)
246	    level4;
247	    with: component class headerForExampleBrowser.
248	(html div)
249	    class: 'component';
250	    with: component.
251	hasAnswer
252	    ifTrue:
253		[(html div)
254		    class: 'answer';
255		    with: answer printString]
256    ]
257
258    renderContentOn: html [
259	<category: 'rendering'>
260	self renderChooserOn: html.
261	self renderComponentOn: html
262    ]
263
264    selector: aSymbol [
265	<category: 'accessing'>
266	selector := aSymbol.
267	self component: (class perform: selector)
268    ]
269
270    selectorPrefix [
271	<category: 'helper'>
272	^'example'
273    ]
274
275    style [
276	<category: 'accessing'>
277	^'.chooser {
278	background-color: #eee;
279	padding: 5px;
280}
281.chooser form,
282.chooser form div {
283	display: inline;
284}
285.chooser form select {
286	margin-right: 5px;
287}
288.component {
289	padding: 5px;
290}
291.answer {
292	background-color: #eee;
293	padding: 5px;
294}'
295    ]
296]
297
298
299
300WAComponent subclass: WAMultiCounter [
301    | counters |
302
303    <comment: 'A WAMultiCounter is a component that consits of several instances of WACounter. Be sure to understand WACounter.
304
305The lesson to learn here is how Seaside components can be composed of other components.
306
307Instance Variables
308	counters:		<Collection<WACounter>>
309
310counters
311	- a Collection of components (instances of WACounter)
312'>
313    <category: 'Seaside-Examples-Misc'>
314
315    WAMultiCounter class >> canBeRoot [
316	<category: 'testing'>
317	^true
318    ]
319
320    WAMultiCounter class >> description [
321	<category: 'accessing'>
322	^'Multiple Seaside components on one page'
323    ]
324
325    WAMultiCounter class >> initialize [
326	<category: 'initialization'>
327	self registerAsApplication: 'examples/multicounter'
328    ]
329
330    children [
331	<category: 'accessing'>
332	^counters
333    ]
334
335    initialize [
336	<category: 'initialization'>
337	super initialize.
338	counters := (1 to: 5) collect: [:each | WACounter new]
339    ]
340
341    renderContentOn: html [
342	<category: 'rendering'>
343	counters do: [:each | html render: each] separatedBy: [html horizontalRule]
344    ]
345]
346
347
348
349Eval [
350    WACounter initialize.
351    WAExampleBrowser initialize.
352    WAMultiCounter initialize
353]
354
355