--- a/MethodSelectionBrowser.st Wed Feb 25 23:21:00 1998 +0100
+++ b/MethodSelectionBrowser.st Wed Feb 25 23:26:47 1998 +0100
@@ -110,7 +110,7 @@
[
|clsName|
resourceTypes isNil ifTrue: [resourceTypes := #(instance class)].
- clsName := self listOfClassesView list at: anIndex.
+ clsName := ((self listOfClassesView list at: anIndex) upTo: $ ) asSymbol.
self valueOfClassName value: clsName.
self class lastSelection: clsName.
(resourceTypes includes: #instance) ifTrue: [
--- a/ResourceSelectionBrowser.st Wed Feb 25 23:21:00 1998 +0100
+++ b/ResourceSelectionBrowser.st Wed Feb 25 23:26:47 1998 +0100
@@ -13,7 +13,7 @@
SelectionBrowser subclass:#ResourceSelectionBrowser
instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
- allClasses'
+ allClasses classSelectionBlock'
classVariableNames:''
poolDictionaries:''
category:'Interface-Dialogs'
@@ -78,7 +78,12 @@
treeViewChildren
- ^[:aTreeItem| aTreeItem contents subclasses asSortedCollection: [:i1 :i2| i1 name < i2 name]]
+ ^[:aTreeItem|
+ |classes|
+ classes := OrderedCollection new.
+ classes
+ addAll: (aTreeItem contents subclasses asSortedCollection: [:i1 :i2| i1 name < i2 name]);
+ yourself]
!
@@ -93,18 +98,7 @@
treeViewIcon
- ^[:aTreeItem|
- aTreeItem contents subclasses notEmpty
- ifTrue:
- [
- aTreeItem hide
- ifTrue: [self iconHidingSubclasses]
- ifFalse: [self iconShowingSubclasses]]
- ifFalse:
- [
- self iconClass
- ]
- ]
+ ^[self iconClass]
!
@@ -135,11 +129,11 @@
#window:
#(#WindowSpec
#name: 'Resource Selection Browser'
- #layout: #(#LayoutFrame 155 0 154 0 754 0 503 0)
+ #layout: #(#LayoutFrame 197 0 172 0 796 0 521 0)
#label: 'Resource Selection Browser'
#min: #(#Point 400 300)
#max: #(#Point 1152 864)
- #bounds: #(#Rectangle 155 154 755 504)
+ #bounds: #(#Rectangle 197 172 797 522)
#usePreferredExtent: false
)
#component:
@@ -161,7 +155,7 @@
#(
#(#SelectionInTreeViewSpec
#name: 'listOfClassesView'
- #layout: #(#LayoutFrame 0 0.0 22 0.0 0 1.0 -22 1.0)
+ #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -22 1.0)
#model: #selectionOfClass
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
@@ -181,8 +175,8 @@
#model: #valueOfClassName
)
#(#LabelSpec
- #name: 'Label1'
- #layout: #(#LayoutFrame 0 0 0 0 297 0 22 0)
+ #name: 'ClassHierarchyLabel'
+ #layout: #(#LayoutFrame 0 0 2 0 297 0 23 0)
#label: ' Class Hierarchy'
#level: 1
#adjust: #left
@@ -198,7 +192,7 @@
#(
#(#DataSetSpec
#name: 'resourcesDataSetView'
- #layout: #(#LayoutFrame 2 0.0 0 0.0 -2 1.0 -22 1.0)
+ #layout: #(#LayoutFrame 2 0.0 2 0.0 -2 1.0 -22 1.0)
#model: #selectionOfResource
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
@@ -226,10 +220,52 @@
)
#(#UISubSpecification
#name: 'SubSpecification'
- #layout: #(#LayoutFrame 2 0.0 -32 1 -2 1.0 -8 1.0)
+ #layout: #(#LayoutFrame 301 0.0 -32 1 -2 1.0 -8 1.0)
#majorKey: #ToolApplicationModel
#minorKey: #windowSpecForCommitWithoutChannels
)
+ #(#HorizontalPanelViewSpec
+ #name: 'HorizontalPanelView1'
+ #layout: #(#LayoutFrame 3 0 76 0.691429 300 0 0 0.977143)
+ #component:
+ #(#SpecCollection
+ #collection:
+ #(
+ #(#LabelSpec
+ #name: 'Label2'
+ #label: 'Create: '
+ #adjust: #right
+ #extent: #(#Point 67 24)
+ )
+ #(#ActionButtonSpec
+ #name: 'CreateClassButton'
+ #activeHelpKey: #dss
+ #label: 'Class'
+ #model: #createClass:
+ #actionValue: 'class'
+ #extent: #(#Point 72 24)
+ )
+ #(#ActionButtonSpec
+ #name: 'CreateSubclassButton'
+ #activeHelpKey: #dss
+ #label: 'Subclass'
+ #model: #createClass:
+ #actionValue: 'subclass'
+ #extent: #(#Point 72 24)
+ )
+ #(#ActionButtonSpec
+ #name: 'CreatePrivateClassButton'
+ #activeHelpKey: #dss
+ #label: 'Private'
+ #model: #createClass:
+ #actionValue: 'private'
+ #extent: #(#Point 72 24)
+ )
+ )
+ )
+ #horizontalLayout: #fit
+ #verticalLayout: #fit
+ )
)
)
)
@@ -271,31 +307,34 @@
^Icon
constantNamed:#'ResourceSelectionBrowser iconClass'
- ifAbsentPut:[(Depth2Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 21 85 85 85 5 26 170 170 170 0 26 170 170 170 0 26 170 170 170 0 26 170 170 170 0 26 170 170 170 0 26 170 170 170 0 26 170 170 170 12 26 170 170 170 5 26 170 170 170 0 26 170 170 170 0 26 170 170 170 0 26 170 170 170 0 0 0 0 0 0 0 0 0 0 0]) ; colorMap:((OrderedCollection new add:(Color black); add:(Color white); add:(Color grey:66.9978); add:(Color red:100.0 green:0.0 blue:0.0); yourself)); mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(#[127 255 128 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 127 255 128]) ; yourself); yourself]!
+ ifAbsentPut:[(Depth2Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@UUUUUAQ****(@F**** @Z****@A****(@F**** @Z****@A****(LF**** TZ****@A****(@F**** @Z****@@@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 170 170 170 255 0 0]; mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@') ; yourself); yourself]
+!
-iconHidingSubclasses
+iconPrivateClass
"Generated by the Image Editor"
"
- ImageEditor openOnClass:self andSelector:#iconHidingSubclasses
+ ImageEditor openOnClass:self andSelector:#iconPrivateClass
"
<resource: #image>
^Icon
- constantNamed:#'ResourceSelectionBrowser iconHidingSubclasses'
- ifAbsentPut:[(Depth4Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 0 0 0 0 1 17 17 17 17 17 17 17 48 1 51 51 51 51 51 51 51 32 1 48 0 0 0 51 51 51 32 1 48 68 68 64 51 51 51 32 1 48 0 0 0 51 51 51 32 1 51 50 51 51 51 51 51 32 1 51 50 51 0 0 0 3 32 1 51 50 34 2 34 34 3 32 1 51 50 51 0 0 0 3 32 1 51 50 51 51 51 51 51 32 1 51 50 51 0 0 0 3 32 1 51 50 34 2 34 34 3 32 1 51 51 51 0 0 0 3 32 3 34 34 34 34 34 34 34 32 0 0 0 0 0 0 0 0 0]) ; colorMap:((OrderedCollection new add:(Color black); add:(Color white); add:(Color grey:49.9962); add:(Color grey:66.9978); add:(Color red:100.0 green:0.0 blue:0.0); add:(Color red:0.0 green:100.0 blue:0.0); add:(Color red:0.0 green:0.0 blue:100.0); add:(Color red:0.0 green:100.0 blue:100.0); add:(Color red:100.0 green:100.0 blue:0.0); add:(Color red:100.0 green:0.0 blue:100.0); add:(Color red:49.9962 green:0.0 blue:0.0); add:(Color red:0.0 green:49.9962 blue:0.0); add:(Color red:0.0 green:0.0 blue:49.9962); add:(Color red:0.0 green:49.9962 blue:49.9962); add:(Color red:49.9962 green:49.9962 blue:0.0); add:(Color red:49.9962 green:0.0 blue:49.9962); yourself)); mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(#[127 255 128 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 127 255 128]) ; yourself); yourself]!
+ constantNamed:#'ResourceSelectionBrowser iconPrivateClass'
+ ifAbsentPut:[(Depth2Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@PUUUUU@A****(@F*??* @Z/??*@A+???(MF/??> @Z5UU:@A+UUW(DF/??> @Z???:@A*??>(@F*??* @Z****C@@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 170 170 170 127 0 0]; mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@') ; yourself); yourself]
+!
-iconShowingSubclasses
+iconRealPrivateClass
"Generated by the Image Editor"
"
- ImageEditor openOnClass:self andSelector:#iconShowingSubclasses
+ ImageEditor openOnClass:self andSelector:#iconRealPrivateClass
"
<resource: #image>
^Icon
- constantNamed:#'ResourceSelectionBrowser iconShowingSubclasses'
- ifAbsentPut:[(Depth4Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(#[0 0 0 0 0 0 0 0 0 1 17 17 17 17 17 17 17 48 1 51 51 51 51 51 51 51 32 1 48 0 0 0 51 51 51 32 1 48 68 68 64 51 51 51 32 1 48 0 0 0 51 51 51 32 1 51 50 51 51 51 51 51 32 1 51 50 51 0 0 0 3 32 1 51 50 34 5 85 85 3 32 1 51 50 51 0 0 0 3 32 1 51 50 51 51 51 51 51 32 1 51 50 51 0 0 0 3 32 1 51 50 34 8 136 136 3 32 1 51 51 51 0 0 0 3 32 3 34 34 34 34 34 34 34 32 0 0 0 0 0 0 0 0 0]) ; colorMap:((OrderedCollection new add:(Color black); add:(Color white); add:(Color grey:49.9962); add:(Color grey:66.9978); add:(Color red:100.0 green:0.0 blue:0.0); add:(Color red:0.0 green:100.0 blue:0.0); add:(Color red:0.0 green:0.0 blue:100.0); add:(Color red:0.0 green:100.0 blue:100.0); add:(Color red:100.0 green:100.0 blue:0.0); add:(Color red:100.0 green:0.0 blue:100.0); add:(Color red:49.9962 green:0.0 blue:0.0); add:(Color red:0.0 green:49.9962 blue:0.0); add:(Color red:0.0 green:0.0 blue:49.9962); add:(Color red:0.0 green:49.9962 blue:49.9962); add:(Color red:49.9962 green:49.9962 blue:0.0); add:(Color red:49.9962 green:0.0 blue:49.9962); yourself)); mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(#[127 255 128 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 255 255 192 127 255 128]) ; yourself); yourself]! !
+ constantNamed:#'ResourceSelectionBrowser iconRealPrivateClass'
+ ifAbsentPut:[(Depth2Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@PUUUUU@A****(@F*??* @Z/??*@A+???(OF/??> @Z5UU:@A+UUW(DF/??> @Z???:@A*??>(@F*??* @Z****C0@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 170 170 170 255 0 0]; mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@') ; yourself); yourself]
+! !
!ResourceSelectionBrowser methodsFor:'accessing - views'!
@@ -381,6 +420,15 @@
!ResourceSelectionBrowser methodsFor:'callbacks - tree view'!
+treeViewChildren
+
+ ^[:aTreeItem|
+ |classes|
+ classes := self class treeViewChildren value: aTreeItem.
+ classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:i1 :i2| i1 name < i2 name]);
+ yourself]
+!
+
treeViewContents
^(Smalltalk at: resourceSuperclass) ? self class treeViewContents
@@ -390,13 +438,27 @@
treeViewIcon
- ^self class treeViewIcon
+ ^[:aTreeItem|
+ |icon|
+ icon := self class treeViewIcon value.
+ aTreeItem contents isPrivate
+ ifTrue:
+ [
+ aTreeItem parent contents ~~ aTreeItem contents superclass
+ ifTrue: [icon := self class iconRealPrivateClass]
+ ifFalse: [icon := self class iconPrivateClass]
+ ].
+ icon]
!
treeViewLabel
- ^self class treeViewLabel
-
+ ^[:aTreeItem|
+ |label superCls|
+ label := self class treeViewLabel value: aTreeItem.
+ (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)])
+ ifTrue: [label := label, ' (', superCls name, ')'].
+ label]
! !
!ResourceSelectionBrowser methodsFor:'callbacks - user'!
@@ -408,7 +470,7 @@
[
|clsName|
resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
- clsName := self listOfClassesView list at: anIndex.
+ clsName := ((self listOfClassesView list at: anIndex) upTo: $ ) asSymbol.
self valueOfClassName value: clsName.
self class lastSelection: clsName.
self listOfResources contents:
@@ -420,6 +482,52 @@
]
!
+createClass: what
+
+ |clsCandidat cls|
+ clsCandidat := self valueOfClassName value asSymbol.
+
+ (Smalltalk at: clsCandidat) notNil
+ ifTrue: [^self warn: 'Cannot create class ', clsCandidat asBoldText,
+ '!!\Key with that name in dictionary ' withCRs, 'Smalltalk' asBoldText, ' detected.'].
+
+ cls := self selectionOfClass value contents.
+ what = 'class' ifTrue: [cls := cls superclass].
+
+ cls isNil ifTrue: [^self warn: 'May not create class with superclass ', 'nil' asBoldText, '!!'].
+
+ what = 'private'
+ ifFalse: [cls subclass: clsCandidat
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category: cls category.]
+ ifTrue:
+ [
+ |superClsCandidate|
+ superClsCandidate := (Dialog
+ request: 'Enter name of superclass of private class.'
+ initialAnswer: 'Object') asSymbol.
+ (superClsCandidate := Smalltalk at: superClsCandidate) isNil ifTrue: [^nil].
+
+ (superClsCandidate isClass and: [superClsCandidate isPrivate not])
+ ifFalse: [^self warn: 'May not create private class with superclass ', superClsCandidate asBoldText, '!!'].
+ superClsCandidate subclass: clsCandidat
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn: cls
+ ].
+
+ allClasses := Object withAllSubclasses.
+
+ what = 'class'
+ ifTrue: [self selectionOfClass value parent changed: #children]
+ ifFalse: [self selectionOfClass value changed: #children].
+
+ classSelectionBlock value: self valueOfClassName value
+!
+
resourceDoubleClicked
resourceMethod := self selectionOfResource value.
@@ -452,7 +560,7 @@
[accept value]])
ifTrue:
[
- ^cls name, ' ', self valueOfSelector value
+ ^self valueOfClassName value, ' ', self valueOfSelector value
].
^nil
! !
@@ -470,9 +578,10 @@
postBuildWith:aBuilder
- |classSelection classSelectionBlock|
+ |classSelection|
allClasses := Object withAllSubclasses.
- classSelection := resourceClass ? self class lastSelection ? #Object.
+ classSelection := resourceClass ? self class lastSelection.
+ (Smalltalk at: classSelection) isNil ifTrue: [classSelection := #Object].
classSelectionBlock :=
[:clsPattern|
|foundClass classes|
@@ -509,8 +618,10 @@
self listOfClassesView validateDoubleClickBlock: [:aTreeItem | aTreeItem contents ~~ self treeViewContents].
self listOfClassesView selectedNodeExpand: true.
- [[classSelectionBlock value: classSelection] value.
- self selectionOfResource value: (self listOfResources detect: [:m| m selector == resourceMethod] ifNone: nil)]
+ [
+ [classSelectionBlock value: classSelection] value.
+ self selectionOfResource value: (self listOfResources detect: [:m| m selector == resourceMethod] ifNone: nil)
+ ]
forkAt: 4.
^super postBuildWith:aBuilder
@@ -523,6 +634,7 @@
icon isNil ifTrue: [icon := method iconOn: aGC].
^icon
+
!
method: aMethod