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

GLMCompositePresentation subclass:#PPParserBrowser

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'PetitGui-Core'

!

!PPParserBrowser class methodsFor:'as yet unclassified'!

openOn: aParserClass 

	^ self new openOn: aParserClass

! !

!PPParserBrowser methodsFor:'building'!

buildBrowser

	"self openOn: PPArithmeticParser"

	| browser |

	browser := GLMTabulator new.

	browser title: [:each | each name].

	browser 

		row: [:r | r column: #productions ; column: #workspace span: 2];

		row: #inspector.

	browser transmit to: #productions; andShow: [:a | 

	 	self productionsIn: a ]. 

	browser transmit to: #workspace; fromOutsidePort: #entity; from: #productions; andShow: [:a | 

		self workspaceIn: a ]. 

	browser transmit to: #inspector; fromOutsidePort: #entity; from: #productions; passivelyFrom: #outer port: #sampleText; andShow: [:a |

		self inspectorIn: a ].

	browser transmit from: #inspector port: #sampleText; toOutsidePort: #sampleText; when: [:arg | arg notNil ].

	browser transmit from: #workspace; toOutsidePort: #productionToSelect; 

		transformed: [:parser | parser name ];

		when: [:parser | parser name notNil ].

	browser transmit fromOutsidePort: #productionToSelect; to: #productions port: #selection.

	^ browser

!

compose

	"self openOn: PPArithmeticParser"

	self title: [:each | each name].

	self tabulator with: [ :tabulator |

		tabulator 

			row: [:r | r column: #productions ; column: #workspace span: 2];

			row: #inspector.

		tabulator transmit to: #productions; andShow: [:a | 

		 	self productionsIn: a ]. 

		tabulator transmit to: #workspace; fromOutsidePort: #entity; from: #productions; andShow: [:a | 

			self workspaceIn: a ]. 

		tabulator transmit to: #inspector; fromOutsidePort: #entity; from: #productions; passivelyFrom: #outer port: #sampleText; andShow: [:a |

			self inspectorIn: a ].

		tabulator transmit from: #inspector port: #sampleText; toOutsidePort: #sampleText; when: [:arg | arg notNil ].

		tabulator transmit from: #workspace; toOutsidePort: #productionToSelect; 

			transformed: [:parser | parser name ];

			when: [:parser | parser name notNil ].

		tabulator transmit fromOutsidePort: #productionToSelect; to: #productions port: #selection ]

! !

!PPParserBrowser methodsFor:'private building'!

exampleIn: composite

	composite text

		title: 'Example';

		useExplicitNotNil;

		display: [ :class :productionSelector | (self production: productionSelector from: class) example ];

		act: [:text | text update] icon: GLMUIThemeExtraIcons glamorousRefresh entitled: 'Generate another one'

!

firstIn: composite

	composite list

		title: 'First';

		useExplicitNotNil;

		display: [ :class :productionSelector | (self production: productionSelector from: class) firstSet ];

		format: [ :parser | parser displayName ]

!

followIn: aBrowser

	aBrowser list

		title: 'Follow';

		useExplicitNotNil;

		format: [ :parser | parser displayName ];

		display: [ :class :productionSelector | 

			| parser |

			parser := class new.

			parser followSets

				at: (parser productionAt: productionSelector)

				ifAbsent: [ Array with: nil asParser ] ]

!

graphIn: composite

	composite morph

		title: 'Graph';

		useExplicitNotNil;

		display: [ :class :selector |

			| morph |

			morph := ScrollPane new.

			morph color: Color white.

			morph scroller addMorph: (self production: selector from: class) morphicProduction.

			morph ]

!

inspectorIn: composite

	composite dynamic

		allowNil;

		display: [ :class :productionSelector :sampleText | 

					| wrapperBrowser |

					wrapperBrowser := GLMTabulator new.

					wrapperBrowser allowNil.

					wrapperBrowser column: #wrapped.

					wrapperBrowser transmit

						to: #wrapped;

						andShow: [ :a | a custom: (PPParserInspector new noTitle) ].

					wrapperBrowser transmit

						from: #wrapped port: #sampleText;

						toOutsidePort: #sampleText.

					wrapperBrowser transmit

						fromOutsidePort: #sampleText;

						to: #wrapped port: #sampleText.

					wrapperBrowser startOn: ([(self production: productionSelector from: class) end] on: Error do: [:e | nil]) .

					(wrapperBrowser pane port: #sampleText) value: (sampleText ifNil: [ '' ] ifNotNil: [ sampleText ]).

					wrapperBrowser

					]

!

mapIn: composite

	self class environment at: #GLMRoassalPresentation ifPresent: [ :cls |

		composite roassal

			title: 'Map';

			useExplicitNotNil;

			painting: [ :view :class :selector |

				(self production: #start from: class)

					viewAllNamedParsersWithSelection: (Array with: selector)  

					previewing: [:eachParser | self sourceCodeFrom: class selector: eachParser name ]

					on:  view ] ]	

!

productionsIn: composite

	"Doru: These menus should be built dynamically: title and enabled status should adapt" 

	"enabled: RBRefactoryChangeManager instance hasRedoableOperations"	" , RBRefactoryChangeManager instance redoChange"	"enabled: RBRefactoryChangeManager instance hasUndoableOperations"	" , RBRefactoryChangeManager instance undoChange "

	composite list

		title: [ :class | class name ];

		format: [ :class | class asString ];

		display: [ :class | self productionSelectorsFrom: class ];

		shouldValidate: true;

		act: [ :list :class | 

					RBRefactoryChangeManager instance redoOperation.

					list pane browser update ]

			icon: GLMUIThemeExtraIcons glamorousRedo

			entitled: 'Redo';

		act: [ :list :class | 

					RBRefactoryChangeManager instance undoOperation.

					list pane browser update ]

			icon: GLMUIThemeExtraIcons glamorousUndo

			entitled: 'Undo';

		selectionAct: [ :list  :class | 

					| oldName refactoring |

					oldName := list selection.

					refactoring := PPRefactoringUtils new performRenameProduction: oldName from: class.

					refactoring changes changes notEmpty ifTrue: [

						list update.

						list selection: refactoring changes changes first newName asSymbol ] ]

			on: $r

			entitled: 'Rename (r)';

		selectionAct: [ :list :class | 

					PPRefactoringUtils new performRefactoring: (PPRemoveProdcutionRefactoring onClass: class production: list selection).

					list pane browser update ]

			on: $x

			entitled: 'Remove (x)';

		selectionAct: [ :list :class | Smalltalk tools browser fullOnClass: class selector: list selection ]

			on: $b

			entitled: 'Browse (b)';

		selectionAct: [ :list :class | (self production: list selection from: class) explore ]

			on: $I

			entitled: 'Explore (I)'

!

sourceIn: composite

	composite smalltalkCode

		title: 'Source';

		useExplicitNotNil;

		display: [ :class :production | self sourceCodeFrom: class selector: production ];

		smalltalkClass: [ :class | class ];

		selectionAct: [ :text :class :production | 

				| selector refactoring |

				selector := UIManager default

					request: 'Production name to extract to:'

					initialAnswer: ''

					title: 'Extract production'.

				selector isEmptyOrNil ifFalse: [

					selector := selector asSymbol.

					refactoring := PPExtractProdcutionRefactoring

						onClass: class

						production: production

						interval: text selectionInterval

						to: selector.

					PPRefactoringUtils new performRefactoring: refactoring.

					text pane browser update.

					(text pane port: #productionToSelect) value: selector ] ]

			on: $e

			entitled: 'Extract production';		

		act: [ :text :class :production | 

				| selector refactoring |

				refactoring := PPDefineProdcutionRefactoring 	

						onClass: class 

						source: text text asString 

						protocols: #(grammar).

				PPRefactoringUtils new performRefactoring: refactoring.

				selector := refactoring changes changes last selector.

				selector = production 

					ifTrue: [text update]

					ifFalse: [

						text pane browser update.

						(text pane port: #productionToSelect) value: selector ] ]

			icon: GLMUIThemeExtraIcons glamorousAccept

			on: $s

			entitled: 'Accept'

!

workspaceIn: composite

	self sourceIn: composite.

	self graphIn: composite.

	self mapIn: composite.

	self exampleIn: composite.

	self firstIn: composite.

	self followIn: composite.

! !

!PPParserBrowser methodsFor:'private utilities'!

production: selector from: class

	| parser |

	parser := class new.

	^ selector isNil 

		ifTrue: [ parser ]

		ifFalse: [ parser productionAt: selector ]

!

productionSelectorsFrom: class

	^ (((class allInstVarNames copyWithoutAll: class ignoredNames)

		collect: [ :each | each asSymbol ])

			select: [ :each | class includesSelector: each ]) asSortedCollection add: #start; yourself

!

sourceCodeFrom: class selector: production

	^ class ultimateSourceCodeAt: (production ifNil: [ #start ]) ifAbsent: [ String new ]

! !

!PPParserBrowser class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPParserBrowser.st,v 1.1 2014-03-04 21:14:30 cg Exp $'

!

version_CVS

    ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPParserBrowser.st,v 1.1 2014-03-04 21:14:30 cg Exp $'

! !