TBehaviorProvider.

One having method dictionary and able to ber modified in IDE.
Does not mean can instantiate, have hierarchy etc. (eg. Trait).

src/Kernel-Classes.st

@@ -11,192 +11,16 @@ I also provides methods for compiling methods and examining the method dictionar
 
 !BehaviorBody methodsFor: 'accessing'!
 
->> aString
-	^ self methodAt: aString
-!
-
 definition
 	self subclassResponsibility
 !
 
-methodAt: aString
-	^ self methodDictionary at: aString
-!
-
-methodDictionary
-	<inlineJS: 'var dict = $globals.HashedCollection._new();
-	var methods = self.methods;
-	Object.keys(methods).forEach(function(i) {
-		if(methods[i].selector) {
-			dict._at_put_(methods[i].selector, methods[i]);
-		}
-	});
-	return dict'>
-!
-
-methodTemplate
-	^ String streamContents: [ :stream | stream 
-		write: 'messageSelectorAndArgumentNames'; lf;
-		tab; write: '"comment stating purpose of message"'; lf;
-		lf;
-		tab; write: '| temporary variable names |'; lf;
-		tab; write: 'statements' ]
-!
-
-methods
-	^ self methodDictionary values
-!
-
-methodsInProtocol: aString
-	^ self methods select: [ :each | each protocol = aString ]
-!
-
-organization
-	^ self basicAt: 'organization'
-!
-
-ownMethods
-	"Answer the methods of the receiver that are not package extensions
-	nor obtained via trait composition"
-
-	^ (self ownProtocols 
-		inject: OrderedCollection new
-		into: [ :acc :each | acc, (self ownMethodsInProtocol: each) ])
-			sorted: [ :a :b | a selector <= b selector ]
-!
-
-ownMethodsInProtocol: aString
-	^ (self methodsInProtocol: aString) select: [ :each | each methodClass = self ]
-!
-
-ownProtocols
-	"Answer the protocols of the receiver that are not package extensions"
-
-	^ self protocols reject: [ :each |
-		each match: '^\*' ]
-!
-
-packageOfProtocol: aString
-	"Answer the package the method of receiver belongs to:
-	- if it is an extension method, answer the corresponding package
-	- else answer the receiver's package"
-	
-	(aString beginsWith: '*') ifFalse: [
-		^ self package ].
-		
-	^ Package 
-		named: aString allButFirst
-		ifAbsent: [ nil ]
-!
-
-protocols
-	^ self organization elements sorted
-!
-
-removeProtocolIfEmpty: aString
-	self methods
-		detect: [ :each | each protocol = aString ]
-		ifNone: [ self organization removeElement: aString ]
-!
-
-selectors
-	^ self methodDictionary keys
-!
-
 theMetaClass
 	self subclassResponsibility
 !
 
 theNonMetaClass
 	self subclassResponsibility
-!
-
-traitComposition
-	^ (self basicAt: 'traitComposition') collect: [ :each | TraitTransformation fromJSON: each ]
-!
-
-traitCompositionDefinition
-	^ self traitComposition ifNotEmpty: [ :traitComposition |
-		String streamContents: [ :str |
-			str write: '{'.
-			traitComposition
-				do: [ :each | str write: each definition ]
-				separatedBy: [ str write: '. ' ].
-			str write: '}' ] ]
-! !
-
-!BehaviorBody methodsFor: 'compiling'!
-
-addCompiledMethod: aMethod
-	| oldMethod announcement |
-	
-	oldMethod := self methodDictionary
-		at: aMethod selector
-		ifAbsent: [ nil ].
-	
-	(self protocols includes: aMethod protocol)
-		ifFalse: [ self organization addElement: aMethod protocol ].
-
-	self basicAddCompiledMethod: aMethod.
-	
-	oldMethod ifNotNil: [
-		self removeProtocolIfEmpty: oldMethod protocol ].
-	
-	announcement := oldMethod
-		ifNil: [
-			MethodAdded new
-					method: aMethod;
-					yourself ]
-		ifNotNil: [
-			MethodModified new
-					oldMethod: oldMethod;
-					method: aMethod;
-					yourself ].
-					
-					
-	SystemAnnouncer current
-				announce: announcement
-!
-
-compile: aString protocol: anotherString
-	^ Compiler new
-		install: aString
-		forClass: self
-		protocol: anotherString
-!
-
-recompile
-	^ Compiler new recompile: self
-!
-
-removeCompiledMethod: aMethod
-	self basicRemoveCompiledMethod: aMethod.
-	
-	self removeProtocolIfEmpty: aMethod protocol.
-	
-	SystemAnnouncer current
-		announce: (MethodRemoved new
-			method: aMethod;
-			yourself)
-!
-
-setTraitComposition: aTraitComposition
-	<inlineJS: '$core.setTraitComposition(aTraitComposition._asJavaScriptObject(), self)'>
-! !
-
-!BehaviorBody methodsFor: 'enumerating'!
-
-protocolsDo: aBlock
-	"Execute aBlock for each method protocol with
-	its collection of methods in the sort order of protocol name."
-
-	| methodsByProtocol |
-	methodsByProtocol := HashedCollection new.
-	self methodDictionary valuesDo: [ :m |
-		(methodsByProtocol at: m protocol ifAbsentPut: [ Array new ])
-			add: m ].
-	self protocols do: [ :protocol |
-		aBlock value: protocol value: (methodsByProtocol at: protocol) ]
 ! !
 
 !BehaviorBody methodsFor: 'printing'!
@@ -207,22 +31,6 @@ printOn: aStream
 		ifNotNil: [ :name | aStream nextPutAll: name ]
 ! !
 
-!BehaviorBody methodsFor: 'private'!
-
-basicAddCompiledMethod: aMethod
-	<inlineJS: '$core.addMethod(aMethod, self)'>
-!
-
-basicRemoveCompiledMethod: aMethod
-	<inlineJS: '$core.removeMethod(aMethod,self)'>
-! !
-
-!BehaviorBody methodsFor: 'testing'!
-
-includesSelector: aString
-	^ self methodDictionary includesKey: aString
-! !
-
 BehaviorBody subclass: #Behavior
 	instanceVariableNames: ''
 	package: 'Kernel-Classes'!
@@ -923,6 +731,205 @@ allSubclassesDo: aBlock
 	"Default for non-classes; to be able to send #allSubclassesDo: to any class / trait."
 ! !
 
+Trait named: #TBehaviorProvider
+	package: 'Kernel-Classes'!
+!TBehaviorProvider commentStamp!
+I have method dictionary and organization.!
+
+!TBehaviorProvider methodsFor: 'accessing'!
+
+>> aString
+	^ self methodAt: aString
+!
+
+methodAt: aString
+	^ self methodDictionary at: aString
+!
+
+methodDictionary
+	<inlineJS: 'var dict = $globals.HashedCollection._new();
+	var methods = self.methods;
+	Object.keys(methods).forEach(function(i) {
+		if(methods[i].selector) {
+			dict._at_put_(methods[i].selector, methods[i]);
+		}
+	});
+	return dict'>
+!
+
+methodTemplate
+	^ String streamContents: [ :stream | stream 
+		write: 'messageSelectorAndArgumentNames'; lf;
+		tab; write: '"comment stating purpose of message"'; lf;
+		lf;
+		tab; write: '| temporary variable names |'; lf;
+		tab; write: 'statements' ]
+!
+
+methods
+	^ self methodDictionary values
+!
+
+methodsInProtocol: aString
+	^ self methods select: [ :each | each protocol = aString ]
+!
+
+organization
+	^ self basicAt: 'organization'
+!
+
+ownMethods
+	"Answer the methods of the receiver that are not package extensions
+	nor obtained via trait composition"
+
+	^ (self ownProtocols 
+		inject: OrderedCollection new
+		into: [ :acc :each | acc, (self ownMethodsInProtocol: each) ])
+			sorted: [ :a :b | a selector <= b selector ]
+!
+
+ownMethodsInProtocol: aString
+	^ (self methodsInProtocol: aString) select: [ :each | each methodClass = self ]
+!
+
+ownProtocols
+	"Answer the protocols of the receiver that are not package extensions"
+
+	^ self protocols reject: [ :each |
+		each match: '^\*' ]
+!
+
+packageOfProtocol: aString
+	"Answer the package the method of receiver belongs to:
+	- if it is an extension method, answer the corresponding package
+	- else answer the receiver's package"
+	
+	(aString beginsWith: '*') ifFalse: [
+		^ self package ].
+		
+	^ Package 
+		named: aString allButFirst
+		ifAbsent: [ nil ]
+!
+
+protocols
+	^ self organization elements sorted
+!
+
+removeProtocolIfEmpty: aString
+	self methods
+		detect: [ :each | each protocol = aString ]
+		ifNone: [ self organization removeElement: aString ]
+!
+
+selectors
+	^ self methodDictionary keys
+!
+
+traitComposition
+	^ (self basicAt: 'traitComposition') collect: [ :each | TraitTransformation fromJSON: each ]
+!
+
+traitCompositionDefinition
+	^ self traitComposition ifNotEmpty: [ :traitComposition |
+		String streamContents: [ :str |
+			str write: '{'.
+			traitComposition
+				do: [ :each | str write: each definition ]
+				separatedBy: [ str write: '. ' ].
+			str write: '}' ] ]
+! !
+
+!TBehaviorProvider methodsFor: 'compiling'!
+
+addCompiledMethod: aMethod
+	| oldMethod announcement |
+	
+	oldMethod := self methodDictionary
+		at: aMethod selector
+		ifAbsent: [ nil ].
+	
+	(self protocols includes: aMethod protocol)
+		ifFalse: [ self organization addElement: aMethod protocol ].
+
+	self basicAddCompiledMethod: aMethod.
+	
+	oldMethod ifNotNil: [
+		self removeProtocolIfEmpty: oldMethod protocol ].
+	
+	announcement := oldMethod
+		ifNil: [
+			MethodAdded new
+					method: aMethod;
+					yourself ]
+		ifNotNil: [
+			MethodModified new
+					oldMethod: oldMethod;
+					method: aMethod;
+					yourself ].
+					
+					
+	SystemAnnouncer current
+				announce: announcement
+!
+
+compile: aString protocol: anotherString
+	^ Compiler new
+		install: aString
+		forClass: self
+		protocol: anotherString
+!
+
+recompile
+	^ Compiler new recompile: self
+!
+
+removeCompiledMethod: aMethod
+	self basicRemoveCompiledMethod: aMethod.
+	
+	self removeProtocolIfEmpty: aMethod protocol.
+	
+	SystemAnnouncer current
+		announce: (MethodRemoved new
+			method: aMethod;
+			yourself)
+!
+
+setTraitComposition: aTraitComposition
+	<inlineJS: '$core.setTraitComposition(aTraitComposition._asJavaScriptObject(), self)'>
+! !
+
+!TBehaviorProvider methodsFor: 'enumerating'!
+
+protocolsDo: aBlock
+	"Execute aBlock for each method protocol with
+	its collection of methods in the sort order of protocol name."
+
+	| methodsByProtocol |
+	methodsByProtocol := HashedCollection new.
+	self methodDictionary valuesDo: [ :m |
+		(methodsByProtocol at: m protocol ifAbsentPut: [ Array new ])
+			add: m ].
+	self protocols do: [ :protocol |
+		aBlock value: protocol value: (methodsByProtocol at: protocol) ]
+! !
+
+!TBehaviorProvider methodsFor: 'private'!
+
+basicAddCompiledMethod: aMethod
+	<inlineJS: '$core.addMethod(aMethod, self)'>
+!
+
+basicRemoveCompiledMethod: aMethod
+	<inlineJS: '$core.removeMethod(aMethod,self)'>
+! !
+
+!TBehaviorProvider methodsFor: 'testing'!
+
+includesSelector: aString
+	^ self methodDictionary includesKey: aString
+! !
+
 Trait named: #TMasterBehavior
 	package: 'Kernel-Classes'!
 !TMasterBehavior commentStamp!
@@ -1117,9 +1124,9 @@ on: aTrait
 	^ super new trait: aTrait; yourself
 ! !
 
-Behavior setTraitComposition: {TBehaviorDefaults} asTraitComposition!
+Behavior setTraitComposition: {TBehaviorDefaults. TBehaviorProvider} asTraitComposition!
 Class setTraitComposition: {TMasterBehavior} asTraitComposition!
-Trait setTraitComposition: {TBehaviorDefaults. TMasterBehavior} asTraitComposition!
+Trait setTraitComposition: {TBehaviorDefaults. TBehaviorProvider. TMasterBehavior} asTraitComposition!
 ! !
 
 !Array methodsFor: '*Kernel-Classes'!

src/Platform-ImportExport.js

@@ -4269,30 +4269,6 @@ messageSends: []
 }),
 $globals.AmdPackageTransport.klass);
 
-$core.addMethod(
-$core.method({
-selector: "exportBehaviorDefinitionTo:using:",
-protocol: "*Platform-ImportExport",
-fn: function (aStream,anExporter){
-var self=this;
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-return $core.withContext(function($ctx1) {
-//>>excludeEnd("ctx");
-self._subclassResponsibility();
-return self;
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx1) {$ctx1.fill(self,"exportBehaviorDefinitionTo:using:",{aStream:aStream,anExporter:anExporter},$globals.BehaviorBody)});
-//>>excludeEnd("ctx");
-},
-//>>excludeStart("ide", pragmas.excludeIdeData);
-args: ["aStream", "anExporter"],
-source: "exportBehaviorDefinitionTo: aStream using: anExporter\x0a\x09self subclassResponsibility",
-referencedClasses: [],
-//>>excludeEnd("ide");
-messageSends: ["subclassResponsibility"]
-}),
-$globals.BehaviorBody);
-
 $core.addMethod(
 $core.method({
 selector: "methodsFor:",
@@ -4307,7 +4283,7 @@ $1=$recv($globals.ClassProtocolReader)._new();
 $recv($1)._class_category_(self,aString);
 return $recv($1)._yourself();
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx1) {$ctx1.fill(self,"methodsFor:",{aString:aString},$globals.BehaviorBody)});
+}, function($ctx1) {$ctx1.fill(self,"methodsFor:",{aString:aString},$globals.TBehaviorProvider)});
 //>>excludeEnd("ctx");
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
@@ -4317,7 +4293,7 @@ referencedClasses: ["ClassProtocolReader"],
 //>>excludeEnd("ide");
 messageSends: ["class:category:", "new", "yourself"]
 }),
-$globals.BehaviorBody);
+$globals.TBehaviorProvider);
 
 $core.addMethod(
 $core.method({
@@ -4330,7 +4306,7 @@ return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
 return self._methodsFor_(aString);
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx1) {$ctx1.fill(self,"methodsFor:stamp:",{aString:aString,aStamp:aStamp},$globals.BehaviorBody)});
+}, function($ctx1) {$ctx1.fill(self,"methodsFor:stamp:",{aString:aString,aStamp:aStamp},$globals.TBehaviorProvider)});
 //>>excludeEnd("ctx");
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
@@ -4340,6 +4316,30 @@ referencedClasses: [],
 //>>excludeEnd("ide");
 messageSends: ["methodsFor:"]
 }),
+$globals.TBehaviorProvider);
+
+$core.addMethod(
+$core.method({
+selector: "exportBehaviorDefinitionTo:using:",
+protocol: "*Platform-ImportExport",
+fn: function (aStream,anExporter){
+var self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+self._subclassResponsibility();
+return self;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"exportBehaviorDefinitionTo:using:",{aStream:aStream,anExporter:anExporter},$globals.BehaviorBody)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aStream", "anExporter"],
+source: "exportBehaviorDefinitionTo: aStream using: anExporter\x0a\x09self subclassResponsibility",
+referencedClasses: [],
+//>>excludeEnd("ide");
+messageSends: ["subclassResponsibility"]
+}),
 $globals.BehaviorBody);
 
 $core.addMethod(
@@ -4559,6 +4559,55 @@ messageSends: ["loadFromNamespace:", "named:"]
 }),
 $globals.Package.klass);
 
+$core.addMethod(
+$core.method({
+selector: "methodsFor:",
+protocol: "*Platform-ImportExport",
+fn: function (aString){
+var self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+var $1;
+$1=$recv($globals.ClassProtocolReader)._new();
+$recv($1)._class_category_(self,aString);
+return $recv($1)._yourself();
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"methodsFor:",{aString:aString},$globals.TBehaviorProvider)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aString"],
+source: "methodsFor: aString\x0a\x09^ ClassProtocolReader new\x0a\x09\x09class: self category: aString;\x0a\x09\x09yourself",
+referencedClasses: ["ClassProtocolReader"],
+//>>excludeEnd("ide");
+messageSends: ["class:category:", "new", "yourself"]
+}),
+$globals.TBehaviorProvider);
+
+$core.addMethod(
+$core.method({
+selector: "methodsFor:stamp:",
+protocol: "*Platform-ImportExport",
+fn: function (aString,aStamp){
+var self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+return self._methodsFor_(aString);
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"methodsFor:stamp:",{aString:aString,aStamp:aStamp},$globals.TBehaviorProvider)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aString", "aStamp"],
+source: "methodsFor: aString stamp: aStamp\x0a\x09\x22Added for file-in compatibility, ignores stamp.\x22\x0a\x09^ self methodsFor: aString",
+referencedClasses: [],
+//>>excludeEnd("ide");
+messageSends: ["methodsFor:"]
+}),
+$globals.TBehaviorProvider);
+
 $core.addMethod(
 $core.method({
 selector: "commentStamp",
@@ -4681,4 +4730,53 @@ messageSends: ["exportTraitDefinitionOf:on:"]
 }),
 $globals.Trait);
 
+$core.addMethod(
+$core.method({
+selector: "methodsFor:",
+protocol: "*Platform-ImportExport",
+fn: function (aString){
+var self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+var $1;
+$1=$recv($globals.ClassProtocolReader)._new();
+$recv($1)._class_category_(self,aString);
+return $recv($1)._yourself();
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"methodsFor:",{aString:aString},$globals.TBehaviorProvider)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aString"],
+source: "methodsFor: aString\x0a\x09^ ClassProtocolReader new\x0a\x09\x09class: self category: aString;\x0a\x09\x09yourself",
+referencedClasses: ["ClassProtocolReader"],
+//>>excludeEnd("ide");
+messageSends: ["class:category:", "new", "yourself"]
+}),
+$globals.TBehaviorProvider);
+
+$core.addMethod(
+$core.method({
+selector: "methodsFor:stamp:",
+protocol: "*Platform-ImportExport",
+fn: function (aString,aStamp){
+var self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+return self._methodsFor_(aString);
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"methodsFor:stamp:",{aString:aString,aStamp:aStamp},$globals.TBehaviorProvider)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aString", "aStamp"],
+source: "methodsFor: aString stamp: aStamp\x0a\x09\x22Added for file-in compatibility, ignores stamp.\x22\x0a\x09^ self methodsFor: aString",
+referencedClasses: [],
+//>>excludeEnd("ide");
+messageSends: ["methodsFor:"]
+}),
+$globals.TBehaviorProvider);
+
 });

src/Platform-ImportExport.st

@@ -1124,17 +1124,6 @@ namespace: aString
 
 exportBehaviorDefinitionTo: aStream using: anExporter
 	self subclassResponsibility
-!
-
-methodsFor: aString
-	^ ClassProtocolReader new
-		class: self category: aString;
-		yourself
-!
-
-methodsFor: aString stamp: aStamp
-	"Added for file-in compatibility, ignores stamp."
-	^ self methodsFor: aString
 ! !
 
 !Class methodsFor: '*Platform-ImportExport'!
@@ -1175,6 +1164,19 @@ load: aPackageName fromNamespace: aString
 	(self named: aPackageName) loadFromNamespace: aString
 ! !
 
+!TBehaviorProvider methodsFor: '*Platform-ImportExport'!
+
+methodsFor: aString
+	^ ClassProtocolReader new
+		class: self category: aString;
+		yourself
+!
+
+methodsFor: aString stamp: aStamp
+	"Added for file-in compatibility, ignores stamp."
+	^ self methodsFor: aString
+! !
+
 !TMasterBehavior methodsFor: '*Platform-ImportExport'!
 
 commentStamp