--- a/ResourceSelectionBrowser.st Thu Jan 25 21:35:49 2018 +0100
+++ b/ResourceSelectionBrowser.st Fri Feb 02 00:54:11 2018 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1997-1998 by eXept Software AG
All Rights Reserved
@@ -15,8 +17,9 @@
SelectionBrowser subclass:#ResourceSelectionBrowser
instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
- allClasses classSelectionBlock'
- classVariableNames:'ClassPresentation'
+ allClasses classSelectionBlock classFilter packageFilter
+ metaClassOnly existingOnly filter classPresentation'
+ classVariableNames:'LastClassPresentation'
poolDictionaries:''
category:'Interface-Dialogs'
!
@@ -58,6 +61,10 @@
resourceTypes <Array> allowed resource types
allClasses <Array> list of the subclasses of resourceSuperclass
classSelectionBlock <Block> by evaluating this block the class selection is done
+ classFilter <Block> if non-nil, given a class, has to return true for a class to be shown
+ packageFilter <Block> if non-nil, given a package, has to return true for a class to be shown
+ existingOnly <Boolean> if set, only classes with existing resources are shown (for load dialogs);
+ otherwise, empty classes are also shown (for save dialogs)
[start with:]
ResourceSelectionBrowser open
@@ -70,117 +77,47 @@
!ResourceSelectionBrowser class methodsFor:'instance creation'!
request:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
- "opens a ResourceSelectionBrowser; return a Message-object or nil."
+ "opens a ResourceSelectionBrowser;
+ return a Message-object (whoInfo) or nil."
- ^ (self new
- title: aTitle)
- openOnSuperclass:aSuperclass
- andClass:aClassOrClassName
- andSelector:aSelector
- withResourceTypes:resourceTypes
+ ^ (self
+ title:aTitle
+ onSuperclass:aSuperclass
+ andClass:aClassOrClassName andSelector:aSelector
+ withResourceTypes:resourceTypes
+ ) openAndLetUserChoose
"
ResourceSelectionBrowser
request: 'Select a Resource Selector'
onSuperclass: #ApplicationModel
- andClassNamed: #MenuEditor
- andSelector: #menuItemImage
+ andClass: MenuEditor andSelector: #menuItemImage
withResourceTypes: #(image)
"
-! !
-
-!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|
+title:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
+ "creates and returns a ResourceSelectionBrowser but does not open it.
+ To open,
+ send the returned browser an openAndLetUserChoose message,
+ which returns the selected resource method's info (whoInfo) or nil on cancel.
+ Use this to set additional filters before opening"
- aTreeItem contents isClass ifTrue:[
- icon := self iconClass.
- aTreeItem contents isPrivate ifTrue:[
- icon := self iconPrivateClass
- ].
- icon
- ] ifFalse:[
- self iconCategory
- ]
- ]
-
-!
+ ^ (self new
+ title: aTitle)
+ onSuperclass:aSuperclass
+ andClass:aClassOrClassName
+ andSelector:aSelector
+ withResourceTypes:resourceTypes
-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
+ title: 'Select a Resource Selector'
+ onSuperclass: #ApplicationModel
+ andClass: MenuEditor andSelector: #menuItemImage
+ withResourceTypes: #(image)
+ ) openAndLetUserChoose
+ "
! !
!ResourceSelectionBrowser class methodsFor:'image specs'!
@@ -295,196 +232,256 @@
<resource: #canvas>
^
- #(FullSpec
- name: windowSpec
- window:
- (WindowSpec
- label: 'Resource Selection Browser'
- name: 'Resource Selection Browser'
- min: (Point 400 300)
- bounds: (Rectangle 12 22 612 372)
- )
- 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)
- horizontalLayout: leftSpace
- verticalLayout: fit
- horizontalSpace: 3
- verticalSpace: 3
- component:
- (SpecCollection
- collection: (
- (RadioButtonSpec
- label: 'Categories'
- name: 'ClassCategoriesRadioButton'
- translateLabel: true
- model: selectionOfClassPresentation
- isTriggerOnDown: true
- lampColor: (Color 0.0 0.0 0.0)
- select: #'Class Categories'
- extent: (Point 124 21)
- )
- (RadioButtonSpec
- label: 'Hierarchy'
- name: 'ClassHierarchyRadioButton'
- translateLabel: true
- model: selectionOfClassPresentation
- isTriggerOnDown: true
- lampColor: (Color 0.0 0.0 0.0)
- select: #'Class Hierarchy'
- extent: (Point 145 21)
- )
+ #(FullSpec
+ name: windowSpec
+ uuid: 'fb378b3c-07aa-11e8-8563-b8f6b1108e05'
+ window:
+ (WindowSpec
+ label: 'Resource Selection Browser'
+ name: 'Resource Selection Browser'
+ uuid: 'f1361a68-0791-11e8-8563-b8f6b1108e05'
+ min: (Point 400 300)
+ bounds: (Rectangle 0 0 644 460)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (VariableHorizontalPanelSpec
+ name: 'VariableHorizontalPanel'
+ layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 -36 1.0)
+ uuid: 'f1361c5c-0791-11e8-8563-b8f6b1108e05'
+ component:
+ (SpecCollection
+ collection: (
+ (ViewSpec
+ name: 'Box1'
+ uuid: 'f1361df6-0791-11e8-8563-b8f6b1108e05'
+ component:
+ (SpecCollection
+ collection: (
+ (HorizontalPanelViewSpec
+ name: 'HorizontalPanel2'
+ layout: (LayoutFrame 0 0 2 0 297 0 23 0)
+ uuid: 'f1361ebe-0791-11e8-8563-b8f6b1108e05'
+ horizontalLayout: leftSpace
+ verticalLayout: fit
+ horizontalSpace: 3
+ verticalSpace: 3
+ component:
+ (SpecCollection
+ collection: (
+ (RadioButtonSpec
+ label: 'Flat'
+ name: 'RadioButton1'
+ uuid: 'f1362062-0791-11e8-8563-b8f6b1108e05'
+ translateLabel: true
+ model: selectionOfClassPresentation
+ isTriggerOnDown: true
+ lampColor: (Color 0.0 0.0 0.0)
+ select: Flat
+ extent: (Point 80 21)
+ )
+ (RadioButtonSpec
+ label: 'Categories'
+ name: 'ClassCategoriesRadioButton'
+ uuid: 'f1362062-0791-11e8-8563-b8f6b1108e05'
+ translateLabel: true
+ model: selectionOfClassPresentation
+ isTriggerOnDown: true
+ lampColor: (Color 0.0 0.0 0.0)
+ select: #'Class Categories'
+ extent: (Point 124 21)
+ )
+ (RadioButtonSpec
+ label: 'Hierarchy'
+ name: 'ClassHierarchyRadioButton'
+ uuid: 'f136233c-0791-11e8-8563-b8f6b1108e05'
+ translateLabel: true
+ model: selectionOfClassPresentation
+ isTriggerOnDown: true
+ lampColor: (Color 0.0 0.0 0.0)
+ select: #'Class Hierarchy'
+ extent: (Point 145 21)
)
-
- )
- )
- (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
- highlightMode: line
- )
- (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
- highlightMode: line
- )
- (InputFieldSpec
- name: 'classNameInputField'
- layout: (LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
- tabable: true
- model: classNameHolder
- acceptOnLeave: true
- acceptOnLostFocus: true
- acceptOnPointerLeave: true
- )
+ )
+
+ )
+ )
+ (SequenceViewSpec
+ name: 'listOfClassesView'
+ layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
+ uuid: 'f13624d6-0791-11e8-8563-b8f6b1108e05'
+ tabable: true
+ model: indexOfSelectedClassInFlatList
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ useIndex: true
+ sequenceList: listOfClassNames
+ )
+ (SelectionInTreeViewSpec
+ name: 'listOfClassHierarchyView'
+ layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
+ uuid: 'f13624d6-0791-11e8-8563-b8f6b1108e05'
+ 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
+ highlightMode: line
+ )
+ (SelectionInTreeViewSpec
+ name: 'listOfClassCategoriesView'
+ layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
+ uuid: 'f13627ba-0791-11e8-8563-b8f6b1108e05'
+ tabable: true
+ model: selectionOfClassCategories
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ showRoot: false
+ showDirectoryIndicator: true
+ valueChangeSelector: classSelected
+ hierarchicalList: rootOfClassCategories
+ validateDoubleClickSelector: validateDoubleClick:
+ childrenSelector: treeViewClassCategoryChildren
+ iconSelector: treeViewClassCategoryIcon
+ highlightMode: line
+ )
+ (InputFieldSpec
+ name: 'classNameInputField'
+ layout: (LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
+ uuid: 'f1362922-0791-11e8-8563-b8f6b1108e05'
+ tabable: true
+ model: classNameHolder
+ acceptOnLeave: true
+ acceptOnLostFocus: true
+ acceptOnPointerLeave: true
)
-
- )
- )
- (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: resourceSelectorHolder
- acceptOnLeave: true
- acceptOnLostFocus: true
- acceptOnPointerLeave: true
- )
+ )
+
+ )
+ )
+ (ViewSpec
+ name: 'Box2'
+ uuid: 'f1362aee-0791-11e8-8563-b8f6b1108e05'
+ component:
+ (SpecCollection
+ collection: (
+ (VariableVerticalPanelSpec
+ name: 'ResourcePanel'
+ layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -24 1.0)
+ uuid: '51c4b91e-07a8-11e8-8563-b8f6b1108e05'
+ component:
+ (SpecCollection
+ collection: (
+ (DataSetSpec
+ name: 'resourcesDataSetView'
+ uuid: 'f1362bac-0791-11e8-8563-b8f6b1108e05'
+ model: selectionOfResourceMethod
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ rowClassName: 'ResourceSelectionBrowser::Row'
+ dataList: listOfResourceMethods
+ useIndex: false
+ has3Dseparators: true
+ doubleClickSelector: resourceDoubleClicked
+ columnHolder: resourceMethodColumns
+ valueChangeSelector: resourceSelected
+ verticalSpacing: 1
+ )
+ (ArbitraryComponentSpec
+ name: 'ImageView'
+ uuid: '51c4bd9c-07a8-11e8-8563-b8f6b1108e05'
+ hasBorder: false
+ component: ImageView
+ )
+ )
+
+ )
+ handles: (Any 0.98999999999999999 1.0)
)
-
- )
- )
+ (InputFieldSpec
+ name: 'selectorInputField'
+ layout: (LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)
+ uuid: 'f1362db4-0791-11e8-8563-b8f6b1108e05'
+ tabable: true
+ model: resourceSelectorHolder
+ acceptOnLeave: true
+ acceptOnLostFocus: true
+ acceptOnPointerLeave: true
+ )
+ )
+
+ )
)
-
- )
- handles: (Any 0.5 1.0)
- )
- (HorizontalPanelViewSpec
- name: 'ButtonPanel'
- layout: (LayoutFrame 2 0.0 -30 1 -2 1.0 -4 1.0)
- horizontalLayout: fit
- verticalLayout: fit
- reverseOrderIfOKAtLeft: true
- component:
- (SpecCollection
- collection: (
- (ActionButtonSpec
- label: 'Help'
- name: 'HelpButton'
- activeHelpKey: dss
- model: openHTMLDocument:
- initiallyDisabled: true
- enableChannel: helpEnabled
- actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
- extent: (Point 196 26)
- )
- (ActionButtonSpec
- label: 'Cancel'
- name: 'cancelButton'
- activeHelpKey: commitCancel
- tabable: true
- model: cancel
- extent: (Point 197 26)
- )
- (ActionButtonSpec
- label: 'OK'
- name: 'okButton'
- activeHelpKey: commitOK
- tabable: true
- model: accept
- isDefault: true
- extent: (Point 197 26)
- )
+ )
+
+ )
+ handles: (Any 0.5 1.0)
+ )
+ (HorizontalPanelViewSpec
+ name: 'ButtonPanel'
+ layout: (LayoutFrame 2 0.0 -30 1 -18 1.0 -4 1.0)
+ uuid: 'f1362f3a-0791-11e8-8563-b8f6b1108e05'
+ horizontalLayout: fit
+ verticalLayout: fit
+ reverseOrderIfOKAtLeft: true
+ component:
+ (SpecCollection
+ collection: (
+ (ActionButtonSpec
+ label: 'Help'
+ name: 'HelpButton'
+ activeHelpKey: dss
+ uuid: 'f136303e-0791-11e8-8563-b8f6b1108e05'
+ translateLabel: true
+ model: openHTMLDocument:
+ initiallyDisabled: true
+ enableChannel: helpEnabled
+ actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
+ extent: (Point 204 26)
)
-
- )
- )
+ (ActionButtonSpec
+ label: 'Cancel'
+ name: 'cancelButton'
+ activeHelpKey: commitCancel
+ uuid: 'f13631ba-0791-11e8-8563-b8f6b1108e05'
+ translateLabel: true
+ tabable: true
+ model: cancel
+ extent: (Point 204 26)
+ )
+ (ActionButtonSpec
+ label: 'OK'
+ name: 'okButton'
+ activeHelpKey: commitOK
+ uuid: 'f1363336-0791-11e8-8563-b8f6b1108e05'
+ translateLabel: true
+ tabable: true
+ model: accept
+ isDefault: true
+ extent: (Point 204 26)
+ )
+ )
+
+ )
+ keepSpaceForOSXResizeHandleH: true
)
-
- )
- )
+ )
+
+ )
+ )
! !
!ResourceSelectionBrowser class methodsFor:'list specs'!
@@ -525,6 +522,32 @@
)
! !
+!ResourceSelectionBrowser methodsFor:'accessing'!
+
+classFilter:aBlock
+ "aBlock to return true/false, given a class.
+ With false, it is not shown in the tree"
+
+ classFilter := aBlock.
+!
+
+existingOnly:something
+ existingOnly := something.
+!
+
+metaClassOnly:aBoolean
+ "force selection to be limited to the metaclass"
+
+ metaClassOnly := aBoolean.
+!
+
+packageFilter:aBlock
+ "aBlock to return true/false, given a packageID.
+ With false, the class is not shown in the tree"
+
+ packageFilter := aBlock.
+! !
+
!ResourceSelectionBrowser methodsFor:'aspects'!
classNameHolder
@@ -545,6 +568,35 @@
^true
!
+indexOfSelectedClassInFlatList
+ |holder|
+
+ (holder := builder bindingAt:#indexOfSelectedClassInFlatList) isNil ifTrue:[
+ builder aspectAt:#indexOfSelectedClassInFlatList put:(holder := nil asValue).
+ holder onChangeEvaluate:[
+ |clsName|
+
+ clsName := self listOfClassNames at:holder value ifAbsent:nil.
+ clsName notNil ifTrue:[
+ classSelectionBlock value:clsName
+ ].
+ ].
+ ].
+ ^ holder
+!
+
+listOfClassNames
+ "returns the value holder for the flat class list"
+
+ |holder|
+
+
+ (holder := builder bindingAt:#listOfClassNames) isNil ifTrue:[
+ builder aspectAt:#listOfClassNames put: (holder := List new).
+ ].
+ ^ holder
+!
+
listOfResourceMethods
"returns the value holder for the list of the resource methods"
@@ -578,12 +630,11 @@
|holder|
(holder := builder bindingAt:#rootOfClassCategories) isNil ifTrue:[
- ClassPresentation = #'Class Categories' ifTrue: [
- builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')].
+ classPresentation = #'Class Categories' ifTrue: [
+ builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')
+ ].
].
^ holder
-
-
!
rootOfClassHierarchy
@@ -593,12 +644,11 @@
(holder := builder bindingAt:#rootOfClassHierarchy) isNil ifTrue:[
- ClassPresentation = #'Class Hierarchy' ifTrue: [
- builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)]
+ classPresentation = #'Class Hierarchy' ifTrue: [
+ builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)
+ ]
].
^ holder
-
-
!
selectionOfClassCategories
@@ -622,29 +672,17 @@
!
selectionOfClassPresentation
- "returns the value holder for the selected class presentation"
+ "returns the value holder for the selected class presentation
+ (Flat, Hierarchy or Category)"
|holder|
(holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[
- builder aspectAt:#selectionOfClassPresentation put:(holder := RadioButtonGroup with: (ClassPresentation := ClassPresentation ? #'Class Categories')).
- holder onChangeEvaluate:
- [
- |hv comp newRoot|
+ builder
+ aspectAt:#selectionOfClassPresentation
+ put:(holder := RadioButtonGroup with: (classPresentation := classPresentation ? LastClassPresentation ? #'Class Categories')).
- 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 classNameHolder value
- ]
+ holder onChangeEvaluate:[self classPresentationChanged ].
].
^ holder
!
@@ -675,91 +713,203 @@
^ self resourceSelectorHolder
! !
-!ResourceSelectionBrowser methodsFor:'callbacks-class list'!
-
-treeViewClassCategoryChildren
- "returns the children for the contents (class) of aTreeItem as a block"
+!ResourceSelectionBrowser methodsFor:'callbacks-user'!
- "/ 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.
+classPresentationChanged
+ "returns the value holder for the selected class presentation
+ (Flat, Hierarchy or Category)"
- |topClass childrenPerCategory privateClasses|
+ |comp newRoot|
- topClass := self treeViewClassHierarchyContents.
- privateClasses := IdentitySet new.
+ classPresentation := LastClassPresentation := self selectionOfClassPresentation value.
- childrenPerCategory := Dictionary new.
-
- topClass withAllSubclassesDo:[:cls |
- |cat set|
-
- cls isPrivate ifFalse:[
- cat := cls category.
- cat notNil ifTrue:[
- set := childrenPerCategory at:cat ifAbsent:nil.
- set isNil ifTrue:[
- childrenPerCategory at:cat put:(set := IdentitySet new).
- ].
- set add:cls
- ].
- ] ifTrue:[
- privateClasses add:cls
- ]
+ classPresentation == #'Flat' ifTrue:[
+ self listOfClassNames isEmpty ifTrue:[ self updateListOfClasses ].
+ comp := builder componentAt: #listOfClassesView.
+ ] ifFalse:[
+ classPresentation == #'Class Hierarchy' ifTrue:[
+ comp := builder componentAt: #listOfClassHierarchyView.
+ newRoot := self rootOfClassHierarchy.
+ ] ifFalse: [
+ comp := builder componentAt: #listOfClassCategoriesView.
+ newRoot := self rootOfClassCategories.
+ ].
+ comp root:newRoot.
].
- ^ [:aTreeItem|
- |cont children initialContents setOfCategories itemCategory setOfClasses|
+ comp raise; requestFocus.
+ classSelectionBlock value:(self classNameHolder value)
+!
+
+classSelected
+ "after a class selection, read the allowed resource methods of the selected class"
+
+ |sel className|
+
+ classPresentation = #'Class Hierarchy'
+"/ ifTrue: [sel := self selectionOfClassHierarchy value]
+ ifFalse: [sel := self selectionOfClassCategories value].
+
+ resourceClass := nil.
+ sel notNil ifTrue:[
+ sel contents ~~ #Category ifTrue:[
+ className := sel name.
+ resourceClass := Smalltalk classNamed:className.
+ ]
+ ].
+ self updateResourceMethodList.
+!
+
+classSelectionUpdate:clsPattern
+ "called when a new class is selected AND when switching presentation modes"
+
+ |foundClass classes|
+
+ "/ because this is also called for presentation switch,
+ "/ we cannot tune it this way...
+ "/ (self classNameHolder value = clsPattern) ifTrue:[
+ "/ resourceClass notNil ifTrue:[
+ "/ resourceClass name = clsPattern ifTrue:[
+ "/ ^ self
+ "/ ].
+ "/ ].
+ "/ ].
- (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]
- children := children collect: [:child| TreeItem name:(child 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.
- ]
+ clsPattern notNil ifTrue:[
+ foundClass := Smalltalk classNamed:clsPattern.
+ ].
+ (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:[].
+ ].
+
+ foundClass notNil ifTrue: [
+ foundClass := foundClass autoload.
+ resourceClass := foundClass.
+
+ classPresentation = #'Flat' ifTrue: [
+ |index|
+
+ index := self listOfClassNames indexOf:resourceClass name.
+ self indexOfSelectedClassInFlatList value:index.
+ ] ifFalse: [
+ classPresentation = #'Class Hierarchy' ifTrue: [
+ |searchArgs nonSuperclasses hierItem|
+
+ false "foundClass isPrivate"
+ ifFalse: [searchArgs := foundClass withAllSuperclasses reversed]
+ ifTrue: [searchArgs := foundClass owningClass withAllSuperclasses reversed.
+ searchArgs add: foundClass].
+ (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil
+ ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]].
+
+ hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs.
+ hierItem notNil ifTrue:[
+ self selectionOfClassHierarchy value:hierItem.
+ ].
+ ] ifFalse: [
+ |searchArgs hierItem|
+
+ false "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].
+
+ hierItem := self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs.
+ hierItem notNil ifTrue:[
+ self selectionOfClassCategories value: hierItem.
+ ].
].
].
- children
+ ].
+
+ self classNameHolder value: clsPattern.
+ self updateResourceMethodList.
+!
+
+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"
+
+ |selectedMethodInfo mthd|
+
+ selectedMethodInfo := self selectionOfResourceMethod value.
+ selectedMethodInfo notNil ifTrue: [
+ self resourceSelectorHolder value:(selectedMethodInfo selector).
+ mthd := selectedMethodInfo method.
+ (mthd hasResource:#image) ifTrue:[
+ (builder componentAt:#ImageView)
+ image:(mthd valueWithReceiver:nil arguments:#())
+ ].
]
+!
- "Modified: / 22-08-2012 / 19:44:59 / cg"
+updateListOfClasses
+ |names|
+
+ classPresentation = #'Flat' ifTrue: [
+ self listOfClassNames isEmpty ifTrue:[
+ names := (Smalltalk allClasses asOrderedCollection sortBySelector:#name)
+ select:[:cls | self filterClass:cls]
+ thenCollect:[:cls | cls name].
+ self listOfClassNames addAll:names.
+ ]
+ ]
!
-treeViewClassCategoryIcon
- "returns the icon for aTreeItem as a block"
+updateResourceMethodList
+ "read the allowed resource methods of the selected class"
+
+ |class className item|
+
+ (class := resourceClass) isNil ifTrue:[
+ classPresentation = #'Class Hierarchy'
+ ifTrue: [item := self selectionOfClassHierarchy value ]
+ ifFalse: [item := self selectionOfClassCategories value ].
- ^self class treeViewClassHierarchyIcon
-
-
-!
+ item notNil ifTrue:[
+ item contents ~~ #Category ifTrue:[
+ className := item name.
+ class := Smalltalk at:className asSymbol.
+ ]
+ ].
+ ] ifFalse:[
+ class := resourceClass
+ ].
-treeViewClassHierarchyContents
- "returns the contents of the root of the class tree list"
+ class isNil ifTrue: [
+ self listOfResourceMethods contents:#().
+ ^self
+ ].
- |cls|
+ className := class name."/class theNonMetaclass name
+
+ self withWaitCursorDo:[
+ |newContents|
+
+ resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
- resourceSuperclass notNil ifTrue:[
- cls := Smalltalk classNamed: resourceSuperclass.
- ].
- cls notNil ifTrue:[^ cls].
- ^ self class treeViewClassHierarchyContents
+ self classNameHolder value: className.
+ self class lastSelection: className.
+
+ newContents := class theMetaclass methodDictionary asOrderedCollection
+ select:[:m | resourceTypes includes: m resourceType].
+
+ newContents := newContents sort:[:m1 :m2 | m1 selector < m2 selector].
+ newContents := newContents collect:[:m| (ResourceMethod new method:m)].
+
+ self listOfResourceMethods contents:newContents
+ .
+ ]
!
validateDoubleClick: aTreeItem
@@ -774,133 +924,24 @@
! !
-!ResourceSelectionBrowser methodsFor:'callbacks-user'!
-
-classSelected
- "after a class selection, read the allowed resource methods of the selected class"
-
- |sel|
-
- ClassPresentation = #'Class Hierarchy'
-"/ ifTrue: [sel := self selectionOfClassHierarchy value]
- ifFalse: [sel := self selectionOfClassCategories value].
-
- sel notNil ifTrue:[
- resourceClass := sel.
- ].
- self updateResourceMethodList.
-!
-
-classSelectionUpdate:clsPattern
- |foundClass classes|
+!ResourceSelectionBrowser methodsFor:'initialization'!
- 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:[].
- ].
-
- foundClass notNil ifTrue: [
- foundClass := foundClass autoload.
- resourceClass := foundClass.
-
- ClassPresentation = #'Class Hierarchy' ifTrue: [
- |searchArgs nonSuperclasses hierItem|
-
- false "foundClass isPrivate"
- ifFalse: [searchArgs := foundClass withAllSuperclasses reversed]
- ifTrue: [searchArgs := foundClass owningClass withAllSuperclasses reversed.
- searchArgs add: foundClass].
- (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil
- ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]].
-
- hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs.
- hierItem notNil ifTrue:[
- self selectionOfClassHierarchy value:hierItem.
- ].
- ] ifFalse: [
- |searchArgs hierItem|
-
- false "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].
+initialize
+ "Invoked when a new instance is created."
- hierItem := self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs.
- hierItem notNil ifTrue:[
- self selectionOfClassCategories value: hierItem.
- ].
- ].
- ].
- self classNameHolder value: clsPattern.
- self updateResourceMethodList.
-!
-
-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 resourceSelectorHolder value: self selectionOfResourceMethod value selector]
-!
-
-updateResourceMethodList
- "read the allowed resource methods of the selected class"
-
- |class className item|
+ metaClassOnly := true.
+ existingOnly := false.
- (class := resourceClass) isNil ifTrue:[
- ClassPresentation = #'Class Hierarchy'
- ifTrue: [item := self selectionOfClassHierarchy value ]
- ifFalse: [item := self selectionOfClassCategories value ].
-
- item notNil ifTrue:[
- className := item name.
- class := Smalltalk at:className asSymbol
- ].
- ].
-
- class isNil ifTrue: [^self].
-
- className := class name."/class theNonMetaclass name
-
- self withWaitCursorDo:[
- |newContents|
-
- resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
-
- self classNameHolder value: className.
- self class lastSelection: className.
-
- newContents := class class methodDictionary asOrderedCollection
- select: [:m | m resources notNil
- and: [resourceTypes includes: m resourceType]
- ].
- newContents := newContents sort:[:m1 :m2 | m1 selector < m2 selector].
- newContents := newContents collect:[:m| (ResourceMethod new method:m)].
-
- self listOfResourceMethods contents:newContents
- .
- ]
+ super initialize.
! !
!ResourceSelectionBrowser methodsFor:'instance creation'!
-openOnSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
- "opens a ResourceSelectionBrowser; return a Message-object or nil"
+onSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
+ "create - but do not yet open
+ a ResourceSelectionBrowser"
- |selectedClass enteredClassName className cls|
+ |cls|
resourceMethod := aSelector.
resourceTypes := aResourceTypes.
@@ -919,6 +960,16 @@
]
].
self resourceSelectorHolder value:(aSelector ? '').
+! !
+
+!ResourceSelectionBrowser methodsFor:'startup & release'!
+
+openAndLetUserChoose
+ "opens the previously configured receiver;
+ return a Message-object or nil"
+
+ |selectedClass enteredClassName className cls|
+
self open.
(selectedClass := self selectionOfClassHierarchy value) isNil ifTrue:[
@@ -947,16 +998,34 @@
^ nil
"Modified: / 22.4.1998 / 14:51:03 / cg"
-! !
+!
+
+openOnSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
+ "opens a ResourceSelectionBrowser; return a Message-object or nil"
-!ResourceSelectionBrowser methodsFor:'startup & release'!
+ self
+ onSuperclass: aSuperclassOrSymbol
+ andClass:aClassOrClassName andSelector: aSelector
+ withResourceTypes: aResourceTypes.
+
+ self openAndLetUserChoose
+!
postBuildWith:aBuilder
"after building and before opening,
create a class selection block, an entry completion block for the class name field"
|classSelection classNameInputField|
-
+
+ (resourceTypes notNil and:[(resourceTypes includesAny:#(image programImage))]) ifTrue:[
+ (builder componentAt: #resourcesDataSetView)
+ origin:0.0@0.0 extent:(1.0 @ 0.7).
+ (builder componentAt: #ImageView)
+ origin:0.0@0.7 extent:(1.0 @ 0.3); beVisible.
+ (builder componentAt: #ResourcePanel)
+ resizeSubviews; sizeChanged:nil.
+ ].
+
allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate].
classSelection := resourceClass isNil ifTrue:[nil] ifFalse:[resourceClass name].
@@ -978,7 +1047,10 @@
classNameInputField contents:what first.
(what at:2) size ~~ 1 ifTrue:[
classNameInputField device beepInEditor
- ]
+ ].
+ (Smalltalk classNamed:(what at:1)) notNil ifTrue:[
+ self classNameHolder value:(what at:1)
+ ].
"/ |what oldClassName|
"/ oldClassName := classNameInputField contents.
"/ what := Smalltalk classnameCompletion: value withoutSpaces.
@@ -988,7 +1060,7 @@
].
classSelectionBlock value: self classNameHolder value.
- self updateResourceMethodList.
+ "/ self updateResourceMethodList. -- will be done automatically via change
self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
^super postBuildWith:aBuilder
@@ -997,12 +1069,213 @@
postOpenWith:aBuilder
"after opening and if turned on make hierarchy view visible"
- ClassPresentation = #'Class Hierarchy'
- ifTrue: [(builder componentAt: #listOfClassHierarchyView) raise].
+ classPresentation = #'Class Hierarchy' ifTrue: [
+ (builder componentAt: #listOfClassHierarchyView) raise
+ ].
+ classPresentation = #'Flat' ifTrue: [
+ self updateListOfClasses.
+ (builder componentAt: #listOfClassesView) raise
+ ].
super postOpenWith:aBuilder
! !
+!ResourceSelectionBrowser methodsFor:'tree building - category'!
+
+filterClass:cls
+ "true if cls is to be shown"
+
+ classFilter notNil ifTrue:[
+ (classFilter value:cls) ifFalse:[^ false].
+ ].
+ packageFilter notNil ifTrue:[
+ (packageFilter value:cls package) ifFalse:[^ false].
+ ].
+ existingOnly == true ifTrue:[
+ ^ cls theMetaclass methodDictionary
+ contains:[:m |
+ resourceTypes includes:m resourceType
+ ].
+ ].
+ ^ true
+!
+
+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.
+
+ |topClass childrenPerCategory privateClasses|
+
+ topClass := self treeViewClassHierarchyContents.
+ privateClasses := IdentitySet new.
+
+ childrenPerCategory := Dictionary new.
+
+ "/ collect all classes to be inserted into the tree(s)
+ topClass withAllSubclassesDo:[:cls |
+ |shown cat set|
+
+ (self filterClass:cls) ifTrue:[
+ cls isPrivate ifFalse:[
+ cat := cls category.
+ cat notNil ifTrue:[
+ (childrenPerCategory at:cat ifAbsentPut:[Set new]) add:cls
+ ].
+ ] ifTrue:[
+ privateClasses add:cls
+ ]
+ ].
+ ].
+
+ "/ need the owningclasses in the tree
+ privateClasses do:[:each |
+ |owner|
+
+ owner := each owningClass.
+ (childrenPerCategory at:(owner category) ifAbsentPut:[Set new]) add:owner
+ ].
+
+ ^ [:aTreeItem|
+ |cont children initialContents setOfCategories itemCategory setOfClasses|
+
+ (cont := aTreeItem contents) isBehavior ifTrue:[
+ children := privateClasses select:[:cls | cls owningClass == aTreeItem contents].
+ children := children select:[:cls | self filterClass:cls].
+ children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name].
+ "/ children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child]
+ children := children collect: [:child| TreeItem name:(child 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].
+ setOfClasses := setOfClasses select:[:cls | self filterClass:cls].
+ 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
+ ]
+
+ "Modified: / 22-08-2012 / 19:44:59 / cg"
+!
+
+treeViewClassCategoryIcon
+ "returns the icon for aTreeItem as a block"
+
+ ^self treeViewClassHierarchyIcon
+! !
+
+!ResourceSelectionBrowser methodsFor:'tree building - hierarchy'!
+
+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 classesWithResourceOrResourceInAnySubclass|
+
+ subclassesAndPrivateClassesPerClass := IdentityDictionary new.
+ classesWithResourceOrResourceInAnySubclass := IdentitySet new.
+
+ Smalltalk allClassesDo:[:cls |
+ |owner superclass info|
+
+ superclass := cls superclass.
+ superclass notNil ifTrue:[
+ info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil.
+ info isNil ifTrue:[
+ subclassesAndPrivateClassesPerClass
+ at:superclass
+ put:(info := {IdentitySet new. IdentitySet new} ).
+ ].
+ (info at:1) add:cls
+ ].
+ (self filterClass:cls) ifTrue:[
+ cls withAllSuperclassesDo:[:each |
+ classesWithResourceOrResourceInAnySubclass add:each
+ ].
+ ].
+ ].
+
+ ^ [: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 select:[:cls | classesWithResourceOrResourceInAnySubclass includes:cls].
+ ]
+!
+
+treeViewClassHierarchyContents
+ "returns the contents of the root of the class tree list"
+
+ |cls|
+
+ resourceSuperclass notNil ifTrue:[
+ cls := Smalltalk classNamed: resourceSuperclass.
+ ].
+ cls := cls ? Object.
+ ^ cls
+!
+
+treeViewClassHierarchyIcon
+ "returns the icon for aTreeItem as a block"
+
+ ^[:aTreeItem|
+ |icon|
+
+ aTreeItem contents isClass ifTrue:[
+ icon := self class iconClass.
+ aTreeItem contents isPrivate ifTrue:[
+ icon := self class iconPrivateClass
+ ].
+ icon
+ ] ifFalse:[
+ self class 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::ResourceMethod methodsFor:'accessing'!
iconOn:aGC
@@ -1037,6 +1310,10 @@
"Modified: / 5.11.2001 / 16:48:35 / cg"
!
+method
+ ^ method
+!
+
method: aMethod
"sets aMethod"