Themes: use stylesheet to define colors in `InlineMessageDialog` and test runners jv
authorJan Vrany <jan.vrany@labware.com>
Mon, 20 Sep 2021 11:32:18 +0100
branchjv
changeset 19612 9f2e3136aa4d
parent 19611 a4b9d283ca40
child 19613 3f9ced4eb473
Themes: use stylesheet to define colors in `InlineMessageDialog` and test runners ...rather than hardcoding them.
Tools__AbstractTestRunner.st
Tools__InlineMessageDialog.st
Tools__TestRunner2.st
Tools__TestRunnerMini.st
--- a/Tools__AbstractTestRunner.st	Tue Sep 21 13:45:08 2021 +0100
+++ b/Tools__AbstractTestRunner.st	Mon Sep 20 11:32:18 2021 +0100
@@ -1,6 +1,7 @@
 "
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
+ Copyright (c) 2021 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -29,8 +30,7 @@
 
 ApplicationModel subclass:#AbstractTestRunner
 	instanceVariableNames:''
-	classVariableNames:'NotRunColor PassedColor FailureColor ErrorColor
-		CurrentlyRunningColor'
+	classVariableNames:''
 	poolDictionaries:''
 	category:'SUnit-UI'
 !
@@ -41,6 +41,7 @@
 "
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
+ Copyright (c) 2021 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -65,53 +66,58 @@
 "
 ! !
 
-!AbstractTestRunner class methodsFor:'initialization'!
-
-initialize
-    "Invoked at system start or when the class is dynamically loaded."
+!AbstractTestRunner methodsFor:'accessing-look'!
 
-    CurrentlyRunningColor   := Color yellow.
-    NotRunColor             := Color redByte:145 greenByte:145 blueByte:145.
-    PassedColor             := Color redByte:92 greenByte:166 blueByte:92.
-    FailureColor            := Color redByte:194 greenByte:110 blueByte:110.
-    ErrorColor              := FailureColor
+errorBackgroundColor
+    <resource: #style (#'testRunner.error.backgroundColor')>
+
+    ^ self styleSheet
+        colorAt:#'testRunner.error.backgroundColor'
+        default:[ Color redByte:194 greenByte:110 blueByte:110 ]
 
-    "Modified: / 15-03-2010 / 21:59:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 05-07-2011 / 14:12:34 / cg"
-! !
+    "Created: / 17-09-2021 / 22:20:02 / Jan Vrany <jan.vrany@labware.com>"
+!
+
+failedBackgroundColor
+    <resource: #style (#'testRunner.failed.backgroundColor')>
 
-!AbstractTestRunner class methodsFor:'accessing'!
+    ^ self styleSheet
+        colorAt:#'testRunner.failed.backgroundColor'
+        default:[ Color redByte:194 greenByte:110 blueByte:110 ]
 
-currentlyRunningColor
-    ^ CurrentlyRunningColor
-
-    "Created: / 05-07-2011 / 14:12:04 / cg"
+    "Created: / 17-09-2021 / 22:19:25 / Jan Vrany <jan.vrany@labware.com>"
 !
 
-errorColor
-    ^ ErrorColor
+notRunBackgroundColor
+    <resource: #style (#'testRunner.notrun.backgroundColor')>
 
-    "Created: / 07-02-2010 / 14:43:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 15-03-2010 / 21:53:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    ^ self styleSheet
+        colorAt:#'testRunner.notrun.backgroundColor'
+        default:[ Color redByte:145 greenByte:145 blueByte:145 ]
+
+    "Created: / 17-09-2021 / 22:20:58 / Jan Vrany <jan.vrany@labware.com>"
 !
 
-failedColor
-    ^ FailureColor
+passedBackgroundColor
+    <resource: #style (#'testRunner.passed.backgroundColor')>
 
-    "Modified: / 15-03-2010 / 21:53:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    ^ self styleSheet
+        colorAt:#'testRunner.passed.backgroundColor'
+        default:[ Color redByte:92 greenByte:166 blueByte:92 ]
+
+    "Created: / 17-09-2021 / 22:18:56 / Jan Vrany <jan.vrany@labware.com>"
 !
 
-notRunColor
-    ^ NotRunColor
+runningBackgroundColor
+    <resource: #style (#'testRunner.running.backgroundColor')>
 
-    "Created: / 15-03-2010 / 09:55:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 15-03-2010 / 21:53:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+    ^ self styleSheet
+        colorAt:#'testRunner.running.backgroundColor'
+        default:[ self styleSheet
+                    colorAt: #'progressIndicator.foregroundColor' 
+                    default: [ Color blue ] ]
 
-passedColor
-    ^ PassedColor
-
-    "Modified: / 15-03-2010 / 21:54:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 17-09-2021 / 22:22:32 / Jan Vrany <jan.vrany@labware.com>"
 ! !
 
 !AbstractTestRunner methodsFor:'private'!
@@ -200,5 +206,3 @@
     ^ '$Id: Tools__AbstractTestRunner.st,v 1.12 2013-05-21 20:21:26 cg Exp $'
 ! !
 
-
-AbstractTestRunner initialize!
--- a/Tools__InlineMessageDialog.st	Tue Sep 21 13:45:08 2021 +0100
+++ b/Tools__InlineMessageDialog.st	Mon Sep 20 11:32:18 2021 +0100
@@ -1,6 +1,7 @@
 "
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
+ Copyright (c) 2021 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -44,6 +45,7 @@
 "
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
+ Copyright (c) 2021 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -107,21 +109,6 @@
 "
 ! !
 
-!InlineMessageDialog class methodsFor:'accessing-colors'!
-
-defaultInformationBackground
-    ^ (Color red:100.0 green:78 blue:23)
-
-    "Created: / 10-04-2012 / 19:31:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-defaultWarningBackground
-
-    ^(Color red:76 green:43 blue:43)
-
-    "Created: / 10-04-2012 / 19:30:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
 !InlineMessageDialog class methodsFor:'interface specs'!
 
 messageInfoSpec
@@ -372,6 +359,28 @@
     "Created: / 28-10-2010 / 18:24:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!InlineMessageDialog methodsFor:'accessing-look'!
+
+infoBackgroundColor
+    <resource: #style (#'inlineMessageDialog.info.backgroundColor')>  
+
+    ^ self styleSheet 
+        colorAt: #'inlineMessageDialog.info.backgroundColor'
+        default: [ Color blue lighter ]
+
+    "Created: / 17-09-2021 / 21:08:04 / Jan Vrany <jan.vrany@labware.com>"
+!
+
+warnBackgroundColor
+    <resource: #style (#'inlineMessageDialog.warning.backgroundColor')>
+
+    ^ self styleSheet 
+        colorAt: #'inlineMessageDialog.warning.backgroundColor'
+        default: [ Color red:76 green:43 blue:43 ]
+
+    "Created: / 17-09-2021 / 21:09:19 / Jan Vrany <jan.vrany@labware.com>"
+! !
+
 !InlineMessageDialog methodsFor:'accessing-presentation'!
 
 changeLayoutUponShowHide: aBoolean
@@ -485,11 +494,11 @@
 !
 
 beInformation
-
-    self backgroundColor: self class defaultInformationBackground.
+    self backgroundColor: self infoBackgroundColor.
     self specHolder value: #messageInfoSpec
 
     "Created: / 11-04-2012 / 11:39:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (format): / 17-09-2021 / 21:12:42 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 beProgress
@@ -508,18 +517,11 @@
 !
 
 beWarning
-    |colorOrNil|
-
-    "/ never, ever use explicit colors. 
-    "/ If at all, ask the stylesheet and add it to your personal one.
-    "/ (Don't expect others to also like your color preferences)
-
-    "/ colorOrNil := self class defaultWarningBackground.
-    colorOrNil := View styleSheet colorAt:'inlineMessageDialog.warning.backgroundColor' default:(self class defaultWarningBackground).
-    self backgroundColor: colorOrNil.
+    self backgroundColor: self warnBackgroundColor.
     self specHolder value: #messageInfoSpec
 
     "Created: / 11-04-2012 / 11:41:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 17-09-2021 / 21:12:30 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 removeComponent: aView
--- a/Tools__TestRunner2.st	Tue Sep 21 13:45:08 2021 +0100
+++ b/Tools__TestRunner2.st	Mon Sep 20 11:32:18 2021 +0100
@@ -1,6 +1,7 @@
 "
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
+ Copyright (c) 2021 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -46,9 +47,9 @@
 	privateIn:TestRunner2
 !
 
-ApplicationModel subclass:#ResultList
+AbstractTestRunner subclass:#ResultList
 	instanceVariableNames:'results resultsHolder selectiomHolder listHolder timestampFormat
-		selectionHolder'
+		selectionHolder passedText failedText errorText'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:TestRunner2
@@ -56,7 +57,7 @@
 
 HierarchicalItem subclass:#ListEntry
 	instanceVariableNames:'label realLabel test result'
-	classVariableNames:'PassedText FailedText ErrorText'
+	classVariableNames:''
 	poolDictionaries:''
 	privateIn:TestRunner2::ResultList
 !
@@ -67,6 +68,7 @@
 "
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
+ Copyright (c) 2021 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -1052,13 +1054,6 @@
 
 !TestRunner2 methodsFor:'accessing'!
 
-errorColor
-    ^ self class 
-        errorColor
-
-    "Modified: / 08-02-2010 / 13:57:26 / Jan Vrany <jan,vrany@fit.cvut.cz>"
-!
-
 errorTestSuite
 
     | testSuite |
@@ -1071,10 +1066,6 @@
     "Created: / 06-06-2008 / 09:08:40 / Jan Vrany <vranyj1@fel.cvut.cz>"
 !
 
-failedColor
-    ^ self class failedColor
-!
-
 failureTestSuite
     | testSuite |
 
@@ -1088,10 +1079,6 @@
     "Modified (format): / 23-09-2011 / 18:56:52 / cg"
 !
 
-passedColor
-    ^ self class passedColor
-!
-
 selectedPackages: packages
 
     self packageList selectedProjects value: packages.
@@ -1802,12 +1789,13 @@
 !
 
 displayFail:result 
-    self displayColor:self errorColor.
+    self displayColor:self errorBackgroundColor.
     self displayMode:'Fail'.
     self displayDetails:result printString.
 
     "Created: / 06-06-2008 / 08:49:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 07-02-2010 / 14:43:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 17-09-2021 / 22:23:42 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 displayMode: mode
@@ -1819,10 +1807,12 @@
 !
 
 displayPass:result 
-    self displayColor:self passedColor.
+    self displayColor:self passedBackgroundColor.
     self displayMode:'Pass '.
     self 
         displayDetails:result printString , ' ' , (self timeSinceLastPassAsString)
+
+    "Modified: / 17-09-2021 / 22:23:51 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 displayResult: aTestResult
@@ -1861,13 +1851,14 @@
 
 displayRunning: result test: test total: total
 
-    self displayColor: (result hasPassed ifTrue:[self class currentlyRunningColor] ifFalse:[Color orange]).
+    self displayColor: self runningBackgroundColor.
     self displayMode: 'Running ' , test printString.
     self displayDetails: total printString , ' total, ' , result printString
 
     "Modified: / 21-06-2000 / 12:14:52 / Sames"
     "Created: / 06-06-2008 / 19:38:48 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 05-07-2011 / 14:14:42 / cg"
+    "Modified: / 17-09-2021 / 22:24:33 / Jan Vrany <jan.vrany@labware.com>"
 ! !
 
 !TestRunner2 methodsFor:'hooks'!
@@ -2024,6 +2015,20 @@
 
 ! !
 
+!TestRunner2::ResultList methodsFor:'accessing'!
+
+errorText
+    ^ errorText
+!
+
+failedText
+    ^ failedText
+!
+
+passedText
+    ^ passedText
+! !
+
 !TestRunner2::ResultList methodsFor:'actions'!
 
 debugTest:entryIndex 
@@ -2129,12 +2134,14 @@
 
     | list |
     list := HierarchicalList new.
+    list application: self.
     list root: self makeRootEntry.            
     list showRoot: false.    
     self listHolder value: list.
 
     "Created: / 07-02-2010 / 11:03:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 07-02-2010 / 13:41:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 17-09-2021 / 22:50:17 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 updateTimestampFormat
@@ -2151,6 +2158,20 @@
     "Modified: / 04-08-2011 / 19:05:57 / cg"
 ! !
 
+!TestRunner2::ResultList methodsFor:'initialization'!
+
+initialize
+    "Invoked when a new instance is created."
+
+    super initialize.
+
+    passedText := (' [', (self resources string:'passed') , ']') withColor: self passedBackgroundColor. 
+    failedText := (' [', (self resources string:'failed') allBold , ']') withColor: self failedBackgroundColor. 
+    errorText :=  (' [', (self resources string:'error') allBold , ']') withColor: self errorBackgroundColor. 
+
+    "/ super initialize.   -- commented since inherited method does nothing
+! !
+
 !TestRunner2::ResultList methodsFor:'private'!
 
 invalidate
@@ -2245,35 +2266,6 @@
     "Created: / 19-03-2010 / 08:41:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!TestRunner2::ResultList::ListEntry class methodsFor:'initialization'!
-
-errorText
-    ErrorText isNil ifTrue:[
-        ErrorText := ' [','error' allBold,']' withColor: Tools::TestRunner2 errorColor "darker".    
-    ].
-    ^ ErrorText
-
-    "Created: / 06-06-2016 / 14:41:59 / cg"
-!
-
-failedText
-    FailedText isNil ifTrue:[
-        FailedText := ' [','failed' allBold,']' withColor: Tools::TestRunner2 failedColor "darker".
-    ].
-    ^ FailedText
-
-    "Created: / 06-06-2016 / 14:41:40 / cg"
-!
-
-passedText
-    PassedText isNil ifTrue:[
-        PassedText := ' [passed]' withColor: Tools::TestRunner2 passedColor darker.
-    ].
-    ^ PassedText
-
-    "Created: / 06-06-2016 / 14:41:16 / cg"
-! !
-
 !TestRunner2::ResultList::ListEntry class methodsFor:'instance creation'!
 
 labeled: aStringOrText
@@ -2295,15 +2287,14 @@
 !
 
 label
-    | result |
-
-    result := self result.
+
+    self result. "/ to ensure result is computed
     realLabel ifNil:[
         realLabel := label.
         test ifNotNil:[
-            result == #passed ifTrue:[realLabel := realLabel , self class passedText].
-            result == #error ifTrue:[realLabel := realLabel , self class errorText].
-            result == #failed ifTrue:[realLabel := realLabel , self class failedText].
+            result == #passed ifTrue:[realLabel := realLabel , self application passedText].
+            result == #error ifTrue:[realLabel := realLabel , self application errorText].
+            result == #failed ifTrue:[realLabel := realLabel , self application failedText].
         ] ifNil: [
             realLabel := realLabel , self summary.
         ]        
@@ -2314,6 +2305,7 @@
     "Modified: / 07-02-2010 / 18:28:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 08-02-2010 / 10:15:35 / Jan Vrany <jan,vrany@fit.cvut.cz>"
     "Modified (format): / 06-06-2016 / 14:43:01 / cg"
+    "Modified: / 17-09-2021 / 22:59:45 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 label:aText
@@ -2461,6 +2453,11 @@
     ^ '$Header$'
 !
 
+version_HG
+
+    ^ '$Changeset: <not expanded> $'
+!
+
 version_SVN
     ^ '$Id$'
 ! !
--- a/Tools__TestRunnerMini.st	Tue Sep 21 13:45:08 2021 +0100
+++ b/Tools__TestRunnerMini.st	Mon Sep 20 11:32:18 2021 +0100
@@ -2,6 +2,7 @@
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
  Copyright (c) 2016-2017 Jan Vrany
+ Copyright (c) 2021 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -53,6 +54,7 @@
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
  Copyright (c) 2016-2017 Jan Vrany
+ Copyright (c) 2021 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -514,6 +516,35 @@
     "Created: / 22-07-2011 / 15:44:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!TestRunnerMini methodsFor:'accessing-look'!
+
+resultBackgroundColorFor: suiteAndResult
+    | result numTests numRun |
+
+    result := suiteAndResult result.
+    suiteAndResult testCount > 0 ifTrue:[
+        result notNil ifTrue:[
+            suiteAndResult hasErrors ifTrue:[^self errorBackgroundColor].
+            suiteAndResult hasFailures ifTrue:[^self failedBackgroundColor].
+            suiteAndResult hasPassed ifTrue:[
+                numTests := suiteAndResult suite tests size.
+                numRun := result passedCount + result skippedCount.
+                numRun = numTests ifTrue:[
+                    ^self passedBackgroundColor 
+                ]
+            ].
+            suiteAndResult hasSkipped ifTrue:[^self notRunBackgroundColor]. 
+        ]
+    ].
+    ^self notRunBackgroundColor
+
+    "Created: / 15-03-2010 / 15:24:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 14-06-2018 / 22:15:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+
+
+    "Created: / 17-09-2021 / 22:28:55 / Jan Vrany <jan.vrany@labware.com>"
+! !
+
 !TestRunnerMini methodsFor:'actions'!
 
 allCoveredClasses
@@ -848,13 +879,13 @@
         resultBackgroundColorHolder := BlockValue 
                 with:[:result :running | 
                     running ifTrue:[
-                        self class currentlyRunningColor
+                        self runningBackgroundColor
                         "/ View defaultBackgroundColor
                     ] ifFalse:[
                         result isNil ifTrue:[
-                            self class notRunColor
+                            self notRunBackgroundColor
                         ] ifFalse:[
-                            result color
+                            self resultBackgroundColorFor: result
                         ]
                     ].
                 ]
@@ -872,6 +903,7 @@
     "Created: / 15-03-2010 / 15:22:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 04-06-2012 / 19:40:11 / cg"
     "Modified: / 23-09-2014 / 09:46:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 17-09-2021 / 22:34:41 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 resultHolder
@@ -1227,29 +1259,6 @@
 
 !TestRunnerMini::SuiteAndResult methodsFor:'accessing'!
 
-color
-    |numTests numRun|
-
-    self testCount > 0 ifTrue:[
-        result notNil ifTrue:[
-            self hasErrors ifTrue:[^AbstractTestRunner errorColor].
-            self hasFailures ifTrue:[^AbstractTestRunner failedColor].
-            self hasPassed ifTrue:[
-                numTests := suite tests size.
-                numRun := result passedCount + result skippedCount.
-                numRun = numTests ifTrue:[
-                    ^AbstractTestRunner passedColor 
-                ]
-            ].
-            self hasSkipped ifTrue:[^AbstractTestRunner notRunColor]. 
-        ]
-    ].
-    ^ AbstractTestRunner notRunColor
-
-    "Created: / 15-03-2010 / 15:24:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 14-06-2018 / 22:15:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
 info
     |numTests numPassed numFailed numRun resources numError numSkipped |