330
|
1 |
"{ Package: 'stx:goodies/petitparser/gui' }"
|
|
2 |
|
|
3 |
GLMCompositePresentation subclass:#PPParserBrowser
|
|
4 |
instanceVariableNames:''
|
|
5 |
classVariableNames:''
|
|
6 |
poolDictionaries:''
|
|
7 |
category:'PetitGui-Core'
|
|
8 |
!
|
|
9 |
|
|
10 |
|
|
11 |
!PPParserBrowser class methodsFor:'as yet unclassified'!
|
|
12 |
|
|
13 |
openOn: aParserClass
|
|
14 |
^ self new openOn: aParserClass
|
|
15 |
! !
|
|
16 |
|
|
17 |
!PPParserBrowser methodsFor:'building'!
|
|
18 |
|
|
19 |
buildBrowser
|
|
20 |
"self openOn: PPArithmeticParser"
|
|
21 |
| browser |
|
|
22 |
|
|
23 |
browser := GLMTabulator new.
|
|
24 |
browser title: [:each | each name].
|
|
25 |
browser
|
|
26 |
row: [:r | r column: #productions ; column: #workspace span: 2];
|
|
27 |
row: #inspector.
|
|
28 |
browser transmit to: #productions; andShow: [:a |
|
|
29 |
self productionsIn: a ].
|
|
30 |
browser transmit to: #workspace; fromOutsidePort: #entity; from: #productions; andShow: [:a |
|
|
31 |
self workspaceIn: a ].
|
|
32 |
browser transmit to: #inspector; fromOutsidePort: #entity; from: #productions; passivelyFrom: #outer port: #sampleText; andShow: [:a |
|
|
33 |
self inspectorIn: a ].
|
|
34 |
browser transmit from: #inspector port: #sampleText; toOutsidePort: #sampleText; when: [:arg | arg notNil ].
|
|
35 |
|
|
36 |
browser transmit from: #workspace; toOutsidePort: #productionToSelect;
|
|
37 |
transformed: [:parser | parser name ];
|
|
38 |
when: [:parser | parser name notNil ].
|
|
39 |
browser transmit fromOutsidePort: #productionToSelect; to: #productions port: #selection.
|
|
40 |
^ browser
|
|
41 |
!
|
|
42 |
|
|
43 |
compose
|
|
44 |
"self openOn: PPArithmeticParser"
|
|
45 |
self title: [:each | each name].
|
|
46 |
self tabulator with: [ :tabulator |
|
|
47 |
tabulator
|
|
48 |
row: [:r | r column: #productions ; column: #workspace span: 2];
|
|
49 |
row: #inspector.
|
|
50 |
tabulator transmit to: #productions; andShow: [:a |
|
|
51 |
self productionsIn: a ].
|
|
52 |
tabulator transmit to: #workspace; fromOutsidePort: #entity; from: #productions; andShow: [:a |
|
|
53 |
self workspaceIn: a ].
|
|
54 |
tabulator transmit to: #inspector; fromOutsidePort: #entity; from: #productions; passivelyFrom: #outer port: #sampleText; andShow: [:a |
|
|
55 |
self inspectorIn: a ].
|
|
56 |
tabulator transmit from: #inspector port: #sampleText; toOutsidePort: #sampleText; when: [:arg | arg notNil ].
|
|
57 |
|
|
58 |
tabulator transmit from: #workspace; toOutsidePort: #productionToSelect;
|
|
59 |
transformed: [:parser | parser name ];
|
|
60 |
when: [:parser | parser name notNil ].
|
|
61 |
tabulator transmit fromOutsidePort: #productionToSelect; to: #productions port: #selection ]
|
|
62 |
! !
|
|
63 |
|
|
64 |
!PPParserBrowser methodsFor:'private building'!
|
|
65 |
|
|
66 |
exampleIn: composite
|
|
67 |
composite text
|
|
68 |
title: 'Example';
|
|
69 |
useExplicitNotNil;
|
|
70 |
display: [ :class :productionSelector | (self production: productionSelector from: class) example ];
|
|
71 |
act: [:text | text update] icon: GLMUIThemeExtraIcons glamorousRefresh entitled: 'Generate another one'
|
|
72 |
!
|
|
73 |
|
|
74 |
firstIn: composite
|
|
75 |
composite list
|
|
76 |
title: 'First';
|
|
77 |
useExplicitNotNil;
|
|
78 |
display: [ :class :productionSelector | (self production: productionSelector from: class) firstSet ];
|
|
79 |
format: [ :parser | parser displayName ]
|
|
80 |
!
|
|
81 |
|
|
82 |
followIn: aBrowser
|
|
83 |
aBrowser list
|
|
84 |
title: 'Follow';
|
|
85 |
useExplicitNotNil;
|
|
86 |
format: [ :parser | parser displayName ];
|
|
87 |
display: [ :class :productionSelector |
|
|
88 |
| parser |
|
|
89 |
parser := class new.
|
|
90 |
parser followSets
|
|
91 |
at: (parser productionAt: productionSelector)
|
|
92 |
ifAbsent: [ Array with: nil asParser ] ]
|
|
93 |
!
|
|
94 |
|
|
95 |
graphIn: composite
|
|
96 |
composite morph
|
|
97 |
title: 'Graph';
|
|
98 |
useExplicitNotNil;
|
|
99 |
display: [ :class :selector |
|
|
100 |
| morph |
|
|
101 |
morph := ScrollPane new.
|
|
102 |
morph color: Color white.
|
|
103 |
morph scroller addMorph: (self production: selector from: class) morphicProduction.
|
|
104 |
morph ]
|
|
105 |
!
|
|
106 |
|
|
107 |
inspectorIn: composite
|
|
108 |
composite dynamic
|
|
109 |
allowNil;
|
|
110 |
display: [ :class :productionSelector :sampleText |
|
|
111 |
| wrapperBrowser |
|
|
112 |
wrapperBrowser := GLMTabulator new.
|
|
113 |
wrapperBrowser allowNil.
|
|
114 |
wrapperBrowser column: #wrapped.
|
|
115 |
wrapperBrowser transmit
|
|
116 |
to: #wrapped;
|
|
117 |
andShow: [ :a | a custom: (PPParserInspector new noTitle) ].
|
|
118 |
|
|
119 |
wrapperBrowser transmit
|
|
120 |
from: #wrapped port: #sampleText;
|
|
121 |
toOutsidePort: #sampleText.
|
|
122 |
|
|
123 |
wrapperBrowser transmit
|
|
124 |
fromOutsidePort: #sampleText;
|
|
125 |
to: #wrapped port: #sampleText.
|
|
126 |
|
|
127 |
wrapperBrowser startOn: ([(self production: productionSelector from: class) end] on: Error do: [:e | nil]) .
|
|
128 |
(wrapperBrowser pane port: #sampleText) value: (sampleText ifNil: [ '' ] ifNotNil: [ sampleText ]).
|
|
129 |
wrapperBrowser
|
|
130 |
]
|
|
131 |
|
|
132 |
|
|
133 |
!
|
|
134 |
|
|
135 |
mapIn: composite
|
|
136 |
self class environment at: #GLMRoassalPresentation ifPresent: [ :cls |
|
|
137 |
composite roassal
|
|
138 |
title: 'Map';
|
|
139 |
useExplicitNotNil;
|
|
140 |
painting: [ :view :class :selector |
|
|
141 |
(self production: #start from: class)
|
|
142 |
viewAllNamedParsersWithSelection: (Array with: selector)
|
|
143 |
previewing: [:eachParser | self sourceCodeFrom: class selector: eachParser name ]
|
|
144 |
on: view ] ]
|
|
145 |
!
|
|
146 |
|
|
147 |
productionsIn: composite
|
|
148 |
"Doru: These menus should be built dynamically: title and enabled status should adapt"
|
|
149 |
"enabled: RBRefactoryChangeManager instance hasRedoableOperations" " , RBRefactoryChangeManager instance redoChange" "enabled: RBRefactoryChangeManager instance hasUndoableOperations" " , RBRefactoryChangeManager instance undoChange "
|
|
150 |
|
|
151 |
composite list
|
|
152 |
title: [ :class | class name ];
|
|
153 |
format: [ :class | class asString ];
|
|
154 |
display: [ :class | self productionSelectorsFrom: class ];
|
|
155 |
shouldValidate: true;
|
|
156 |
act: [ :list :class |
|
|
157 |
RBRefactoryChangeManager instance redoOperation.
|
|
158 |
list pane browser update ]
|
|
159 |
icon: GLMUIThemeExtraIcons glamorousRedo
|
|
160 |
entitled: 'Redo';
|
|
161 |
act: [ :list :class |
|
|
162 |
RBRefactoryChangeManager instance undoOperation.
|
|
163 |
list pane browser update ]
|
|
164 |
icon: GLMUIThemeExtraIcons glamorousUndo
|
|
165 |
entitled: 'Undo';
|
|
166 |
selectionAct: [ :list :class |
|
|
167 |
| oldName refactoring |
|
|
168 |
oldName := list selection.
|
|
169 |
refactoring := PPRefactoringUtils new performRenameProduction: oldName from: class.
|
|
170 |
refactoring changes changes notEmpty ifTrue: [
|
|
171 |
list update.
|
|
172 |
list selection: refactoring changes changes first newName asSymbol ] ]
|
|
173 |
on: $r
|
|
174 |
entitled: 'Rename (r)';
|
|
175 |
selectionAct: [ :list :class |
|
|
176 |
PPRefactoringUtils new performRefactoring: (PPRemoveProdcutionRefactoring onClass: class production: list selection).
|
|
177 |
list pane browser update ]
|
|
178 |
on: $x
|
|
179 |
entitled: 'Remove (x)';
|
|
180 |
selectionAct: [ :list :class | Smalltalk tools browser fullOnClass: class selector: list selection ]
|
|
181 |
on: $b
|
|
182 |
entitled: 'Browse (b)';
|
|
183 |
selectionAct: [ :list :class | (self production: list selection from: class) explore ]
|
|
184 |
on: $I
|
|
185 |
entitled: 'Explore (I)'
|
|
186 |
!
|
|
187 |
|
|
188 |
sourceIn: composite
|
|
189 |
composite smalltalkCode
|
|
190 |
title: 'Source';
|
|
191 |
useExplicitNotNil;
|
|
192 |
display: [ :class :production | self sourceCodeFrom: class selector: production ];
|
|
193 |
smalltalkClass: [ :class | class ];
|
|
194 |
selectionAct: [ :text :class :production |
|
|
195 |
| selector refactoring |
|
|
196 |
selector := UIManager default
|
|
197 |
request: 'Production name to extract to:'
|
|
198 |
initialAnswer: ''
|
|
199 |
title: 'Extract production'.
|
|
200 |
selector isEmptyOrNil ifFalse: [
|
|
201 |
selector := selector asSymbol.
|
|
202 |
refactoring := PPExtractProdcutionRefactoring
|
|
203 |
onClass: class
|
|
204 |
production: production
|
|
205 |
interval: text selectionInterval
|
|
206 |
to: selector.
|
|
207 |
PPRefactoringUtils new performRefactoring: refactoring.
|
|
208 |
text pane browser update.
|
|
209 |
(text pane port: #productionToSelect) value: selector ] ]
|
|
210 |
on: $e
|
|
211 |
entitled: 'Extract production';
|
|
212 |
act: [ :text :class :production |
|
|
213 |
| selector refactoring |
|
|
214 |
refactoring := PPDefineProdcutionRefactoring
|
|
215 |
onClass: class
|
|
216 |
source: text text asString
|
|
217 |
protocols: #(grammar).
|
|
218 |
PPRefactoringUtils new performRefactoring: refactoring.
|
|
219 |
selector := refactoring changes changes last selector.
|
|
220 |
selector = production
|
|
221 |
ifTrue: [text update]
|
|
222 |
ifFalse: [
|
|
223 |
text pane browser update.
|
|
224 |
(text pane port: #productionToSelect) value: selector ] ]
|
|
225 |
icon: GLMUIThemeExtraIcons glamorousAccept
|
|
226 |
on: $s
|
|
227 |
entitled: 'Accept'
|
|
228 |
!
|
|
229 |
|
|
230 |
workspaceIn: composite
|
|
231 |
self sourceIn: composite.
|
|
232 |
self graphIn: composite.
|
|
233 |
self mapIn: composite.
|
|
234 |
self exampleIn: composite.
|
|
235 |
self firstIn: composite.
|
|
236 |
self followIn: composite.
|
|
237 |
! !
|
|
238 |
|
|
239 |
!PPParserBrowser methodsFor:'private utilities'!
|
|
240 |
|
|
241 |
production: selector from: class
|
|
242 |
| parser |
|
|
243 |
parser := class new.
|
|
244 |
^ selector isNil
|
|
245 |
ifTrue: [ parser ]
|
|
246 |
ifFalse: [ parser productionAt: selector ]
|
|
247 |
!
|
|
248 |
|
|
249 |
productionSelectorsFrom: class
|
|
250 |
^ (((class allInstVarNames copyWithoutAll: class ignoredNames)
|
|
251 |
collect: [ :each | each asSymbol ])
|
|
252 |
select: [ :each | class includesSelector: each ]) asSortedCollection add: #start; yourself
|
|
253 |
!
|
|
254 |
|
|
255 |
sourceCodeFrom: class selector: production
|
|
256 |
^ class ultimateSourceCodeAt: (production ifNil: [ #start ]) ifAbsent: [ String new ]
|
|
257 |
! !
|
|
258 |
|
|
259 |
!PPParserBrowser class methodsFor:'documentation'!
|
|
260 |
|
|
261 |
version
|
|
262 |
^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPParserBrowser.st,v 1.1 2014-03-04 21:14:30 cg Exp $'
|
|
263 |
!
|
|
264 |
|
|
265 |
version_CVS
|
|
266 |
^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPParserBrowser.st,v 1.1 2014-03-04 21:14:30 cg Exp $'
|
|
267 |
! !
|
|
268 |
|