hg/stx-libtool2: comparison ResourceSelectionBrowser.st

equal deleted inserted replaced

-:9cd2115ac627
+:49c81e9cc6f7
 "
 SelectionBrowser subclass:#ResourceSelectionBrowser
 	instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
-		allClasses'
+		allClasses classSelectionBlock'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Interface-Dialogs'
 !
 !ResourceSelectionBrowser class methodsFor:'callbacks - default'!
 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]
 !
 treeViewContents
 !
 treeViewIcon
-^[:aTreeItem|
+^[self iconClass]
-aTreeItem contents subclasses notEmpty
-ifTrue:
-[
-aTreeItem hide
-ifTrue:  [self iconHidingSubclasses]
-ifFalse: [self iconShowingSubclasses]]
-ifFalse:
-[
-self iconClass
-]
-]
 !
 treeViewLabel
 #(#FullSpec
 #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:
 #(#SpecCollection
 #collection:
 #(#SpecCollection
 #collection:
 #(
 #(#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
 #miniScrollerHorizontal: true
 #showDirectoryIndicatorForRoot: false
 #name: 'classNameInputField'
 #layout: #(#LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
 #model: #valueOfClassName
 )
 #(#LabelSpec
-#name: 'Label1'
+#name: 'ClassHierarchyLabel'
-#layout: #(#LayoutFrame 0 0 0 0 297 0 22 0)
+#layout: #(#LayoutFrame 0 0 2 0 297 0 23 0)
 #label: ' Class Hierarchy'
 #level: 1
 #adjust: #left
 )
 )
 #(#SpecCollection
 #collection:
 #(
 #(#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
 #miniScrollerHorizontal: true
 #rowClassName: 'ResourceSelectionBrowser::Row'
 )
 #handles: #(#Any 0.5 1.0)
 )
 #(#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
 )
 )
 )
 )
 ! !
 <resource: #image>
 ^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'
+constantNamed:#'ResourceSelectionBrowser iconPrivateClass'
-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]!
+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'
+constantNamed:#'ResourceSelectionBrowser iconRealPrivateClass'
-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]! !
+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'!
 classNameInputField
 ^ holder
 ! !
 !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
 !
 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'!
 classSelected: anIndex
 self selectionOfClass value isNil ifTrue: [^nil].
 self withWaitCursorDo:
 [
 |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:
 ((((Smalltalk at: clsName)
 class methodDictionary
 [:m| m resources notNil and: [resourceTypes includes: m resourceType]]))
 collect: [:m| Row new method: m]).
 ]
 !
+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.
 accept value: true.
 self close
 (self selectionOfClass value notNil and:
 [(cls := Smalltalk at: self selectionOfClass value name) isClass and:
 [accept value]])
 ifTrue:
 [
-^cls name, ' ', self valueOfSelector value
+^self valueOfClassName value, ' ', self valueOfSelector value
 ].
 ^nil
 ! !
 !ResourceSelectionBrowser methodsFor:'startup / release'!
 !
 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|
 ((foundClass := Smalltalk at: clsPattern printString asSymbol) isClass not or:
 [foundClass name ~= clsPattern])
 classSelectionBlock value: self classNameInputField contents
 ].
 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
 ! !
 iconOn:aGC
 icon isNil ifTrue: [icon := method iconOn: aGC].
 ^icon
 !
 method: aMethod
 method := aMethod

changeset 680	49c81e9cc6f7
parent 664	6ed67e67d321
child 689	ff099c344dd6