--- a/MethodSelectionBrowser.st Thu Apr 09 18:54:28 1998 +0200
+++ b/MethodSelectionBrowser.st Thu Apr 09 21:12:59 1998 +0200
@@ -1,5 +1,5 @@
"
- COPYRIGHT (c) 1997 by eXept Software AG
+ COPYRIGHT (c) 1997-1998 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
@@ -19,7 +19,7 @@
category:'Interface-Dialogs'
!
-Object subclass:#Row
+Object subclass:#Method
instanceVariableNames:'selector protocol'
classVariableNames:''
poolDictionaries:''
@@ -30,7 +30,7 @@
copyright
"
- COPYRIGHT (c) 1997 by eXept Software AG
+ COPYRIGHT (c) 1997-1998 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
@@ -46,6 +46,9 @@
documentation
"
+ The MethodSelectionBrowser allows you to browse in class hierarchies
+ for selecting methods for you purposes.
+
[start with:]
MethodSelectionBrowser open
@@ -57,30 +60,36 @@
!MethodSelectionBrowser class methodsFor:'instance creation'!
-request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withTypes: aResourceTypes
+request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withTypes: protocolTypes
+ "opens a MethodSelectionBrowser on
+ aSuperclassOrSymbol,
+ and aClassOrSymbol,
+ and aSelector,
+ with allowed protocolTypes"
"
MethodSelectionBrowser
- request: 'Select a Method'
- onSuperclass: #ApplicationModel
- andClass: #ToolApplicationModel
- andSelector: #saveIcon
- withTypes: #(class)
+ request: 'Select a Method'
+ onSuperclass: #ApplicationModel
+ andClass: #ToolApplicationModel
+ andSelector: #saveIcon
+ withTypes: #(class)
"
^self new
- title: aTitle;
- openOnSuperclass: aSuperclass
- andClass: aClass
- andSelector: aSelector
- withTypes: aResourceTypes
+ title: aTitle;
+ openOnSuperclass: aSuperclass
+ andClass: aClass
+ andSelector: aSelector
+ withTypes: protocolTypes
! !
!MethodSelectionBrowser class methodsFor:'list specs'!
-columnsOfDataSetView
+resourceMethodColumns
+ "returns the columns for the table of the resource methods"
^ #(
#(#DataSetColumnSpec
@@ -103,28 +112,33 @@
!MethodSelectionBrowser methodsFor:'callbacks - user'!
-classSelected: anIndex
+classSelected
+ "after a class selection, read the class or/and instance methods of the selected class"
self selectionOfClass value isNil ifTrue: [^nil].
self withWaitCursorDo:
[
- |clsName|
+ |clsName contentsBlock|
resourceTypes isNil ifTrue: [resourceTypes := #(instance class)].
- clsName := ((self listOfClassesView list at: anIndex) upTo: $ ) asSymbol.
+ clsName := self selectionOfClass value name.
self valueOfClassName value: clsName.
self class lastSelection: clsName.
- (resourceTypes includes: #instance) ifTrue: [
- self listOfResources contents:
- (((Smalltalk at: clsName)
- selectors
- asOrderedCollection)
- collect: [:sel| Row new selector: sel; protocol: 'instance'])].
- (resourceTypes includes: #class) ifTrue: [
- self listOfResources addAll:
- (((Smalltalk at: clsName)
- class selectors
- asOrderedCollection)
- collect: [:sel| Row new selector: sel; protocol: 'class'])].
+ self listOfResourceMethods removeAll.
+ contentsBlock :=
+ [:protocol|
+ |cls|
+ (resourceTypes includes: protocol)
+ ifTrue:
+ [
+ cls := Smalltalk at: clsName.
+ cls := (protocol = #instance) ifTrue: [cls] ifFalse: [cls class].
+ self listOfResourceMethods addAll:
+ (cls selectors asOrderedCollection
+ collect: [:sel| Method new selector: sel; protocol: protocol asString])
+ ]
+ ].
+ contentsBlock value: #instance.
+ contentsBlock value: #class.
]
@@ -132,20 +146,26 @@
!MethodSelectionBrowser methodsFor:'instance creation'!
-openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withTypes: aResourceTypes
+openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withTypes: protocolTypes
+ "opens a MethodSelectionBrowser on
+ aSuperclassOrSymbol,
+ and aClassOrSymbol,
+ and aSelector,
+ with allowed protocolTypes"
|message type row|
+
message := super openOnSuperclass: aSuperclassOrSymbol
- andClass: aClassOrSymbol
- andSelector: aSelector
- withResourceTypes: aResourceTypes.
+ andClass: aClassOrSymbol
+ andSelector: aSelector
+ withResourceTypes: protocolTypes.
(message notNil and:
- [((row := self selectionOfResource value) notNil and:
- [(type := row type) = 'class'])])
+ [((row := self selectionOfResourceMethod value) notNil and:
+ [(type := row protocol) = 'class'])])
ifTrue:
[
- message := message replChar:$ withString: ' class '
+ message := message replChar:$ withString: ' class '
].
^message
@@ -156,6 +176,7 @@
!MethodSelectionBrowser methodsFor:'startup / release'!
postBuildWith:aBuilder
+ "sets the correct title"
title := 'Method Selection Browser'.
@@ -163,7 +184,7 @@
! !
-!MethodSelectionBrowser::Row methodsFor:'accessing'!
+!MethodSelectionBrowser::Method methodsFor:'accessing'!
protocol
--- a/ResourceSelectionBrowser.st Thu Apr 09 18:54:28 1998 +0200
+++ b/ResourceSelectionBrowser.st Thu Apr 09 21:12:59 1998 +0200
@@ -1,5 +1,5 @@
"
- COPYRIGHT (c) 1997 by eXept Software AG
+ COPYRIGHT (c) 1997-1998 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
@@ -13,13 +13,14 @@
SelectionBrowser subclass:#ResourceSelectionBrowser
instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
- allClasses classSelectionBlock classAndResourceSelectionProcess'
+ allClasses classSelectionBlock readResourcesProcess
+ mayReadResources'
classVariableNames:''
poolDictionaries:''
category:'Interface-Dialogs'
!
-Object subclass:#Row
+Object subclass:#ResourceMethod
instanceVariableNames:'method icon resourceType selector'
classVariableNames:''
poolDictionaries:''
@@ -30,7 +31,7 @@
copyright
"
- COPYRIGHT (c) 1997 by eXept Software AG
+ COPYRIGHT (c) 1997-1998 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
@@ -46,52 +47,69 @@
documentation
"
The ResourceSelectionBrowser allows you to browse in class hierarchies
- and to select resource methods in order to load method contents or to save
- something to methods.
+ and to select resource methods for loading or to saving resource
+ specifications (#canvas, #menu, etc.).
+
+ [instance variables:]
+ resourceMethod <Symbol> selector of the resource spec
+ resourceClass <Symbol> class of the resource spec
+ resourceSuperclass <Symbol> root class of the tree list
+ resourceTypes <Array> allowed resource types
+ allClasses <Array> list of the subclasses of resourceSuperclass
+ classSelectionBlock <Block> by evaluating this block the class selection is done
+ readResourcesProcess <Process> process of reading the resource methods
+ mayReadResources <Boolean> flag whether may read the resource methods
[start with:]
- ResourceSelectionBrowser open
+ ResourceSelectionBrowser open
[author:]
- Thomas Zwick, eXept Software AG
+ Thomas Zwick, eXept Software AG
"
! !
!ResourceSelectionBrowser class methodsFor:'instance creation'!
request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withResourceTypes: resourceTypes
-
+ "opens a ResourceSelectionBrowser
+ with aTitle
+ on aSuperclassOrSymbol,
+ and aClassOrSymbol,
+ and aSelector,
+ with allowed aResourceTypes"
"
ResourceSelectionBrowser
- request: 'Select a Resource Selector'
- onSuperclass: #ApplicationModel
- andClass: #ToolApplicationModel
- andSelector: #saveIcon
- withResourceTypes: #(image)
+ request: 'Select a Resource Selector'
+ onSuperclass: #ApplicationModel
+ andClass: #ToolApplicationModel
+ andSelector: #saveIcon
+ withResourceTypes: #(image)
"
^self new
- title: aTitle;
- openOnSuperclass: aSuperclass
- andClass: aClass
- andSelector: aSelector
- withResourceTypes: resourceTypes
+ title: aTitle;
+ openOnSuperclass: aSuperclass
+ andClass: aClass
+ andSelector: aSelector
+ withResourceTypes: resourceTypes
! !
!ResourceSelectionBrowser class methodsFor:'callbacks - default'!
treeViewChildren
+ "returns the children for the contents (class) of aTreeItem as a block"
^[:aTreeItem|
- |classes|
- classes := OrderedCollection new.
- classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:i1 :i2| i1 name < i2 name]).
- classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:i1 :i2| i1 name < i2 name]).
- classes
+ |classes|
+ classes := OrderedCollection new.
+ classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:i1 :i2| i1 name < i2 name]).
+ classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:i1 :i2| i1 name < i2 name]).
+ classes
]
!
treeViewContents
+ "returns the default contents of the root of the class tree list"
^Smalltalk at: #Object
@@ -101,27 +119,30 @@
!
treeViewIcon
+ "returns the icon for aTreeItem as a block"
^[:aTreeItem|
- |icon|
- icon := self iconClass.
- aTreeItem contents isPrivate
- ifTrue:
- [
- icon := self iconPrivateClass
- ].
- icon]
+ |icon|
+ icon := self iconClass.
+ aTreeItem contents isPrivate
+ ifTrue:
+ [
+ icon := self iconPrivateClass
+ ].
+ icon
+ ]
!
treeViewLabel
+ "returns the label for aTreeItem as a block"
^[:aTreeItem|
- |label superCls|
- label := aTreeItem contents name.
- (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)])
- ifTrue: [label := label, ' (', superCls name, ')'].
- label
+ |label superCls|
+ label := aTreeItem contents name.
+ (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)])
+ ifTrue: [label := label, ' (', superCls name, ')'].
+ label
]
@@ -143,8 +164,8 @@
<resource: #image>
^Icon
- constantNamed:#'ResourceSelectionBrowser iconClass'
- 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]!
+ constantNamed:#'ResourceSelectionBrowser iconClass'
+ ifAbsentPut:[(Depth2Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@UUUUU!!Q****(@F**** @Z****@A****(@F**** @Z****@A****(LF**** TZ****@A****(@F**** @Z****@B@@@@@@@@@@@@@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]!
iconPrivateClass
"This resource specification was automatically generated
@@ -160,8 +181,8 @@
<resource: #image>
^Icon
- constantNamed:#'ResourceSelectionBrowser iconPrivateClass'
- ifAbsentPut:[(Depth2Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@PUUUUU@A****(@F*??* @Z+??*@A*/*>(OF*>+: @Z+??*@A*/?:(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]! !
+ constantNamed:#'ResourceSelectionBrowser iconPrivateClass'
+ ifAbsentPut:[(Depth2Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@PUUUUU A****(@F*??* @Z+??*@A*/*>(OF*>+: @Z+??*@A*/?:(DF*>** @Z+:**@A*/**(@F*>** @Z****C2@@@@@@@@@@@@@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 class methodsFor:'interface specs'!
@@ -183,154 +204,159 @@
^
#(#FullSpec
- #window:
- #(#WindowSpec
- #name: 'Resource Selection Browser'
- #layout: #(#LayoutFrame 433 0 242 0 1032 0 591 0)
- #label: 'Resource Selection Browser'
- #min: #(#Point 400 300)
- #max: #(#Point 1152 864)
- #bounds: #(#Rectangle 433 242 1033 592)
- #usePreferredExtent: false
- )
- #component:
- #(#SpecCollection
- #collection:
- #(
- #(#VariableHorizontalPanelSpec
- #name: 'variableHorizontalPanel'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -40 1.0)
- #component:
- #(#SpecCollection
- #collection:
- #(
- #(#ViewSpec
- #name: 'view1'
- #component:
- #(#SpecCollection
- #collection:
- #(
- #(#SelectionInTreeViewSpec
- #name: 'listOfClassesView'
- #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -22 1.0)
- #model: #selectionOfClass
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #showDirectoryIndicatorForRoot: false
- #showDirectoryIndicator: true
- #valueChangeSelector: #classSelected:
- #hierarchicalList: #listOfClasses
- #contentsSelector: #treeViewContents
- #labelSelector: #treeViewLabel
- #childrenSelector: #treeViewChildren
- #iconSelector: #treeViewIcon
- )
- #(#InputFieldSpec
- #name: 'classNameInputField'
- #layout: #(#LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
- #model: #valueOfClassName
- )
- #(#LabelSpec
- #name: 'ClassHierarchyLabel'
- #layout: #(#LayoutFrame 0 0 2 0 297 0 23 0)
- #label: ' Class Hierarchy'
- #level: 1
- #adjust: #left
- )
- )
- )
- )
- #(#ViewSpec
- #name: 'view2'
- #component:
- #(#SpecCollection
- #collection:
- #(
- #(#DataSetSpec
- #name: 'resourcesDataSetView'
- #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'
- #dataList: #listOfResources
- #useIndex: false
- #has3Dsepartors: true
- #doubleClickSelector: #resourceDoubleClicked
- #columnHolder: #columnsOfDataSetView
- #valueChangeSelector: #resourceSelected
- #verticalSpacing: 1
- )
- #(#InputFieldSpec
- #name: 'selectorInputField'
- #layout: #(#LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)
- #model: #valueOfSelector
- )
- )
- )
- )
- )
- )
- #handles: #(#Any 0.5 1.0)
- )
- #(#UISubSpecification
- #name: 'SubSpecification'
- #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 72 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
- )
- )
- )
+ #window:
+ #(#WindowSpec
+ #name: 'Resource Selection Browser'
+ #layout: #(#LayoutFrame 221 0 252 0 820 0 601 0)
+ #label: 'Resource Selection Browser'
+ #min: #(#Point 400 300)
+ #max: #(#Point 1152 864)
+ #bounds: #(#Rectangle 221 252 821 602)
+ #usePreferredExtent: false
+ )
+ #component:
+ #(#SpecCollection
+ #collection:
+ #(
+ #(#VariableHorizontalPanelSpec
+ #name: 'VariableHorizontalPanel'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -40 1.0)
+ #component:
+ #(#SpecCollection
+ #collection:
+ #(
+ #(#ViewSpec
+ #name: 'Box1'
+ #component:
+ #(#SpecCollection
+ #collection:
+ #(
+ #(#SelectionInTreeViewSpec
+ #name: 'listOfClassesView'
+ #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -22 1.0)
+ #tabable: true
+ #model: #selectionOfClass
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #showDirectoryIndicatorForRoot: false
+ #showDirectoryIndicator: true
+ #valueChangeSelector: #classSelected
+ #hierarchicalList: #rootOfClasses
+ #validateDoubleClickSelector: #validateDoubleClick:
+ #contentsSelector: #treeViewContents
+ #labelSelector: #treeViewLabel
+ #childrenSelector: #treeViewChildren
+ #iconSelector: #treeViewIcon
+ )
+ #(#InputFieldSpec
+ #name: 'classNameInputField'
+ #layout: #(#LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
+ #tabable: true
+ #model: #valueOfClassName
+ )
+ #(#LabelSpec
+ #name: 'ClassHierarchyLabel'
+ #layout: #(#LayoutFrame 0 0 2 0 297 0 23 0)
+ #label: ' Class Hierarchy'
+ #level: 1
+ #adjust: #left
+ )
+ )
+ )
+ )
+ #(#ViewSpec
+ #name: 'Box2'
+ #component:
+ #(#SpecCollection
+ #collection:
+ #(
+ #(#DataSetSpec
+ #name: 'resourcesDataSetView'
+ #layout: #(#LayoutFrame 2 0.0 2 0.0 -2 1.0 -22 1.0)
+ #model: #selectionOfResourceMethod
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #rowClassName: 'ResourceSelectionBrowser::Row'
+ #dataList: #listOfResourceMethods
+ #useIndex: false
+ #has3Dsepartors: true
+ #doubleClickSelector: #resourceDoubleClicked
+ #columnHolder: #resourceMethodColumns
+ #valueChangeSelector: #resourceSelected
+ #verticalSpacing: 1
+ )
+ #(#InputFieldSpec
+ #name: 'selectorInputField'
+ #layout: #(#LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)
+ #tabable: true
+ #model: #valueOfResourceSelector
+ )
+ )
+ )
+ )
+ )
+ )
+ #handles: #(#Any 0.5 1.0)
+ )
+ #(#UISubSpecification
+ #name: 'windowSpecForCommitWithoutChannels'
+ #layout: #(#LayoutFrame 301 0.0 -32 1 -2 1.0 -8 1.0)
+ #majorKey: #ToolApplicationModel
+ #minorKey: #windowSpecForCommitWithoutChannels
+ )
+ #(#HorizontalPanelViewSpec
+ #name: 'HorizontalPanelView'
+ #layout: #(#LayoutFrame 3 0 76 0.691429 300 0 0 0.977143)
+ #component:
+ #(#SpecCollection
+ #collection:
+ #(
+ #(#LabelSpec
+ #name: 'Label2'
+ #label: 'Create: '
+ #adjust: #right
+ #extent: #(#Point 72 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
+ )
+ )
+ )
)
! !
!ResourceSelectionBrowser class methodsFor:'list specs'!
-columnsOfDataSetView
+resourceMethodColumns
+ "returns the columns for the table of the resource methods"
^ #(#(#DataSetColumnSpec
#width: 20
@@ -352,126 +378,132 @@
))
! !
-!ResourceSelectionBrowser methodsFor:'accessing - views'!
-
-classNameInputField
-
- ^builder componentAt: #classNameInputField
-!
-
-listOfClassesView
-
- ^builder componentAt: #listOfClassesView
-! !
-
!ResourceSelectionBrowser methodsFor:'aspects'!
-columnsOfDataSetView
+listOfResourceMethods
+ "returns the value holder for the list of the resource methods"
|holder|
- (holder := builder bindingAt:#columnsOfDataSetView) isNil ifTrue:[
- builder aspectAt:#columnsOfDataSetView put:(holder := List new).
- holder addAll: (self class columnsOfDataSetView collect: [:i| i decodeAsLiteralArray]).
+ (holder := builder bindingAt:#listOfResourceMethods) isNil ifTrue:[
+ builder aspectAt:#listOfResourceMethods put:(holder := List new).
].
^ holder
-
-
!
-listOfClasses
+resourceMethodColumns
+ "returns the columns for the table of the resource methods as value holder"
|holder|
- (holder := builder bindingAt:#listOfClasses) isNil ifTrue:[
- builder aspectAt:#listOfClasses put: (holder := TreeItem new)
+ (holder := builder bindingAt:#resourceMethodColumns) isNil ifTrue:[
+ builder aspectAt:#resourceMethodColumns put:(holder := List new).
+ holder addAll: (self class resourceMethodColumns collect: [:i| i decodeAsLiteralArray]).
+ ].
+ ^ holder
+!
+
+rootOfClasses
+ "returns the value holder for the root of the class tree list"
+
+ |holder|
+ (holder := builder bindingAt:#rootOfClasses) isNil ifTrue:[
+ builder aspectAt:#rootOfClasses put: (holder := SelectionInTree new root: TreeItem new)
].
^ holder
!
-listOfResources
+selectionOfClass
+ "returns the value holder for the selected class of the class tree list"
|holder|
- (holder := builder bindingAt:#listOfResources) isNil ifTrue:[
- builder aspectAt:#listOfResources put:(holder := List new).
+ (holder := builder bindingAt:#selectionOfClass) isNil ifTrue:[
+ builder aspectAt:#selectionOfClass put:(holder := ValueHolder new).
].
^ holder
!
-selectionOfClass
+selectionOfResourceMethod
+ "returns the value holder for the selected resource method of the resource method list"
|holder|
- (holder := builder bindingAt:#selectionOfClass) isNil ifTrue:[
- builder aspectAt:#selectionOfClass put:(holder := ValueHolder new).
- ].
- ^ holder
-!
-
-selectionOfResource
-
- |holder|
- (holder := builder bindingAt:#selectionOfResource) isNil ifTrue:[
- builder aspectAt:#selectionOfResource put:(holder := '' asValue).
+ (holder := builder bindingAt:#selectionOfResourceMethod) isNil ifTrue:[
+ builder aspectAt:#selectionOfResourceMethod put:(holder := '' asValue).
].
^ holder
!
valueOfClassName
+ "returns the value holder for the name of the class"
|holder|
(holder := builder bindingAt:#valueOfClassName) isNil ifTrue:[
- builder aspectAt:#valueOfClassName put:(holder := '' asValue).
+ builder aspectAt:#valueOfClassName put:(holder := '' asValue).
].
^ holder
!
-valueOfSelector
+valueOfResourceSelector
+ "returns the value holder for the name of the selector"
|holder|
- (holder := builder bindingAt:#valueOfSelector) isNil ifTrue:[
- builder aspectAt:#valueOfSelector put:(holder := '' asValue).
+ (holder := builder bindingAt:#valueOfResourceSelector) isNil ifTrue:[
+ builder aspectAt:#valueOfResourceSelector put:(holder := '' asValue).
].
^ holder
! !
-!ResourceSelectionBrowser methodsFor:'callbacks - tree view'!
+!ResourceSelectionBrowser methodsFor:'callbacks - class list'!
treeViewContents
+ "returns the contents of the root of the class tree list"
^(Smalltalk at: resourceSuperclass) ? self class treeViewContents
+!
+
+validateDoubleClick: aTreeItem
+ "returns whether a class may be selected"
+
+ ^aTreeItem contents ~~ self treeViewContents
+
+
+
! !
!ResourceSelectionBrowser methodsFor:'callbacks - user'!
-classSelected: anIndex
+classSelected
+ "after a class selection, read the allowed resource methods of the selected class"
- self selectionOfClass value isNil ifTrue: [^nil].
+ (mayReadResources not or: [self selectionOfClass value isNil]) ifTrue: [^nil].
self withWaitCursorDo:
[
|clsName|
resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
- clsName := ((self listOfClassesView list at: anIndex) printString upTo: $ ) asSymbol.
+ clsName := self selectionOfClass value name.
self valueOfClassName value: clsName.
self class lastSelection: clsName.
- self listOfResources contents:
+ self listOfResourceMethods contents:
((((Smalltalk at: clsName)
class methodDictionary
asOrderedCollection select:
[:m| m resources notNil and: [resourceTypes includes: m resourceType]]))
- collect: [:m| Row new method: m]).
+ collect: [:m| (ResourceMethod new method: m)]).
]
!
createClass: what
+ "creates a class, a subclass, or a private class of the selected class"
|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.'].
+ 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].
@@ -481,66 +513,73 @@
what = 'private'
ifFalse:
[
- cls subclass: clsCandidat
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category: cls category
+ cls subclass: clsCandidat
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category: cls category
]
ifTrue:
[
- |superClsCandidate|
- superClsCandidate := (Dialog
- request: 'Enter name of superclass of private class.'
- initialAnswer: 'Object') asSymbol.
- (Smalltalk at: superClsCandidate) isNil ifTrue: [^self warn: 'Class ', superClsCandidate asBoldText, ' does not exist!!'].
+ |superClsCandidate|
+ superClsCandidate := (Dialog
+ request: 'Enter name of superclass of private class.'
+ initialAnswer: 'Object') asSymbol.
+ (Smalltalk at: superClsCandidate) isNil ifTrue: [^self warn: 'Class ', superClsCandidate asBoldText, ' does not exist!!'].
- ((superClsCandidate := Smalltalk at: 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
+ ((superClsCandidate := Smalltalk at: 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].
+ ifTrue: [self selectionOfClass value parent changed: #children]
+ ifFalse: [self selectionOfClass value changed: #children].
classSelectionBlock value: self valueOfClassName value
!
resourceDoubleClicked
+ "after a double click on resource method, accept it and close"
- resourceMethod := self selectionOfResource value.
accept value: true.
+
self close
!
resourceSelected
+ "after a click on a resource method, set its selector into the field"
- resourceMethod := self selectionOfResource value.
- self selectionOfResource value notNil
- ifTrue: [self valueOfSelector value: self selectionOfResource value selector]
+ self selectionOfResourceMethod value notNil
+ ifTrue: [self valueOfResourceSelector value: self selectionOfResourceMethod value selector]
! !
!ResourceSelectionBrowser methodsFor:'instance creation'!
openOnSuperclass: aSuperclassOrSymbol andClass: aClassOrSymbol andSelector: aSelector withResourceTypes: aResourceTypes
+ "opens a ResourceSelectionBrowser on
+ aSuperclassOrSymbol,
+ and aClassOrSymbol,
+ and aSelector,
+ with allowed aResourceTypes"
|clsName|
+
resourceMethod := aSelector.
resourceTypes := aResourceTypes.
resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol].
resourceClass := aClassOrSymbol isClass
- ifTrue: [aClassOrSymbol name]
- ifFalse: [(Smalltalk at: aClassOrSymbol) notNil
- ifTrue: [aClassOrSymbol]
- ifFalse: [nil]].
- self valueOfSelector value:(aSelector ? '').
+ ifTrue: [aClassOrSymbol name]
+ ifFalse: [(Smalltalk at: aClassOrSymbol) notNil
+ ifTrue: [aClassOrSymbol]
+ ifFalse: [nil]].
+ self valueOfResourceSelector value:(aSelector ? '').
self open.
@@ -550,7 +589,7 @@
((Smalltalk at: clsName) isClass and: [accept value])
ifTrue:
[
- ^clsName, ' ', self valueOfSelector value
+ ^clsName, ' ', self valueOfResourceSelector value
].
^nil
! !
@@ -558,9 +597,10 @@
!ResourceSelectionBrowser methodsFor:'startup / release'!
closeCancel
+ "after a cancel, terminate readResourcesProcess"
- resourceMethod := nil.
- classAndResourceSelectionProcess notNil ifTrue: [classAndResourceSelectionProcess terminate].
+ readResourcesProcess notNil ifTrue: [readResourcesProcess terminate].
+
super closeCancel
@@ -568,14 +608,18 @@
!
postBuildWith:aBuilder
+ "after building and before opening,
+ create a class selection block, an entry completion block for the class name field,
+ and select the class and the resource selector"
- |classSelection|
- allClasses := Object withAllSubclasses.
+ |classSelection classNameInputField|
+
+ allClasses := self treeViewContents withAllSubclasses reject: [:cls| cls isPrivate].
classSelection := resourceClass.
(Smalltalk at: classSelection) isNil
ifTrue: [classSelection := self class lastSelection].
(Smalltalk at: classSelection) isNil
- ifTrue: [classSelection := #Object].
+ ifTrue: [classSelection := self treeViewContents].
classSelectionBlock :=
[:clsPattern|
|foundClass classes|
@@ -589,93 +633,98 @@
classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)].
].
foundClass := classes at: 1 ifAbsent: [nil]
- ].
+ ].
foundClass notNil
ifTrue:
- [|item|
- item := self listOfClasses
- detectChild:[:child :arg| child contents == arg ]
- arguments:(foundClass withAllSuperclasses reverse).
- item notNil ifTrue:[
- self selectionOfClass value:item
- ]
+ [
+ |superClasses nonSuperclasses item|
+ superClasses := foundClass withAllSuperclasses reverse.
+ (nonSuperclasses := self treeViewContents allSuperclasses) notNil
+ ifTrue: [superClasses := superClasses reject: [:cls| nonSuperclasses includes: cls]].
+ item := self rootOfClasses detectItem:[:child :arg| child contents == arg] arguments:superClasses.
+ item notNil ifTrue:[self selectionOfClass value:item]
].
self valueOfClassName value: clsPattern
].
self valueOfClassName value: classSelection.
- self classNameInputField entryCompletionBlock:
+
+ (classNameInputField := builder componentAt: #classNameInputField) entryCompletionBlock:
[:value|
|what|
what := Smalltalk classnameCompletion: value withoutSpaces.
- self classNameInputField contents:what first.
+ classNameInputField contents:what first.
(what at:2) size ~~ 1 ifTrue:[Display beep].
- classSelectionBlock value: self classNameInputField contents
+ classSelectionBlock value: classNameInputField contents
].
- self listOfClassesView validateDoubleClickBlock: [:aTreeItem | aTreeItem contents ~~ self treeViewContents].
- self listOfClassesView selectedNodeExpand: true.
+
+ mayReadResources := false.
+ classSelectionBlock value: classSelection.
- classAndResourceSelectionProcess :=
+ readResourcesProcess :=
[
- [classSelectionBlock value: classSelection] value.
- self selectionOfResource value: (self listOfResources detect: [:m| m selector == resourceMethod] ifNone: nil).
- classAndResourceSelectionProcess := nil
- ]
- forkAt: 4.
+ mayReadResources := true.
+ self classSelected.
+ self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
+ readResourcesProcess := nil.
+ ] forkAt: 4.
^super postBuildWith:aBuilder
! !
-!ResourceSelectionBrowser::Row methodsFor:'accessing'!
+!ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!
iconOn:aGC
- "register and answer an icon indicating the resource type."
+ "registers and returns an icon indicating the resource type"
self resourceType isNil ifTrue: [^nil].
icon isNil
ifTrue:
[
- |cls sel image imageKey|
- ((self resourceType = #image) or: [resourceType = #fileImage])
- ifTrue:
- [
- cls := method who methodClass soleInstance.
- sel := method who methodSelector.
- ]
- ifFalse:
- [
- cls := BrowserView.
- sel := (resourceType, 'Icon') asSymbol.
- ].
- imageKey := (cls name, sel) asSymbol.
- (icon := aGC registeredImageAt: imageKey) isNil
- ifTrue:
- [
- image := cls perform: sel.
- image extent y > 18
- ifTrue:
- [
- image := image magnifiedBy: 18/image extent y
- ].
- aGC registerImage: image key: imageKey.
- icon := aGC registeredImageAt: imageKey.
- ].
+ |cls sel image imageKey|
+ ((self resourceType = #image) or: [resourceType = #fileImage])
+ ifTrue:
+ [
+ cls := method who methodClass soleInstance.
+ sel := method who methodSelector.
+ ]
+ ifFalse:
+ [
+ cls := BrowserView.
+ sel := (resourceType, 'Icon') asSymbol.
+ ].
+ imageKey := (cls name, sel) asSymbol.
+ (icon := aGC registeredImageAt: imageKey) isNil
+ ifTrue:
+ [
+ image := cls perform: sel.
+ image extent y > 18
+ ifTrue:
+ [
+ image := image magnifiedBy: 18/image extent y
+ ].
+ aGC registerImage: image key: imageKey.
+ icon := aGC registeredImageAt: imageKey.
+ ].
].
^icon
!
method: aMethod
+ "sets aMethod"
method := aMethod
!
resourceType
+ "returns resourceType"
resourceType isNil ifTrue: [resourceType := method resourceType].
^resourceType
!
selector
+ "returns selector"
selector isNil ifTrue: [selector := method who methodSelector].
^selector