44 ! |
45 ! |
45 |
46 |
46 documentation |
47 documentation |
47 " |
48 " |
48 The ResourceSelectionBrowser allows you to browse in class hierarchies |
49 The ResourceSelectionBrowser allows you to browse in class hierarchies |
49 and to select resource methods in order to load method contents or to save |
50 and to select resource methods for loading or to saving resource |
50 something to methods. |
51 specifications (#canvas, #menu, etc.). |
|
52 |
|
53 [instance variables:] |
|
54 resourceMethod <Symbol> selector of the resource spec |
|
55 resourceClass <Symbol> class of the resource spec |
|
56 resourceSuperclass <Symbol> root class of the tree list |
|
57 resourceTypes <Array> allowed resource types |
|
58 allClasses <Array> list of the subclasses of resourceSuperclass |
|
59 classSelectionBlock <Block> by evaluating this block the class selection is done |
|
60 readResourcesProcess <Process> process of reading the resource methods |
|
61 mayReadResources <Boolean> flag whether may read the resource methods |
51 |
62 |
52 [start with:] |
63 [start with:] |
53 ResourceSelectionBrowser open |
64 ResourceSelectionBrowser open |
54 |
65 |
55 [author:] |
66 [author:] |
56 Thomas Zwick, eXept Software AG |
67 Thomas Zwick, eXept Software AG |
57 " |
68 " |
58 ! ! |
69 ! ! |
59 |
70 |
60 !ResourceSelectionBrowser class methodsFor:'instance creation'! |
71 !ResourceSelectionBrowser class methodsFor:'instance creation'! |
61 |
72 |
62 request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withResourceTypes: resourceTypes |
73 request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withResourceTypes: resourceTypes |
63 |
74 "opens a ResourceSelectionBrowser |
|
75 with aTitle |
|
76 on aSuperclassOrSymbol, |
|
77 and aClassOrSymbol, |
|
78 and aSelector, |
|
79 with allowed aResourceTypes" |
64 " |
80 " |
65 ResourceSelectionBrowser |
81 ResourceSelectionBrowser |
66 request: 'Select a Resource Selector' |
82 request: 'Select a Resource Selector' |
67 onSuperclass: #ApplicationModel |
83 onSuperclass: #ApplicationModel |
68 andClass: #ToolApplicationModel |
84 andClass: #ToolApplicationModel |
69 andSelector: #saveIcon |
85 andSelector: #saveIcon |
70 withResourceTypes: #(image) |
86 withResourceTypes: #(image) |
71 " |
87 " |
72 |
88 |
73 ^self new |
89 ^self new |
74 title: aTitle; |
90 title: aTitle; |
75 openOnSuperclass: aSuperclass |
91 openOnSuperclass: aSuperclass |
76 andClass: aClass |
92 andClass: aClass |
77 andSelector: aSelector |
93 andSelector: aSelector |
78 withResourceTypes: resourceTypes |
94 withResourceTypes: resourceTypes |
79 ! ! |
95 ! ! |
80 |
96 |
81 !ResourceSelectionBrowser class methodsFor:'callbacks - default'! |
97 !ResourceSelectionBrowser class methodsFor:'callbacks - default'! |
82 |
98 |
83 treeViewChildren |
99 treeViewChildren |
|
100 "returns the children for the contents (class) of aTreeItem as a block" |
84 |
101 |
85 ^[:aTreeItem| |
102 ^[:aTreeItem| |
86 |classes| |
103 |classes| |
87 classes := OrderedCollection new. |
104 classes := OrderedCollection new. |
88 classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:i1 :i2| i1 name < i2 name]). |
105 classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:i1 :i2| i1 name < i2 name]). |
89 classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:i1 :i2| i1 name < i2 name]). |
106 classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:i1 :i2| i1 name < i2 name]). |
90 classes |
107 classes |
91 ] |
108 ] |
92 ! |
109 ! |
93 |
110 |
94 treeViewContents |
111 treeViewContents |
|
112 "returns the default contents of the root of the class tree list" |
95 |
113 |
96 ^Smalltalk at: #Object |
114 ^Smalltalk at: #Object |
97 |
115 |
98 |
116 |
99 |
117 |
100 |
118 |
101 ! |
119 ! |
102 |
120 |
103 treeViewIcon |
121 treeViewIcon |
|
122 "returns the icon for aTreeItem as a block" |
104 |
123 |
105 ^[:aTreeItem| |
124 ^[:aTreeItem| |
106 |icon| |
125 |icon| |
107 icon := self iconClass. |
126 icon := self iconClass. |
108 aTreeItem contents isPrivate |
127 aTreeItem contents isPrivate |
109 ifTrue: |
128 ifTrue: |
110 [ |
129 [ |
111 icon := self iconPrivateClass |
130 icon := self iconPrivateClass |
112 ]. |
131 ]. |
113 icon] |
132 icon |
|
133 ] |
114 |
134 |
115 ! |
135 ! |
116 |
136 |
117 treeViewLabel |
137 treeViewLabel |
|
138 "returns the label for aTreeItem as a block" |
118 |
139 |
119 ^[:aTreeItem| |
140 ^[:aTreeItem| |
120 |label superCls| |
141 |label superCls| |
121 label := aTreeItem contents name. |
142 label := aTreeItem contents name. |
122 (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)]) |
143 (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)]) |
123 ifTrue: [label := label, ' (', superCls name, ')']. |
144 ifTrue: [label := label, ' (', superCls name, ')']. |
124 label |
145 label |
125 ] |
146 ] |
126 |
147 |
127 |
148 |
128 ! ! |
149 ! ! |
129 |
150 |
181 <resource: #canvas> |
202 <resource: #canvas> |
182 |
203 |
183 ^ |
204 ^ |
184 |
205 |
185 #(#FullSpec |
206 #(#FullSpec |
186 #window: |
207 #window: |
187 #(#WindowSpec |
208 #(#WindowSpec |
188 #name: 'Resource Selection Browser' |
209 #name: 'Resource Selection Browser' |
189 #layout: #(#LayoutFrame 433 0 242 0 1032 0 591 0) |
210 #layout: #(#LayoutFrame 221 0 252 0 820 0 601 0) |
190 #label: 'Resource Selection Browser' |
211 #label: 'Resource Selection Browser' |
191 #min: #(#Point 400 300) |
212 #min: #(#Point 400 300) |
192 #max: #(#Point 1152 864) |
213 #max: #(#Point 1152 864) |
193 #bounds: #(#Rectangle 433 242 1033 592) |
214 #bounds: #(#Rectangle 221 252 821 602) |
194 #usePreferredExtent: false |
215 #usePreferredExtent: false |
195 ) |
216 ) |
196 #component: |
217 #component: |
197 #(#SpecCollection |
218 #(#SpecCollection |
198 #collection: |
219 #collection: |
199 #( |
220 #( |
200 #(#VariableHorizontalPanelSpec |
221 #(#VariableHorizontalPanelSpec |
201 #name: 'variableHorizontalPanel' |
222 #name: 'VariableHorizontalPanel' |
202 #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -40 1.0) |
223 #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -40 1.0) |
203 #component: |
224 #component: |
204 #(#SpecCollection |
225 #(#SpecCollection |
205 #collection: |
226 #collection: |
206 #( |
227 #( |
207 #(#ViewSpec |
228 #(#ViewSpec |
208 #name: 'view1' |
229 #name: 'Box1' |
209 #component: |
230 #component: |
210 #(#SpecCollection |
231 #(#SpecCollection |
211 #collection: |
232 #collection: |
212 #( |
233 #( |
213 #(#SelectionInTreeViewSpec |
234 #(#SelectionInTreeViewSpec |
214 #name: 'listOfClassesView' |
235 #name: 'listOfClassesView' |
215 #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -22 1.0) |
236 #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -22 1.0) |
216 #model: #selectionOfClass |
237 #tabable: true |
217 #hasHorizontalScrollBar: true |
238 #model: #selectionOfClass |
218 #hasVerticalScrollBar: true |
239 #hasHorizontalScrollBar: true |
219 #miniScrollerHorizontal: true |
240 #hasVerticalScrollBar: true |
220 #showDirectoryIndicatorForRoot: false |
241 #miniScrollerHorizontal: true |
221 #showDirectoryIndicator: true |
242 #showDirectoryIndicatorForRoot: false |
222 #valueChangeSelector: #classSelected: |
243 #showDirectoryIndicator: true |
223 #hierarchicalList: #listOfClasses |
244 #valueChangeSelector: #classSelected |
224 #contentsSelector: #treeViewContents |
245 #hierarchicalList: #rootOfClasses |
225 #labelSelector: #treeViewLabel |
246 #validateDoubleClickSelector: #validateDoubleClick: |
226 #childrenSelector: #treeViewChildren |
247 #contentsSelector: #treeViewContents |
227 #iconSelector: #treeViewIcon |
248 #labelSelector: #treeViewLabel |
228 ) |
249 #childrenSelector: #treeViewChildren |
229 #(#InputFieldSpec |
250 #iconSelector: #treeViewIcon |
230 #name: 'classNameInputField' |
251 ) |
231 #layout: #(#LayoutFrame 2 0.0 -22 1 -1 1.0 0 1) |
252 #(#InputFieldSpec |
232 #model: #valueOfClassName |
253 #name: 'classNameInputField' |
233 ) |
254 #layout: #(#LayoutFrame 2 0.0 -22 1 -1 1.0 0 1) |
234 #(#LabelSpec |
255 #tabable: true |
235 #name: 'ClassHierarchyLabel' |
256 #model: #valueOfClassName |
236 #layout: #(#LayoutFrame 0 0 2 0 297 0 23 0) |
257 ) |
237 #label: ' Class Hierarchy' |
258 #(#LabelSpec |
238 #level: 1 |
259 #name: 'ClassHierarchyLabel' |
239 #adjust: #left |
260 #layout: #(#LayoutFrame 0 0 2 0 297 0 23 0) |
240 ) |
261 #label: ' Class Hierarchy' |
241 ) |
262 #level: 1 |
242 ) |
263 #adjust: #left |
243 ) |
264 ) |
244 #(#ViewSpec |
265 ) |
245 #name: 'view2' |
266 ) |
246 #component: |
267 ) |
247 #(#SpecCollection |
268 #(#ViewSpec |
248 #collection: |
269 #name: 'Box2' |
249 #( |
270 #component: |
250 #(#DataSetSpec |
271 #(#SpecCollection |
251 #name: 'resourcesDataSetView' |
272 #collection: |
252 #layout: #(#LayoutFrame 2 0.0 2 0.0 -2 1.0 -22 1.0) |
273 #( |
253 #model: #selectionOfResource |
274 #(#DataSetSpec |
254 #hasHorizontalScrollBar: true |
275 #name: 'resourcesDataSetView' |
255 #hasVerticalScrollBar: true |
276 #layout: #(#LayoutFrame 2 0.0 2 0.0 -2 1.0 -22 1.0) |
256 #miniScrollerHorizontal: true |
277 #model: #selectionOfResourceMethod |
257 #rowClassName: 'ResourceSelectionBrowser::Row' |
278 #hasHorizontalScrollBar: true |
258 #dataList: #listOfResources |
279 #hasVerticalScrollBar: true |
259 #useIndex: false |
280 #miniScrollerHorizontal: true |
260 #has3Dsepartors: true |
281 #rowClassName: 'ResourceSelectionBrowser::Row' |
261 #doubleClickSelector: #resourceDoubleClicked |
282 #dataList: #listOfResourceMethods |
262 #columnHolder: #columnsOfDataSetView |
283 #useIndex: false |
263 #valueChangeSelector: #resourceSelected |
284 #has3Dsepartors: true |
264 #verticalSpacing: 1 |
285 #doubleClickSelector: #resourceDoubleClicked |
265 ) |
286 #columnHolder: #resourceMethodColumns |
266 #(#InputFieldSpec |
287 #valueChangeSelector: #resourceSelected |
267 #name: 'selectorInputField' |
288 #verticalSpacing: 1 |
268 #layout: #(#LayoutFrame 2 0.0 -22 1 -2 1.0 0 1) |
289 ) |
269 #model: #valueOfSelector |
290 #(#InputFieldSpec |
270 ) |
291 #name: 'selectorInputField' |
271 ) |
292 #layout: #(#LayoutFrame 2 0.0 -22 1 -2 1.0 0 1) |
272 ) |
293 #tabable: true |
273 ) |
294 #model: #valueOfResourceSelector |
274 ) |
295 ) |
275 ) |
296 ) |
276 #handles: #(#Any 0.5 1.0) |
297 ) |
277 ) |
298 ) |
278 #(#UISubSpecification |
299 ) |
279 #name: 'SubSpecification' |
300 ) |
280 #layout: #(#LayoutFrame 301 0.0 -32 1 -2 1.0 -8 1.0) |
301 #handles: #(#Any 0.5 1.0) |
281 #majorKey: #ToolApplicationModel |
302 ) |
282 #minorKey: #windowSpecForCommitWithoutChannels |
303 #(#UISubSpecification |
283 ) |
304 #name: 'windowSpecForCommitWithoutChannels' |
284 #(#HorizontalPanelViewSpec |
305 #layout: #(#LayoutFrame 301 0.0 -32 1 -2 1.0 -8 1.0) |
285 #name: 'HorizontalPanelView1' |
306 #majorKey: #ToolApplicationModel |
286 #layout: #(#LayoutFrame 3 0 76 0.691429 300 0 0 0.977143) |
307 #minorKey: #windowSpecForCommitWithoutChannels |
287 #component: |
308 ) |
288 #(#SpecCollection |
309 #(#HorizontalPanelViewSpec |
289 #collection: |
310 #name: 'HorizontalPanelView' |
290 #( |
311 #layout: #(#LayoutFrame 3 0 76 0.691429 300 0 0 0.977143) |
291 #(#LabelSpec |
312 #component: |
292 #name: 'Label2' |
313 #(#SpecCollection |
293 #label: 'Create: ' |
314 #collection: |
294 #adjust: #right |
315 #( |
295 #extent: #(#Point 72 24) |
316 #(#LabelSpec |
296 ) |
317 #name: 'Label2' |
297 #(#ActionButtonSpec |
318 #label: 'Create: ' |
298 #name: 'CreateClassButton' |
319 #adjust: #right |
299 #activeHelpKey: #dss |
320 #extent: #(#Point 72 24) |
300 #label: 'Class' |
321 ) |
301 #model: #createClass: |
322 #(#ActionButtonSpec |
302 #actionValue: 'class' |
323 #name: 'CreateClassButton' |
303 #extent: #(#Point 72 24) |
324 #activeHelpKey: #dss |
304 ) |
325 #label: 'Class' |
305 #(#ActionButtonSpec |
326 #model: #createClass: |
306 #name: 'CreateSubclassButton' |
327 #actionValue: 'class' |
307 #activeHelpKey: #dss |
328 #extent: #(#Point 72 24) |
308 #label: 'Subclass' |
329 ) |
309 #model: #createClass: |
330 #(#ActionButtonSpec |
310 #actionValue: 'subclass' |
331 #name: 'CreateSubclassButton' |
311 #extent: #(#Point 72 24) |
332 #activeHelpKey: #dss |
312 ) |
333 #label: 'Subclass' |
313 #(#ActionButtonSpec |
334 #model: #createClass: |
314 #name: 'CreatePrivateClassButton' |
335 #actionValue: 'subclass' |
315 #activeHelpKey: #dss |
336 #extent: #(#Point 72 24) |
316 #label: 'Private' |
337 ) |
317 #model: #createClass: |
338 #(#ActionButtonSpec |
318 #actionValue: 'private' |
339 #name: 'CreatePrivateClassButton' |
319 #extent: #(#Point 72 24) |
340 #activeHelpKey: #dss |
320 ) |
341 #label: 'Private' |
321 ) |
342 #model: #createClass: |
322 ) |
343 #actionValue: 'private' |
323 #horizontalLayout: #fit |
344 #extent: #(#Point 72 24) |
324 #verticalLayout: #fit |
345 ) |
325 ) |
346 ) |
326 ) |
347 ) |
327 ) |
348 #horizontalLayout: #fit |
|
349 #verticalLayout: #fit |
|
350 ) |
|
351 ) |
|
352 ) |
328 ) |
353 ) |
329 ! ! |
354 ! ! |
330 |
355 |
331 !ResourceSelectionBrowser class methodsFor:'list specs'! |
356 !ResourceSelectionBrowser class methodsFor:'list specs'! |
332 |
357 |
333 columnsOfDataSetView |
358 resourceMethodColumns |
|
359 "returns the columns for the table of the resource methods" |
334 |
360 |
335 ^ #(#(#DataSetColumnSpec |
361 ^ #(#(#DataSetColumnSpec |
336 #width: 20 |
362 #width: 20 |
337 #height: 20 |
363 #height: 20 |
338 #printSelector: #iconOn: |
364 #printSelector: #iconOn: |
350 #model: #resourceType |
376 #model: #resourceType |
351 #canSelect: false |
377 #canSelect: false |
352 )) |
378 )) |
353 ! ! |
379 ! ! |
354 |
380 |
355 !ResourceSelectionBrowser methodsFor:'accessing - views'! |
|
356 |
|
357 classNameInputField |
|
358 |
|
359 ^builder componentAt: #classNameInputField |
|
360 ! |
|
361 |
|
362 listOfClassesView |
|
363 |
|
364 ^builder componentAt: #listOfClassesView |
|
365 ! ! |
|
366 |
|
367 !ResourceSelectionBrowser methodsFor:'aspects'! |
381 !ResourceSelectionBrowser methodsFor:'aspects'! |
368 |
382 |
369 columnsOfDataSetView |
383 listOfResourceMethods |
|
384 "returns the value holder for the list of the resource methods" |
370 |
385 |
371 |holder| |
386 |holder| |
372 (holder := builder bindingAt:#columnsOfDataSetView) isNil ifTrue:[ |
387 (holder := builder bindingAt:#listOfResourceMethods) isNil ifTrue:[ |
373 builder aspectAt:#columnsOfDataSetView put:(holder := List new). |
388 builder aspectAt:#listOfResourceMethods put:(holder := List new). |
374 holder addAll: (self class columnsOfDataSetView collect: [:i| i decodeAsLiteralArray]). |
|
375 ]. |
389 ]. |
376 ^ holder |
390 ^ holder |
377 |
391 ! |
378 |
392 |
379 ! |
393 resourceMethodColumns |
380 |
394 "returns the columns for the table of the resource methods as value holder" |
381 listOfClasses |
|
382 |
395 |
383 |holder| |
396 |holder| |
384 (holder := builder bindingAt:#listOfClasses) isNil ifTrue:[ |
397 (holder := builder bindingAt:#resourceMethodColumns) isNil ifTrue:[ |
385 builder aspectAt:#listOfClasses put: (holder := TreeItem new) |
398 builder aspectAt:#resourceMethodColumns put:(holder := List new). |
|
399 holder addAll: (self class resourceMethodColumns collect: [:i| i decodeAsLiteralArray]). |
386 ]. |
400 ]. |
387 ^ holder |
401 ^ holder |
388 |
402 ! |
389 |
403 |
390 ! |
404 rootOfClasses |
391 |
405 "returns the value holder for the root of the class tree list" |
392 listOfResources |
|
393 |
406 |
394 |holder| |
407 |holder| |
395 (holder := builder bindingAt:#listOfResources) isNil ifTrue:[ |
408 (holder := builder bindingAt:#rootOfClasses) isNil ifTrue:[ |
396 builder aspectAt:#listOfResources put:(holder := List new). |
409 builder aspectAt:#rootOfClasses put: (holder := SelectionInTree new root: TreeItem new) |
397 ]. |
410 ]. |
398 ^ holder |
411 ^ holder |
|
412 |
|
413 |
399 ! |
414 ! |
400 |
415 |
401 selectionOfClass |
416 selectionOfClass |
|
417 "returns the value holder for the selected class of the class tree list" |
402 |
418 |
403 |holder| |
419 |holder| |
404 (holder := builder bindingAt:#selectionOfClass) isNil ifTrue:[ |
420 (holder := builder bindingAt:#selectionOfClass) isNil ifTrue:[ |
405 builder aspectAt:#selectionOfClass put:(holder := ValueHolder new). |
421 builder aspectAt:#selectionOfClass put:(holder := ValueHolder new). |
406 ]. |
422 ]. |
407 ^ holder |
423 ^ holder |
408 ! |
424 ! |
409 |
425 |
410 selectionOfResource |
426 selectionOfResourceMethod |
|
427 "returns the value holder for the selected resource method of the resource method list" |
411 |
428 |
412 |holder| |
429 |holder| |
413 (holder := builder bindingAt:#selectionOfResource) isNil ifTrue:[ |
430 (holder := builder bindingAt:#selectionOfResourceMethod) isNil ifTrue:[ |
414 builder aspectAt:#selectionOfResource put:(holder := '' asValue). |
431 builder aspectAt:#selectionOfResourceMethod put:(holder := '' asValue). |
415 ]. |
432 ]. |
416 ^ holder |
433 ^ holder |
417 ! |
434 ! |
418 |
435 |
419 valueOfClassName |
436 valueOfClassName |
|
437 "returns the value holder for the name of the class" |
420 |
438 |
421 |holder| |
439 |holder| |
422 (holder := builder bindingAt:#valueOfClassName) isNil ifTrue:[ |
440 (holder := builder bindingAt:#valueOfClassName) isNil ifTrue:[ |
423 builder aspectAt:#valueOfClassName put:(holder := '' asValue). |
441 builder aspectAt:#valueOfClassName put:(holder := '' asValue). |
424 ]. |
442 ]. |
425 ^ holder |
443 ^ holder |
426 ! |
444 ! |
427 |
445 |
428 valueOfSelector |
446 valueOfResourceSelector |
|
447 "returns the value holder for the name of the selector" |
429 |
448 |
430 |holder| |
449 |holder| |
431 (holder := builder bindingAt:#valueOfSelector) isNil ifTrue:[ |
450 (holder := builder bindingAt:#valueOfResourceSelector) isNil ifTrue:[ |
432 builder aspectAt:#valueOfSelector put:(holder := '' asValue). |
451 builder aspectAt:#valueOfResourceSelector put:(holder := '' asValue). |
433 ]. |
452 ]. |
434 ^ holder |
453 ^ holder |
435 ! ! |
454 ! ! |
436 |
455 |
437 !ResourceSelectionBrowser methodsFor:'callbacks - tree view'! |
456 !ResourceSelectionBrowser methodsFor:'callbacks - class list'! |
438 |
457 |
439 treeViewContents |
458 treeViewContents |
|
459 "returns the contents of the root of the class tree list" |
440 |
460 |
441 ^(Smalltalk at: resourceSuperclass) ? self class treeViewContents |
461 ^(Smalltalk at: resourceSuperclass) ? self class treeViewContents |
442 |
462 |
443 |
463 |
|
464 ! |
|
465 |
|
466 validateDoubleClick: aTreeItem |
|
467 "returns whether a class may be selected" |
|
468 |
|
469 ^aTreeItem contents ~~ self treeViewContents |
|
470 |
|
471 |
|
472 |
444 ! ! |
473 ! ! |
445 |
474 |
446 !ResourceSelectionBrowser methodsFor:'callbacks - user'! |
475 !ResourceSelectionBrowser methodsFor:'callbacks - user'! |
447 |
476 |
448 classSelected: anIndex |
477 classSelected |
449 |
478 "after a class selection, read the allowed resource methods of the selected class" |
450 self selectionOfClass value isNil ifTrue: [^nil]. |
479 |
|
480 (mayReadResources not or: [self selectionOfClass value isNil]) ifTrue: [^nil]. |
451 self withWaitCursorDo: |
481 self withWaitCursorDo: |
452 [ |
482 [ |
453 |clsName| |
483 |clsName| |
454 resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes]. |
484 resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes]. |
455 clsName := ((self listOfClassesView list at: anIndex) printString upTo: $ ) asSymbol. |
485 clsName := self selectionOfClass value name. |
456 self valueOfClassName value: clsName. |
486 self valueOfClassName value: clsName. |
457 self class lastSelection: clsName. |
487 self class lastSelection: clsName. |
458 self listOfResources contents: |
488 self listOfResourceMethods contents: |
459 ((((Smalltalk at: clsName) |
489 ((((Smalltalk at: clsName) |
460 class methodDictionary |
490 class methodDictionary |
461 asOrderedCollection select: |
491 asOrderedCollection select: |
462 [:m| m resources notNil and: [resourceTypes includes: m resourceType]])) |
492 [:m| m resources notNil and: [resourceTypes includes: m resourceType]])) |
463 collect: [:m| Row new method: m]). |
493 collect: [:m| (ResourceMethod new method: m)]). |
464 ] |
494 ] |
465 ! |
495 ! |
466 |
496 |
467 createClass: what |
497 createClass: what |
|
498 "creates a class, a subclass, or a private class of the selected class" |
468 |
499 |
469 |clsCandidat cls| |
500 |clsCandidat cls| |
|
501 |
470 clsCandidat := self valueOfClassName value asSymbol. |
502 clsCandidat := self valueOfClassName value asSymbol. |
471 |
503 |
472 (Smalltalk at: clsCandidat) notNil |
504 (Smalltalk at: clsCandidat) notNil |
473 ifTrue: [^self warn: 'Cannot create class ', clsCandidat asBoldText, |
505 ifTrue: [^self warn: 'Cannot create class ', clsCandidat asBoldText, |
474 '!!\Key with that name in dictionary ' withCRs, 'Smalltalk' asBoldText, ' detected.']. |
506 '!!\Key with that name in dictionary ' withCRs, 'Smalltalk' asBoldText, ' detected.']. |
475 |
507 |
476 cls := self selectionOfClass value contents. |
508 cls := self selectionOfClass value contents. |
477 what = 'class' ifTrue: [cls := cls superclass]. |
509 what = 'class' ifTrue: [cls := cls superclass]. |
478 |
510 |
479 cls isNil ifTrue: [^self warn: 'May not create class with superclass ', 'nil' asBoldText, '!!']. |
511 cls isNil ifTrue: [^self warn: 'May not create class with superclass ', 'nil' asBoldText, '!!']. |
480 |
512 |
481 what = 'private' |
513 what = 'private' |
482 ifFalse: |
514 ifFalse: |
483 [ |
515 [ |
484 cls subclass: clsCandidat |
516 cls subclass: clsCandidat |
485 instanceVariableNames:'' |
517 instanceVariableNames:'' |
486 classVariableNames:'' |
518 classVariableNames:'' |
487 poolDictionaries:'' |
519 poolDictionaries:'' |
488 category: cls category |
520 category: cls category |
489 ] |
521 ] |
490 ifTrue: |
522 ifTrue: |
491 [ |
523 [ |
492 |superClsCandidate| |
524 |superClsCandidate| |
493 superClsCandidate := (Dialog |
525 superClsCandidate := (Dialog |
494 request: 'Enter name of superclass of private class.' |
526 request: 'Enter name of superclass of private class.' |
495 initialAnswer: 'Object') asSymbol. |
527 initialAnswer: 'Object') asSymbol. |
496 (Smalltalk at: superClsCandidate) isNil ifTrue: [^self warn: 'Class ', superClsCandidate asBoldText, ' does not exist!!']. |
528 (Smalltalk at: superClsCandidate) isNil ifTrue: [^self warn: 'Class ', superClsCandidate asBoldText, ' does not exist!!']. |
497 |
529 |
498 ((superClsCandidate := Smalltalk at: superClsCandidate) isClass and: [superClsCandidate isPrivate not]) |
530 ((superClsCandidate := Smalltalk at: superClsCandidate) isClass and: [superClsCandidate isPrivate not]) |
499 ifFalse: [^self warn: 'May not create private class with superclass ', superClsCandidate asBoldText, '!!']. |
531 ifFalse: [^self warn: 'May not create private class with superclass ', superClsCandidate asBoldText, '!!']. |
500 superClsCandidate subclass: clsCandidat |
532 superClsCandidate subclass: clsCandidat |
501 instanceVariableNames:'' |
533 instanceVariableNames:'' |
502 classVariableNames:'' |
534 classVariableNames:'' |
503 poolDictionaries:'' |
535 poolDictionaries:'' |
504 privateIn: cls |
536 privateIn: cls |
505 ]. |
537 ]. |
506 |
538 |
507 allClasses := Object withAllSubclasses. |
539 allClasses := Object withAllSubclasses. |
508 |
540 |
509 what = 'class' |
541 what = 'class' |
510 ifTrue: [self selectionOfClass value parent changed: #children] |
542 ifTrue: [self selectionOfClass value parent changed: #children] |
511 ifFalse: [self selectionOfClass value changed: #children]. |
543 ifFalse: [self selectionOfClass value changed: #children]. |
512 |
544 |
513 classSelectionBlock value: self valueOfClassName value |
545 classSelectionBlock value: self valueOfClassName value |
514 ! |
546 ! |
515 |
547 |
516 resourceDoubleClicked |
548 resourceDoubleClicked |
517 |
549 "after a double click on resource method, accept it and close" |
518 resourceMethod := self selectionOfResource value. |
550 |
519 accept value: true. |
551 accept value: true. |
|
552 |
520 self close |
553 self close |
521 ! |
554 ! |
522 |
555 |
523 resourceSelected |
556 resourceSelected |
524 |
557 "after a click on a resource method, set its selector into the field" |
525 resourceMethod := self selectionOfResource value. |
558 |
526 self selectionOfResource value notNil |
559 self selectionOfResourceMethod value notNil |
527 ifTrue: [self valueOfSelector value: self selectionOfResource value selector] |
560 ifTrue: [self valueOfResourceSelector value: self selectionOfResourceMethod value selector] |
528 ! ! |
561 ! ! |
529 |
562 |
530 !ResourceSelectionBrowser methodsFor:'instance creation'! |
563 !ResourceSelectionBrowser methodsFor:'instance creation'! |
531 |
564 |
532 openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withResourceTypes: aResourceTypes |
565 openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withResourceTypes: aResourceTypes |
|
566 "opens a ResourceSelectionBrowser on |
|
567 aSuperclassOrSymbol, |
|
568 and aClassOrSymbol, |
|
569 and aSelector, |
|
570 with allowed aResourceTypes" |
533 |
571 |
534 |clsName| |
572 |clsName| |
|
573 |
535 resourceMethod := aSelector. |
574 resourceMethod := aSelector. |
536 resourceTypes := aResourceTypes. |
575 resourceTypes := aResourceTypes. |
537 resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol]. |
576 resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol]. |
538 resourceClass := aClassOrSymbol isClass |
577 resourceClass := aClassOrSymbol isClass |
539 ifTrue: [aClassOrSymbol name] |
578 ifTrue: [aClassOrSymbol name] |
540 ifFalse: [(Smalltalk at: aClassOrSymbol) notNil |
579 ifFalse: [(Smalltalk at: aClassOrSymbol) notNil |
541 ifTrue: [aClassOrSymbol] |
580 ifTrue: [aClassOrSymbol] |
542 ifFalse: [nil]]. |
581 ifFalse: [nil]]. |
543 self valueOfSelector value:(aSelector ? ''). |
582 self valueOfResourceSelector value:(aSelector ? ''). |
544 |
583 |
545 self open. |
584 self open. |
546 |
585 |
547 (clsName := self selectionOfClass value) isNil ifTrue: [^nil]. |
586 (clsName := self selectionOfClass value) isNil ifTrue: [^nil]. |
548 clsName := (clsName name upTo: $ ) asSymbol. |
587 clsName := (clsName name upTo: $ ) asSymbol. |
549 |
588 |
550 ((Smalltalk at: clsName) isClass and: [accept value]) |
589 ((Smalltalk at: clsName) isClass and: [accept value]) |
551 ifTrue: |
590 ifTrue: |
552 [ |
591 [ |
553 ^clsName, ' ', self valueOfSelector value |
592 ^clsName, ' ', self valueOfResourceSelector value |
554 ]. |
593 ]. |
555 ^nil |
594 ^nil |
556 ! ! |
595 ! ! |
557 |
596 |
558 !ResourceSelectionBrowser methodsFor:'startup / release'! |
597 !ResourceSelectionBrowser methodsFor:'startup / release'! |
559 |
598 |
560 closeCancel |
599 closeCancel |
561 |
600 "after a cancel, terminate readResourcesProcess" |
562 resourceMethod := nil. |
601 |
563 classAndResourceSelectionProcess notNil ifTrue: [classAndResourceSelectionProcess terminate]. |
602 readResourcesProcess notNil ifTrue: [readResourcesProcess terminate]. |
|
603 |
564 super closeCancel |
604 super closeCancel |
565 |
605 |
566 |
606 |
567 |
607 |
568 ! |
608 ! |
569 |
609 |
570 postBuildWith:aBuilder |
610 postBuildWith:aBuilder |
571 |
611 "after building and before opening, |
572 |classSelection| |
612 create a class selection block, an entry completion block for the class name field, |
573 allClasses := Object withAllSubclasses. |
613 and select the class and the resource selector" |
|
614 |
|
615 |classSelection classNameInputField| |
|
616 |
|
617 allClasses := self treeViewContents withAllSubclasses reject: [:cls| cls isPrivate]. |
574 classSelection := resourceClass. |
618 classSelection := resourceClass. |
575 (Smalltalk at: classSelection) isNil |
619 (Smalltalk at: classSelection) isNil |
576 ifTrue: [classSelection := self class lastSelection]. |
620 ifTrue: [classSelection := self class lastSelection]. |
577 (Smalltalk at: classSelection) isNil |
621 (Smalltalk at: classSelection) isNil |
578 ifTrue: [classSelection := #Object]. |
622 ifTrue: [classSelection := self treeViewContents]. |
579 classSelectionBlock := |
623 classSelectionBlock := |
580 [:clsPattern| |
624 [:clsPattern| |
581 |foundClass classes| |
625 |foundClass classes| |
582 ((foundClass := Smalltalk at: clsPattern printString asSymbol) isClass not or: |
626 ((foundClass := Smalltalk at: clsPattern printString asSymbol) isClass not or: |
583 [foundClass name ~= clsPattern]) |
627 [foundClass name ~= clsPattern]) |
587 1 to: clsPattern size do: |
631 1 to: clsPattern size do: |
588 [:i| |
632 [:i| |
589 classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)]. |
633 classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)]. |
590 ]. |
634 ]. |
591 foundClass := classes at: 1 ifAbsent: [nil] |
635 foundClass := classes at: 1 ifAbsent: [nil] |
592 ]. |
636 ]. |
593 foundClass notNil |
637 foundClass notNil |
594 ifTrue: |
638 ifTrue: |
595 [|item| |
639 [ |
596 item := self listOfClasses |
640 |superClasses nonSuperclasses item| |
597 detectChild:[:child :arg| child contents == arg ] |
641 superClasses := foundClass withAllSuperclasses reverse. |
598 arguments:(foundClass withAllSuperclasses reverse). |
642 (nonSuperclasses := self treeViewContents allSuperclasses) notNil |
599 item notNil ifTrue:[ |
643 ifTrue: [superClasses := superClasses reject: [:cls| nonSuperclasses includes: cls]]. |
600 self selectionOfClass value:item |
644 item := self rootOfClasses detectItem:[:child :arg| child contents == arg] arguments:superClasses. |
601 ] |
645 item notNil ifTrue:[self selectionOfClass value:item] |
602 ]. |
646 ]. |
603 self valueOfClassName value: clsPattern |
647 self valueOfClassName value: clsPattern |
604 ]. |
648 ]. |
605 self valueOfClassName value: classSelection. |
649 self valueOfClassName value: classSelection. |
606 self classNameInputField entryCompletionBlock: |
650 |
|
651 (classNameInputField := builder componentAt: #classNameInputField) entryCompletionBlock: |
607 [:value| |
652 [:value| |
608 |what| |
653 |what| |
609 what := Smalltalk classnameCompletion: value withoutSpaces. |
654 what := Smalltalk classnameCompletion: value withoutSpaces. |
610 self classNameInputField contents:what first. |
655 classNameInputField contents:what first. |
611 (what at:2) size ~~ 1 ifTrue:[Display beep]. |
656 (what at:2) size ~~ 1 ifTrue:[Display beep]. |
612 classSelectionBlock value: self classNameInputField contents |
657 classSelectionBlock value: classNameInputField contents |
613 ]. |
658 ]. |
614 self listOfClassesView validateDoubleClickBlock: [:aTreeItem | aTreeItem contents ~~ self treeViewContents]. |
659 |
615 self listOfClassesView selectedNodeExpand: true. |
660 mayReadResources := false. |
616 |
661 classSelectionBlock value: classSelection. |
617 classAndResourceSelectionProcess := |
662 |
|
663 readResourcesProcess := |
618 [ |
664 [ |
619 [classSelectionBlock value: classSelection] value. |
665 mayReadResources := true. |
620 self selectionOfResource value: (self listOfResources detect: [:m| m selector == resourceMethod] ifNone: nil). |
666 self classSelected. |
621 classAndResourceSelectionProcess := nil |
667 self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil). |
622 ] |
668 readResourcesProcess := nil. |
623 forkAt: 4. |
669 ] forkAt: 4. |
624 |
670 |
625 ^super postBuildWith:aBuilder |
671 ^super postBuildWith:aBuilder |
626 |
672 |
627 ! ! |
673 ! ! |
628 |
674 |
629 !ResourceSelectionBrowser::Row methodsFor:'accessing'! |
675 !ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'! |
630 |
676 |
631 iconOn:aGC |
677 iconOn:aGC |
632 "register and answer an icon indicating the resource type." |
678 "registers and returns an icon indicating the resource type" |
633 |
679 |
634 self resourceType isNil ifTrue: [^nil]. |
680 self resourceType isNil ifTrue: [^nil]. |
635 icon isNil |
681 icon isNil |
636 ifTrue: |
682 ifTrue: |
637 [ |
683 [ |
638 |cls sel image imageKey| |
684 |cls sel image imageKey| |
639 ((self resourceType = #image) or: [resourceType = #fileImage]) |
685 ((self resourceType = #image) or: [resourceType = #fileImage]) |
640 ifTrue: |
686 ifTrue: |
641 [ |
687 [ |
642 cls := method who methodClass soleInstance. |
688 cls := method who methodClass soleInstance. |
643 sel := method who methodSelector. |
689 sel := method who methodSelector. |
644 ] |
690 ] |
645 ifFalse: |
691 ifFalse: |
646 [ |
692 [ |
647 cls := BrowserView. |
693 cls := BrowserView. |
648 sel := (resourceType, 'Icon') asSymbol. |
694 sel := (resourceType, 'Icon') asSymbol. |
649 ]. |
695 ]. |
650 imageKey := (cls name, sel) asSymbol. |
696 imageKey := (cls name, sel) asSymbol. |
651 (icon := aGC registeredImageAt: imageKey) isNil |
697 (icon := aGC registeredImageAt: imageKey) isNil |
652 ifTrue: |
698 ifTrue: |
653 [ |
699 [ |
654 image := cls perform: sel. |
700 image := cls perform: sel. |
655 image extent y > 18 |
701 image extent y > 18 |
656 ifTrue: |
702 ifTrue: |
657 [ |
703 [ |
658 image := image magnifiedBy: 18/image extent y |
704 image := image magnifiedBy: 18/image extent y |
659 ]. |
705 ]. |
660 aGC registerImage: image key: imageKey. |
706 aGC registerImage: image key: imageKey. |
661 icon := aGC registeredImageAt: imageKey. |
707 icon := aGC registeredImageAt: imageKey. |
662 ]. |
708 ]. |
663 ]. |
709 ]. |
664 ^icon |
710 ^icon |
665 ! |
711 ! |
666 |
712 |
667 method: aMethod |
713 method: aMethod |
|
714 "sets aMethod" |
668 |
715 |
669 method := aMethod |
716 method := aMethod |
670 ! |
717 ! |
671 |
718 |
672 resourceType |
719 resourceType |
|
720 "returns resourceType" |
673 |
721 |
674 resourceType isNil ifTrue: [resourceType := method resourceType]. |
722 resourceType isNil ifTrue: [resourceType := method resourceType]. |
675 ^resourceType |
723 ^resourceType |
676 ! |
724 ! |
677 |
725 |
678 selector |
726 selector |
|
727 "returns selector" |
679 |
728 |
680 selector isNil ifTrue: [selector := method who methodSelector]. |
729 selector isNil ifTrue: [selector := method who methodSelector]. |
681 ^selector |
730 ^selector |
682 ! ! |
731 ! ! |
683 |
732 |