Fixes #833

- Adds CompiledMethod >> package
- Use the method package (if selected) to determine which package to commit

js/Helios-Core.js

@@ -314,11 +314,11 @@ protocol: 'commands actions',
 fn: function (){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
-_st(self._environment())._commitPackage_(self._selectedPackage());
+_st(self._environment())._commitPackage_(self._packageToCommit());
 return self}, function($ctx1) {$ctx1.fill(self,"commitPackage",{},globals.HLToolModel)})},
 args: [],
-source: "commitPackage\x0a\x09self environment commitPackage: self selectedPackage",
-messageSends: ["commitPackage:", "environment", "selectedPackage"],
+source: "commitPackage\x0a\x09self environment commitPackage: self packageToCommit",
+messageSends: ["commitPackage:", "environment", "packageToCommit"],
 referencedClasses: []
 }),
 globals.HLToolModel);
@@ -617,6 +617,31 @@ referencedClasses: []
 }),
 globals.HLToolModel);
 
+smalltalk.addMethod(
+smalltalk.method({
+selector: "packageToCommit",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1;
+$2=self._selectedMethod();
+if(($receiver = $2) == nil || $receiver == null){
+$1=self._selectedPackage();
+} else {
+var method;
+method=$receiver;
+$1=_st(method)._package();
+};
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"packageToCommit",{},globals.HLToolModel)})},
+args: [],
+source: "packageToCommit\x0a\x09\x22Answer the package to commit depending on the context:\x0a\x09- if a Method is selected, answer its package\x0a\x09- else answer the `selectedPackage`\x22\x0a\x09\x0a\x09^ self selectedMethod \x0a\x09\x09ifNil: [ self selectedPackage ]\x0a\x09\x09ifNotNil: [ :method | method package ]",
+messageSends: ["ifNil:ifNotNil:", "selectedMethod", "selectedPackage", "package"],
+referencedClasses: []
+}),
+globals.HLToolModel);
+
 smalltalk.addMethod(
 smalltalk.method({
 selector: "packages",

js/Kernel-Methods.js

@@ -658,6 +658,38 @@ referencedClasses: []
 }),
 globals.CompiledMethod);
 
+smalltalk.addMethod(
+smalltalk.method({
+selector: "package",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+function $Package(){return globals.Package||(typeof Package=="undefined"?nil:Package)}
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1,$4,$3,$5;
+$2=self._protocol();
+$ctx1.sendIdx["protocol"]=1;
+$1=_st($2)._beginsWith_("*");
+if(! smalltalk.assert($1)){
+$4=self._methodClass();
+$ctx1.sendIdx["methodClass"]=1;
+$3=_st($4)._package();
+$ctx1.sendIdx["package"]=1;
+return $3;
+};
+$5=_st($Package())._named_ifAbsent_(_st(self._protocol())._allButFirst(),(function(){
+return smalltalk.withContext(function($ctx2) {
+return _st(self._methodClass())._package();
+}, function($ctx2) {$ctx2.fillBlock({},$ctx1,2)})}));
+return $5;
+}, function($ctx1) {$ctx1.fill(self,"package",{},globals.CompiledMethod)})},
+args: [],
+source: "package\x0a\x09\x22Answer the package the receiver belongs to:\x0a\x09- if it is an extension method, answer the corresponding package\x0a\x09- else answer the `methodClass` package\x22\x0a\x09\x0a\x09(self protocol beginsWith: '*') ifFalse: [\x0a\x09\x09^ self methodClass package ].\x0a\x09\x09\x0a\x09^ Package \x0a\x09\x09named: self protocol allButFirst\x0a\x09\x09ifAbsent: [ self methodClass package ]",
+messageSends: ["ifFalse:", "beginsWith:", "protocol", "package", "methodClass", "named:ifAbsent:", "allButFirst"],
+referencedClasses: ["Package"]
+}),
+globals.CompiledMethod);
+
 smalltalk.addMethod(
 smalltalk.method({
 selector: "protocol",

st/Helios-Core.st

@@ -92,6 +92,16 @@ availableProtocols
 	^ self environment availableProtocolsFor: self selectedClass
 !
 
+packageToCommit
+	"Answer the package to commit depending on the context:
+	- if a Method is selected, answer its package
+	- else answer the `selectedPackage`"
+	
+	^ self selectedMethod 
+		ifNil: [ self selectedPackage ]
+		ifNotNil: [ :method | method package ]
+!
+
 packages
 	^ self environment packages
 !
@@ -191,7 +201,7 @@ saveSourceCode
 !HLToolModel methodsFor: 'commands actions'!
 
 commitPackage
-	self environment commitPackage: self selectedPackage
+	self environment commitPackage: self packageToCommit
 !
 
 copyClassTo: aClassName

st/Kernel-Methods.st

@@ -224,6 +224,19 @@ methodClass
 	^ self basicAt: 'methodClass'
 !
 
+package
+	"Answer the package the receiver belongs to:
+	- if it is an extension method, answer the corresponding package
+	- else answer the `methodClass` package"
+	
+	(self protocol beginsWith: '*') ifFalse: [
+		^ self methodClass package ].
+		
+	^ Package 
+		named: self protocol allButFirst
+		ifAbsent: [ self methodClass package ]
+!
+
 protocol
 	^ (self basicAt: 'protocol') ifNil: [ self defaultProtocol ]
 !