SUnit for Helios

src/Compiler-Core.js

@@ -687,31 +687,6 @@ globals.Compiler.klass);
 
 smalltalk.addClass('DoIt', globals.Object, [], 'Compiler-Core');
 globals.DoIt.comment="`DoIt` is the class used to compile and evaluate expressions. See `Compiler >> evaluateExpression:`.";
-smalltalk.addMethod(
-smalltalk.method({
-selector: "xxxDoIt",
-protocol: 'xxxDoIt',
-fn: function (){
-var self=this;
-function $Smalltalk(){return globals.Smalltalk||(typeof Smalltalk=="undefined"?nil:Smalltalk)}
-return smalltalk.withContext(function($ctx1) { 
-var $1;
-$1=_st((function(){
-return smalltalk.withContext(function($ctx2) {
-return _st(_st($Smalltalk())._packages())._do_((function(each){
-return smalltalk.withContext(function($ctx3) {
-return _st(each)._commit();
-}, function($ctx3) {$ctx3.fillBlock({each:each},$ctx2,2)})}));
-}, function($ctx2) {$ctx2.fillBlock({},$ctx1,1)})}))._value();
-return $1;
-}, function($ctx1) {$ctx1.fill(self,"xxxDoIt",{},globals.DoIt)})},
-args: [],
-source: "xxxDoIt ^ [ Smalltalk packages do: [ :each | each commit ] ] value",
-messageSends: ["value", "do:", "packages", "commit"],
-referencedClasses: ["Smalltalk"]
-}),
-globals.DoIt);
-
 
 
 smalltalk.addClass('Evaluator', globals.InterfacingObject, [], 'Compiler-Core');

src/Helios-Announcements.js

@@ -504,6 +504,124 @@ smalltalk.addClass('HLPackageSelected', globals.HLItemSelected, [], 'Helios-Anno
 smalltalk.addClass('HLProtocolSelected', globals.HLItemSelected, [], 'Helios-Announcements');
 
 
+smalltalk.addClass('HLItemUnselected', globals.HLAnnouncement, ['item'], 'Helios-Announcements');
+smalltalk.addMethod(
+smalltalk.method({
+selector: "item",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+var $1;
+$1=self["@item"];
+return $1;
+},
+args: [],
+source: "item\x0a\x09^ item",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLItemUnselected);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "item:",
+protocol: 'accessing',
+fn: function (anObject){
+var self=this;
+self["@item"]=anObject;
+return self},
+args: ["anObject"],
+source: "item: anObject\x0a\x09item := anObject",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLItemUnselected);
+
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "on:",
+protocol: 'instance creation',
+fn: function (anItem){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $2,$3,$1;
+$2=self._new();
+_st($2)._item_(anItem);
+$3=_st($2)._yourself();
+$1=$3;
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"on:",{anItem:anItem},globals.HLItemUnselected.klass)})},
+args: ["anItem"],
+source: "on: anItem\x0a\x09^ self new\x0a    \x09item: anItem;\x0a        yourself",
+messageSends: ["item:", "new", "yourself"],
+referencedClasses: []
+}),
+globals.HLItemUnselected.klass);
+
+
+smalltalk.addClass('HLClassUnselected', globals.HLItemUnselected, [], 'Helios-Announcements');
+
+
+smalltalk.addClass('HLPackageUnselected', globals.HLItemUnselected, [], 'Helios-Announcements');
+
+
+smalltalk.addClass('HLRunTests', globals.HLAnnouncement, ['testSuiteRunner'], 'Helios-Announcements');
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testSuiteRunner",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+var $1;
+$1=self["@testSuiteRunner"];
+return $1;
+},
+args: [],
+source: "testSuiteRunner\x0a\x09^ testSuiteRunner",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLRunTests);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testSuiteRunner:",
+protocol: 'accessing',
+fn: function (anObject){
+var self=this;
+self["@testSuiteRunner"]=anObject;
+return self},
+args: ["anObject"],
+source: "testSuiteRunner: anObject\x0a\x09testSuiteRunner := anObject",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLRunTests);
+
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "on:",
+protocol: 'instance creation',
+fn: function (aTestSuiteRunner){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $2,$3,$1;
+$2=self._new();
+_st($2)._testSuiteRunner_(aTestSuiteRunner);
+$3=_st($2)._yourself();
+$1=$3;
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"on:",{aTestSuiteRunner:aTestSuiteRunner},globals.HLRunTests.klass)})},
+args: ["aTestSuiteRunner"],
+source: "on: aTestSuiteRunner\x0a\x09^self new\x0a\x09\x09testSuiteRunner: aTestSuiteRunner;\x0a\x09\x09yourself",
+messageSends: ["testSuiteRunner:", "new", "yourself"],
+referencedClasses: []
+}),
+globals.HLRunTests.klass);
+
+
 smalltalk.addClass('HLSaveSourceCode', globals.HLAnnouncement, [], 'Helios-Announcements');
 
 

src/Helios-Announcements.st

@@ -258,6 +258,58 @@ HLItemSelected subclass: #HLProtocolSelected
 	instanceVariableNames: ''
 	package: 'Helios-Announcements'!
 
+HLAnnouncement subclass: #HLItemUnselected
+	instanceVariableNames: 'item'
+	package: 'Helios-Announcements'!
+
+!HLItemUnselected methodsFor: 'accessing'!
+
+item
+	^ item
+!
+
+item: anObject
+	item := anObject
+! !
+
+!HLItemUnselected class methodsFor: 'instance creation'!
+
+on: anItem
+	^ self new
+    	item: anItem;
+        yourself
+! !
+
+HLItemUnselected subclass: #HLClassUnselected
+	instanceVariableNames: ''
+	package: 'Helios-Announcements'!
+
+HLItemUnselected subclass: #HLPackageUnselected
+	instanceVariableNames: ''
+	package: 'Helios-Announcements'!
+
+HLAnnouncement subclass: #HLRunTests
+	instanceVariableNames: 'testSuiteRunner'
+	package: 'Helios-Announcements'!
+
+!HLRunTests methodsFor: 'accessing'!
+
+testSuiteRunner
+	^ testSuiteRunner
+!
+
+testSuiteRunner: anObject
+	testSuiteRunner := anObject
+! !
+
+!HLRunTests class methodsFor: 'instance creation'!
+
+on: aTestSuiteRunner
+	^self new
+		testSuiteRunner: aTestSuiteRunner;
+		yourself
+! !
+
 HLAnnouncement subclass: #HLSaveSourceCode
 	instanceVariableNames: ''
 	package: 'Helios-Announcements'!

src/Helios-Commands-SUnit.js

@@ -0,0 +1,202 @@
+define("helios/Helios-Commands-SUnit", ["amber_vm/smalltalk", "amber_vm/nil", "amber_vm/_st", "amber_vm/globals", "helios/Helios-Commands-Tools"], function(smalltalk,nil,_st, globals){
+smalltalk.addPackage('Helios-Commands-SUnit');
+smalltalk.packages["Helios-Commands-SUnit"].transport = {"type":"amd","amdNamespace":"helios"};
+
+smalltalk.addClass('HLSUnitCommand', globals.HLToolCommand, [], 'Helios-Commands-SUnit');
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "isValidFor:",
+protocol: 'testing',
+fn: function (aModel){
+var self=this;
+function $HLSUnitModel(){return globals.HLSUnitModel||(typeof HLSUnitModel=="undefined"?nil:HLSUnitModel)}
+return smalltalk.withContext(function($ctx1) { 
+var $1;
+$1=_st(aModel)._isKindOf_($HLSUnitModel());
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"isValidFor:",{aModel:aModel},globals.HLSUnitCommand.klass)})},
+args: ["aModel"],
+source: "isValidFor: aModel\x0a\x09^ aModel isKindOf: HLSUnitModel",
+messageSends: ["isKindOf:"],
+referencedClasses: ["HLSUnitModel"]
+}),
+globals.HLSUnitCommand.klass);
+
+
+smalltalk.addClass('HLSUnitRunTests', globals.HLSUnitCommand, [], 'Helios-Commands-SUnit');
+smalltalk.addMethod(
+smalltalk.method({
+selector: "execute",
+protocol: 'executing',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+_st(self._model())._runTests();
+return self}, function($ctx1) {$ctx1.fill(self,"execute",{},globals.HLSUnitRunTests)})},
+args: [],
+source: "execute\x0a\x09self model runTests",
+messageSends: ["runTests", "model"],
+referencedClasses: []
+}),
+globals.HLSUnitRunTests);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "isActive",
+protocol: 'testing',
+fn: function (){
+var self=this;
+return true;
+},
+args: [],
+source: "isActive\x0a\x09^true",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitRunTests);
+
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "key",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "r";
+},
+args: [],
+source: "key\x0a\x09^'r'",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitRunTests.klass);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "label",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "Run Tests";
+},
+args: [],
+source: "label\x0a\x09^'Run Tests'",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitRunTests.klass);
+
+
+smalltalk.addClass('HLSUnitSelectAllCommand', globals.HLSUnitCommand, [], 'Helios-Commands-SUnit');
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "key",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "a";
+},
+args: [],
+source: "key\x0a\x09^ 'a'",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitSelectAllCommand.klass);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "label",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "Select all";
+},
+args: [],
+source: "label\x0a\x09^ 'Select all'",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitSelectAllCommand.klass);
+
+
+smalltalk.addClass('HLSUnitSelectAllPackagesCommand', globals.HLSUnitSelectAllCommand, [], 'Helios-Commands-SUnit');
+smalltalk.addMethod(
+smalltalk.method({
+selector: "category",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "Packages";
+},
+args: [],
+source: "category\x0a\x09^'Packages'",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitSelectAllPackagesCommand);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "execute",
+protocol: 'executing',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+_st(self._model())._selectAllPackages();
+return self}, function($ctx1) {$ctx1.fill(self,"execute",{},globals.HLSUnitSelectAllPackagesCommand)})},
+args: [],
+source: "execute\x0a\x09self model selectAllPackages",
+messageSends: ["selectAllPackages", "model"],
+referencedClasses: []
+}),
+globals.HLSUnitSelectAllPackagesCommand);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "isActive",
+protocol: 'testing',
+fn: function (){
+var self=this;
+return true;
+},
+args: [],
+source: "isActive\x0a\x09^true",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitSelectAllPackagesCommand);
+
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "key",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "p";
+},
+args: [],
+source: "key\x0a\x09^ 'p'",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitSelectAllPackagesCommand.klass);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "label",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "Select all packages";
+},
+args: [],
+source: "label\x0a\x09^ 'Select all packages'",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitSelectAllPackagesCommand.klass);
+
+});

src/Helios-Commands-SUnit.st

@@ -0,0 +1,83 @@
+Smalltalk createPackage: 'Helios-Commands-SUnit'!
+HLToolCommand subclass: #HLSUnitCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands-SUnit'!
+
+!HLSUnitCommand class methodsFor: 'testing'!
+
+isValidFor: aModel
+	^ aModel isKindOf: HLSUnitModel
+! !
+
+HLSUnitCommand subclass: #HLSUnitRunTests
+	instanceVariableNames: ''
+	package: 'Helios-Commands-SUnit'!
+
+!HLSUnitRunTests methodsFor: 'executing'!
+
+execute
+	self model runTests
+! !
+
+!HLSUnitRunTests methodsFor: 'testing'!
+
+isActive
+	^true
+! !
+
+!HLSUnitRunTests class methodsFor: 'accessing'!
+
+key
+	^'r'
+!
+
+label
+	^'Run Tests'
+! !
+
+HLSUnitCommand subclass: #HLSUnitSelectAllCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands-SUnit'!
+
+!HLSUnitSelectAllCommand class methodsFor: 'accessing'!
+
+key
+	^ 'a'
+!
+
+label
+	^ 'Select all'
+! !
+
+HLSUnitSelectAllCommand subclass: #HLSUnitSelectAllPackagesCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands-SUnit'!
+
+!HLSUnitSelectAllPackagesCommand methodsFor: 'accessing'!
+
+category
+	^'Packages'
+! !
+
+!HLSUnitSelectAllPackagesCommand methodsFor: 'executing'!
+
+execute
+	self model selectAllPackages
+! !
+
+!HLSUnitSelectAllPackagesCommand methodsFor: 'testing'!
+
+isActive
+	^true
+! !
+
+!HLSUnitSelectAllPackagesCommand class methodsFor: 'accessing'!
+
+key
+	^ 'p'
+!
+
+label
+	^ 'Select all packages'
+! !
+

src/Helios-Commands-Tools.js

@@ -571,21 +571,6 @@ referencedClasses: []
 globals.HLFindClassCommand);
 
 
-smalltalk.addMethod(
-smalltalk.method({
-selector: "isValidFor:",
-protocol: 'testing',
-fn: function (aModel){
-var self=this;
-return true;
-},
-args: ["aModel"],
-source: "isValidFor: aModel\x0a\x09^ true",
-messageSends: [],
-referencedClasses: []
-}),
-globals.HLFindClassCommand.klass);
-
 smalltalk.addMethod(
 smalltalk.method({
 selector: "key",

src/Helios-Commands-Tools.st

@@ -225,12 +225,6 @@ label
 	^ 'Find class'
 ! !
 
-!HLFindClassCommand class methodsFor: 'testing'!
-
-isValidFor: aModel
-	^ true
-! !
-
 HLFindCommand subclass: #HLFindReferencesCommand
 	instanceVariableNames: ''
 	package: 'Helios-Commands-Tools'!

src/Helios-Core.js

@@ -2057,25 +2057,28 @@ fn: function (aListItem){
 var self=this;
 var item;
 return smalltalk.withContext(function($ctx1) { 
-var $1,$2,$receiver;
+var $1,$2,$3,$4,$receiver;
 $1=_st(aListItem)._get_((0));
 if(($receiver = $1) == null || $receiver.isNil){
 return self;
 } else {
 $1;
 };
-_st(_st(_st(aListItem)._parent())._children())._removeClass_("active");
-_st(aListItem)._addClass_("active");
+$2=_st(_st(aListItem)._parent())._children();
+$3=self._activeItemCssClass();
+$ctx1.sendIdx["activeItemCssClass"]=1;
+_st($2)._removeClass_($3);
+_st(aListItem)._addClass_(self._activeItemCssClass());
 self._ensureVisible_(aListItem);
 item=_st(aListItem)._data_("item");
-$2=_st(self._selectedItem()).__eq_eq(item);
-if(! smalltalk.assert($2)){
+$4=_st(self._selectedItem()).__eq_eq(item);
+if(! smalltalk.assert($4)){
 self._selectItem_(item);
 };
 return self}, function($ctx1) {$ctx1.fill(self,"activateListItem:",{aListItem:aListItem,item:item},globals.HLListWidget)})},
 args: ["aListItem"],
-source: "activateListItem: aListItem\x0a\x09| item |\x0a\x09\x0a\x09(aListItem get: 0) ifNil: [ ^ self ].\x0a\x09aListItem parent children removeClass: 'active'.\x0a\x09aListItem addClass: 'active'.\x0a    \x0a\x09self ensureVisible: aListItem.\x0a    \x0a   \x22Activate the corresponding item\x22\x0a   item := aListItem data: 'item'.\x0a   self selectedItem == item ifFalse: [\x0a\x09   self selectItem: item ]",
-messageSends: ["ifNil:", "get:", "removeClass:", "children", "parent", "addClass:", "ensureVisible:", "data:", "ifFalse:", "==", "selectedItem", "selectItem:"],
+source: "activateListItem: aListItem\x0a\x09| item |\x0a\x09\x0a\x09(aListItem get: 0) ifNil: [ ^ self ].\x0a\x09aListItem parent children removeClass: self activeItemCssClass.\x0a\x09aListItem addClass: self activeItemCssClass.\x0a    \x0a\x09self ensureVisible: aListItem.\x0a    \x0a   \x22Activate the corresponding item\x22\x0a   item := aListItem data: 'item'.\x0a   self selectedItem == item ifFalse: [\x0a\x09   self selectItem: item ]",
+messageSends: ["ifNil:", "get:", "removeClass:", "children", "parent", "activeItemCssClass", "addClass:", "ensureVisible:", "data:", "ifFalse:", "==", "selectedItem", "selectItem:"],
 referencedClasses: []
 }),
 globals.HLListWidget);
@@ -2087,23 +2090,27 @@ protocol: 'actions',
 fn: function (){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
-var $4,$3,$2,$1;
+var $4,$3,$6,$5,$2,$1;
 $4=self._wrapper();
 $ctx1.sendIdx["wrapper"]=1;
 $3=_st($4)._asJQuery();
 $ctx1.sendIdx["asJQuery"]=1;
-$2=_st($3)._find_("li.active");
+$6=self._activeItemCssClass();
+$ctx1.sendIdx["activeItemCssClass"]=1;
+$5="li.".__comma($6);
+$ctx1.sendIdx[","]=1;
+$2=_st($3)._find_($5);
 $ctx1.sendIdx["find:"]=1;
 $1=_st($2)._next();
 self._activateListItem_($1);
-_st(_st(_st(_st(self._wrapper())._asJQuery())._find_(" .active"))._get())._ifEmpty_((function(){
+_st(_st(_st(_st(self._wrapper())._asJQuery())._find_(" .".__comma(self._activeItemCssClass())))._get())._ifEmpty_((function(){
 return smalltalk.withContext(function($ctx2) {
 return self._activateFirstListItem();
 }, function($ctx2) {$ctx2.fillBlock({},$ctx1,1)})}));
 return self}, function($ctx1) {$ctx1.fill(self,"activateNextListItem",{},globals.HLListWidget)})},
 args: [],
-source: "activateNextListItem\x0a\x09self activateListItem: (self wrapper asJQuery find: 'li.active') next.\x0a\x09\x0a\x09\x22select the first item if none is selected\x22\x0a\x09(self wrapper asJQuery find: ' .active') get ifEmpty: [\x0a\x09\x09self activateFirstListItem ]",
-messageSends: ["activateListItem:", "next", "find:", "asJQuery", "wrapper", "ifEmpty:", "get", "activateFirstListItem"],
+source: "activateNextListItem\x0a\x09self activateListItem: (self wrapper asJQuery find: ('li.', self activeItemCssClass)) next.\x0a\x09\x0a\x09\x22select the first item if none is selected\x22\x0a\x09(self wrapper asJQuery find: (' .', self activeItemCssClass)) get ifEmpty: [\x0a\x09\x09self activateFirstListItem ]",
+messageSends: ["activateListItem:", "next", "find:", "asJQuery", "wrapper", ",", "activeItemCssClass", "ifEmpty:", "get", "activateFirstListItem"],
 referencedClasses: []
 }),
 globals.HLListWidget);
@@ -2115,11 +2122,26 @@ protocol: 'actions',
 fn: function (){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
-self._activateListItem_(_st(_st(_st(self._wrapper())._asJQuery())._find_("li.active"))._prev());
+self._activateListItem_(_st(_st(_st(self._wrapper())._asJQuery())._find_("li.".__comma(self._activeItemCssClass())))._prev());
 return self}, function($ctx1) {$ctx1.fill(self,"activatePreviousListItem",{},globals.HLListWidget)})},
 args: [],
-source: "activatePreviousListItem\x0a\x09self activateListItem: (self wrapper asJQuery find: 'li.active') prev",
-messageSends: ["activateListItem:", "prev", "find:", "asJQuery", "wrapper"],
+source: "activatePreviousListItem\x0a\x09self activateListItem: (self wrapper asJQuery find:  ('li.', self activeItemCssClass)) prev",
+messageSends: ["activateListItem:", "prev", "find:", "asJQuery", "wrapper", ",", "activeItemCssClass"],
+referencedClasses: []
+}),
+globals.HLListWidget);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "activeItemCssClass",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "active";
+},
+args: [],
+source: "activeItemCssClass\x0a\x09^'active'",
+messageSends: [],
 referencedClasses: []
 }),
 globals.HLListWidget);
@@ -2320,6 +2342,21 @@ referencedClasses: []
 }),
 globals.HLListWidget);
 
+smalltalk.addMethod(
+smalltalk.method({
+selector: "listCssClass",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return "nav nav-pills nav-stacked";
+},
+args: [],
+source: "listCssClass \x0a\x09^'nav nav-pills nav-stacked'",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLListWidget);
+
 smalltalk.addMethod(
 smalltalk.method({
 selector: "listCssClassForItem:",
@@ -2426,7 +2463,7 @@ var self=this;
 return smalltalk.withContext(function($ctx1) { 
 var $1,$2,$3,$4;
 $1=_st(html)._ul();
-_st($1)._class_("nav nav-pills nav-stacked");
+_st($1)._class_(self._listCssClass());
 $ctx1.sendIdx["class:"]=1;
 $2=_st($1)._with_((function(){
 return smalltalk.withContext(function($ctx2) {
@@ -2442,8 +2479,8 @@ return self._renderButtonsOn_(html);
 self._setupKeyBindings();
 return self}, function($ctx1) {$ctx1.fill(self,"renderContentOn:",{html:html},globals.HLListWidget)})},
 args: ["html"],
-source: "renderContentOn: html\x0a\x09html ul \x0a    \x09class: 'nav nav-pills nav-stacked';\x0a        with: [ self renderListOn: html ].\x0a    html div class: 'pane_actions form-actions'; with: [\x0a      \x09self renderButtonsOn: html ].\x0a        \x0a   self setupKeyBindings",
-messageSends: ["class:", "ul", "with:", "renderListOn:", "div", "renderButtonsOn:", "setupKeyBindings"],
+source: "renderContentOn: html\x0a\x09html ul \x0a    \x09class: self listCssClass;\x0a        with: [ self renderListOn: html ].\x0a    html div class: 'pane_actions form-actions'; with: [\x0a      \x09self renderButtonsOn: html ].\x0a        \x0a   self setupKeyBindings",
+messageSends: ["class:", "ul", "listCssClass", "with:", "renderListOn:", "div", "renderButtonsOn:", "setupKeyBindings"],
 referencedClasses: []
 }),
 globals.HLListWidget);
@@ -6858,11 +6895,14 @@ selector: "openTestRunner",
 protocol: 'actions',
 fn: function (){
 var self=this;
-return self},
+function $HLSUnit(){return globals.HLSUnit||(typeof HLSUnit=="undefined"?nil:HLSUnit)}
+return smalltalk.withContext(function($ctx1) { 
+_st($HLSUnit())._openAsTab();
+return self}, function($ctx1) {$ctx1.fill(self,"openTestRunner",{},globals.HLWelcomeWidget)})},
 args: [],
-source: "openTestRunner",
-messageSends: [],
-referencedClasses: []
+source: "openTestRunner\x0a\x09HLSUnit openAsTab",
+messageSends: ["openAsTab"],
+referencedClasses: ["HLSUnit"]
 }),
 globals.HLWelcomeWidget);
 
@@ -6890,7 +6930,7 @@ protocol: 'rendering',
 fn: function (html){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
-var $1,$2,$3,$4;
+var $1,$2,$3,$4,$5,$6;
 $1=_st(html)._button();
 $ctx1.sendIdx["button"]=1;
 _st($1)._class_("button");
@@ -6903,16 +6943,27 @@ return self._openClassBrowser();
 }, function($ctx2) {$ctx2.fillBlock({},$ctx1,1)})}));
 $ctx1.sendIdx["onClick:"]=1;
 $3=_st(html)._button();
+$ctx1.sendIdx["button"]=2;
 _st($3)._class_("button");
+$ctx1.sendIdx["class:"]=2;
 _st($3)._with_("Workspace");
+$ctx1.sendIdx["with:"]=2;
 $4=_st($3)._onClick_((function(){
 return smalltalk.withContext(function($ctx2) {
 return self._openWorkspace();
 }, function($ctx2) {$ctx2.fillBlock({},$ctx1,2)})}));
+$ctx1.sendIdx["onClick:"]=2;
+$5=_st(html)._button();
+_st($5)._class_("button");
+_st($5)._with_("Test Runner");
+$6=_st($5)._onClick_((function(){
+return smalltalk.withContext(function($ctx2) {
+return self._openTestRunner();
+}, function($ctx2) {$ctx2.fillBlock({},$ctx1,3)})}));
 return self}, function($ctx1) {$ctx1.fill(self,"renderButtonsOn:",{html:html},globals.HLWelcomeWidget)})},
 args: ["html"],
-source: "renderButtonsOn: html\x0a\x09html button\x0a\x09\x09class: 'button';\x0a\x09\x09with: 'Class Browser';\x0a\x09\x09onClick: [ self openClassBrowser ].\x0a\x09html button\x0a\x09\x09class: 'button';\x0a\x09\x09with: 'Workspace';\x0a\x09\x09onClick: [ self openWorkspace ].\x0a\x09\x22html button\x0a\x09\x09class: 'button';\x0a\x09\x09with: 'Test Runner';\x0a\x09\x09onClick: [ self openTestRunner ].\x0a\x09html button\x0a\x09\x09class: 'button';\x0a\x09\x09with: 'Help';\x0a\x09\x09onClick: [ self openHelp ]\x22",
-messageSends: ["class:", "button", "with:", "onClick:", "openClassBrowser", "openWorkspace"],
+source: "renderButtonsOn: html\x0a\x09html button\x0a\x09\x09class: 'button';\x0a\x09\x09with: 'Class Browser';\x0a\x09\x09onClick: [ self openClassBrowser ].\x0a\x09html button\x0a\x09\x09class: 'button';\x0a\x09\x09with: 'Workspace';\x0a\x09\x09onClick: [ self openWorkspace ].\x0a\x09html button\x0a\x09\x09class: 'button';\x0a\x09\x09with: 'Test Runner';\x0a\x09\x09onClick: [ self openTestRunner ].\x0a\x09\x22html button\x0a\x09\x09class: 'button';\x0a\x09\x09with: 'Help';\x0a\x09\x09onClick: [ self openHelp ]\x22",
+messageSends: ["class:", "button", "with:", "onClick:", "openClassBrowser", "openWorkspace", "openTestRunner"],
 referencedClasses: []
 }),
 globals.HLWelcomeWidget);

src/Helios-Core.st

@@ -744,6 +744,10 @@ HLFocusableWidget subclass: #HLListWidget
 
 !HLListWidget methodsFor: 'accessing'!
 
+activeItemCssClass
+	^'active'
+!
+
 cssClassForItem: anObject
 	^ ''
 !
@@ -761,6 +765,10 @@ items: aCollection
 	items := aCollection
 !
 
+listCssClass 
+	^'nav nav-pills nav-stacked'
+!
+
 listCssClassForItem: anObject
 	^ self selectedItem = anObject
 		ifTrue: [ 'active' ]
@@ -795,8 +803,8 @@ activateListItem: aListItem
 	| item |
 	
 	(aListItem get: 0) ifNil: [ ^ self ].
-	aListItem parent children removeClass: 'active'.
-	aListItem addClass: 'active'.
+	aListItem parent children removeClass: self activeItemCssClass.
+	aListItem addClass: self activeItemCssClass.
     
 	self ensureVisible: aListItem.
     
@@ -807,15 +815,15 @@ activateListItem: aListItem
 !
 
 activateNextListItem
-	self activateListItem: (self wrapper asJQuery find: 'li.active') next.
+	self activateListItem: (self wrapper asJQuery find: ('li.', self activeItemCssClass)) next.
 	
 	"select the first item if none is selected"
-	(self wrapper asJQuery find: ' .active') get ifEmpty: [
+	(self wrapper asJQuery find: (' .', self activeItemCssClass)) get ifEmpty: [
 		self activateFirstListItem ]
 !
 
 activatePreviousListItem
-	self activateListItem: (self wrapper asJQuery find: 'li.active') prev
+	self activateListItem: (self wrapper asJQuery find:  ('li.', self activeItemCssClass)) prev
 !
 
 ensureVisible: aListItem	
@@ -881,7 +889,7 @@ renderButtonsOn: html
 
 renderContentOn: html
 	html ul 
-    	class: 'nav nav-pills nav-stacked';
+    	class: self listCssClass;
         with: [ self renderListOn: html ].
     html div class: 'pane_actions form-actions'; with: [
       	self renderButtonsOn: html ].
@@ -2294,6 +2302,7 @@ openHelp
 !
 
 openTestRunner
+	HLSUnit openAsTab
 !
 
 openWorkspace
@@ -2311,11 +2320,11 @@ renderButtonsOn: html
 		class: 'button';
 		with: 'Workspace';
 		onClick: [ self openWorkspace ].
-	"html button
+	html button
 		class: 'button';
 		with: 'Test Runner';
 		onClick: [ self openTestRunner ].
-	html button
+	"html button
 		class: 'button';
 		with: 'Help';
 		onClick: [ self openHelp ]"

src/Helios-SUnit-Tests.js

@@ -0,0 +1,313 @@
+define("helios/Helios-SUnit-Tests", ["amber_vm/smalltalk", "amber_vm/nil", "amber_vm/_st", "amber_vm/globals", "amber_core/SUnit"], function(smalltalk,nil,_st, globals){
+smalltalk.addPackage('Helios-SUnit-Tests');
+smalltalk.packages["Helios-SUnit-Tests"].transport = {"type":"amd","amdNamespace":"helios"};
+
+smalltalk.addClass('HLSUnitModelTest', globals.TestCase, ['model'], 'Helios-SUnit-Tests');
+smalltalk.addMethod(
+smalltalk.method({
+selector: "setUp",
+protocol: 'initializing',
+fn: function (){
+var self=this;
+function $HLSUnitModel(){return globals.HLSUnitModel||(typeof HLSUnitModel=="undefined"?nil:HLSUnitModel)}
+return smalltalk.withContext(function($ctx1) { 
+($ctx1.supercall = true, globals.HLSUnitModelTest.superclass.fn.prototype._setUp.apply(_st(self), []));
+$ctx1.supercall = false;
+self["@model"]=_st($HLSUnitModel())._new();
+return self}, function($ctx1) {$ctx1.fill(self,"setUp",{},globals.HLSUnitModelTest)})},
+args: [],
+source: "setUp\x0a\x09super setUp.\x0a\x09model := HLSUnitModel new",
+messageSends: ["setUp", "new"],
+referencedClasses: ["HLSUnitModel"]
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testClassBecomesAvailable",
+protocol: 'tests',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1;
+$2=_st(self["@model"])._testClasses();
+$ctx1.sendIdx["testClasses"]=1;
+$1=_st($2)._isEmpty();
+self._assert_($1);
+$ctx1.sendIdx["assert:"]=1;
+_st(self["@model"])._selectPackage_(self._thisPackage());
+self._assert_(_st(_st(self["@model"])._testClasses())._includes_(self._class()));
+return self}, function($ctx1) {$ctx1.fill(self,"testClassBecomesAvailable",{},globals.HLSUnitModelTest)})},
+args: [],
+source: "testClassBecomesAvailable\x0a\x09self assert: model testClasses isEmpty.\x0a\x09model selectPackage: self thisPackage.\x0a\x09self assert: (model testClasses includes: self class).\x0a\x09\x0a\x09",
+messageSends: ["assert:", "isEmpty", "testClasses", "selectPackage:", "thisPackage", "includes:", "class"],
+referencedClasses: []
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testEmptyTestResults",
+protocol: 'tests',
+fn: function (){
+var self=this;
+function $TestResult(){return globals.TestResult||(typeof TestResult=="undefined"?nil:TestResult)}
+return smalltalk.withContext(function($ctx1) { 
+self._assert_(_st(_st(self["@model"])._testResult())._isKindOf_($TestResult()));
+return self}, function($ctx1) {$ctx1.fill(self,"testEmptyTestResults",{},globals.HLSUnitModelTest)})},
+args: [],
+source: "testEmptyTestResults\x0a\x09self assert: (model testResult isKindOf: TestResult)",
+messageSends: ["assert:", "isKindOf:", "testResult"],
+referencedClasses: ["TestResult"]
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testSelectAllPackages",
+protocol: 'tests',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1,$3;
+$2=_st(self["@model"])._selectedPackages();
+$ctx1.sendIdx["selectedPackages"]=1;
+$1=_st($2)._isEmpty();
+self._assert_($1);
+_st(self["@model"])._selectAllPackages();
+$3=_st(_st(self["@model"])._selectedPackages())._size();
+$ctx1.sendIdx["size"]=1;
+self._assert_equals_($3,_st(_st(self["@model"])._testPackages())._size());
+return self}, function($ctx1) {$ctx1.fill(self,"testSelectAllPackages",{},globals.HLSUnitModelTest)})},
+args: [],
+source: "testSelectAllPackages\x0a\x09self assert: model selectedPackages isEmpty.\x0a\x09model selectAllPackages.\x0a\x09self assert: model selectedPackages size equals: model testPackages size",
+messageSends: ["assert:", "isEmpty", "selectedPackages", "selectAllPackages", "assert:equals:", "size", "testPackages"],
+referencedClasses: []
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testSelectClass",
+protocol: 'tests',
+fn: function (){
+var self=this;
+var announcementFired;
+function $HLClassSelected(){return globals.HLClassSelected||(typeof HLClassSelected=="undefined"?nil:HLClassSelected)}
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1,$3,$4;
+_st(self["@model"])._selectPackage_(self._thisPackage());
+$2=_st(self["@model"])._selectedClasses();
+$ctx1.sendIdx["selectedClasses"]=1;
+$1=_st($2)._isEmpty();
+self._assert_($1);
+$ctx1.sendIdx["assert:"]=1;
+_st(_st(self["@model"])._announcer())._on_do_for_($HLClassSelected(),(function(){
+announcementFired=true;
+return announcementFired;
+}),self);
+$3=self["@model"];
+$4=self._class();
+$ctx1.sendIdx["class"]=1;
+_st($3)._selectClass_($4);
+self._assert_equals_(_st(_st(self["@model"])._selectedClasses())._anyOne(),self._class());
+self._assert_(announcementFired);
+return self}, function($ctx1) {$ctx1.fill(self,"testSelectClass",{announcementFired:announcementFired},globals.HLSUnitModelTest)})},
+args: [],
+source: "testSelectClass\x0a\x09| announcementFired |\x0a\x09model selectPackage: self thisPackage.\x0a\x09self assert: model selectedClasses isEmpty.\x0a\x09model announcer on: HLClassSelected\x0a\x09\x09do: [ announcementFired := true ]\x0a\x09\x09for: self.\x0a\x09model selectClass: self class.\x0a\x09self assert: model selectedClasses anyOne equals: self class.\x0a\x09self assert: announcementFired.\x0a\x09\x0a\x09",
+messageSends: ["selectPackage:", "thisPackage", "assert:", "isEmpty", "selectedClasses", "on:do:for:", "announcer", "selectClass:", "class", "assert:equals:", "anyOne"],
+referencedClasses: ["HLClassSelected"]
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testSelectPackage",
+protocol: 'tests',
+fn: function (){
+var self=this;
+var announcementFired;
+function $HLPackageSelected(){return globals.HLPackageSelected||(typeof HLPackageSelected=="undefined"?nil:HLPackageSelected)}
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1,$3,$4;
+$2=_st(self["@model"])._selectedPackages();
+$ctx1.sendIdx["selectedPackages"]=1;
+$1=_st($2)._isEmpty();
+self._assert_($1);
+$ctx1.sendIdx["assert:"]=1;
+_st(_st(self["@model"])._announcer())._on_do_for_($HLPackageSelected(),(function(){
+announcementFired=true;
+return announcementFired;
+}),self);
+$3=self["@model"];
+$4=self._thisPackage();
+$ctx1.sendIdx["thisPackage"]=1;
+_st($3)._selectPackage_($4);
+self._assert_equals_(_st(_st(self["@model"])._selectedPackages())._anyOne(),self._thisPackage());
+self._assert_(announcementFired);
+return self}, function($ctx1) {$ctx1.fill(self,"testSelectPackage",{announcementFired:announcementFired},globals.HLSUnitModelTest)})},
+args: [],
+source: "testSelectPackage\x0a\x09| announcementFired |\x0a\x09self assert: model selectedPackages isEmpty.\x0a\x09model announcer on: HLPackageSelected\x0a\x09\x09do: [ announcementFired := true ]\x0a\x09\x09for: self.\x0a\x09model selectPackage: self thisPackage.\x0a\x09self assert: model selectedPackages anyOne equals: self thisPackage.\x0a\x09self assert: announcementFired",
+messageSends: ["assert:", "isEmpty", "selectedPackages", "on:do:for:", "announcer", "selectPackage:", "thisPackage", "assert:equals:", "anyOne"],
+referencedClasses: ["HLPackageSelected"]
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testSelectedClassNotListedIfPackageUnselected",
+protocol: 'tests',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $1,$2,$3,$4,$6,$5;
+$1=self["@model"];
+$2=self._thisPackage();
+$ctx1.sendIdx["thisPackage"]=1;
+_st($1)._selectPackage_($2);
+$3=self["@model"];
+$4=self._class();
+$ctx1.sendIdx["class"]=1;
+_st($3)._selectClass_($4);
+$6=_st(self["@model"])._selectedClasses();
+$ctx1.sendIdx["selectedClasses"]=1;
+$5=_st($6)._anyOne();
+self._assert_equals_($5,self._class());
+_st(self["@model"])._unselectPackage_(self._thisPackage());
+self._assert_(_st(_st(self["@model"])._selectedClasses())._isEmpty());
+return self}, function($ctx1) {$ctx1.fill(self,"testSelectedClassNotListedIfPackageUnselected",{},globals.HLSUnitModelTest)})},
+args: [],
+source: "testSelectedClassNotListedIfPackageUnselected\x0a\x09model selectPackage: self thisPackage.\x0a\x09model selectClass: self class.\x0a\x09self assert: model selectedClasses anyOne equals: self class.\x0a\x09model unselectPackage: self thisPackage.\x0a\x09self assert: model selectedClasses isEmpty.\x0a\x09",
+messageSends: ["selectPackage:", "thisPackage", "selectClass:", "class", "assert:equals:", "anyOne", "selectedClasses", "unselectPackage:", "assert:", "isEmpty"],
+referencedClasses: []
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testTestClassHasOnlyTestClasses",
+protocol: 'tests',
+fn: function (){
+var self=this;
+var notATestClass;
+function $Object(){return globals.Object||(typeof Object=="undefined"?nil:Object)}
+function $Smalltalk(){return globals.Smalltalk||(typeof Smalltalk=="undefined"?nil:Smalltalk)}
+return smalltalk.withContext(function($ctx1) { 
+notATestClass=_st($Object())._subclass_instanceVariableNames_package_("HLNotATestClass","",_st(self._class())._category());
+_st(self["@model"])._selectPackage_(self._thisPackage());
+self._deny_(_st(_st(self["@model"])._testClasses())._includes_(notATestClass));
+_st($Smalltalk())._removeClass_(notATestClass);
+return self}, function($ctx1) {$ctx1.fill(self,"testTestClassHasOnlyTestClasses",{notATestClass:notATestClass},globals.HLSUnitModelTest)})},
+args: [],
+source: "testTestClassHasOnlyTestClasses\x0a\x09| notATestClass |\x0a\x09notATestClass := Object subclass: #HLNotATestClass\x0a\x09\x09instanceVariableNames: ''\x0a\x09\x09package: self class category.\x0a\x09model selectPackage: self thisPackage.\x0a\x09self deny: (model testClasses includes: notATestClass).\x0a\x09Smalltalk removeClass: notATestClass.\x0a\x09\x0a\x09",
+messageSends: ["subclass:instanceVariableNames:package:", "category", "class", "selectPackage:", "thisPackage", "deny:", "includes:", "testClasses", "removeClass:"],
+referencedClasses: ["Object", "Smalltalk"]
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testTestPackages",
+protocol: 'tests',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1;
+$2=_st(self["@model"])._testPackages();
+$ctx1.sendIdx["testPackages"]=1;
+$1=_st($2)._notEmpty();
+self._assert_($1);
+$ctx1.sendIdx["assert:"]=1;
+self._assert_(_st(_st(self["@model"])._testPackages())._anySatisfy_((function(each){
+return smalltalk.withContext(function($ctx2) {
+return _st(each).__eq(self._thisPackage());
+}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)})})));
+return self}, function($ctx1) {$ctx1.fill(self,"testTestPackages",{},globals.HLSUnitModelTest)})},
+args: [],
+source: "testTestPackages\x0a\x09self assert: model testPackages notEmpty.\x0a\x09self assert: (model testPackages anySatisfy: [:each | each = self thisPackage]).",
+messageSends: ["assert:", "notEmpty", "testPackages", "anySatisfy:", "=", "thisPackage"],
+referencedClasses: []
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testUnselectClass",
+protocol: 'tests',
+fn: function (){
+var self=this;
+var announcementFired;
+function $HLClassUnselected(){return globals.HLClassUnselected||(typeof HLClassUnselected=="undefined"?nil:HLClassUnselected)}
+return smalltalk.withContext(function($ctx1) { 
+var $1,$2;
+_st(self["@model"])._selectPackage_(self._thisPackage());
+$1=self["@model"];
+$2=self._class();
+$ctx1.sendIdx["class"]=1;
+_st($1)._selectClass_($2);
+_st(_st(self["@model"])._announcer())._on_do_for_($HLClassUnselected(),(function(){
+announcementFired=true;
+return announcementFired;
+}),self);
+_st(self["@model"])._unselectClass_(self._class());
+self._assert_(_st(_st(self["@model"])._selectedClasses())._isEmpty());
+$ctx1.sendIdx["assert:"]=1;
+self._assert_(announcementFired);
+return self}, function($ctx1) {$ctx1.fill(self,"testUnselectClass",{announcementFired:announcementFired},globals.HLSUnitModelTest)})},
+args: [],
+source: "testUnselectClass\x0a\x09| announcementFired |\x0a\x09model selectPackage: self thisPackage.\x0a\x09model selectClass: self class.\x0a\x09model announcer on: HLClassUnselected\x0a\x09\x09do: [ announcementFired := true ]\x0a\x09\x09for: self.\x0a\x09model unselectClass: self class.\x0a\x09self assert: model selectedClasses isEmpty.\x0a\x09self assert: announcementFired\x0a\x09\x0a\x09",
+messageSends: ["selectPackage:", "thisPackage", "selectClass:", "class", "on:do:for:", "announcer", "unselectClass:", "assert:", "isEmpty", "selectedClasses"],
+referencedClasses: ["HLClassUnselected"]
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testUnselectPackage",
+protocol: 'tests',
+fn: function (){
+var self=this;
+var announcementFired;
+function $HLPackageUnselected(){return globals.HLPackageUnselected||(typeof HLPackageUnselected=="undefined"?nil:HLPackageUnselected)}
+return smalltalk.withContext(function($ctx1) { 
+var $1,$2;
+$1=self["@model"];
+$2=self._thisPackage();
+$ctx1.sendIdx["thisPackage"]=1;
+_st($1)._selectPackage_($2);
+_st(_st(self["@model"])._announcer())._on_do_for_($HLPackageUnselected(),(function(){
+announcementFired=true;
+return announcementFired;
+}),self);
+_st(self["@model"])._unselectPackage_(self._thisPackage());
+self._assert_(_st(_st(self["@model"])._selectedPackages())._isEmpty());
+$ctx1.sendIdx["assert:"]=1;
+self._assert_(announcementFired);
+return self}, function($ctx1) {$ctx1.fill(self,"testUnselectPackage",{announcementFired:announcementFired},globals.HLSUnitModelTest)})},
+args: [],
+source: "testUnselectPackage\x0a\x09| announcementFired |\x0a\x09model selectPackage: self thisPackage.\x0a\x09model announcer on: HLPackageUnselected\x0a\x09\x09do: [ announcementFired := true ]\x0a\x09\x09for: self.\x0a\x09model unselectPackage: self thisPackage.\x0a\x09self assert: model selectedPackages isEmpty.\x0a\x09self assert: announcementFired.",
+messageSends: ["selectPackage:", "thisPackage", "on:do:for:", "announcer", "unselectPackage:", "assert:", "isEmpty", "selectedPackages"],
+referencedClasses: ["HLPackageUnselected"]
+}),
+globals.HLSUnitModelTest);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "thisPackage",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $1;
+$1=_st(self._class())._package();
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"thisPackage",{},globals.HLSUnitModelTest)})},
+args: [],
+source: "thisPackage\x0a\x09^self class package",
+messageSends: ["package", "class"],
+referencedClasses: []
+}),
+globals.HLSUnitModelTest);
+
+
+});

src/Helios-SUnit-Tests.st

@@ -0,0 +1,105 @@
+Smalltalk createPackage: 'Helios-SUnit-Tests'!
+TestCase subclass: #HLSUnitModelTest
+	instanceVariableNames: 'model'
+	package: 'Helios-SUnit-Tests'!
+
+!HLSUnitModelTest methodsFor: 'accessing'!
+
+thisPackage
+	^self class package
+! !
+
+!HLSUnitModelTest methodsFor: 'initializing'!
+
+setUp
+	super setUp.
+	model := HLSUnitModel new
+! !
+
+!HLSUnitModelTest methodsFor: 'tests'!
+
+testClassBecomesAvailable
+	self assert: model testClasses isEmpty.
+	model selectPackage: self thisPackage.
+	self assert: (model testClasses includes: self class).
+!
+
+testEmptyTestResults
+	self assert: (model testResult isKindOf: TestResult)
+!
+
+testSelectAllPackages
+	self assert: model selectedPackages isEmpty.
+	model selectAllPackages.
+	self assert: model selectedPackages size equals: model testPackages size
+!
+
+testSelectClass
+	| announcementFired |
+	model selectPackage: self thisPackage.
+	self assert: model selectedClasses isEmpty.
+	model announcer on: HLClassSelected
+		do: [ announcementFired := true ]
+		for: self.
+	model selectClass: self class.
+	self assert: model selectedClasses anyOne equals: self class.
+	self assert: announcementFired.
+!
+
+testSelectPackage
+	| announcementFired |
+	self assert: model selectedPackages isEmpty.
+	model announcer on: HLPackageSelected
+		do: [ announcementFired := true ]
+		for: self.
+	model selectPackage: self thisPackage.
+	self assert: model selectedPackages anyOne equals: self thisPackage.
+	self assert: announcementFired
+!
+
+testSelectedClassNotListedIfPackageUnselected
+	model selectPackage: self thisPackage.
+	model selectClass: self class.
+	self assert: model selectedClasses anyOne equals: self class.
+	model unselectPackage: self thisPackage.
+	self assert: model selectedClasses isEmpty.
+!
+
+testTestClassHasOnlyTestClasses
+	| notATestClass |
+	notATestClass := Object subclass: #HLNotATestClass
+		instanceVariableNames: ''
+		package: self class category.
+	model selectPackage: self thisPackage.
+	self deny: (model testClasses includes: notATestClass).
+	Smalltalk removeClass: notATestClass.
+!
+
+testTestPackages
+	self assert: model testPackages notEmpty.
+	self assert: (model testPackages anySatisfy: [:each | each = self thisPackage]).
+!
+
+testUnselectClass
+	| announcementFired |
+	model selectPackage: self thisPackage.
+	model selectClass: self class.
+	model announcer on: HLClassUnselected
+		do: [ announcementFired := true ]
+		for: self.
+	model unselectClass: self class.
+	self assert: model selectedClasses isEmpty.
+	self assert: announcementFired
+!
+
+testUnselectPackage
+	| announcementFired |
+	model selectPackage: self thisPackage.
+	model announcer on: HLPackageUnselected
+		do: [ announcementFired := true ]
+		for: self.
+	model unselectPackage: self thisPackage.
+	self assert: model selectedPackages isEmpty.
+	self assert: announcementFired.
+! !
+

src/Helios-SUnit.st

@@ -1,6 +1,246 @@
 Smalltalk createPackage: 'Helios-SUnit'!
+HLToolListWidget subclass: #HLMultiSelectToolListWidget
+	instanceVariableNames: ''
+	package: 'Helios-SUnit'!
+!HLMultiSelectToolListWidget commentStamp!
+This is a list that handles multiple selection!
+
+!HLMultiSelectToolListWidget methodsFor: 'accessing'!
+
+activeItemCssClass
+	^'selector'
+!
+
+listCssClass 
+	^'nav nav-multiselect nav-pills nav-stacked'
+!
+
+listCssClassForItem: anObject
+	 |class |
+	class := self selectedItem = anObject
+		ifTrue: [ 'selector' ]
+		ifFalse: [ '' ].
+	(self isSelected: anObject)
+		ifTrue: [class := class, ' active'].
+	^class
+! !
+
+!HLMultiSelectToolListWidget methodsFor: 'actions'!
+
+select: anObject
+	self subclassResponsibility
+!
+
+toggleListItem: aListItem
+	| item |
+	
+	(aListItem get: 0) ifNil: [ ^ self ].
+	"Find item"
+	item := aListItem data: 'item'.
+	self toggleSelection: item
+!
+
+toggleSelection: anObject
+	(self isSelected: anObject) 
+		ifTrue: [ self unselect: anObject ]
+		ifFalse: [self select: anObject ]
+!
+
+unselect: anObject
+	self subclassResponsibility
+! !
+
+!HLMultiSelectToolListWidget methodsFor: 'rendering'!
+
+renderItem: anObject on: html
+	| li |
+    
+	li := html li.
+	li asJQuery data: 'item' put: anObject.
+    li
+		class: (self listCssClassForItem: anObject);
+        with: [ 
+        	html a
+            	with: [ 
+            		(html tag: 'i') class: (self cssClassForItem: anObject).
+  					self renderItemLabel: anObject on: html ];
+				onClick: [
+                  	self toggleListItem: li asJQuery ] ]
+! !
+
+!HLMultiSelectToolListWidget methodsFor: 'testing'!
+
+isSelected: anObject
+	self subclassResponsibility
+! !
+
+HLMultiSelectToolListWidget subclass: #HLSUnitClassesListWidget
+	instanceVariableNames: ''
+	package: 'Helios-SUnit'!
+!HLSUnitClassesListWidget commentStamp!
+I display a list of  classes (subclasses of `TestCase`).!
+
+!HLSUnitClassesListWidget methodsFor: 'accessing'!
+
+cssClassForItem: aClass	
+	^ aClass theNonMetaClass heliosClass
+!
+
+items
+	^ items ifNil: [ self initializeItems ]
+!
+
+label
+	^ 'Classes'
+! !
+
+!HLSUnitClassesListWidget methodsFor: 'actions'!
+
+observeModel
+    self model announcer 
+		on: HLPackageSelected
+		send: #onPackageSelected:
+		to: self;
+		
+		on: HLPackageUnselected
+		send: #onPackageUnselected:
+		to: self;
+		
+		on: HLClassSelected
+		send: #onClassSelected:
+		to: self;
+		
+		on: HLClassUnselected
+		send: #onClassUnselected:
+		to: self
+!
+
+select: anObject
+	model selectClass: anObject
+!
+
+unselect: anObject
+	model unselectClass: anObject
+! !
+
+!HLSUnitClassesListWidget methodsFor: 'initialization'!
+
+initializeItems
+	^items := model testClasses
+! !
+
+!HLSUnitClassesListWidget methodsFor: 'reactions'!
+
+onClassSelected: anAnnouncement
+	self refresh
+!
+
+onClassUnselected: anAnnouncement
+	self refresh
+!
+
+onPackageSelected: anAnnouncement
+	self initializeItems;
+		refresh
+!
+
+onPackageUnselected: anAnnouncement
+	self initializeItems;
+		refresh
+! !
+
+!HLSUnitClassesListWidget methodsFor: 'rendering'!
+
+renderItemLabel: aClass on: html
+	html with: aClass name
+! !
+
+!HLSUnitClassesListWidget methodsFor: 'testing'!
+
+isSelected: anObject
+	^model selectedClasses includes: anObject
+! !
+
+HLMultiSelectToolListWidget subclass: #HLSUnitPackagesListWidget
+	instanceVariableNames: ''
+	package: 'Helios-SUnit'!
+!HLSUnitPackagesListWidget commentStamp!
+I display a list of packages for which unit tests are associated (packages containing subclasses of `TestCase`).!
+
+!HLSUnitPackagesListWidget methodsFor: 'accessing'!
+
+cssClassForItem: anItem	
+	^ anItem isDirty 
+		ifTrue: [ 'package_dirty' ]
+		ifFalse: [ 'package' ]
+!
+
+items
+	^ items ifNil: [ self initializeItems ]
+!
+
+label
+	^ 'Packages'
+! !
+
+!HLSUnitPackagesListWidget methodsFor: 'actions'!
+
+observeModel
+    self model announcer 
+		on: HLPackageSelected
+		send: #onPackageSelected:
+		to: self;
+		
+		on: HLPackageUnselected
+		send: #onPackageUnselected:
+		to: self
+!
+
+select: anObject
+	model selectPackage: anObject
+!
+
+unselect: anObject
+	model unselectPackage: anObject
+! !
+
+!HLSUnitPackagesListWidget methodsFor: 'initialization'!
+
+initializeItems
+	^items := model testPackages 
+		sort: [:a :b | a name < b name]
+! !
+
+!HLSUnitPackagesListWidget methodsFor: 'reactions'!
+
+onPackageSelected: anAnnouncement
+	self refresh
+!
+
+onPackageUnselected: anAnnouncement
+	self refresh
+! !
+
+!HLSUnitPackagesListWidget methodsFor: 'rendering'!
+
+renderButtonsOn: html
+	html button
+	with: 'Run Tests';
+	onClick: [ self model runTests ]
+!
+
+renderItemLabel: aPackage on: html
+	html with: aPackage name
+! !
+
+!HLSUnitPackagesListWidget methodsFor: 'testing'!
+
+isSelected: anObject
+	^model selectedPackages includes: anObject
+! !
+
 HLWidget subclass: #HLSUnit
-	instanceVariableNames: 'model packagesListWidget resultWidget'
+	instanceVariableNames: 'model packagesListWidget classesListWidget resultWidget failuresWidget errorsWidget'
 	package: 'Helios-SUnit'!
 !HLSUnit commentStamp!
 I am the main widget for running unit tests in Helios.
@@ -13,26 +253,60 @@ model
 	^ model ifNil: [ model := HLSUnitModel new ]
 ! !
 
+!HLSUnit methodsFor: 'keybindings'!
+
+registerBindingsOn: aBindingGroup
+	HLToolCommand 
+		registerConcreteClassesOn: aBindingGroup 
+		for: self model
+! !
+
 !HLSUnit methodsFor: 'rendering'!
 
 renderContentOn: html
-	html with: (HLVerticalSplitter
-        with: self packagesListWidget 
-        with: self resultWidget).
+	html with: (HLContainer with:  (
+		HLVerticalSplitter 
+			with: (HLVerticalSplitter
+				with: self packagesListWidget 
+        		with: self classesListWidget)
+			with: (HLHorizontalSplitter 
+				with: self resultWidget
+				with: (HLHorizontalSplitter 
+					with: self failuresWidget
+					with: self errorsWidget)))).
 	
 	self packagesListWidget focus
 ! !
 
 !HLSUnit methodsFor: 'widgets'!
 
+classesListWidget
+	^ classesListWidget ifNil: [ 
+		classesListWidget := HLSUnitClassesListWidget on: self model.
+		classesListWidget next: self failuresWidget ]
+!
+
+errorsWidget
+	^ errorsWidget ifNil: [errorsWidget := HLSUnitErrorsListWidget on: self model]
+!
+
+failuresWidget
+	^ failuresWidget ifNil: [
+		failuresWidget := HLSUnitFailuresListWidget on: self model.
+		failuresWidget next: self errorsWidget]
+!
+
 packagesListWidget
 	^ packagesListWidget ifNil: [ 
-		packagesListWidget := HLSUnitPackagesListWidget on: self model ]
+		packagesListWidget := HLSUnitPackagesListWidget on: self model.
+		packagesListWidget next: self classesListWidget]
 !
 
 resultWidget
 	^ resultWidget ifNil: [
-		resultWidget := HLWidget new ]
+		resultWidget := HLSUnitResults new
+			model: self model;
+			yourself]
 ! !
 
 !HLSUnit class methodsFor: 'accessing'!
@@ -56,53 +330,299 @@ canBeOpenAsTab
 ! !
 
 HLModel subclass: #HLSUnitModel
-	instanceVariableNames: 'selectedPackages'
+	instanceVariableNames: 'selectedPackages selectedClasses testResult currentSuite'
 	package: 'Helios-SUnit'!
 
 !HLSUnitModel methodsFor: 'accessing'!
 
+currentSuite
+	^currentSuite
+!
+
+selectedClasses
+	^ (self privateSelectedClasses) select: [:each |
+		self selectedPackages includes: each package]
+!
+
 selectedPackages
 	^ selectedPackages ifNil: [ selectedPackages := Set new ]
 !
 
+testCases
+	| testCases |
+	testCases := #().
+	self selectedClasses
+		do: [ :each | testCases addAll: each buildSuite ].
+	^ testCases
+!
+
+testClasses
+	"Answer all concrete subclasses of TestCase in selected packages"
+	
+	| stream |
+	stream := Array new writeStream.
+	self selectedPackages do: [ :package |
+		stream nextPutAll: (package classes select:  [ :each |
+			(each includesBehavior: TestCase) and: [ 
+				each isAbstract not ] ] ) ].
+	^ stream contents
+!
+
 testPackages
 	"Answer all packages containing concrete subclasses of TestCase"
 	
 	^ self environment packages 
 		select: [ :each | each isTestPackage ]
+!
+
+testResult
+	^testResult ifNil: [testResult := TestResult new]
 ! !
 
 !HLSUnitModel methodsFor: 'actions'!
 
+runTests
+	| worker |
+	worker := TestSuiteRunner on: self testCases.
+	testResult := worker result.
+	self subscribeToTestSuite: worker.
+	self announcer announce: (HLRunTests on: worker).
+	worker run
+!
+
+selectAllPackages
+	self testPackages do: [:each | self selectPackage: each]
+!
+
+selectClass: aClass
+	self privateSelectedClasses add: aClass.
+	self announcer announce: (HLClassSelected on: aClass).
+!
+
 selectPackage: aPackage
-	self packages add: aPackage
+	self selectedPackages add: aPackage.
+	self announcer announce: (HLPackageSelected on: aPackage).
+!
+
+subscribeToTestSuite: aTestSuiteRunner
+	currentSuite ifNotNil: [ currentSuite announcer unsubscribe: self].
+	currentSuite := aTestSuiteRunner.
+	currentSuite announcer 
+		on: ResultAnnouncement
+		send: #onResultAnnouncement:
+		to: self
+!
+
+unselectClass: aClass
+	self privateSelectedClasses remove: aClass ifAbsent: [^self].
+	self announcer announce: (HLClassUnselected on: aClass).
 !
 
 unselectPackage: aPackage
-	self packages remove: aPackage ifAbsent: []
+	self selectedPackages remove: aPackage ifAbsent: [^self].
+	self announcer announce: (HLPackageUnselected on: aPackage).
+! !
+
+!HLSUnitModel methodsFor: 'private'!
+
+privateSelectedClasses
+	^ (selectedClasses ifNil: [ selectedClasses := Set new ])
+! !
+
+!HLSUnitModel methodsFor: 'reacting'!
+
+onResultAnnouncement: announcement
+	"Propogate announcement"
+	self announcer announce: announcement.
+! !
+
+HLToolListWidget subclass: #HLSUnitResultListWidget
+	instanceVariableNames: ''
+	package: 'Helios-SUnit'!
+
+!HLSUnitResultListWidget methodsFor: 'actions'!
+
+performFailure: aTestCase
+	aTestCase runCase
+! !
+
+!HLSUnitResultListWidget methodsFor: 'initialization'!
+
+observeModel
+	self model announcer 
+		on: ResultAnnouncement
+		send: #onResultAnnouncement:
+		to: self
+! !
+
+!HLSUnitResultListWidget methodsFor: 'reacting'!
+
+onResultAnnouncement: announcement
+	self refresh.
+! !
+
+!HLSUnitResultListWidget methodsFor: 'rendering'!
+
+renderItemLabel: anObject on: html
+	html span
+		with: anObject class name, ' >> ', anObject selector;
+		onClick: [ self performFailure: anObject ]
+! !
+
+HLSUnitResultListWidget subclass: #HLSUnitErrorsListWidget
+	instanceVariableNames: ''
+	package: 'Helios-SUnit'!
+
+!HLSUnitErrorsListWidget methodsFor: 'accessing'!
+
+items
+	^self model testResult errors
+!
+
+label
+	^'Errors'
+! !
+
+HLSUnitResultListWidget subclass: #HLSUnitFailuresListWidget
+	instanceVariableNames: ''
+	package: 'Helios-SUnit'!
+
+!HLSUnitFailuresListWidget methodsFor: 'accessing'!
+
+label
+	^'Failures'
+! !
+
+!HLSUnitFailuresListWidget methodsFor: 'as yet unclassified'!
+
+items
+	^self model testResult failures
 ! !
 
-HLWidget subclass: #HLSUnitPackagesListWidget
+HLWidget subclass: #HLSUnitResultStatus
 	instanceVariableNames: 'model'
 	package: 'Helios-SUnit'!
-!HLSUnitPackagesListWidget commentStamp!
-I display a list of packages for which unit tests are associated (packages containing subclasses of `TestCase`).!
 
-!HLSUnitPackagesListWidget methodsFor: 'accessing'!
+!HLSUnitResultStatus methodsFor: 'accessing'!
+
+model
+	^ model ifNil: [model := TestResult new]
+!
+
+model: anObject
+	model := anObject.
+	self observeModel.
+!
+
+result
+	^ self model testResult
+!
+
+statusCssClass
+	^'sunit status ', self result status
+!
+
+statusInfo
+	^ self printTotal, self printPasses, self printErrors, self printFailures
+! !
+
+!HLSUnitResultStatus methodsFor: 'initialization'!
+
+observeModel
+	self model announcer 
+		on: ResultAnnouncement
+		send: #onResultAnnouncement:
+		to: self
+! !
+
+!HLSUnitResultStatus methodsFor: 'printing'!
+
+printErrors
+	^ self result errors size asString , ' errors, '
+!
+
+printFailures
+	^ self result failures size asString, ' failures'
+!
+
+printPasses
+	^ (self result runs - self result errors size - self result failures size) asString , ' passes, '
+!
+
+printTotal
+	^ self result total asString, ' runs, '
+! !
+
+!HLSUnitResultStatus methodsFor: 'reacting'!
+
+onResultAnnouncement: announcement
+	self refresh.
+! !
+
+!HLSUnitResultStatus methodsFor: 'rendering'!
+
+renderContentOn: html
+	html div
+		class: self statusCssClass;
+		with: [ html span with: self statusInfo ]
+! !
+
+HLWidget subclass: #HLSUnitResults
+	instanceVariableNames: 'model progressBarWidget resultStatusWidget'
+	package: 'Helios-SUnit'!
+
+!HLSUnitResults methodsFor: 'accessing'!
 
 model
-	^ model
+	^model
 !
 
 model: anObject
-	model := anObject
+	model := anObject.
+	self observeModel
+!
+
+progressBarWidget
+	^progressBarWidget ifNil: [progressBarWidget := HLProgressBarWidget new
+		label: '';
+		yourself]
+!
+
+resultStatusWidget
+	^resultStatusWidget ifNil: [resultStatusWidget := HLSUnitResultStatus new
+		model: self model;
+		yourself]
+! !
+
+!HLSUnitResults methodsFor: 'initialization'!
+
+observeModel
+    self model announcer 
+		on: HLRunTests
+		send: #onRunTests:
+		to: self;
+		
+		on: ResultAnnouncement
+		send: #onResultAnnouncement:
+		to: self
 ! !
 
-!HLSUnitPackagesListWidget class methodsFor: 'instance creation'!
+!HLSUnitResults methodsFor: 'reacting'!
 
-on: aSUnitModel
-	^ self new
-		model: aSUnitModel;
-		yourself
+onResultAnnouncement: announcement
+	self progressBarWidget 
+		updateProgress: self model testResult runs / self model testResult total * 100.
+!
+
+onRunTests: announcement
+	self progressBarWidget updateProgress: 0;
+		refresh.
+! !
+
+!HLSUnitResults methodsFor: 'rendering'!
+
+renderContentOn: html
+	html with: self resultStatusWidget;
+		with: self progressBarWidget
 ! !
 

support/helios/all-inner.js

@@ -13,12 +13,14 @@ define([
 	'helios/Helios-Commands-Core',
 	'helios/Helios-Commands-Tools',
 	'helios/Helios-Commands-Browser',
+	'helios/Helios-Commands-SUnit',
 	'helios/Helios-Layout',
 	'helios/Helios-KeyBindings',
 	'helios/Helios-Browser',
 	'helios/Helios-Workspace',
 	'helios/Helios-Transcript',
 	'helios/Helios-SUnit',
+	'helios/Helios-SUnit-Tests',
 	'helios/Helios-Debugger',
 	'helios/Helios-Inspector',
 	'helios/Helios-References',