# HG changeset patch # User tz # Date 892149179 -7200 # Node ID 905c3b4ba56539bcbde8145000f7f587e84a1c05 # Parent 96f106b0a61ea42996644fce845f162e07736d53 revised diff -r 96f106b0a61e -r 905c3b4ba565 MethodSelectionBrowser.st --- 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 diff -r 96f106b0a61e -r 905c3b4ba565 ResourceSelectionBrowser.st --- 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 selector of the resource spec + resourceClass class of the resource spec + resourceSuperclass root class of the tree list + resourceTypes allowed resource types + allClasses list of the subclasses of resourceSuperclass + classSelectionBlock by evaluating this block the class selection is done + readResourcesProcess process of reading the resource methods + mayReadResources 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 @@ ^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 @@ ^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