Codegen: added support for smart action node compiling.
Avoid creation of intermediate result collection for action nodes if all references
to action block's argument (i.e., the nodes collection) is in form of:
* <nodes> at: <numeric constant>
* <nodes> first (second, third...
"{ 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 $'
! !