--- a/ApplicationModel.st Fri Dec 13 11:55:04 2019 +0100
+++ b/ApplicationModel.st Wed Sep 15 13:09:51 2021 +0100
@@ -1,6 +1,7 @@
"
COPYRIGHT (c) 1995 by Claus Gittinger
COPYRIGHT (c) 2016-2017 Jan Vrany
+ COPYRIGHT (c) 2021 LabWare
All Rights Reserved
This software is furnished under a license and may be used
@@ -15,14 +16,14 @@
"{ NameSpace: Smalltalk }"
Model subclass:#ApplicationModel
- instanceVariableNames:'builder resources keyboardMap device masterApplication'
+ instanceVariableNames:'builder resources keyboardMap device masterApplication styleSheet'
classVariableNames:'DefaultExtents DefaultLabels DefaultVisuals
RecentlyOpenedApplications'
poolDictionaries:''
category:'Interface-Framework'
!
-ApplicationModel class instanceVariableNames:'ClassResources defaultKeyboardMap'
+ApplicationModel class instanceVariableNames:'ClassResources defaultKeyboardMap defaultStyleSheet'
"
No other class instance variables are inherited by this class.
@@ -35,6 +36,7 @@
"
COPYRIGHT (c) 1995 by Claus Gittinger
COPYRIGHT (c) 2016-2017 Jan Vrany
+ COPYRIGHT (c) 2021 LabWare
All Rights Reserved
This software is furnished under a license and may be used
@@ -165,6 +167,79 @@
defaultKeyboardMap := KeyboardMap new.
"Created: / 04-02-2017 / 22:46:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+initializeDefaultStyleSheet
+ "
+ Initialize default style sheet.
+
+ The default stylesheet is looked up in package's 'styles' directory
+ as follows:
+ 1. look for style file with the same name as current view's style,
+ for example, if current view style is 'Adwaita.style' then look
+ for file named 'Adwaita.style'.
+ 2. look for style named either 'light.style' (for light themes, the
+ default) or 'dark.style' for (dark themes), depending on current
+ style variant
+ 3. look for style name 'default.style'. Note, that 'default.style' may
+ still contain conditional definitions based on theme variant.
+
+ The stylesheet has superclasses' stylesheet defined as it's superpack,
+ and ApplicationModel's stylesheet is linked to the current view stylesheet
+ (that is, to `SimpleView styleSheet`). This is done prior reading any individual
+ style files so style files can use abstract definitios (like 'viewBackground')
+ from current style.
+ "
+
+ | stylesDir style |
+
+ style := ViewStyle new.
+ style packsClassName: self name.
+ self == ApplicationModel ifTrue: [
+ style superPack: SimpleView styleSheet
+ ] ifFalse: [
+ style superPack: self superclass defaultStyleSheet.
+ ].
+
+
+ stylesDir := Smalltalk getPackageDirectoryForPackage: self package.
+ stylesDir notNil ifTrue: [ stylesDir := stylesDir / 'styles' ].
+ (stylesDir notNil and:[ stylesDir isDirectory ]) ifTrue: [
+ | styleFile |
+
+ styleFile := stylesDir / (SimpleView styleSheet name , '.style').
+ styleFile exists ifFalse: [
+ styleFile := stylesDir / ((SimpleView styleSheet at:'variant') = 'dark' ifTrue:['dark.style'] ifFalse:[ 'light.style' ]).
+ styleFile exists ifFalse: [
+ styleFile := stylesDir / 'default.style'
+ ]
+ ].
+ "/ Avoid reading stylesheet if it's the same as superclasses one
+ (style superPack notNil
+ and:[ style superPack packsFileName notNil
+ and:[ style superPack packsFileName asFilename = styleFile ] ]) ifTrue: [
+ "/ Okay, packs are the same - no need to read it again
+ ] ifFalse: [
+ "/ No, superpack is different. Read the contents
+ styleFile exists ifTrue: [
+ | failedToRead |
+
+ failedToRead := (style readFromFile: styleFile baseName directory: styleFile directory) isNil.
+
+ style name: styleFile withoutSuffix baseName.
+ style at:#fileReadFailed put:failedToRead.
+ ].
+ ].
+ ].
+ defaultStyleSheet := style.
+
+ "
+ ApplicationModel flushDefaultStyleSheet
+ Tools::NewSystemBrowser initializeDefaultStyleSheet; defaultStyleSheet
+ "
+
+ "Created: / 15-09-2021 / 12:06:39 / Jan Vrany <jan.vrany@labware.com>"
+ "Modified (comment): / 15-09-2021 / 13:08:10 / Jan Vrany <jan.vrany@labware.com>"
! !
!ApplicationModel class methodsFor:'instance creation'!
@@ -210,6 +285,15 @@
^ defaultKeyboardMap
"Created: / 04-02-2017 / 22:46:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+defaultStyleSheet
+ defaultStyleSheet isNil ifTrue:[
+ self initializeDefaultStyleSheet
+ ].
+ ^ defaultStyleSheet
+
+ "Created: / 15-09-2021 / 11:47:04 / Jan Vrany <jan.vrany@labware.com>"
! !
!ApplicationModel class methodsFor:'active help'!
@@ -834,6 +918,19 @@
^ aFont asSize:newSize.
!
+flushDefaultStyleSheet
+ defaultStyleSheet := nil.
+ self subclassesDo: [ :each | each flushDefaultStyleSheet ]
+
+ "
+ ApplicationModel flushDefaultStyleSheet
+ Tools::NewSystemBrowser initializeDefaultStyleSheet
+
+ "
+
+ "Created: / 15-09-2021 / 12:27:22 / Jan Vrany <jan.vrany@labware.com>"
+!
+
selfResponsibleFor:aKey
<resource: #obsolete>
@@ -1471,6 +1568,19 @@
"Modified (comment): / 25-11-2016 / 15:25:36 / cg"
!
+styleSheet
+ styleSheet isNil ifTrue:[
+ self initializeStyleSheet.
+ ].
+ ^styleSheet
+
+ "
+ WorkspaceApplication new open; yourself
+ "
+
+ "Created: / 15-09-2021 / 11:34:48 / Jan Vrany <jan.vrany@labware.com>"
+!
+
topMasterApplication
"return the topmost master application. Useful when nested subapplications are used"
@@ -2986,6 +3096,12 @@
]
!
+initializeStyleSheet
+ styleSheet := self class defaultStyleSheet.
+
+ "Created: / 15-09-2021 / 11:35:36 / Jan Vrany <jan.vrany@labware.com>"
+!
+
setDevice:aDevice
"set the device (i.e. some Screen), where the application shall open its view(s).
The default device (if not set here) will be the current screen."