70 |
69 |
71 !ResourceSelectionBrowser class methodsFor:'instance creation'! |
70 !ResourceSelectionBrowser class methodsFor:'instance creation'! |
72 |
71 |
73 request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withResourceTypes: resourceTypes |
72 request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withResourceTypes: resourceTypes |
74 "opens a ResourceSelectionBrowser |
73 "opens a ResourceSelectionBrowser |
75 with aTitle |
74 with aTitle |
76 on aSuperclassOrSymbol, |
75 on aSuperclassOrSymbol, |
77 and aClassOrSymbol, |
76 and aClassOrSymbol, |
78 and aSelector, |
77 and aSelector, |
79 with allowed aResourceTypes" |
78 with allowed aResourceTypes" |
80 " |
79 " |
81 ResourceSelectionBrowser |
80 ResourceSelectionBrowser |
82 request: 'Select a Resource Selector' |
81 request: 'Select a Resource Selector' |
83 onSuperclass: #ApplicationModel |
82 onSuperclass: #ApplicationModel |
84 andClass: #ToolApplicationModel |
83 andClass: #MenuEditor |
85 andSelector: #saveIcon |
84 andSelector: #menuItemImage |
86 withResourceTypes: #(image) |
85 withResourceTypes: #(image) |
87 " |
86 " |
88 |
87 |
89 ^self new |
88 ^self new |
90 title: aTitle; |
89 title: aTitle; |
91 openOnSuperclass: aSuperclass |
90 openOnSuperclass: aSuperclass |
92 andClass: aClass |
91 andClass: aClass |
93 andSelector: aSelector |
92 andSelector: aSelector |
94 withResourceTypes: resourceTypes |
93 withResourceTypes: resourceTypes |
95 ! ! |
94 ! ! |
96 |
95 |
97 !ResourceSelectionBrowser class methodsFor:'callbacks - default'! |
96 !ResourceSelectionBrowser class methodsFor:'callbacks - default'! |
98 |
97 |
99 treeViewChildren |
98 treeViewClassHierarchyChildren |
100 "returns the children for the contents (class) of aTreeItem as a block" |
99 "returns the children for the contents (class) of aTreeItem as a block" |
101 |
100 |
102 ^[:aTreeItem| |
101 ^[:aTreeItem| |
103 |classes| |
102 |classes| |
104 classes := OrderedCollection new. |
103 classes := OrderedCollection new. |
105 classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:i1 :i2| i1 name < i2 name]). |
104 classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]). |
106 classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:i1 :i2| i1 name < i2 name]). |
105 classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]). |
107 classes |
106 classes |
108 ] |
107 ] |
109 ! |
108 ! |
110 |
109 |
111 treeViewContents |
110 treeViewClassHierarchyContents |
112 "returns the default contents of the root of the class tree list" |
111 "returns the default contents of the root of the class tree list" |
113 |
112 |
114 ^ Object |
113 ^ Object |
115 |
114 |
116 "Modified: / 22.4.1998 / 14:44:11 / cg" |
115 ! |
117 ! |
116 |
118 |
117 treeViewClassHierarchyIcon |
119 treeViewIcon |
|
120 "returns the icon for aTreeItem as a block" |
118 "returns the icon for aTreeItem as a block" |
121 |
119 |
122 ^[:aTreeItem| |
120 ^[:aTreeItem| |
123 |icon| |
121 |icon| |
124 icon := self iconClass. |
122 aTreeItem contents isClass |
125 aTreeItem contents isPrivate |
123 ifTrue: |
126 ifTrue: |
124 [ |
127 [ |
125 icon := self iconClass. |
128 icon := self iconPrivateClass |
126 aTreeItem contents isPrivate |
129 ]. |
127 ifTrue: |
130 icon |
128 [ |
|
129 icon := self iconPrivateClass |
|
130 ]. |
|
131 icon |
|
132 ] |
|
133 ifFalse: |
|
134 [ |
|
135 self iconCategory |
|
136 ] |
131 ] |
137 ] |
132 |
138 |
133 ! |
139 ! |
134 |
140 |
135 treeViewLabel |
141 treeViewClassHierarchyLabel |
136 "returns the label for aTreeItem as a block" |
142 "returns the label for aTreeItem as a block" |
137 |
143 |
138 ^[:aTreeItem| |
144 ^[:aTreeItem| |
139 |label superCls| |
145 |label superCls| |
140 label := aTreeItem contents name. |
146 label := aTreeItem contents name. |
141 (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)]) |
147 (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)]) |
142 ifTrue: [label := label, ' (', superCls name, ')']. |
148 ifTrue: [label := label, ' (', superCls name, ')']. |
143 label |
149 label |
144 ] |
150 ] |
145 |
151 |
146 |
152 |
147 ! ! |
153 ! ! |
148 |
154 |
149 !ResourceSelectionBrowser class methodsFor:'image specs'! |
155 !ResourceSelectionBrowser class methodsFor:'image specs'! |
|
156 |
|
157 iconCategory |
|
158 "This resource specification was automatically generated |
|
159 by the ImageEditor of ST/X." |
|
160 |
|
161 "Do not manually edit this!! If it is corrupted, |
|
162 the ImageEditor may not be able to read the specification." |
|
163 |
|
164 " |
|
165 self iconCategory inspect |
|
166 ImageEditor openOnClass:self andSelector:#iconCategory |
|
167 " |
|
168 |
|
169 <resource: #image> |
|
170 |
|
171 ^Icon |
|
172 constantNamed:#'ResourceSelectionBrowser iconCategory' |
|
173 ifAbsentPut:[(Depth4Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'3L0@@@@@@L3L3L@@@@@@@@3L3@@3L3L3L0CL3@LQDQDQD#CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@L#L3L3L3CL3@@3L3L3L0CL3L@@@@@@@@3L3L0@@@@@@L3L') ; colorMapFromArray:#[0 0 0 255 255 255 170 170 170 127 127 127 255 0 0 0 255 0 0 0 255 0 255 255 255 255 0 255 0 255 127 0 0 0 127 0 0 0 127 0 127 127 127 127 0 127 0 127]; mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'<@O@8@G@3?3@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@3?3@8@G@<@O@') ; yourself); yourself]! |
150 |
174 |
151 iconClass |
175 iconClass |
152 "This resource specification was automatically generated |
176 "This resource specification was automatically generated |
153 by the ImageEditor of ST/X." |
177 by the ImageEditor of ST/X." |
154 |
178 |
227 #name: 'Box1' |
251 #name: 'Box1' |
228 #component: |
252 #component: |
229 #(#SpecCollection |
253 #(#SpecCollection |
230 #collection: |
254 #collection: |
231 #( |
255 #( |
232 #(#LabelSpec |
256 #(#HorizontalPanelViewSpec |
233 #name: 'ClassHierarchyLabel' |
257 #name: 'HorizontalPanel2' |
234 #layout: #(#LayoutFrame 0 0.0 2 0 0 1.0 23 0) |
258 #layout: #(#LayoutFrame 0 0 2 0 297 0 23 0) |
235 #label: ' Class Hierarchy:' |
259 #component: |
236 #level: 1 |
260 #(#SpecCollection |
237 #adjust: #left |
261 #collection: |
|
262 #( |
|
263 #(#RadioButtonSpec |
|
264 #name: 'ClassCategoriesRadioButton' |
|
265 #label: 'Class Categories' |
|
266 #translateLabel: true |
|
267 #model: #selectionOfClassPresentation |
|
268 #isTriggerOnDown: true |
|
269 #lampColor: #(#Color 0.0 0.0 0.0) |
|
270 #select: #'Class Categories' |
|
271 #extent: #(#Point 150 21) |
|
272 ) |
|
273 #(#RadioButtonSpec |
|
274 #name: 'ClassHierarchyRadioButton' |
|
275 #label: 'Class Hierarchy' |
|
276 #translateLabel: true |
|
277 #model: #selectionOfClassPresentation |
|
278 #isTriggerOnDown: true |
|
279 #lampColor: #(#Color 0.0 0.0 0.0) |
|
280 #select: #'Class Hierarchy' |
|
281 #extent: #(#Point 145 21) |
|
282 ) |
|
283 ) |
|
284 ) |
|
285 #horizontalLayout: #leftSpace |
|
286 #verticalLayout: #fit |
|
287 #horizontalSpace: 3 |
|
288 #verticalSpace: 3 |
238 ) |
289 ) |
239 #(#SelectionInTreeViewSpec |
290 #(#SelectionInTreeViewSpec |
240 #name: 'listOfClassesView' |
291 #name: 'listOfClassHierarchyView' |
241 #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -60 1.0) |
292 #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -60 1.0) |
242 #tabable: true |
293 #tabable: true |
243 #model: #selectionOfClass |
294 #model: #selectionOfClassHierarchy |
244 #hasHorizontalScrollBar: true |
295 #hasHorizontalScrollBar: true |
245 #hasVerticalScrollBar: true |
296 #hasVerticalScrollBar: true |
246 #miniScrollerHorizontal: true |
297 #miniScrollerHorizontal: true |
247 #showDirectoryIndicatorForRoot: false |
298 #showDirectoryIndicatorForRoot: false |
248 #showDirectoryIndicator: true |
299 #showDirectoryIndicator: true |
249 #valueChangeSelector: #classSelected |
300 #valueChangeSelector: #classSelected |
250 #hierarchicalList: #rootOfClasses |
301 #hierarchicalList: #rootOfClassHierarchy |
251 #validateDoubleClickSelector: #validateDoubleClick: |
302 #validateDoubleClickSelector: #validateDoubleClick: |
252 #contentsSelector: #treeViewContents |
303 #contentsSelector: #treeViewClassHierarchyContents |
253 #labelSelector: #treeViewLabel |
304 #labelSelector: #treeViewClassHierarchyLabel |
254 #childrenSelector: #treeViewChildren |
305 #childrenSelector: #treeViewClassHierarchyChildren |
255 #iconSelector: #treeViewIcon |
306 #iconSelector: #treeViewClassHierarchyIcon |
|
307 ) |
|
308 #(#SelectionInTreeViewSpec |
|
309 #name: 'listOfClassCategoriesView' |
|
310 #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -60 1.0) |
|
311 #tabable: true |
|
312 #model: #selectionOfClassCategories |
|
313 #hasHorizontalScrollBar: true |
|
314 #hasVerticalScrollBar: true |
|
315 #miniScrollerHorizontal: true |
|
316 #showDirectoryIndicatorForRoot: false |
|
317 #showDirectoryIndicator: true |
|
318 #valueChangeSelector: #classSelected |
|
319 #hierarchicalList: #rootOfClassCategories |
|
320 #validateDoubleClickSelector: #validateDoubleClick: |
|
321 #childrenSelector: #treeViewClassCategoryChildren |
|
322 #iconSelector: #treeViewClassCategoryIcon |
256 ) |
323 ) |
257 #(#InputFieldSpec |
324 #(#InputFieldSpec |
258 #name: 'classNameInputField' |
325 #name: 'classNameInputField' |
259 #layout: #(#LayoutFrame 2 0.0 -58 1 -1 1.0 -36 1) |
326 #layout: #(#LayoutFrame 2 0.0 -58 1 -1 1.0 -36 1) |
260 #tabable: true |
327 #tabable: true |
261 #model: #valueOfClassName |
328 #model: #valueOfClassName |
262 ) |
|
263 #(#HorizontalPanelViewSpec |
|
264 #name: 'HorizontalPanelView' |
|
265 #layout: #(#LayoutFrame 0 0.0 -28 1 0 1.0 -4 1) |
|
266 #component: |
|
267 #(#SpecCollection |
|
268 #collection: |
|
269 #( |
|
270 #(#LabelSpec |
|
271 #name: 'CreateLabel' |
|
272 #label: 'Create: ' |
|
273 #adjust: #right |
|
274 #extent: #(#Point 72 24) |
|
275 ) |
|
276 #(#ActionButtonSpec |
|
277 #name: 'CreateClassButton' |
|
278 #activeHelpKey: #dss |
|
279 #label: 'Class' |
|
280 #model: #createClass: |
|
281 #actionValue: 'class' |
|
282 #extent: #(#Point 72 24) |
|
283 ) |
|
284 #(#ActionButtonSpec |
|
285 #name: 'CreateSubclassButton' |
|
286 #activeHelpKey: #dss |
|
287 #label: 'Subclass' |
|
288 #model: #createClass: |
|
289 #actionValue: 'subclass' |
|
290 #extent: #(#Point 72 24) |
|
291 ) |
|
292 #(#ActionButtonSpec |
|
293 #name: 'CreatePrivateClassButton' |
|
294 #activeHelpKey: #dss |
|
295 #label: 'Private' |
|
296 #model: #createClass: |
|
297 #actionValue: 'private' |
|
298 #extent: #(#Point 73 24) |
|
299 ) |
|
300 ) |
|
301 ) |
|
302 #horizontalLayout: #fit |
|
303 #verticalLayout: #fit |
|
304 ) |
329 ) |
305 ) |
330 ) |
306 ) |
331 ) |
307 ) |
332 ) |
308 #(#ViewSpec |
333 #(#ViewSpec |
331 #name: 'selectorInputField' |
357 #name: 'selectorInputField' |
332 #layout: #(#LayoutFrame 2 0.0 -58 1 -2 1.0 -36 1) |
358 #layout: #(#LayoutFrame 2 0.0 -58 1 -2 1.0 -36 1) |
333 #tabable: true |
359 #tabable: true |
334 #model: #valueOfResourceSelector |
360 #model: #valueOfResourceSelector |
335 ) |
361 ) |
336 #(#HorizontalPanelViewSpec |
|
337 #name: 'HorizontalPanel1' |
|
338 #layout: #(#LayoutFrame 2 0.0 -28 1 -2 1.0 -4 1.0) |
|
339 #component: |
|
340 #(#SpecCollection |
|
341 #collection: |
|
342 #( |
|
343 #(#ActionButtonSpec |
|
344 #name: 'HelpButton' |
|
345 #activeHelpKey: #dss |
|
346 #label: 'Help' |
|
347 #model: #openHTMLDocument: |
|
348 #initiallyDisabled: true |
|
349 #enableChannel: #helpEnabled |
|
350 #actionValue: 'tools/uipainter/ResourceSelectionBrowser.html' |
|
351 #extent: #(#Point 96 24) |
|
352 ) |
|
353 #(#ActionButtonSpec |
|
354 #name: 'cancelButton' |
|
355 #activeHelpKey: #commitCancel |
|
356 #label: 'Cancel' |
|
357 #tabable: true |
|
358 #model: #cancel |
|
359 #extent: #(#Point 96 24) |
|
360 ) |
|
361 #(#ActionButtonSpec |
|
362 #name: 'okButton' |
|
363 #activeHelpKey: #commitOK |
|
364 #label: 'OK' |
|
365 #tabable: true |
|
366 #model: #accept |
|
367 #isDefault: true |
|
368 #extent: #(#Point 96 24) |
|
369 ) |
|
370 ) |
|
371 ) |
|
372 #horizontalLayout: #fit |
|
373 #verticalLayout: #fit |
|
374 ) |
|
375 ) |
362 ) |
376 ) |
363 ) |
377 ) |
364 ) |
378 ) |
365 ) |
379 ) |
366 ) |
380 #handles: #(#Any 0.5 1.0) |
367 #handles: #(#Any 0.5 1.0) |
|
368 ) |
|
369 #(#HorizontalPanelViewSpec |
|
370 #name: 'HorizontalPanel1' |
|
371 #layout: #(#LayoutFrame 2 0.0 -30 1 -2 1.0 -4 1.0) |
|
372 #component: |
|
373 #(#SpecCollection |
|
374 #collection: |
|
375 #( |
|
376 #(#ActionButtonSpec |
|
377 #name: 'HelpButton' |
|
378 #activeHelpKey: #dss |
|
379 #label: 'Help' |
|
380 #model: #openHTMLDocument: |
|
381 #initiallyDisabled: true |
|
382 #enableChannel: #helpEnabled |
|
383 #actionValue: 'tools/uipainter/ResourceSelectionBrowser.html' |
|
384 #extent: #(#Point 196 26) |
|
385 ) |
|
386 #(#ActionButtonSpec |
|
387 #name: 'cancelButton' |
|
388 #activeHelpKey: #commitCancel |
|
389 #label: 'Cancel' |
|
390 #tabable: true |
|
391 #model: #cancel |
|
392 #extent: #(#Point 196 26) |
|
393 ) |
|
394 #(#ActionButtonSpec |
|
395 #name: 'okButton' |
|
396 #activeHelpKey: #commitOK |
|
397 #label: 'OK' |
|
398 #tabable: true |
|
399 #model: #accept |
|
400 #isDefault: true |
|
401 #extent: #(#Point 196 24) |
|
402 ) |
|
403 ) |
|
404 ) |
|
405 #horizontalLayout: #fit |
|
406 #verticalLayout: #fit |
381 ) |
407 ) |
382 ) |
408 ) |
383 ) |
409 ) |
384 ) |
410 ) |
385 ! ! |
411 ! ! |
449 holder addAll: (self class tableColumnsForResourceMethodAttributes collect: [:i| i decodeAsLiteralArray]). |
475 holder addAll: (self class tableColumnsForResourceMethodAttributes collect: [:i| i decodeAsLiteralArray]). |
450 ]. |
476 ]. |
451 ^ holder |
477 ^ holder |
452 ! |
478 ! |
453 |
479 |
454 rootOfClasses |
480 rootOfClassCategories |
455 "returns the value holder for the root of the class tree list" |
481 "returns the value holder for the root of the class tree list" |
456 |
482 |
|
483 |holder| |
|
484 |
|
485 (holder := builder bindingAt:#rootOfClassCategories) isNil ifTrue:[ |
|
486 ClassPresentation = #'Class Categories' ifTrue: [ |
|
487 builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')]. |
|
488 ]. |
|
489 ^ holder |
|
490 |
|
491 |
|
492 ! |
|
493 |
|
494 rootOfClassHierarchy |
|
495 "returns the value holder for the root of the class tree list" |
|
496 |
457 |holder| |
497 |holder| |
458 (holder := builder bindingAt:#rootOfClasses) isNil ifTrue:[ |
498 |
459 builder aspectAt:#rootOfClasses put: (holder := TreeItem new) |
499 |
460 ]. |
500 (holder := builder bindingAt:#rootOfClassHierarchy) isNil ifTrue:[ |
461 ^ holder |
501 ClassPresentation = #'Class Hierarchy' ifTrue: [ |
462 |
502 builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)] |
463 |
503 ]. |
464 ! |
504 ^ holder |
465 |
505 |
466 selectionOfClass |
506 |
|
507 ! |
|
508 |
|
509 selectionOfClassCategories |
467 "returns the value holder for the selected class of the class tree list" |
510 "returns the value holder for the selected class of the class tree list" |
468 |
511 |
|
512 |holder| |
|
513 (holder := builder bindingAt:#selectionOfClassCategories) isNil ifTrue:[ |
|
514 builder aspectAt:#selectionOfClassCategories put:(holder := ValueHolder new). |
|
515 ]. |
|
516 ^ holder |
|
517 ! |
|
518 |
|
519 selectionOfClassHierarchy |
|
520 "returns the value holder for the selected class of the class tree list" |
|
521 |
|
522 |holder| |
|
523 (holder := builder bindingAt:#selectionOfClassHierarchy) isNil ifTrue:[ |
|
524 builder aspectAt:#selectionOfClassHierarchy put:(holder := ValueHolder new). |
|
525 ]. |
|
526 ^ holder |
|
527 ! |
|
528 |
|
529 selectionOfClassPresentation |
|
530 "returns the value holder for the selected class presentation" |
|
531 |
469 |holder| |
532 |holder| |
470 (holder := builder bindingAt:#selectionOfClass) isNil ifTrue:[ |
533 (holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[ |
471 builder aspectAt:#selectionOfClass put:(holder := ValueHolder new). |
534 builder aspectAt:#selectionOfClassPresentation put:(holder := RadioButtonGroup with: (ClassPresentation := ClassPresentation ? #'Class Categories')). |
|
535 holder onChangeSend: #value to: [holder value = #'Class Hierarchy' |
|
536 ifTrue: [ClassPresentation := holder value.(builder componentAt: #listOfClassHierarchyView) root: self rootOfClassHierarchy. (builder componentAt: #listOfClassHierarchyView) raise. classSelectionBlock value: self valueOfClassName value] |
|
537 ifFalse: [ClassPresentation := holder value.(builder componentAt: #listOfClassCategoriesView) root: self rootOfClassCategories. (builder componentAt: #listOfClassCategoriesView) raise. classSelectionBlock value: self valueOfClassName value]] |
472 ]. |
538 ]. |
473 ^ holder |
539 ^ holder |
474 ! |
540 ! |
475 |
541 |
476 selectionOfResourceMethod |
542 selectionOfResourceMethod |
503 ^ holder |
569 ^ holder |
504 ! ! |
570 ! ! |
505 |
571 |
506 !ResourceSelectionBrowser methodsFor:'callbacks - class list'! |
572 !ResourceSelectionBrowser methodsFor:'callbacks - class list'! |
507 |
573 |
508 treeViewContents |
574 treeViewClassCategoryChildren |
|
575 "returns the children for the contents (class) of aTreeItem as a block" |
|
576 |
|
577 ^[:aTreeItem| |
|
578 |children| |
|
579 children := OrderedCollection new. |
|
580 aTreeItem contents = '' |
|
581 ifTrue: |
|
582 [ |
|
583 children := (self treeViewClassHierarchyContents withAllSubclasses collect: [:cls| cls category]) asSet asSortedCollection. |
|
584 children := children collect: [:child| TreeItem name: child contents: 'Category'] |
|
585 ]. |
|
586 aTreeItem contents = 'Category' |
|
587 ifTrue: |
|
588 [ |
|
589 children := self treeViewClassHierarchyContents withAllSubclasses select: [:cls| cls category = aTreeItem name and: [cls isPrivate not]]. |
|
590 children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name]. |
|
591 children := children collect: [:child| TreeItem name: child name contents: child] |
|
592 ]. |
|
593 aTreeItem contents isClass |
|
594 ifTrue: |
|
595 [ |
|
596 children := aTreeItem contents privateClasses. |
|
597 children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name]. |
|
598 children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child] |
|
599 ]. |
|
600 children |
|
601 ] |
|
602 |
|
603 |
|
604 ! |
|
605 |
|
606 treeViewClassCategoryIcon |
|
607 "returns the icon for aTreeItem as a block" |
|
608 |
|
609 ^self class treeViewClassHierarchyIcon |
|
610 |
|
611 |
|
612 ! |
|
613 |
|
614 treeViewClassHierarchyContents |
509 "returns the contents of the root of the class tree list" |
615 "returns the contents of the root of the class tree list" |
510 |
616 |
511 |cls| |
617 |cls| |
512 |
618 |
513 resourceSuperclass notNil ifTrue:[ |
619 resourceSuperclass notNil ifTrue:[ |
514 cls := Smalltalk at: resourceSuperclass. |
620 cls := Smalltalk at: resourceSuperclass. |
515 ]. |
621 ]. |
516 ^ cls ? self class treeViewContents |
622 ^ cls ? self class treeViewClassHierarchyContents |
517 |
623 |
518 "Modified: / 22.4.1998 / 14:43:19 / cg" |
624 "Modified: / 22.4.1998 / 14:43:19 / cg" |
519 ! |
625 ! |
520 |
626 |
521 validateDoubleClick: aTreeItem |
627 validateDoubleClick: aTreeItem |
522 "returns whether a class may be selected" |
628 "returns whether a class may be selected" |
523 |
629 |
524 ^aTreeItem contents ~~ self treeViewContents |
630 ^aTreeItem contents ~= '' and: [aTreeItem contents ~~ self treeViewClassHierarchyContents] |
525 |
631 |
526 |
632 |
527 |
633 |
528 ! ! |
634 ! ! |
529 |
635 |
530 !ResourceSelectionBrowser methodsFor:'callbacks - user'! |
636 !ResourceSelectionBrowser methodsFor:'callbacks - user'! |
531 |
637 |
532 classSelected |
638 classSelected |
533 "after a class selection, read the allowed resource methods of the selected class" |
639 "after a class selection, read the allowed resource methods of the selected class" |
534 |
640 |
535 (mayReadResources not or: [self selectionOfClass value isNil]) ifTrue: [^nil]. |
641 ClassPresentation = #'Class Hierarchy' |
|
642 ifTrue: [self selectionOfClassHierarchy value isNil ifTrue: [^nil]] |
|
643 ifFalse: [self selectionOfClassCategories value isNil ifTrue: [^nil]]. |
|
644 |
536 self withWaitCursorDo: |
645 self withWaitCursorDo: |
537 [ |
646 [ |
538 |clsName| |
647 |clsName| |
539 resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes]. |
648 resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes]. |
540 clsName := (self selectionOfClass value name upTo: $ ) asSymbol. |
649 |
|
650 ClassPresentation = #'Class Hierarchy' |
|
651 ifTrue: [clsName := (self selectionOfClassHierarchy value name upTo: $ ) asSymbol] |
|
652 ifFalse: [clsName := (self selectionOfClassCategories value name upTo: $ ) asSymbol]. |
|
653 |
541 self valueOfClassName value: clsName. |
654 self valueOfClassName value: clsName. |
542 self class lastSelection: clsName. |
655 self class lastSelection: clsName. |
543 self listOfResourceMethods contents: |
656 self listOfResourceMethods contents: |
544 ((((Smalltalk at: clsName) |
657 ((((Smalltalk at: clsName) |
545 class methodDictionary |
658 class methodDictionary |
547 [:m| m resources notNil and: [resourceTypes includes: m resourceType]])) |
660 [:m| m resources notNil and: [resourceTypes includes: m resourceType]])) |
548 collect: [:m| (ResourceMethod new method: m)]). |
661 collect: [:m| (ResourceMethod new method: m)]). |
549 ] |
662 ] |
550 ! |
663 ! |
551 |
664 |
552 createClass: what |
|
553 "creates a class, a subclass, or a private class of the selected class" |
|
554 |
|
555 |clsCandidat cls| |
|
556 |
|
557 clsCandidat := self valueOfClassName value asSymbol. |
|
558 |
|
559 (Smalltalk at: clsCandidat) notNil |
|
560 ifTrue: [^self warn: 'Cannot create class ', clsCandidat asBoldText, |
|
561 '!!\Key with that name in dictionary ' withCRs, 'Smalltalk' asBoldText, ' detected.']. |
|
562 |
|
563 cls := self selectionOfClass value contents. |
|
564 what = 'class' ifTrue: [cls := cls superclass]. |
|
565 |
|
566 cls isNil ifTrue: [^self warn: 'May not create class with superclass ', 'nil' asBoldText, '!!']. |
|
567 |
|
568 what = 'private' |
|
569 ifFalse: |
|
570 [ |
|
571 cls subclass: clsCandidat |
|
572 instanceVariableNames:'' |
|
573 classVariableNames:'' |
|
574 poolDictionaries:'' |
|
575 category: cls category |
|
576 ] |
|
577 ifTrue: |
|
578 [ |
|
579 |superClsCandidate| |
|
580 superClsCandidate := (Dialog |
|
581 request: 'Enter name of superclass of private class.' |
|
582 initialAnswer: 'Object') asSymbol. |
|
583 (Smalltalk at: superClsCandidate) isNil ifTrue: [^self warn: 'Class ', superClsCandidate asBoldText, ' does not exist!!']. |
|
584 |
|
585 ((superClsCandidate := Smalltalk at: superClsCandidate) isClass and: [superClsCandidate isPrivate not]) |
|
586 ifFalse: [^self warn: 'May not create private class with superclass ', superClsCandidate asBoldText, '!!']. |
|
587 superClsCandidate subclass: clsCandidat |
|
588 instanceVariableNames:'' |
|
589 classVariableNames:'' |
|
590 poolDictionaries:'' |
|
591 privateIn: cls |
|
592 ]. |
|
593 |
|
594 allClasses := Object withAllSubclasses. |
|
595 |
|
596 what = 'class' |
|
597 ifTrue: [self selectionOfClass value parent changed: #children] |
|
598 ifFalse: [self selectionOfClass value changed: #children]. |
|
599 |
|
600 classSelectionBlock value: self valueOfClassName value |
|
601 ! |
|
602 |
|
603 resourceDoubleClicked |
665 resourceDoubleClicked |
604 "after a double click on resource method, accept it and close" |
666 "after a double click on resource method, accept it and close" |
605 |
667 |
606 accept value: true. |
668 accept value: true. |
607 |
669 |
656 "Modified: / 22.4.1998 / 14:51:03 / cg" |
720 "Modified: / 22.4.1998 / 14:51:03 / cg" |
657 ! ! |
721 ! ! |
658 |
722 |
659 !ResourceSelectionBrowser methodsFor:'startup / release'! |
723 !ResourceSelectionBrowser methodsFor:'startup / release'! |
660 |
724 |
661 closeCancel |
|
662 "after a cancel, terminate readResourcesProcess" |
|
663 |
|
664 readResourcesProcess notNil ifTrue: [readResourcesProcess terminate]. |
|
665 |
|
666 super closeCancel |
|
667 |
|
668 |
|
669 |
|
670 ! |
|
671 |
|
672 postBuildWith:aBuilder |
725 postBuildWith:aBuilder |
673 "after building and before opening, |
726 "after building and before opening, |
674 create a class selection block, an entry completion block for the class name field, |
727 create a class selection block, an entry completion block for the class name field" |
675 and select the class and the resource selector" |
|
676 |
728 |
677 |classSelection classNameInputField| |
729 |classSelection classNameInputField| |
678 |
730 |
679 allClasses := self treeViewContents withAllSubclasses reject: [:cls| cls isPrivate]. |
731 allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate]. |
680 classSelection := resourceClass. |
732 classSelection := resourceClass. |
681 |
733 |
682 (classSelection isNil or:[Smalltalk at: classSelection]) isNil |
734 (classSelection isNil or:[Smalltalk at: classSelection]) isNil |
683 ifTrue: [classSelection := self class lastSelection]. |
735 ifTrue: [classSelection := self class lastSelection]. |
684 (classSelection isNil or:[Smalltalk at: classSelection]) isNil |
736 (classSelection isNil or:[Smalltalk at: classSelection]) isNil |
701 ]. |
753 ]. |
702 foundClass := classes at: 1 ifAbsent: [nil] |
754 foundClass := classes at: 1 ifAbsent: [nil] |
703 ]. |
755 ]. |
704 foundClass notNil |
756 foundClass notNil |
705 ifTrue: |
757 ifTrue: |
706 [ |
758 [ |
707 |superClasses nonSuperclasses item cls| |
759 ClassPresentation = #'Class Hierarchy' |
708 ((cls := Smalltalk at: classSelection) notNil and: [cls isPrivate]) |
760 ifTrue: |
709 ifFalse: [superClasses := foundClass withAllSuperclasses reverse] |
761 [ |
710 ifTrue: [superClasses := cls owningClass withAllSuperclasses reverse. superClasses add: cls] |
762 |searchArgs nonSuperclasses| |
711 . |
763 foundClass isPrivate |
712 (nonSuperclasses := self treeViewContents allSuperclasses) notNil |
764 ifFalse: [searchArgs := foundClass withAllSuperclasses reverse] |
713 ifTrue: [superClasses := superClasses reject: [:cls| nonSuperclasses includes: cls]]. |
765 ifTrue: [searchArgs := foundClass owningClass withAllSuperclasses reverse. searchArgs add: foundClass] |
714 item := self rootOfClasses detectChild:[:child :arg| child contents == arg] arguments:superClasses. |
766 . |
715 item notNil ifTrue:[self selectionOfClass value:item] |
767 (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil |
|
768 ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]]. |
|
769 |
|
770 self selectionOfClassHierarchy value: (self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs). |
|
771 ] |
|
772 ifFalse: |
|
773 [ |
|
774 |searchArgs| |
|
775 foundClass isPrivate |
|
776 ifTrue: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass owningClass name with: foundClass name] |
|
777 ifFalse: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass name]. |
|
778 |
|
779 self selectionOfClassCategories value: (self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs). |
|
780 ]. |
716 ]. |
781 ]. |
717 self valueOfClassName value: clsPattern |
782 self valueOfClassName value: clsPattern |
718 ]. |
783 ]. |
719 self valueOfClassName value: classSelection. |
784 self valueOfClassName value: classSelection. |
720 |
785 |
721 (classNameInputField := builder componentAt: #classNameInputField) entryCompletionBlock: |
786 (classNameInputField := builder componentAt: #classNameInputField) entryCompletionBlock: |
722 [:value| |
787 [:value| |
723 |what| |
788 |what oldClassName| |
|
789 oldClassName := classNameInputField contents. |
724 what := Smalltalk classnameCompletion: value withoutSpaces. |
790 what := Smalltalk classnameCompletion: value withoutSpaces. |
725 classNameInputField contents:what first. |
791 classNameInputField contents:what first. |
726 (what at:2) size ~~ 1 ifTrue:[Screen current beep]. |
792 oldClassName = classNameInputField contents ifTrue:[classNameInputField flash]. |
727 classSelectionBlock value: classNameInputField contents |
793 classSelectionBlock value: classNameInputField contents |
728 ]. |
794 ]. |
729 |
795 |
730 mayReadResources := false. |
|
731 classSelectionBlock value: classSelection. |
|
732 |
|
733 readResourcesProcess := |
|
734 [ |
|
735 mayReadResources := true. |
|
736 self classSelected. |
|
737 self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil). |
|
738 readResourcesProcess := nil. |
|
739 ] forkAt: 4. |
|
740 |
|
741 ^super postBuildWith:aBuilder |
796 ^super postBuildWith:aBuilder |
742 |
797 |
743 "Modified: / 22.4.1998 / 14:48:22 / cg" |
798 ! |
|
799 |
|
800 postOpenWith:aBuilder |
|
801 "after opening, raise the the view do select class and resource method" |
|
802 |
|
803 ClassPresentation = #'Class Hierarchy' |
|
804 ifTrue: [(builder componentAt: #listOfClassHierarchyView) raise]. |
|
805 |
|
806 classSelectionBlock value: self valueOfClassName value. |
|
807 self classSelected. |
|
808 self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil). |
744 ! ! |
809 ! ! |
745 |
810 |
746 !ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'! |
811 !ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'! |
747 |
812 |
748 iconOn:aGC |
813 iconOn:aGC |