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