|
1 "{ Package: 'stx:goodies/petitparser/gui' }"! |
|
2 |
|
3 !PPAndParser methodsFor:'*petitgui-accessing'! |
|
4 |
|
5 displayDescription |
|
6 ^ 'and' |
|
7 ! ! |
|
8 |
|
9 !PPAndParser methodsFor:'*petitgui-accessing'! |
|
10 |
|
11 exampleOn: aStream |
|
12 ! ! |
|
13 |
|
14 !PPChoiceParser methodsFor:'*petitgui-morphic'! |
|
15 |
|
16 exampleOn: aStream |
|
17 "If there is already a lot written, try to pick an empty possiblity." |
|
18 |
|
19 aStream position > 512 ifTrue: [ |
|
20 (parsers anySatisfy: [ :each | each isNullable ]) |
|
21 ifTrue: [ ^ self ] ]. |
|
22 parsers atRandom exampleOn: aStream |
|
23 ! ! |
|
24 |
|
25 !PPChoiceParser methodsFor:'*petitgui-morphic'! |
|
26 |
|
27 morphicShapeSeen: aSet depth: anInteger |
|
28 ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | |
|
29 | morph | |
|
30 morph := self newColumnMorph |
|
31 cellInset: 5; |
|
32 yourself. |
|
33 self children do: [ :each | |
|
34 morph addMorphBack: (self newRowMorph |
|
35 hResizing: #spaceFill; |
|
36 addMorphBack: (cc value: each); |
|
37 addMorphBack: (self newColumnMorph |
|
38 hResizing: #spaceFill; |
|
39 addMorphBack: (self newSpacerMorph height: 10); |
|
40 addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) |
|
41 hResizing: #spaceFill; |
|
42 minWidth: 20; |
|
43 yourself); |
|
44 yourself); |
|
45 yourself) ]. |
|
46 morph fullBounds. |
|
47 self newRowMorph |
|
48 addMorphBack: (self newColumnMorph |
|
49 addMorphBack: (self newSpacerMorph height: 10); |
|
50 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); |
|
51 yourself); |
|
52 addMorphBack: (self newColumnMorph |
|
53 addMorphBack: (self newSpacerMorph width: 1; height: 10); |
|
54 addMorphBack: (LineMorph from: 0 @ 0 to: 0 @ (morph height - 23) color: Color black width: 1); |
|
55 yourself); |
|
56 addMorphBack: morph; |
|
57 addMorphBack: (self newColumnMorph |
|
58 addMorphBack: (self newSpacerMorph width: 1; height: 10); |
|
59 addMorphBack: (LineMorph from: 0 @ (morph height - 23) to: 0 @ 0 color: Color black width: 1) |
|
60 makeForwardArrow; |
|
61 width: 1; |
|
62 yourself); |
|
63 yourself ] |
|
64 ! ! |
|
65 |
|
66 !PPDelegateParser methodsFor:'*petitgui-accessing'! |
|
67 |
|
68 displayDescription |
|
69 ^ nil |
|
70 ! ! |
|
71 |
|
72 !PPDelegateParser methodsFor:'*petitgui-accessing'! |
|
73 |
|
74 exampleOn: aStream |
|
75 parser exampleOn: aStream |
|
76 ! ! |
|
77 |
|
78 !PPDelegateParser methodsFor:'*petitgui-morphic'! |
|
79 |
|
80 morphicShapeSeen: aSet depth: anInteger |
|
81 ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | |
|
82 self displayDescription isNil |
|
83 ifTrue: [ cc value: parser ] |
|
84 ifFalse: [ |
|
85 self newRowMorph |
|
86 addMorphBack: (self newColumnMorph |
|
87 addMorphBack: (self newSpacerMorph height: 10); |
|
88 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); |
|
89 yourself); |
|
90 addMorphBack: (self newRowMorph |
|
91 color: (self backgroundForDepth: anInteger); |
|
92 addMorphBack: (self newColumnMorph |
|
93 addMorphBack: (cc value: parser); |
|
94 addMorphBack: (self newRowMorph |
|
95 hResizing: #spaceFill; |
|
96 addMorphBack: (self newSpacerMorph |
|
97 width: 20; |
|
98 yourself); |
|
99 addMorphBack: (self newColumnMorph |
|
100 hResizing: #spaceFill; |
|
101 listCentering: #center; |
|
102 addMorphBack: (self newSpacerMorph); |
|
103 addMorphBack: (StringMorph new |
|
104 contents: self displayDescription; |
|
105 yourself); |
|
106 yourself); |
|
107 yourself); |
|
108 yourself); |
|
109 addMorphBack: (self newColumnMorph |
|
110 addMorphBack: (self newSpacerMorph height: 10); |
|
111 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); |
|
112 yourself); |
|
113 yourself); |
|
114 yourself ] ] |
|
115 ! ! |
|
116 |
|
117 !PPEndOfInputParser methodsFor:'*petitgui-accessing'! |
|
118 |
|
119 displayDescription |
|
120 ^ 'end of input' |
|
121 ! ! |
|
122 |
|
123 !PPEpsilonParser methodsFor:'*petitgui-accessing'! |
|
124 |
|
125 displayName |
|
126 ^ 'epsilon' |
|
127 ! ! |
|
128 |
|
129 !PPEpsilonParser methodsFor:'*petitgui-morphic'! |
|
130 |
|
131 morphicShapeSeen: aSet depth: anInteger |
|
132 ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | |
|
133 self newRowMorph |
|
134 addMorphBack: (self newColumnMorph |
|
135 addMorphBack: (self newSpacerMorph height: 10); |
|
136 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); |
|
137 yourself); |
|
138 yourself ] |
|
139 ! ! |
|
140 |
|
141 !PPFailingParser methodsFor:'*petitgui-accessing'! |
|
142 |
|
143 displayColor |
|
144 ^ Color red |
|
145 ! ! |
|
146 |
|
147 !PPFailingParser methodsFor:'*petitgui-accessing'! |
|
148 |
|
149 displayName |
|
150 ^ message |
|
151 ! ! |
|
152 |
|
153 !PPLiteralParser methodsFor:'*petitgui-accessing'! |
|
154 |
|
155 displayName |
|
156 ^ literal printString |
|
157 ! ! |
|
158 |
|
159 !PPLiteralSequenceParser methodsFor:'*petitgui-accessing'! |
|
160 |
|
161 exampleOn: aStream |
|
162 aStream nextPutAll: literal |
|
163 ! ! |
|
164 |
|
165 !PPNotParser methodsFor:'*petitgui-accessing'! |
|
166 |
|
167 displayDescription |
|
168 ^ 'not' |
|
169 ! ! |
|
170 |
|
171 !PPNotParser methodsFor:'*petitgui-accessing'! |
|
172 |
|
173 exampleOn: aStream |
|
174 ! ! |
|
175 |
|
176 !PPParser methodsFor:'*petitgui-accessing'! |
|
177 |
|
178 backgroundForDepth: anInteger |
|
179 ^ Color gray: 1.0 - (anInteger / 20.0) |
|
180 ! ! |
|
181 |
|
182 !PPParser methodsFor:'*petitgui-accessing'! |
|
183 |
|
184 displayColor |
|
185 ^ self isTerminal |
|
186 ifTrue: [ Color r: 0.5 g: 0.0 b: 0.5 ] |
|
187 ifFalse: [ Color blue ] |
|
188 ! ! |
|
189 |
|
190 !PPParser methodsFor:'*petitgui-accessing'! |
|
191 |
|
192 displayName |
|
193 ^ self name isNil |
|
194 ifFalse: [ self name asString ] |
|
195 ifTrue: [ self class name asString ] |
|
196 ! ! |
|
197 |
|
198 !PPParser methodsFor:'*petitgui-accessing'! |
|
199 |
|
200 example |
|
201 ^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024 |
|
202 ! ! |
|
203 |
|
204 !PPParser methodsFor:'*petitgui-accessing'! |
|
205 |
|
206 exampleOn: aStream |
|
207 ! ! |
|
208 |
|
209 !PPParser methodsFor:'*petitgui'! |
|
210 |
|
211 gtInspectorParserInspectorIn: composite |
|
212 <gtInspectorPresentationOrder: 30> |
|
213 composite custom: ( |
|
214 PPParserInspector new |
|
215 title: 'Inspector'; |
|
216 startOn: self) |
|
217 ! ! |
|
218 |
|
219 !PPParser methodsFor:'*petitgui-morphic'! |
|
220 |
|
221 morphicProduction |
|
222 ^ self newRowMorph |
|
223 layoutInset: 4; |
|
224 addMorphBack: (self newRowMorph |
|
225 layoutInset: 4; |
|
226 addMorphBack: (StringMorph new |
|
227 contents: self displayName; |
|
228 emphasis: TextEmphasis bold emphasisCode; |
|
229 yourself); |
|
230 yourself); |
|
231 addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0); |
|
232 addMorphBack: (self newColumnMorph |
|
233 addMorphBack: (self newSpacerMorph); |
|
234 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) |
|
235 makeForwardArrow; |
|
236 yourself); |
|
237 yourself |
|
238 ! ! |
|
239 |
|
240 !PPParser methodsFor:'*petitgui-morphic'! |
|
241 |
|
242 morphicShapeDefault |
|
243 ^ self newRowMorph |
|
244 addMorphBack: (self newColumnMorph |
|
245 addMorphBack: (self newSpacerMorph); |
|
246 addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) |
|
247 makeForwardArrow; |
|
248 yourself); |
|
249 addMorphBack: (self newRowMorph |
|
250 borderWidth: 1; |
|
251 layoutInset: 3; |
|
252 color: Color white; |
|
253 addMorphBack: (StringMorph new |
|
254 contents: self displayName; |
|
255 color: self displayColor; |
|
256 yourself); |
|
257 yourself); |
|
258 yourself |
|
259 ! ! |
|
260 |
|
261 !PPParser methodsFor:'*petitgui-morphic'! |
|
262 |
|
263 morphicShapeSeen: aSet depth: anInteger |
|
264 ^ self morphicShapeDefault |
|
265 ! ! |
|
266 |
|
267 !PPParser methodsFor:'*petitgui-morphic'! |
|
268 |
|
269 morphicShapeSeen: aSet depth: anInteger do: aBlock |
|
270 " avoid recursion " |
|
271 (aSet includes: self) |
|
272 ifTrue: [ ^ self morphicShapeDefault ]. |
|
273 " display nice name when possible " |
|
274 (anInteger > 0 and: [ self name notNil ]) |
|
275 ifTrue: [ ^ self morphicShapeDefault ]. |
|
276 " don't do it too deep " |
|
277 (anInteger > 10) |
|
278 ifTrue: [ ^ self morphicShapeDefault ]. |
|
279 aSet add: self. |
|
280 ^ aBlock value: [ :parser | |
|
281 parser |
|
282 morphicShapeSeen: aSet |
|
283 depth: anInteger + 1 ] |
|
284 ! ! |
|
285 |
|
286 !PPParser methodsFor:'*petitgui-mondrian'! |
|
287 |
|
288 namedParsers |
|
289 | result | |
|
290 result := OrderedCollection new. |
|
291 self namedParsersDo: [ :parser | result addLast: parser ]. |
|
292 ^ result |
|
293 ! ! |
|
294 |
|
295 !PPParser methodsFor:'*petitgui-mondrian'! |
|
296 |
|
297 namedParsersDo: aBlock |
|
298 self namedParsersDo: aBlock seen: IdentitySet new |
|
299 ! ! |
|
300 |
|
301 !PPParser methodsFor:'*petitgui-mondrian'! |
|
302 |
|
303 namedParsersDo: aBlock seen: aSet |
|
304 self children do: [ :each | |
|
305 (aSet includes: each) |
|
306 ifFalse: [ |
|
307 aSet add: each. |
|
308 each name isEmptyOrNil |
|
309 ifFalse: [ aBlock value: each ] |
|
310 ifTrue: [ each namedParsersDo: aBlock seen: aSet ] ] ] |
|
311 ! ! |
|
312 |
|
313 !PPParser methodsFor:'*petitgui-morphic-creational'! |
|
314 |
|
315 newColumnMorph |
|
316 ^ AlignmentMorph newColumn |
|
317 cellPositioning: #topLeft; |
|
318 color: Color transparent; |
|
319 listCentering: #topLeft; |
|
320 vResizing: #shrinkWrap; |
|
321 hResizing: #shrinkWrap; |
|
322 layoutInset: 0; |
|
323 yourself |
|
324 ! ! |
|
325 |
|
326 !PPParser methodsFor:'*petitgui-morphic-creational'! |
|
327 |
|
328 newRowMorph |
|
329 ^ AlignmentMorph newRow |
|
330 cellPositioning: #topLeft; |
|
331 color: Color transparent; |
|
332 listCentering: #topLeft; |
|
333 vResizing: #shrinkWrap; |
|
334 hResizing: #shrinkWrap; |
|
335 layoutInset: 0; |
|
336 yourself |
|
337 ! ! |
|
338 |
|
339 !PPParser methodsFor:'*petitgui-morphic-creational'! |
|
340 |
|
341 newSpacerMorph |
|
342 ^ Morph new |
|
343 color: Color transparent; |
|
344 borderWidth: 0; |
|
345 extent: 7 @ 7; |
|
346 yourself |
|
347 ! ! |
|
348 |
|
349 !PPParser methodsFor:'*petitgui-mondrian'! |
|
350 |
|
351 viewAllNamedParsers |
|
352 | view | |
|
353 view := MOViewRenderer new. |
|
354 self viewAllNamedParsersOn: view. |
|
355 view open |
|
356 ! ! |
|
357 |
|
358 !PPParser methodsFor:'*petitgui-mondrian'! |
|
359 |
|
360 viewAllNamedParsersOn: view |
|
361 view shape rectangle text: #displayName; withoutBorder. |
|
362 view nodes: (self allParsers select: [:each | each name isEmptyOrNil not ]). |
|
363 view edgesToAll: #namedParsers. |
|
364 view horizontalDominanceTreeLayout layered |
|
365 ! ! |
|
366 |
|
367 !PPParser methodsFor:'*petitgui-mondrian'! |
|
368 |
|
369 viewAllNamedParsersWithSelection: aCollectionOfNames on: view |
|
370 self viewAllNamedParsersWithSelection: aCollectionOfNames previewing: [ :each | each name ] on: view |
|
371 ! ! |
|
372 |
|
373 !PPParser methodsFor:'*petitgui-mondrian'! |
|
374 |
|
375 viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view |
|
376 view shape label |
|
377 color: [:each | (aCollectionOfNames includes: each name) ifFalse: [Color black] ifTrue: [Color red]]; |
|
378 text: [:each |each displayName]. |
|
379 view interaction popupText: aBlock. |
|
380 view interaction item: 'Explore' action: #explore. |
|
381 view nodes: (self allParsers select: [:each | each name isEmptyOrNil not ]). |
|
382 view edges: (self allParsers select: [:each | each name isEmptyOrNil not ])from: #yourself toAll: #namedParsers. |
|
383 view horizontalDominanceTreeLayout verticalGap: 10; layered |
|
384 ! ! |
|
385 |
|
386 !PPPluggableParser methodsFor:'*petitgui-accessing'! |
|
387 |
|
388 displayName |
|
389 ^ String streamContents: [ :stream | block decompile shortPrintOn: stream ] |
|
390 ! ! |
|
391 |
|
392 !PPPredicateParser methodsFor:'*petitgui-accessing'! |
|
393 |
|
394 displayName |
|
395 ^ predicateMessage |
|
396 ! ! |
|
397 |
|
398 !PPPredicateParser methodsFor:'*petitgui-accessing'! |
|
399 |
|
400 exampleOn: aStream |
|
401 "Produce a random character that is valid. If there are characters in the alpha-numeric range prefer those over all others." |
|
402 |
|
403 | valid normal | |
|
404 valid := Character allCharacters |
|
405 select: [ :char | self matches: (String with: char) ]. |
|
406 normal := valid |
|
407 select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ]. |
|
408 aStream nextPut: (normal isEmpty |
|
409 ifTrue: [ valid atRandom ] |
|
410 ifFalse: [ normal atRandom ]) |
|
411 ! ! |
|
412 |
|
413 !PPRepeatingParser methodsFor:'*petitgui-accessing'! |
|
414 |
|
415 displayDescription |
|
416 ^ String streamContents: [ :stream | |
|
417 min = 0 |
|
418 ifFalse: [ stream print: min; nextPutAll: '..' ]. |
|
419 max = SmallInteger maxVal |
|
420 ifTrue: [ stream nextPut: $* ] |
|
421 ifFalse: [ stream print: max ] ] |
|
422 ! ! |
|
423 |
|
424 !PPRepeatingParser methodsFor:'*petitgui-accessing'! |
|
425 |
|
426 exampleOn: aStream |
|
427 "Perform the minimal repeatitions required, and a random amount of more if possible and if not that much output has been produced yet." |
|
428 |
|
429 min timesRepeat: [ |
|
430 super exampleOn: aStream ]. |
|
431 (max - min min: 5) atRandom timesRepeat: [ |
|
432 aStream position > 512 |
|
433 ifTrue: [ ^ self ]. |
|
434 super exampleOn: aStream ] |
|
435 ! ! |
|
436 |
|
437 !PPSequenceParser methodsFor:'*petitgui-accessing'! |
|
438 |
|
439 exampleOn: aStream |
|
440 parsers do: [ :each | each exampleOn: aStream ] |
|
441 ! ! |
|
442 |
|
443 !PPSequenceParser methodsFor:'*petitgui-morphic'! |
|
444 |
|
445 morphicShapeSeen: aSet depth: anInteger |
|
446 ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | |
|
447 self children |
|
448 inject: self newRowMorph |
|
449 into: [ :result :each | |
|
450 result |
|
451 addMorphBack: (cc value: each); |
|
452 yourself ] ] |
|
453 ! ! |
|
454 |
|
455 !PPTrimmingParser methodsFor:'*petitgui-accessing'! |
|
456 |
|
457 exampleOn: aStream |
|
458 super exampleOn: aStream. |
|
459 aStream nextPut: Character space |
|
460 ! ! |
|
461 |
|
462 !PPUnresolvedParser methodsFor:'*petitgui-accessing'! |
|
463 |
|
464 displayColor |
|
465 ^ Color red |
|
466 ! ! |
|
467 |
|
468 !Refactoring methodsFor:'*petitgui-utilities'! |
|
469 |
|
470 checkCompositeParser: aClass |
|
471 ^ (RBCondition isMetaclass: aClass) not |
|
472 "& RBCondition isSubclass: class of: self compositeParserClass" |
|
473 & (RBCondition new |
|
474 type: (Array with: #subclass with: self compositeParserClass with: aClass) |
|
475 block: [ aClass includesClass: self compositeParserClass ] |
|
476 errorString: aClass printString , ' is <1?:not >a subclass of ' , self compositeParserClass printString) |
|
477 ! ! |
|
478 |
|
479 !Refactoring methodsFor:'*petitgui-utilities'! |
|
480 |
|
481 compositeParserClass |
|
482 ^ self classObjectFor: #PPCompositeParser |
|
483 ! ! |
|
484 |
|
485 !stx_goodies_petitparser_gui class methodsFor:'documentation'! |
|
486 |
|
487 extensionsVersion_CVS |
|
488 ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/extensions.st,v 1.2 2014-03-04 21:19:47 cg Exp $' |
|
489 ! ! |