--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/gui/PPParserBrowser.st Tue Mar 04 22:14:30 2014 +0100
@@ -0,0 +1,268 @@
+"{ 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 $'
+! !
+