"
COPYRIGHT (c) 1997-1998 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
SelectionBrowser subclass:#ResourceSelectionBrowser
instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
allClasses classSelectionBlock'
classVariableNames:'ClassPresentation'
poolDictionaries:''
category:'Interface-Dialogs'
!
Object subclass:#ResourceMethod
instanceVariableNames:'method icon resourceType selector'
classVariableNames:''
poolDictionaries:''
privateIn:ResourceSelectionBrowser
!
!ResourceSelectionBrowser class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1997-1998 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
The ResourceSelectionBrowser allows you to browse in class hierarchies
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
[start with:]
ResourceSelectionBrowser open
[author:]
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: #MenuEditor
andSelector: #menuItemImage
withResourceTypes: #(image)
"
^self new
title: aTitle;
openOnSuperclass: aSuperclass
andClass: aClass
andSelector: aSelector
withResourceTypes: resourceTypes
! !
!ResourceSelectionBrowser class methodsFor:'callbacks - default'!
treeViewClassHierarchyChildren
"returns the children for the contents (class) of aTreeItem as a block"
"/ cg: tz's algorithm was very-very slow,
"/ (it enumerated classes hundreds of times,
"/ leading to a square runtime behavior
"/ - i.e. very slow scrolling )
"/ Speed up things by caching facts while enumerating
"/ classes once only.
|subclassesAndPrivateClassesPerClass|
subclassesAndPrivateClassesPerClass := IdentityDictionary new.
Smalltalk allClassesDo:[:cls |
|owner superclass info|
(owner := cls owningClass) notNil ifTrue:[
info := subclassesAndPrivateClassesPerClass at:owner ifAbsent:nil.
info isNil ifTrue:[
subclassesAndPrivateClassesPerClass at:owner put:(info := Array with:IdentitySet new
with:IdentitySet new).
].
(info at:2) add:cls
] ifFalse:[
superclass := cls superclass.
superclass notNil ifTrue:[
info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil.
info isNil ifTrue:[
subclassesAndPrivateClassesPerClass at:superclass put:(info := Array with:IdentitySet new
with:IdentitySet new).
].
(info at:1) add:cls
]
]
].
^ [:aTreeItem|
|classes itemClass info|
classes := OrderedCollection new.
itemClass := aTreeItem contents.
info := subclassesAndPrivateClassesPerClass at:itemClass ifAbsent:nil.
info notNil ifTrue:[
classes addAll:((info at:1) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
classes addAll:((info at:2) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
].
classes
]
!
treeViewClassHierarchyContents
"returns the default contents of the root of the class tree list"
^ Object
!
treeViewClassHierarchyIcon
"returns the icon for aTreeItem as a block"
^[:aTreeItem|
|icon|
aTreeItem contents isClass ifTrue:[
icon := self iconClass.
aTreeItem contents isPrivate ifTrue:[
icon := self iconPrivateClass
].
icon
] ifFalse:[
self iconCategory
]
]
!
treeViewClassHierarchyLabel
"returns the label for aTreeItem as a block"
^[:aTreeItem|
|label superCls itemContents|
itemContents := aTreeItem contents.
label := itemContents name.
(itemContents isPrivate
and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)])
ifTrue: [label := label, ' (', superCls name, ')'].
label
]
! !
!ResourceSelectionBrowser class methodsFor:'image specs'!
iconCategory
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self iconCategory inspect
ImageEditor openOnClass:self andSelector:#iconCategory
"
<resource: #image>
^Icon
constantNamed:#'ResourceSelectionBrowser iconCategory'
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]!
iconClass
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
ImageEditor openOnClass:self andSelector:#iconClass
"
<resource: #image>
^Icon
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
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
ImageEditor openOnClass:self andSelector:#iconPrivateClass
"
<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****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'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:ResourceSelectionBrowser andSelector:#windowSpec
ResourceSelectionBrowser new openInterface:#windowSpec
ResourceSelectionBrowser open
"
<resource: #canvas>
^
#(#FullSpec
#window:
#(#WindowSpec
#name: 'Resource Selection Browser'
#layout: #(#LayoutFrame 194 0 307 0 793 0 656 0)
#label: 'Resource Selection Browser'
#min: #(#Point 400 300)
#max: #(#Point 1152 864)
#bounds: #(#Rectangle 194 307 794 657)
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection:
#(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -36 1.0)
#component:
#(#SpecCollection
#collection:
#(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection:
#(
#(#HorizontalPanelViewSpec
#name: 'HorizontalPanel2'
#layout: #(#LayoutFrame 0 0 2 0 297 0 23 0)
#component:
#(#SpecCollection
#collection:
#(
#(#RadioButtonSpec
#name: 'ClassCategoriesRadioButton'
#label: 'Categories'
#translateLabel: true
#model: #selectionOfClassPresentation
#isTriggerOnDown: true
#lampColor: #(#Color 0.0 0.0 0.0)
#select: #'Class Categories'
#extent: #(#Point 124 21)
)
#(#RadioButtonSpec
#name: 'ClassHierarchyRadioButton'
#label: 'Hierarchy'
#translateLabel: true
#model: #selectionOfClassPresentation
#isTriggerOnDown: true
#lampColor: #(#Color 0.0 0.0 0.0)
#select: #'Class Hierarchy'
#extent: #(#Point 145 21)
)
)
)
#horizontalLayout: #leftSpace
#verticalLayout: #fit
#horizontalSpace: 3
#verticalSpace: 3
)
#(#SelectionInTreeViewSpec
#name: 'listOfClassHierarchyView'
#layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
#tabable: true
#model: #selectionOfClassHierarchy
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#showDirectoryIndicatorForRoot: false
#showDirectoryIndicator: true
#valueChangeSelector: #classSelected
#hierarchicalList: #rootOfClassHierarchy
#validateDoubleClickSelector: #validateDoubleClick:
#contentsSelector: #treeViewClassHierarchyContents
#labelSelector: #treeViewClassHierarchyLabel
#childrenSelector: #treeViewClassHierarchyChildren
#iconSelector: #treeViewClassHierarchyIcon
)
#(#SelectionInTreeViewSpec
#name: 'listOfClassCategoriesView'
#layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
#tabable: true
#model: #selectionOfClassCategories
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#showRoot: false
#showDirectoryIndicator: true
#valueChangeSelector: #classSelected
#hierarchicalList: #rootOfClassCategories
#validateDoubleClickSelector: #validateDoubleClick:
#childrenSelector: #treeViewClassCategoryChildren
#iconSelector: #treeViewClassCategoryIcon
)
#(#InputFieldSpec
#name: 'classNameInputField'
#layout: #(#LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
#tabable: true
#model: #valueOfClassName
)
)
)
)
#(#ViewSpec
#name: 'Box2'
#component:
#(#SpecCollection
#collection:
#(
#(#DataSetSpec
#name: 'resourcesDataSetView'
#layout: #(#LayoutFrame 2 0.0 2 0.0 -2 1.0 -24 1.0)
#model: #selectionOfResourceMethod
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#rowClassName: 'ResourceSelectionBrowser::Row'
#dataList: #listOfResourceMethods
#useIndex: false
#has3Dsepartors: true
#has3Dseparators: 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)
)
#(#HorizontalPanelViewSpec
#name: 'HorizontalPanel1'
#layout: #(#LayoutFrame 2 0.0 -30 1 -2 1.0 -4 1.0)
#component:
#(#SpecCollection
#collection:
#(
#(#ActionButtonSpec
#name: 'HelpButton'
#activeHelpKey: #dss
#label: 'Help'
#model: #openHTMLDocument:
#initiallyDisabled: true
#enableChannel: #helpEnabled
#actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
#extent: #(#Point 196 26)
)
#(#ActionButtonSpec
#name: 'cancelButton'
#activeHelpKey: #commitCancel
#label: 'Cancel'
#tabable: true
#model: #cancel
#extent: #(#Point 196 26)
)
#(#ActionButtonSpec
#name: 'okButton'
#activeHelpKey: #commitOK
#label: 'OK'
#tabable: true
#model: #accept
#isDefault: true
#extent: #(#Point 196 24)
)
)
)
#horizontalLayout: #fit
#verticalLayout: #fit
)
)
)
)
"Modified: / 27.7.1998 / 18:05:40 / cg"
! !
!ResourceSelectionBrowser class methodsFor:'list specs'!
tableColumnsForResourceMethodAttributes
"This resource specification was automatically generated
by the DataSetBuilder of ST/X."
"Do not manually edit this!! If it is corrupted,
the DataSetBuilder may not be able to read the specification."
"
DataSetBuilder new openOnClass:ResourceSelectionBrowser andSelector:#tableColumnsForResourceMethodAttributes
"
<resource: #tableColumns>
^ #(
#(#DataSetColumnSpec
#width: 20
#height: 20
#printSelector: #iconOn:
#canSelect: false
)
#(#DataSetColumnSpec
#label: ' Selector'
#labelAlignment: #left
#model: #selector
#canSelect: false
)
#(#DataSetColumnSpec
#label: ' Resource Type'
#labelAlignment: #left
#model: #resourceType
#canSelect: false
)
)
! !
!ResourceSelectionBrowser methodsFor:'aspects'!
helpEnabled
"returns whether there is a documentation file"
^true
!
listOfResourceMethods
"returns the value holder for the list of the resource methods"
|holder|
(holder := builder bindingAt:#listOfResourceMethods) isNil ifTrue:[
builder aspectAt:#listOfResourceMethods put:(holder := List new).
].
^ holder
!
resourceMethodColumns
"returns the columns for the table of the resource methods as value holder"
|holder|
(holder := builder bindingAt:#resourceMethodColumns) isNil ifTrue:[
builder aspectAt:#resourceMethodColumns put:(holder := List new).
holder addAll: (self class tableColumnsForResourceMethodAttributes collect: [:i| i decodeAsLiteralArray]).
].
^ holder
!
rootOfClassCategories
"returns the value holder for the root of the class tree list"
|holder|
(holder := builder bindingAt:#rootOfClassCategories) isNil ifTrue:[
ClassPresentation = #'Class Categories' ifTrue: [
builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')].
].
^ holder
!
rootOfClassHierarchy
"returns the value holder for the root of the class tree list"
|holder|
(holder := builder bindingAt:#rootOfClassHierarchy) isNil ifTrue:[
ClassPresentation = #'Class Hierarchy' ifTrue: [
builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)]
].
^ holder
!
selectionOfClassCategories
"returns the value holder for the selected class of the class tree list"
|holder|
(holder := builder bindingAt:#selectionOfClassCategories) isNil ifTrue:[
builder aspectAt:#selectionOfClassCategories put:(holder := ValueHolder new).
].
^ holder
!
selectionOfClassHierarchy
"returns the value holder for the selected class of the class tree list"
|holder|
(holder := builder bindingAt:#selectionOfClassHierarchy) isNil ifTrue:[
builder aspectAt:#selectionOfClassHierarchy put:(holder := ValueHolder new).
].
^ holder
!
selectionOfClassPresentation
"returns the value holder for the selected class presentation"
|holder|
(holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[
builder aspectAt:#selectionOfClassPresentation put:(holder := RadioButtonGroup with: (ClassPresentation := ClassPresentation ? #'Class Categories')).
holder onChangeSend: #value to:
[
|hv comp newRoot|
hv := holder value.
ClassPresentation := hv.
hv = #'Class Hierarchy' ifTrue:[
comp := builder componentAt: #listOfClassHierarchyView.
newRoot := self rootOfClassHierarchy.
] ifFalse: [
comp := builder componentAt: #listOfClassCategoriesView.
newRoot := self rootOfClassCategories.
].
comp root:newRoot.
comp raise.
classSelectionBlock value: self valueOfClassName value
]
].
^ holder
!
selectionOfResourceMethod
"returns the value holder for the selected resource method of the resource method list"
|holder|
(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).
].
^ holder
!
valueOfResourceSelector
"returns the value holder for the name of the selector"
|holder|
(holder := builder bindingAt:#valueOfResourceSelector) isNil ifTrue:[
builder aspectAt:#valueOfResourceSelector put:(holder := '' asValue).
].
^ holder
! !
!ResourceSelectionBrowser methodsFor:'callbacks - class list'!
treeViewClassCategoryChildren
"returns the children for the contents (class) of aTreeItem as a block"
"/ cg: tz's algorithm was very-very slow,
"/ (it enumerated classes hundreds of times,
"/ leading to a square runtime behavior
"/ - i.e. very slow scrolling )
"/ Speed up things by caching facts while enumerating
"/ classes once only.
|allClasses topClass childrenPerCategory privateClasses|
topClass := self treeViewClassHierarchyContents.
allClasses := topClass withAllSubclasses.
privateClasses := IdentitySet new.
childrenPerCategory := Dictionary new.
allClasses do:[:cls |
|cat set|
cls isPrivate ifFalse:[
cat := cls category.
set := childrenPerCategory at:cat ifAbsent:nil.
set isNil ifTrue:[
childrenPerCategory at:cat put:(set := IdentitySet new).
].
set add:cls
] ifTrue:[
privateClasses add:cls
]
].
^ [:aTreeItem|
|cont children initialContents setOfCategories itemCategory setOfClasses|
(cont := aTreeItem contents) isBehavior ifTrue:[
children := privateClasses select:[:cls | cls owningClass == aTreeItem contents].
children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name].
children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child]
] ifFalse:[
cont size == 0 ifTrue:[
setOfCategories := childrenPerCategory keys.
children := setOfCategories asSortedCollection.
children := children collect: [:nm | TreeItem name:nm contents:#Category]
] ifFalse:[
cont == #Category ifTrue:[
itemCategory := aTreeItem name.
setOfClasses := childrenPerCategory at:itemCategory ifAbsent:[Set new].
children := setOfClasses asOrderedCollection sort:[:c1 :c2 | c1 name <= c2 name].
children := children collect:[:child | TreeItem name:child name contents:child].
] ifFalse:[
"/ huh ?
children := OrderedCollection new.
]
].
].
children
]
!
treeViewClassCategoryIcon
"returns the icon for aTreeItem as a block"
^self class treeViewClassHierarchyIcon
!
treeViewClassHierarchyContents
"returns the contents of the root of the class tree list"
|cls|
resourceSuperclass notNil ifTrue:[
cls := Smalltalk at: resourceSuperclass.
].
cls notNil ifTrue:[^ cls].
^ self class treeViewClassHierarchyContents
!
validateDoubleClick: aTreeItem
"returns whether a class may be selected"
|cont|
^ (cont := aTreeItem contents) ~= ''
and: [cont ~~ self treeViewClassHierarchyContents]
! !
!ResourceSelectionBrowser methodsFor:'callbacks - user'!
classSelected
"after a class selection, read the allowed resource methods of the selected class"
ClassPresentation = #'Class Hierarchy'
ifTrue: [self selectionOfClassHierarchy value isNil ifTrue: [^nil]]
ifFalse: [self selectionOfClassCategories value isNil ifTrue: [^nil]].
self withWaitCursorDo:
[
|clsName|
resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
ClassPresentation = #'Class Hierarchy'
ifTrue: [clsName := (self selectionOfClassHierarchy value name upTo: $ ) asSymbol]
ifFalse: [clsName := (self selectionOfClassCategories value name upTo: $ ) asSymbol].
self valueOfClassName value: clsName.
self class lastSelection: clsName.
self listOfResourceMethods contents:
((((Smalltalk at: clsName)
class methodDictionary
asOrderedCollection select:
[:m| m resources notNil and: [resourceTypes includes: m resourceType]]))
collect: [:m| (ResourceMethod new method: m)]).
]
!
resourceDoubleClicked
"after a double click on resource method, accept it and close"
accept value: true.
self closeRequest
!
resourceSelected
"after a click on a resource method, set its selector into the field"
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 clsNameString|
resourceMethod := aSelector.
resourceTypes := aResourceTypes.
resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol].
resourceClass := nil.
aClassOrSymbol isClass
ifTrue: [resourceClass := aClassOrSymbol name]
ifFalse: [
aClassOrSymbol notNil ifTrue:[
(Smalltalk at: aClassOrSymbol) notNil
ifTrue: [resourceClass := aClassOrSymbol]
]
].
self valueOfResourceSelector value:(aSelector ? '').
self open.
(clsName := self selectionOfClassHierarchy value) isNil ifTrue:[
(clsName := self selectionOfClassCategories value) isNil ifTrue:[
(clsNameString := self valueOfClassName value) isNil ifTrue:[
accept value ifTrue:[
self warn:'No valid class selected/entered'.
].
^ nil
]
]
].
clsNameString isNil ifTrue:[
clsNameString := clsName name upTo:Character space
].
clsNameString := clsNameString asSymbol.
((Smalltalk at: clsNameString) isClass and:[accept value]) ifTrue:[
^ clsNameString, ' ', self valueOfResourceSelector value
].
accept value ifTrue:[
self warn:'No valid class selected/entered'.
].
^ nil
"Modified: / 22.4.1998 / 14:51:03 / cg"
! !
!ResourceSelectionBrowser methodsFor:'startup / release'!
postBuildWith:aBuilder
"after building and before opening,
create a class selection block, an entry completion block for the class name field"
|classSelection classNameInputField|
allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate].
classSelection := resourceClass.
(classSelection isNil or:[Smalltalk at: classSelection]) isNil
ifTrue: [classSelection := self class lastSelection].
(classSelection isNil or:[Smalltalk at: classSelection]) isNil
ifTrue: [classSelection := self treeViewContents].
classSelectionBlock :=
[:clsPattern|
|foundClass classes|
clsPattern notNil ifTrue:[
foundClass := Smalltalk at:(clsPattern printString asSymbol).
].
(foundClass isClass not or:[foundClass name ~= clsPattern])
ifTrue:
[
classes := allClasses select: [:cls| cls name size >= clsPattern size].
1 to: clsPattern size do:
[:i|
classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)].
].
foundClass := classes at: 1 ifAbsent: [nil]
].
foundClass notNil
ifTrue:
[
ClassPresentation = #'Class Hierarchy'
ifTrue:
[
|searchArgs nonSuperclasses|
foundClass isPrivate
ifFalse: [searchArgs := foundClass withAllSuperclasses reverse]
ifTrue: [searchArgs := foundClass owningClass withAllSuperclasses reverse. searchArgs add: foundClass]
.
(nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil
ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]].
self selectionOfClassHierarchy value: (self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs).
]
ifFalse:
[
|searchArgs|
foundClass isPrivate
ifTrue: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass owningClass name with: foundClass name]
ifFalse: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass name].
self selectionOfClassCategories value: (self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs).
].
].
self valueOfClassName value: clsPattern
].
self valueOfClassName value: classSelection.
(classNameInputField := builder componentAt: #classNameInputField) entryCompletionBlock:
[:value|
|what oldClassName|
oldClassName := classNameInputField contents.
what := Smalltalk classnameCompletion: value withoutSpaces.
classNameInputField contents:what first.
oldClassName = classNameInputField contents ifTrue:[classNameInputField flash].
classSelectionBlock value: classNameInputField contents
].
classSelectionBlock value: self valueOfClassName value.
self classSelected.
self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
^super postBuildWith:aBuilder
!
postOpenWith:aBuilder
"after opening and if turned on make hierarchy view visible"
ClassPresentation = #'Class Hierarchy'
ifTrue: [(builder componentAt: #listOfClassHierarchyView) raise].
^super postOpenWith:aBuilder
! !
!ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!
iconOn:aGC
"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.
].
].
^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
! !
!ResourceSelectionBrowser class methodsFor:'documentation'!
version
^ '$Header$'
! !