"{ Package: 'stx:goodies/petitparser/gui' }"!

!PPAndParser methodsFor:'*petitgui-accessing'!

displayDescription

	^ 'and'

! !

!PPAndParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

! !

!PPChoiceParser methodsFor:'*petitgui-morphic'!

exampleOn: aStream

	"If there is already a lot written, try to pick an empty possiblity."

	aStream position > 512 ifTrue: [

		(parsers anySatisfy: [ :each | each isNullable ])

			ifTrue: [ ^ self ] ].

	parsers atRandom exampleOn: aStream

! !

!PPChoiceParser methodsFor:'*petitgui-morphic'!

morphicShapeSeen: aSet depth: anInteger

	^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |

		| morph |

		morph := self newColumnMorph 

			cellInset: 5;

			yourself.

		self children do: [ :each | 

			morph addMorphBack: (self newRowMorph

				hResizing: #spaceFill;

				addMorphBack: (cc value: each);

				addMorphBack: (self newColumnMorph

					hResizing: #spaceFill;

					addMorphBack: (self newSpacerMorph height: 10);

					addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)

						hResizing: #spaceFill;

						minWidth: 20;

						yourself);

					yourself);

				yourself) ].

		morph fullBounds.

		self newRowMorph

			addMorphBack: (self newColumnMorph

				addMorphBack: (self newSpacerMorph height: 10);

				addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);

				yourself);

			addMorphBack: (self newColumnMorph

				addMorphBack: (self newSpacerMorph width: 1; height: 10);

				addMorphBack: (LineMorph from: 0 @ 0 to: 0 @ (morph height - 23) color: Color black width: 1);

				yourself);

			addMorphBack: morph;

			addMorphBack: (self newColumnMorph

				addMorphBack: (self newSpacerMorph width: 1; height: 10);

				addMorphBack: (LineMorph from: 0 @ (morph height - 23) to: 0 @ 0 color: Color black width: 1)

					makeForwardArrow;

					width: 1;

				yourself);

			yourself ]

! !

!PPDelegateParser methodsFor:'*petitgui-accessing'!

displayDescription

	^ nil

! !

!PPDelegateParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

	parser exampleOn: aStream

! !

!PPDelegateParser methodsFor:'*petitgui-morphic'!

morphicShapeSeen: aSet depth: anInteger

	^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |

		self displayDescription isNil

			ifTrue: [ cc value: parser ]

			ifFalse: [

				self newRowMorph

					addMorphBack: (self newColumnMorph

						addMorphBack: (self newSpacerMorph height: 10);

						addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);

						yourself);

					addMorphBack: (self newRowMorph

						color: (self backgroundForDepth: anInteger);

						addMorphBack: (self newColumnMorph

							addMorphBack: (cc value: parser);

							addMorphBack: (self newRowMorph

								hResizing: #spaceFill;

								addMorphBack: (self newSpacerMorph

									width: 20;

									yourself);

								addMorphBack: (self newColumnMorph

									hResizing: #spaceFill;

									listCentering: #center;

									addMorphBack: (self newSpacerMorph);

									addMorphBack: (StringMorph new

										contents: self displayDescription;

										yourself);

									yourself);

								yourself);

							yourself);		

						addMorphBack: (self newColumnMorph

							addMorphBack: (self newSpacerMorph height: 10);

							addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);

							yourself);

						yourself);

					yourself ] ]

! !

!PPEndOfInputParser methodsFor:'*petitgui-accessing'!

displayDescription

	^ 'end of input'

! !

!PPEpsilonParser methodsFor:'*petitgui-accessing'!

displayName

	^ 'epsilon'

! !

!PPEpsilonParser methodsFor:'*petitgui-morphic'!

morphicShapeSeen: aSet depth: anInteger

	^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |

		self newRowMorph

			addMorphBack: (self newColumnMorph

				addMorphBack: (self newSpacerMorph height: 10);

				addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);

				yourself);

			yourself ]

! !

!PPFailingParser methodsFor:'*petitgui-accessing'!

displayColor

	^ Color red

! !

!PPFailingParser methodsFor:'*petitgui-accessing'!

displayName

	^ message

! !

!PPLiteralParser methodsFor:'*petitgui-accessing'!

displayName

	^ literal printString

! !

!PPLiteralSequenceParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

	aStream nextPutAll: literal

! !

!PPNotParser methodsFor:'*petitgui-accessing'!

displayDescription

	^ 'not'

! !

!PPNotParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

! !

!PPParser methodsFor:'*petitgui-accessing'!

backgroundForDepth: anInteger

	^ Color gray: 1.0 - (anInteger / 20.0)

! !

!PPParser methodsFor:'*petitgui-accessing'!

displayColor

	^ self isTerminal

		ifTrue: [ Color r: 0.5 g: 0.0 b: 0.5 ]

		ifFalse: [ Color blue ]

! !

!PPParser methodsFor:'*petitgui-accessing'!

displayName

	^ self name isNil

		ifFalse: [ self name asString ]

		ifTrue: [ self class name asString ]

! !

!PPParser methodsFor:'*petitgui-accessing'!

example

	^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024

! !

!PPParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

! !

!PPParser methodsFor:'*petitgui'!

gtInspectorParserInspectorIn: composite

	<gtInspectorPresentationOrder: 30>

	composite custom: (

		PPParserInspector new 

			title: 'Inspector';

			startOn: self)

! !

!PPParser methodsFor:'*petitgui-morphic'!

morphicProduction

	^ self newRowMorph

		layoutInset: 4;

		addMorphBack: (self newRowMorph

			layoutInset: 4;

			addMorphBack: (StringMorph new

				contents: self displayName;

				emphasis: TextEmphasis bold emphasisCode;

				yourself);

			yourself);

		addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0);

		addMorphBack: (self newColumnMorph

			addMorphBack: (self newSpacerMorph);

			addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)	

				makeForwardArrow;

			yourself);

		yourself

! !

!PPParser methodsFor:'*petitgui-morphic'!

morphicShapeDefault

	^ self newRowMorph

		addMorphBack: (self newColumnMorph

			addMorphBack: (self newSpacerMorph);

			addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)	

				makeForwardArrow;

			yourself);

		addMorphBack: (self newRowMorph

			borderWidth: 1;

			layoutInset: 3;

			color: Color white;

			addMorphBack: (StringMorph new

				contents: self displayName;

				color: self displayColor;

				yourself);

			yourself);

		yourself

! !

!PPParser methodsFor:'*petitgui-morphic'!

morphicShapeSeen: aSet depth: anInteger

	^ self morphicShapeDefault

! !

!PPParser methodsFor:'*petitgui-morphic'!

morphicShapeSeen: aSet depth: anInteger do: aBlock

	" avoid recursion "

	(aSet includes: self)

		ifTrue: [ ^ self morphicShapeDefault ].

	" display nice name when possible "

	(anInteger > 0 and: [ self name notNil ]) 

		ifTrue: [ ^ self morphicShapeDefault ].

	" don't do it too deep "

	(anInteger > 10)

		ifTrue: [ ^ self morphicShapeDefault ].

	aSet add: self. 

	^ aBlock value: [ :parser |

		parser 

			morphicShapeSeen: aSet 

			depth: anInteger + 1 ]

! !

!PPParser methodsFor:'*petitgui-mondrian'!

namedParsers

    | result |

    result := OrderedCollection new.

    self namedParsersDo: [ :parser | result addLast: parser ].

    ^ result

! !

!PPParser methodsFor:'*petitgui-mondrian'!

namedParsersDo: aBlock

    self namedParsersDo: aBlock seen: IdentitySet new

! !

!PPParser methodsFor:'*petitgui-mondrian'!

namedParsersDo: aBlock seen: aSet

    self children do: [ :each | 

        (aSet includes: each)

            ifFalse: [

		        aSet add: each.

		        each name isEmptyOrNil

		            ifFalse: [ aBlock value: each ]

		            ifTrue: [ each namedParsersDo: aBlock seen: aSet ] ] ]

! !

!PPParser methodsFor:'*petitgui-morphic-creational'!

newColumnMorph

	^ AlignmentMorph newColumn

		cellPositioning: #topLeft;

		color: Color transparent;

		listCentering: #topLeft;

		vResizing: #shrinkWrap;

		hResizing: #shrinkWrap;

		layoutInset: 0;

		yourself

! !

!PPParser methodsFor:'*petitgui-morphic-creational'!

newRowMorph

	^ AlignmentMorph newRow

		cellPositioning: #topLeft;

		color: Color transparent;

		listCentering: #topLeft;

		vResizing: #shrinkWrap;

		hResizing: #shrinkWrap;

		layoutInset: 0;

		yourself

! !

!PPParser methodsFor:'*petitgui-morphic-creational'!

newSpacerMorph

	^ Morph new

		color: Color transparent;

		borderWidth: 0;

		extent: 7 @ 7;

		yourself

! !

!PPParser methodsFor:'*petitgui-mondrian'!

viewAllNamedParsers

	| view |

	view := MOViewRenderer new.

	self viewAllNamedParsersOn: view.

	view open

! !

!PPParser methodsFor:'*petitgui-mondrian'!

viewAllNamedParsersOn: view

	view shape rectangle text: #displayName; withoutBorder. 

	view nodes: (self allParsers select: [:each |  each name isEmptyOrNil not ]).

	view edgesToAll: #namedParsers.

	view horizontalDominanceTreeLayout layered

! !

!PPParser methodsFor:'*petitgui-mondrian'!

viewAllNamedParsersWithSelection: aCollectionOfNames on: view

	self viewAllNamedParsersWithSelection: aCollectionOfNames previewing: [ :each | each name ] on: view

! !

!PPParser methodsFor:'*petitgui-mondrian'!

viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view

	view shape label 

		color: [:each | (aCollectionOfNames includes: each name) ifFalse: [Color black] ifTrue: [Color red]];

		text: [:each |each displayName].

	view interaction popupText: aBlock.

	view interaction item: 'Explore' action: #explore.

	view nodes: (self allParsers select: [:each |  each name isEmptyOrNil not ]).

	view edges: (self allParsers select: [:each |  each name isEmptyOrNil not ])from: #yourself toAll: #namedParsers.

	view horizontalDominanceTreeLayout verticalGap: 10; layered

! !

!PPPluggableParser methodsFor:'*petitgui-accessing'!

displayName

	^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]

! !

!PPPredicateParser methodsFor:'*petitgui-accessing'!

displayName

	^ predicateMessage

! !

!PPPredicateParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

	"Produce a random character that is valid. If there are characters in the alpha-numeric range prefer those over all others."

	| valid normal |

	valid := Character allCharacters

		select: [ :char | self matches: (String with: char) ].

	normal := valid

		select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ].

	aStream nextPut: (normal isEmpty

		ifTrue: [ valid atRandom ]

		ifFalse: [ normal atRandom ])

! !

!PPRepeatingParser methodsFor:'*petitgui-accessing'!

displayDescription

	^ String streamContents: [ :stream |

		min = 0 

			ifFalse: [ stream print: min; nextPutAll: '..' ].

		max = SmallInteger maxVal

			ifTrue: [ stream nextPut: $* ]

			ifFalse: [ stream print: max ] ]

! !

!PPRepeatingParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

	"Perform the minimal repeatitions required, and a random amount of more if possible and if not that much output has been produced yet."

	min timesRepeat: [ 

		super exampleOn: aStream ].

	(max - min min: 5) atRandom timesRepeat: [

		aStream position > 512

			ifTrue: [ ^ self ].

		super exampleOn: aStream ]

! !

!PPSequenceParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

	parsers do: [ :each | each exampleOn: aStream ]

! !

!PPSequenceParser methodsFor:'*petitgui-morphic'!

morphicShapeSeen: aSet depth: anInteger

	^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |

		self children

			inject: self newRowMorph

			into: [ :result :each | 

				result 

					addMorphBack: (cc value: each);

					yourself ] ]

! !

!PPTrimmingParser methodsFor:'*petitgui-accessing'!

exampleOn: aStream

	super exampleOn: aStream.

	aStream nextPut: Character space

! !

!PPUnresolvedParser methodsFor:'*petitgui-accessing'!

displayColor

	^ Color red

! !

!Refactoring methodsFor:'*petitgui-utilities'!

checkCompositeParser: aClass

        ^ (RBCondition isMetaclass: aClass) not

        "&  RBCondition isSubclass: class of: self compositeParserClass"

        & (RBCondition new

                type: (Array with: #subclass with: self compositeParserClass with: aClass)

                block: [ aClass includesClass: self compositeParserClass ]

                errorString: aClass printString , ' is <1?:not >a subclass of ' , self compositeParserClass printString)

! !

!Refactoring methodsFor:'*petitgui-utilities'!

compositeParserClass

        ^ self classObjectFor: #PPCompositeParser

! !

!stx_goodies_petitparser_gui class methodsFor:'documentation'!

extensionsVersion_CVS

    ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/extensions.st,v 1.2 2014-03-04 21:19:47 cg Exp $'

! !