"{ 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 $'
! !