SystemOrganization addCategory: #'PetitGui-Core'!

!PPTrimmingParser methodsFor: '*petitgui-accessing' stamp: 'lr 4/14/2010 20:48'!
exampleOn: aStream
	super exampleOn: aStream.
	aStream nextPut: Character space! !

!PPEpsilonParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:42'!
displayName
	^ 'epsilon'! !

!PPEpsilonParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/18/2009 11:15'!
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 ]! !

!PPEndOfInputParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:18'!
displayDescription
	^ 'end of input'! !

!PPChoiceParser methodsFor: '*petitgui-morphic' stamp: 'lr 5/2/2010 20:15'!
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' stamp: 'lr 11/18/2009 11:14'!
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 ]! !

!PPPredicateParser methodsFor: '*petitgui-accessing' stamp: 'lr 5/2/2010 19:35'!
displayName
	^ predicateMessage! !

!PPPredicateParser methodsFor: '*petitgui-accessing' stamp: 'lr 5/1/2010 17:05'!
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 ])! !

!PPLiteralParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:19'!
displayName
	^ literal printString! !

!PPSequenceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:24'!
exampleOn: aStream
	parsers do: [ :each | each exampleOn: aStream ]! !

!PPSequenceParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/17/2009 21:54'!
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 ] ]! !

PPStream subclass: #PPBrowserStream
	instanceVariableNames: 'positions stamps parsers'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitGui-Core'!

!PPBrowserStream methodsFor: 'converting' stamp: 'lr 4/15/2010 15:12'!
asExecutionTrace
	| trace |
	trace := OrderedCollection new: parsers size.
	1 to: parsers size do: [ :index |
		| parser |
		parser := parsers at: index.
		parser name isNil ifFalse: [
			| start stop |
			start := positions at: index.
			stop := positions at: index + 1 ifAbsent: [ self size ].
			trace addLast: (Array with: parser with: start with: stop) ] ].
	^ trace! !

!PPBrowserStream methodsFor: 'converting' stamp: 'lr 2/3/2010 20:21'!
asFrequencyTable
	| bag total result |
	bag := parsers asBag.
	total := 100.0 / bag size.
	result := OrderedCollection new.
	bag sortedCounts 
		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
	^ result! !

!PPBrowserStream methodsFor: 'converting' stamp: 'lr 6/3/2010 10:29'!
asPositionDrawing
	| stream source last |
	stream := WriteStream on: String new.
	source := self contents readStream.
	last := 0.
	[ source atEnd ] whileFalse: [
		[ source atEnd not and: [ source peek isSeparator ] ]
			whileTrue: [ source next ].
		stream nextPutAll: '\fill [source] ('; print: source position / 100.0; nextPutAll: ', 0) rectangle ('.
		[ source atEnd not and: [ source peek isSeparator not ] ]
			whileTrue: [ source next ].
		stream print: source position / 100.0; nextPutAll: ', '; print: self positions size / 100.0; nextPutAll: ');'; cr ].
	stream nextPutAll: '\draw [parser] (0, 0)'.
	1 to: self positions size do: [ :index |
		last <= (self positions at: index)
			ifTrue: [ stream nextPutAll: ' --' ].
		last := self positions at: index.
		stream nextPutAll: ' ('; print: last / 100.0; nextPutAll: ', '; print: index / 100.0; nextPut: $) ].
	stream nextPut: $;.
	^ stream contents! !

!PPBrowserStream methodsFor: 'converting' stamp: 'lr 6/4/2010 14:53'!
asPositionMorph
	| width height canvas morph |
	width := self size + 1 min: 2048.
	height := self positions size min: 2048.
	canvas := FormCanvas extent: width @ height.
	self contents keysAndValuesDo: [ :index :char |
		char isSeparator 
			ifFalse: [ canvas line: index @ 1 to: index @ height color: Color paleBlue ] ].
	1 to: height do: [ :index |
		canvas form colorAt: (self positions at: index) @ index put: Color black ].
	morph := canvas form asMorph.
	morph 
		on: #mouseDown
		send: #mouseDown:with:
		to: self.
	^ morph! !

!PPBrowserStream methodsFor: 'converting' stamp: 'lr 2/3/2010 20:21'!
asTimingTable
	| bag total result |
	bag := Bag new.
	1 to: stamps size - 1 do: [ :index |
		bag
			add: (parsers at: index) 
			withOccurrences: (stamps at: index + 1) - (stamps at: index) ].
	total := stamps last - stamps first.
	result := OrderedCollection new.
	bag sortedCounts
		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
	^ result! !

!PPBrowserStream methodsFor: 'private' stamp: 'lr 2/4/2010 13:06'!
mouseDown: anEvent with: aMorph
	| location string parser |
	location := anEvent position.
	string := collection 
		copyFrom: (location x - 5 min: collection size max: 1) 
		to: (location x + 5 min: collection size max: 1).
	parser := parsers at: location y.
	Transcript 
		show: string printString; cr;
		show: parser displayName; cr;
		cr! !

!PPBrowserStream methodsFor: 'accessing' stamp: 'lr 2/3/2010 13:45'!
next
	| result |
	result := super next.
	self step.
	^ result! !

!PPBrowserStream methodsFor: 'accessing' stamp: 'lr 2/3/2010 13:45'!
next: aNumber
	| result |
	result := super next: aNumber.
	self step.
	^ result! !

!PPBrowserStream methodsFor: 'information' stamp: 'lr 2/3/2010 14:55'!
parsers
	^ parsers! !

!PPBrowserStream methodsFor: 'positioning' stamp: 'lr 2/3/2010 13:46'!
position: aNumber
	super position: aNumber.
	self step! !

!PPBrowserStream methodsFor: 'information' stamp: 'lr 2/3/2010 14:55'!
positions
	^ positions! !

!PPBrowserStream methodsFor: 'positioning' stamp: 'lr 2/3/2010 14:53'!
reset
	super reset.
	positions := OrderedCollection new: 1024.
	stamps := OrderedCollection new: 1024.
	parsers := OrderedCollection new: 1024! !

!PPBrowserStream methodsFor: 'information' stamp: 'lr 2/3/2010 14:55'!
stamps
	^ stamps! !

!PPBrowserStream methodsFor: 'private' stamp: 'lr 2/3/2010 14:53'!
step
	positions addLast: position.
	stamps addLast: Time millisecondClockValue.
	parsers addLast: thisContext sender sender receiver! !

!PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:11'!
backgroundForDepth: anInteger
	^ Color gray: 1.0 - (anInteger / 20.0)! !

!PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 5/22/2010 10:45'!
displayColor
	^ self isTerminal
		ifTrue: [ Color purple ]
		ifFalse: [ Color blue ]! !

!PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:31'!
displayName
	^ self name isNil
		ifFalse: [ self name asString ]
		ifTrue: [ self class name asString ]! !

!PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:37'!
example
	^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024! !

!PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:20'!
exampleOn: aStream! !

!PPParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/18/2009 10:56'!
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' stamp: 'lr 11/17/2009 22:03'!
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;
			on: #click send: #value to: [ Transcript show: self; cr ];
			addMorphBack: (StringMorph new
				contents: self displayName;
				color: self displayColor;
				yourself);
			yourself);
		yourself! !

!PPParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/13/2009 13:24'!
morphicShapeSeen: aSet depth: anInteger
	^ self morphicShapeDefault! !

!PPParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/13/2009 13:43'!
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-morphic-creational' stamp: 'lr 11/17/2009 21:58'!
newColumnMorph
	^ AlignmentMorph newColumn
		cellPositioning: #topLeft;
		color: Color transparent;
		listCentering: #topLeft;
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap;
		layoutInset: 0;
		yourself! !

!PPParser methodsFor: '*petitgui-morphic-creational' stamp: 'lr 11/17/2009 21:57'!
newRowMorph
	^ AlignmentMorph newRow
		cellPositioning: #topLeft;
		color: Color transparent;
		listCentering: #topLeft;
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap;
		layoutInset: 0;
		yourself! !

!PPParser methodsFor: '*petitgui-morphic-creational' stamp: 'lr 11/17/2009 22:03'!
newSpacerMorph
	^ Morph new
		color: Color transparent;
		borderWidth: 0;
		extent: 7 @ 7;
		yourself! !

!PPLiteralSequenceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'!
exampleOn: aStream
	aStream nextPutAll: literal! !

!PPNotParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:17'!
displayDescription
	^ 'not'! !

!PPNotParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/11/2009 21:09'!
exampleOn: aStream! !

!PPLiteralObjectParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'!
exampleOn: aStream
	aStream nextPut: literal! !

!PPUnresolvedParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:15'!
displayColor
	^ Color red! !

!PPAndParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:17'!
displayDescription
	^ 'and'! !

!PPAndParser methodsFor: '*petitgui-accessing' stamp: 'lr 5/1/2010 16:16'!
exampleOn: aStream! !

!PPDelegateParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:20'!
displayDescription
	^ nil! !

!PPDelegateParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:27'!
exampleOn: aStream
	parser exampleOn: aStream! !

!PPDelegateParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/18/2009 11:21'!
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 ] ]! !

!PPRepeatingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:18'!
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' stamp: 'lr 11/11/2009 20:57'!
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 ]! !

!PPPluggableParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:41'!
displayName
	^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]! !

Object subclass: #PPBrowser
	instanceVariableNames: 'browser input stream output'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitGui-Core'!

!PPBrowser class methodsFor: 'initialization' stamp: 'lr 5/12/2010 23:29'!
initialize
	Smalltalk at: #TheWorldMenu ifPresent: [ :class |
		class class methodDict at: #registerOpenCommand: ifPresent: [ :method |
			(method sendsSelector: #deprecated:) 
				ifFalse: [ TheWorldMenu registerOpenCommand: (Array with: self label with: (Array with: self with: #open)) ] ] ]! !

!PPBrowser class methodsFor: 'accessing' stamp: 'lr 4/14/2010 20:47'!
label
	^ 'PetitParser'! !

!PPBrowser class methodsFor: 'accessing' stamp: 'lr 5/7/2010 22:30'!
menuCommandOn: aBuilder
	<worldMenu>

	(aBuilder item: self label)
		parent: #Tools;
		action: [ self new open ]! !

!PPBrowser class methodsFor: 'instance-creation' stamp: 'lr 11/6/2009 16:32'!
open
	^ self new open! !

!PPBrowser class methodsFor: 'initialization' stamp: 'lr 5/12/2010 23:30'!
unload
	Smalltalk at: #TheWorldMenu ifPresent: [ :class |
		class class methodDict at: #unregisterOpenCommandWithReceiver: ifPresent: [ :method |
			(method sendsSelector: #deprecated:) 
				ifFalse: [ class unregisterOpenCommandWithReceiver: self ] ] ]! !

!PPBrowser methodsFor: 'browse' stamp: 'lr 2/4/2010 08:12'!
browseClassesOn: aBrowser
	aBrowser tree
		title: 'Grammars';
		format: [ :class | class name ];
		children: [ :class | self subclassesOf: class ];
		act: [
			self selectedClass removeFromSystem.
			aBrowser entity: self rootClass ]
			on: $r entitled: 'remove (x)';
		act: [
			StandardToolSet browse: self selectedClass selector: nil ] 
			on: $b entitled: 'browse (b)'! !

!PPBrowser methodsFor: 'browse-static' stamp: 'lr 11/20/2009 16:19'!
browseCyclesOn: aBrowser
	aBrowser list
		title: 'Cycles';
		useExplicitNotNil;
		format: [ :parser | parser displayName ];
		display: [ :parsers | self production cycleSet ]! !

!PPBrowser methodsFor: 'browse' stamp: 'lr 4/16/2010 00:02'!
browseDynamicOn: aBrowser
	| tabulator |
	aBrowser useExplicitNotNil.
	
	tabulator := aBrowser tabulator.
	tabulator
		title: 'Dynamic';
		useExplicitNotNil;
		row: #input; row: #output.
	tabulator transmit
		to: #input;
		andShow: [ :a | self browseInputOn: a ].
	tabulator transmit
		to: #output;
		from: #input;
		andShow: [ :a | self browseOutputOn: a ].
		
	tabulator transmit
		from: #output;
		to: #input->#selectionInterval;
		when: [ :selection | selection notNil ];
		transformed: [ :selection | selection second to: selection third ]
! !

!PPBrowser methodsFor: 'browse-static' stamp: 'lr 11/11/2009 20:45'!
browseExampleOn: aBrowser
	aBrowser text
		title: 'Example';
		useExplicitNotNil;
		display: [ :parsers | self production example ]! !

!PPBrowser methodsFor: 'browse-static' stamp: 'lr 6/26/2010 14:36'!
browseFirstOn: aBrowser
	aBrowser list
		title: 'First';
		useExplicitNotNil;
		format: [ :parser | parser displayName ];
		display: [ :parsers | self production firstSet ]! !

!PPBrowser methodsFor: 'browse-static' stamp: 'lr 6/26/2010 14:37'!
browseFollowOn: aBrowser
	aBrowser list
		title: 'Follow';
		useExplicitNotNil;
		format: [ :parser | parser displayName ];
		display: [ :parsers | 
			| parser |
			parser := self selectedClass new.
			parser followSets
				at: (parser productionAt: self selectedSelector)
				ifAbsent: [ Array with: nil asParser ] ]! !

!PPBrowser methodsFor: 'browse-static' stamp: 'lr 11/17/2009 20:22'!
browseGraphOn: aBrowser
	aBrowser morph
		title: 'Graph';
		useExplicitNotNil;
		display: [ :parsers |
			| morph |
			morph := ScrollPane new.
			morph color: Color white.
			morph scroller addMorph: self production morphicProduction.
			morph ]! !

!PPBrowser methodsFor: 'browse-dynamic' stamp: 'lr 4/14/2010 21:10'!
browseInputOn: aBrowser
	aBrowser text
		useExplicitNotNil;
		display: [ :class :selector | input ];
		populate: #selection on: $s entitled: 'parse (s)' with: [ :presentation |
			input := presentation text asString.
			stream := PPBrowserStream on: input.
			output := self production end 
				parse: stream.
			output isPetitFailure
				ifTrue: [ presentation selectionInterval: (output position + 1 to: output position) ].
			output ];
		populate: #selection on: $s entitled: 'inspect (i)' with: [ :presentation |
			input := presentation text asString.
			stream := PPBrowserStream on: input.
			output := self production end
				parse: stream.
			output explore.
			output ]! !

!PPBrowser methodsFor: 'browse' stamp: 'lr 4/15/2010 10:46'!
browseOn: aBrowser
	aBrowser title: self class label; color: Color yellow muchDarker.
	aBrowser row: [ :row | row column: #class; column: #selector ].
	aBrowser row: [ :row | row column: #part span: 2 ] span: 2.
	aBrowser transmit 
		to: #class; 
		andShow: [ :aPane | self browseClassesOn: aPane ].
	aBrowser transmit 
		to: #selector; 
		from: #class; 
		andShow: [ :aPane | self browseSelectorsOn: aPane ].
	aBrowser transmit
		to: #part;
		from: #class;
		from: #selector;
		andShow: [ :aPane | self browsePartsOn: aPane ]! !

!PPBrowser methodsFor: 'browse-dynamic' stamp: 'tg 7/27/2010 16:34'!
browseOutputOn: aBrowser
	aBrowser text
		title: 'Result';
		display: [ output ];
		act: [:text | output inspect ] entitled: 'Inspect'.

	aBrowser list
		title: 'Debugger';
		format: [ :each | (String new: 2 * each fourth withAll: $ ) asText , each first, ' - ', each last printString ];
		display: [ 
			| depth trace |
			depth := -1.
			trace := OrderedCollection new.
			(self production end transform: [ :each |
				each name notNil 
					ifTrue: [ 
						each >=> [ :s :cc |
							| t r |
							depth := depth + 1. 
							trace addLast: (t := Array with: each name with: s position + 1 with: s position with: depth with: Object new with: nil).
							r := cc value.
							t at: t size put: r.
							t at: 3 put: s position.
							r isPetitFailure
								ifFalse: [ t at: 1 put: (t at: 1) asText allBold ].
							depth := depth - 1.
							r ] ]
					ifFalse: [ each ] ])
				parse: input.
			trace ].
	aBrowser table 
		title: 'Tally';
		column: 'Parser' evaluated: [ :each | each first displayName ];
		column: 'Count' evaluated: [ :each | each second printString ];
		column: 'Percentage (%)' evaluated: [ :each | each third printString ];
		display: [ stream asFrequencyTable ].
	aBrowser table 
		title: 'Profile';
		column: 'Parser' evaluated: [ :each | each first displayName ];
		column: 'Time (ms)' evaluated: [ :each | each second printString ];
		column: 'Percentage (%)' evaluated: [ :each | each third printString ];
		display: [ stream asTimingTable ].
	aBrowser morph 
		title: 'Progress';
		display: [
			| morph |
			morph := ScrollPane new.
			morph color: Color white.
			morph scroller addMorph: stream asPositionMorph.
			morph ]! !

!PPBrowser methodsFor: 'browse' stamp: 'tg 4/15/2010 14:39'!
browsePartsOn: aComposite
	aComposite useExplicitNotNil.
	aComposite tabbedArrangement.
	self browseStaticOn: aComposite.
	self browseDynamicOn: aComposite	! !

!PPBrowser methodsFor: 'browse' stamp: 'lr 4/15/2010 11:00'!
browseSelectorsOn: aBrowser
	aBrowser list
		title: 'Productions';
		format: [ :class | class asString ];
		display: [ :class | 
			((((class allInstVarNames
				copyWithoutAll: class ignoredNames)
				copyWithoutAll: self rootClass allInstVarNames)
				collect: [ :each | each asSymbol ])
				select: [ :each | class includesSelector: each ])
				asSortedCollection ];
		act: [
			StandardToolSet 
				browse: self selectedClass 
				selector: self selectedSelector ] 
			on: $b entitled: 'browse (b)';
		act: [
			| class selector |
			class := self selectedClass.
			selector := self selectedSelector.
			(class instVarNames includes: selector)
				ifTrue: [ class removeInstVarName: selector ].
			class removeSelector: selector.
			aBrowser entity: self rootModel.
			self selectedClass: class ]
			on: $r entitled: 'remove (x)'! !

!PPBrowser methodsFor: 'browse-static' stamp: 'lr 11/13/2009 08:54'!
browseSourceOn: aBrowser
	aBrowser text
		title: 'Source';
		useExplicitNotNil;
		display: [ self sourceCode ];
		forSmalltalk: [ self selectedClass ];
		act: [ :node | 
			| class selector |
			class := self selectedClass.
			selector := self sourceCode: node text asString in: class.
			aBrowser entity: self rootModel.
			self selectedClass: class.
			self selectedSelector: selector ]
		on: $s entitled: 'accept (s)'! !

!PPBrowser methodsFor: 'browse' stamp: 'tg 4/15/2010 14:40'!
browseStaticOn: aBrowser
	aBrowser useExplicitNotNil.
	aBrowser tabbedArrangement.
	self browseSourceOn: aBrowser.
	self browseGraphOn: aBrowser.
	self browseCyclesOn: aBrowser.
	self browseFirstOn: aBrowser.
	self browseFollowOn: aBrowser.
	self browseExampleOn: aBrowser! !

!PPBrowser methodsFor: 'initialize-release' stamp: 'lr 4/14/2010 21:05'!
initialize
	super initialize.
	input := String new.
	output := String new.
	stream := PPBrowserStream on: input! !

!PPBrowser methodsFor: 'public' stamp: 'tg 11/16/2009 15:21'!
open
	browser := GLMTabulator new.
	self browseOn: browser.
	browser openOn: self rootModel! !

!PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/23/2009 22:24'!
production
	| parser |
	^ (parser := self selectedClass new)
		productionAt: (self selectedSelector
			ifNil: [ ^ parser ])! !

!PPBrowser methodsFor: 'accessing' stamp: 'lr 11/11/2009 08:23'!
rootClass
	^ PPCompositeParser! !

!PPBrowser methodsFor: 'accessing' stamp: 'lr 11/11/2009 08:45'!
rootModel
	^ self subclassesOf: self rootClass! !

!PPBrowser methodsFor: 'accessing-view' stamp: 'lr 4/15/2010 10:47'!
selectedClass
	^ ((browser paneNamed: #class) port: #selection) value! !

!PPBrowser methodsFor: 'accessing-view' stamp: 'lr 4/15/2010 10:47'!
selectedClass: aClass
	((browser paneNamed: #class) port: #selection) value: aClass! !

!PPBrowser methodsFor: 'accessing-view' stamp: 'lr 4/15/2010 10:47'!
selectedSelector
	^ ((browser paneNamed: #selector) port: #selection) value! !

!PPBrowser methodsFor: 'accessing-view' stamp: 'lr 4/15/2010 10:47'!
selectedSelector: aSelector
	((browser paneNamed: #selector) port: #selection) value: aSelector! !

!PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/11/2009 20:42'!
sourceCode
	^ (self selectedClass ifNil: [ ^ String new ]) 
		sourceCodeAt: (self selectedSelector ifNil: [ #start ])
		ifAbsent: [ String new ]! !

!PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/13/2009 10:59'!
sourceCode: aString in: aClass
	| tree source selector |
	tree := RBParser parseMethod: aString onError: [ :msg :pos | nil ].
	source := tree isNil
		ifTrue: [ aString ]
		ifFalse: [ 
			| rewriter |
			rewriter := RBParseTreeRewriter new.
			rewriter
				replace: '`#literal' with: '`#literal asParser' when: [ :node |
					(node isLiteralNode and: [ node value isString or: [ node value isCharacter ] ])
						and: [ (node parent isNil or: [ node parent isMessage not or: [ node parent selector ~= #asParser ] ])
						and: [ (node parents noneSatisfy: [ :each | each isBlock ]) ] ] ];
				replaceMethod: '`@method: `@args | `@temps | ``@.statements. ``.statement `{ :node | node isReturn not }' 
					with: '`@method: `@args | `@temps | ``@.statements. ^ ``.statement'.
			(rewriter executeTree: tree)
				ifTrue: [ rewriter tree newSource ]
				ifFalse: [ aString ] ].
	selector := aClass compile: source.
	(aString numArgs = 0 and: [ (aClass allInstVarNames includes: selector) not ])
		ifTrue: [ aClass addInstVarName: selector asString ].
	^ selector! !

!PPBrowser methodsFor: 'querying' stamp: 'lr 11/11/2009 08:44'!
subclassesOf: aBehavior
	^ aBehavior subclasses asSortedCollection: [ :a :b | a name < b name ]! !

Object subclass: #PPTextHighlighter
	instanceVariableNames: 'parser attributeMapper'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitGui-Core'!

!PPTextHighlighter commentStamp: '<historical>' prior: 0!
This is a utility class for creating a highlighted text. For this we need:
- a parser: PPParser
- an attributeMapper

Here is a template to use it:

PPTextHighlighter new
	parser: YourParser new;
	color: 'tokenName1' with: Color blue;
	color: 'tokenName2' with: Color gray;
	highlight: string.!

!PPTextHighlighter methodsFor: 'public' stamp: 'tg 7/27/2010 23:41'!
addAttribute: aTextAttribute for: anElementString 
	| attributes |
	attributes := self attributeMapper at: anElementString ifAbsentPut: [OrderedCollection new].
	attributes add: aTextAttribute! !

!PPTextHighlighter methodsFor: 'accessing' stamp: 'tg 7/27/2010 23:09'!
attributeMapper 
	"returns a dictionary with keys corresponding to parser names and 
	values corresponding to a collection of TextAttributes"
	^ attributeMapper! !

!PPTextHighlighter methodsFor: 'accessing' stamp: 'tg 7/27/2010 23:07'!
attributeMapper: aDictionary 
	attributeMapper := aDictionary! !

!PPTextHighlighter methodsFor: 'public' stamp: 'tg 7/27/2010 23:42'!
bold: anElementString
	self addAttribute: TextEmphasis bold for: anElementString! !

!PPTextHighlighter methodsFor: 'public' stamp: 'tg 7/28/2010 08:06'!
color: anElementString with: aColor
	self addAttribute: (TextColor new color: aColor) for: anElementString! !

!PPTextHighlighter methodsFor: 'public' stamp: 'tg 7/27/2010 23:39'!
highlight: aString
	| text highlighter |
	text := aString asText.
	highlighter := parser transform: [ :p |
		attributeMapper at: p name
			ifPresent: [ :attributes | 
				p ==> [ :token | 
					attributes do: [:each |
						text 
							addAttribute: each 
							from: token start 
							to: token stop ] ] ]
			ifAbsent: [ p ] ].
	highlighter parse: text.
	^ text! !

!PPTextHighlighter methodsFor: 'initialization' stamp: 'tg 7/27/2010 23:09'!
initialize
	parser := #any asParser.
	attributeMapper := Dictionary new! !

!PPTextHighlighter methodsFor: 'accessing' stamp: 'tg 7/27/2010 23:06'!
parser
	^ parser! !

!PPTextHighlighter methodsFor: 'accessing' stamp: 'tg 7/27/2010 23:21'!
parser: aParser
	parser := aParser! !

!PPFailingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:16'!
displayColor
	^ Color red! !

!PPFailingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:43'!
displayName
	^ message! !
PPBrowser initialize!