ViewStyle: unified style resource lookup jv
authorJan Vrany <jan.vrany@fit.cvut.cz>
Thu, 01 Sep 2016 23:27:10 +0100
branchjv
changeset 7540 69b0ea8c4b30
parent 7491 b8d53ade8f6f
child 7541 39940e2446a5
ViewStyle: unified style resource lookup
ViewStyle.st
--- a/ViewStyle.st	Mon Jul 18 21:17:55 2016 +0100
+++ b/ViewStyle.st	Thu Sep 01 23:27:10 2016 +0100
@@ -119,43 +119,81 @@
 
 !ViewStyle methodsFor:'accessing'!
 
-at:aKey
-    |sCls val|
+at:key
+    ^ self at: key default: nil for: thisContext sender receiver
+
+    "Modified: / 10-09-1995 / 10:59:38 / claus"
+    "Modified: / 19-07-2016 / 21:41:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
 
-    sCls := thisContext sender receiver.
-    sCls isBehavior ifFalse:[sCls := sCls class].
-    (sCls isSubclassOf:SimpleView) ifTrue:[
-	val := self at:(sCls name , '.' , aKey) default:nil.
-	val notNil ifTrue:[^ val].
-    ].
-    ^ self at:aKey default:nil
+at:key default:default
+    ^ self at: key default: default for: thisContext sender receiver
 
-    "Modified: 10.9.1995 / 10:59:38 / claus"
+    "Created: / 14-10-1997 / 00:21:15 / cg"
+    "Modified: / 15-09-1998 / 21:47:13 / cg"
+    "Modified: / 19-07-2016 / 21:41:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-at:aKey default:default
-    "translate a string; if not present, return default.
-     Here, two keys are tried, iff the key is of the form 'foo.bar',
-     'fooBar' is also tried.
-     This has been added for a smooth migration towards names with a form of
-     'classname.itemKey' in the stylesheets."
+at:key default:default for: class
+    "Retrieve a style resource (color, image, string...) for given key and
+     view `class`. If not found, `default` is returned.
+
+     Resource `key` is either a simple key (for example 'foo') or
+     compound key (for example 'bar.foo'). Resource is looked up
+     as follows:
 
-    |v i k2|
+     1. key '<class name>.foo' is looked up, if it exists
+        then its value is returned.
+     2. key 'bar.foo' is looked up, if it exists then
+        then its value is returned (only if key is compound)
+     3. key 'foo' is looked up,  if it exists then
+        then its value is returned
+     4. `default` value is returned.
+
+    This has been added to support fine-grained resource (mainly color) specification
+    allowing (easy) customization per widget class (in a somewhat predictable) way.
+    All that while being backward compatible.
+    "
+
+    | i key1 key2 key3 |
 
-    (self includesKey:aKey) ifTrue:[
-	^ (super at:aKey ifAbsent:default) value
+    i := key indexOf: $..
+    i ~~ 0 ifTrue:[ 
+        key3 := (key copyFrom: i + 1).
+        key2 := key.
+    ] ifFalse:[ 
+        key3 := key.
+        key2 := nil.
     ].
-    (i := aKey indexOf:$.) ~~ 0 ifTrue:[
-	k2 := (aKey copyTo:i-1) , (aKey copyFrom:i+1) asUppercaseFirst.
-	(self includesKey:k2) ifTrue:[^ super at:k2 ifAbsent:default].
+    key1 := class class theNonMetaclass name , '.' , key3.
+
+    (self includesKey:key1) ifTrue:[
+        ^ (super at:key1 ifAbsent:default) value
     ].
-    ^ default value
+    (key2 notNil and:[self includesKey:key2]) ifTrue:[
+        ^ (super at:key2 ifAbsent:default) value
+    ].
+    (self includesKey:key3) ifTrue:[
+        ^ (super at:key3 ifAbsent:default) value
+    ].
+    ^ default value.
 
-    "Created: / 14.10.1997 / 00:21:15 / cg"
-    "Modified: / 15.9.1998 / 21:47:13 / cg"
+    "Created: / 19-07-2016 / 22:21:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-colorAt:aKey
+colorAt: key
+    ^ self colorAt: key default: nil for: thisContext sender receiver
+
+    "Modified: / 19-07-2016 / 21:32:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+colorAt:key default:default
+    ^ self colorAt:key default:default for: thisContext sender receiver
+
+    "Modified (format): / 19-07-2016 / 21:36:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+colorAt:key default:default for:class
     "retrieve a color resource - also acquire a device color
      to avoid repeated color allocations later"
 
@@ -163,7 +201,7 @@
 
     device := Display.
 
-    value := self at:aKey default:nil.
+    value := self at:key default:default for: class.
     value isInteger ifTrue:[
         value := Color rgbValue:value
     ].
@@ -172,61 +210,32 @@
         deviceColor notNil ifTrue:[^ deviceColor].
     ].
     ^ value
-!
 
-colorAt:aKey default:default
-    "retrieve a color resource - also acquire a device color
-     to avoid repeated color allocations later"
-
-    |value device deviceColor|
-
-    device := Display.
-
-    value := self at:aKey default:default.
-    value isInteger ifTrue:[
-        value := Color rgbValue:value
-    ].
-    (value notNil and:[device notNil]) ifTrue:[
-        deviceColor := value onDevice:device.
-        deviceColor notNil ifTrue:[^ deviceColor].
-    ].
-    ^ value
-!
-
-deviceResourceAt:aKey default:default
-    "retrieve a resource - also acquire a device version
-     for the default display, to avoid repeated allocations later"
-
-    |aResource deviceResource device|
-
-    device := Display.
-
-    aResource := self at:aKey default:default.
-    (aResource notNil and:[device notNil]) ifTrue:[
-        deviceResource := aResource onDevice:device.
-        deviceResource notNil ifTrue:[^ deviceResource].
-    ].
-    ^ aResource
-
-    "Modified: / 5.9.1998 / 20:25:19 / cg"
+    "Created: / 19-07-2016 / 21:32:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 19-07-2016 / 22:40:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 doesNotUnderstand:aMessage
     ^ self at:(aMessage selector) default:nil
 !
 
-fontAt:aKey
+fontAt:key
+   ^ self fontAt: key default: nil for: thisContext sender receiver.
+!
+
+fontAt:key default:default
+    ^ self fontAt:key default:default for: thisContext sender receiver
+
+    "Modified: / 19-07-2016 / 22:42:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+fontAt:key default:default for: class
     "retrieve a font resource - also acquire a device font
      to avoid repeated font allocations later"
 
-    ^ self deviceResourceAt:aKey default:nil 
-!
+    ^ self deviceResourceAt:key default:default for: class
 
-fontAt:aKey default:default
-    "retrieve a font resource - also acquire a device font
-     to avoid repeated font allocations later"
-
-    ^ self deviceResourceAt:aKey default:default
+    "Created: / 19-07-2016 / 22:42:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 is3D
@@ -261,6 +270,26 @@
     "Created: 6.9.1997 / 11:40:16 / cg"
 ! !
 
+!ViewStyle methodsFor:'private'!
+
+deviceResourceAt:key default:default for: class
+    "retrieve a resource - also acquire a device version
+     for the default display, to avoid repeated allocations later"
+
+    |aResource deviceResource device|
+
+    device := Display.
+
+    aResource := self at:key default:default for: class.
+    (aResource notNil and:[device notNil]) ifTrue:[
+        deviceResource := aResource onDevice:device.
+        deviceResource notNil ifTrue:[^ deviceResource].
+    ].
+    ^ aResource
+
+    "Created: / 19-07-2016 / 22:41:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !ViewStyle methodsFor:'queries'!
 
 isWindowsStyle
@@ -336,5 +365,10 @@
 
 version_CVS
     ^ '$Header$'
+!
+
+version_HG
+
+    ^ '$Changeset: <not expanded> $'
 ! !