#REFACTORING by exept
authorClaus Gittinger <cg@exept.de>
Sat, 10 Aug 2019 10:15:32 +0200
changeset 24525 3f0d79a2a519
parent 24524 4f5081209498
child 24526 cafea70df1c4
#REFACTORING by exept class: InlineObject class comment/format in: #classForSlotNames:mutable: changed: #slotNamesAndValuesFromDictionary:mutable: class: InlineObject::InlineObjectClassDescription class definition changed: #package
InlineObject.st
--- a/InlineObject.st	Sat Aug 10 10:04:33 2019 +0200
+++ b/InlineObject.st	Sat Aug 10 10:15:32 2019 +0200
@@ -22,6 +22,13 @@
 	category:'Kernel-Classes'
 !
 
+ClassDescription subclass:#InlineObjectClassDescription
+	instanceVariableNames:'name'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:InlineObject
+!
+
 InlineObject subclass:#InlineObjectPrototype
 	instanceVariableNames:'i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 i14 i15 i16 i17 i18
 		i19 i20 i21 i22 i23 i24 i25 i26 i27 i28 i29 i30 i31 i32 i33 i34
@@ -170,8 +177,9 @@
 !
 
 slotNamesAndValuesFromDictionary:namesAndValuesDict mutable:beMutable
-    "return a new inline object given slot names and slot values as elements
-     in the argument, namesAndValuesDict"
+    "return a new inline object, given slot names and slot values as elements
+     in the argument, namesAndValuesDict.
+     If the dictionary is unordered, slots are created in the sorted key order"
 
     |sz keys values idx|
 
@@ -179,15 +187,31 @@
     keys := Array new:sz.
     values := Array new:sz.
     idx := 1.
-    namesAndValuesDict keysAndValuesDo:[:k :v |
-        keys at:idx put:k.
-        values at:idx put:v.
-        idx := idx + 1.
+    namesAndValuesDict isOrdered ifTrue:[
+        namesAndValuesDict keysAndValuesDo:[:k :v |
+            keys at:idx put:k.
+            values at:idx put:v.
+            idx := idx + 1.
+        ].
+    ] ifFalse:[
+        namesAndValuesDict keysSorted do:[:k |
+            keys at:idx put:k.
+            values at:idx put:(namesAndValuesDict at:k).
+            idx := idx + 1.
+        ]
     ].
     ^ self slotNames:keys values:values mutable:beMutable
 
     "
-     InlineObject slotNamesAndValuesFromDictionary:(Dictionary withKeyValuePairs:#(('foo' 10) ('bar' 20) ('baz' 30)))
+     InlineObject 
+        slotNamesAndValuesFromDictionary:(
+            Dictionary withKeyValuePairs:#(('foo' 10) ('bar' 20) ('baz' 30))
+        )
+
+     InlineObject 
+        slotNamesAndValuesFromDictionary:(
+            OrderedDictionary withKeyValuePairs:#( ('bar' 20) ('baz' 30) ('foo' 10) )
+        )
     "
 
     "Created: / 25-06-2019 / 16:53:50 / Claus Gittinger"
@@ -405,6 +429,144 @@
    "
 ! !
 
+!InlineObject::InlineObjectClassDescription class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2009 by eXept Software AG
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+    inline objects are an experimental feature in ST/X
+    (and currently not used by the system).
+    Inline literal objects are created by the parsers/compilers with the following
+    syntax:
+        #{
+            <slotName1>: value .
+            <slotName2>: value .
+            ...
+        }
+    where each value is a literal, separated by period from the next   
+    i.e. similar to the brace-array construct { expr1 . expr2... }
+
+    For every inline object, an anonymous class is created,
+    providing getters and setters for the slots.
+    (if literal objects are immutable (which is the default), 
+     no setters are generated)
+
+    You cannot add any semantic (i.e. methods) to inline objects -
+    they are only useful as containers with a nicer protocol
+    as compared to dictionaries or arrays.
+
+    All such created classes will be subclasses of me.
+
+    [example:]
+        |foo|
+
+        foo := #{ 
+                 foo: 'foo value' .
+                 bar: 'bar value' .
+                 baz: 'and obviously: a baz value' .
+                }.
+        foo bar.
+        foo baz.
+        foo inspect.
+"
+!
+
+version
+    ^ '$Header$'
+!
+
+version_CVS
+    ^ '$Header$'
+! !
+
+!InlineObject::InlineObjectClassDescription methodsFor:'accessing'!
+
+setName:newName
+    "because classes are shared, multiple uses may try to use different names.
+     I am anonymous anyway, so the name is only kept for the user's convenience
+     (i.e. to provide a nicer printString)
+     Only remember the very first one.
+     (maybe we should concatenate names instead)."
+
+    name isNil ifTrue:[
+        name := newName
+    ] ifFalse:[
+        name = newName ifFalse:[
+            name := name,'/',newName
+        ].
+    ].
+
+    "
+     |o1 o2|
+
+     o1 := InlineObject slotNames:#('foo' 'bar' 'baz' 'bla') values:#(1 2 3 4).
+     o1 class setName:'myFoo'.
+     o2 := InlineObject slotNames:#('foo' 'bar' 'baz' 'bla') values:#(1 2 3 4).
+     o2 class setName:'myFoo2'.
+     o1 inspect.
+     o2 inspect.
+    "
+
+    "Created: / 25-06-2019 / 16:40:36 / Claus Gittinger"
+    "Modified: / 28-06-2019 / 14:38:32 / Claus Gittinger"
+! !
+
+!InlineObject::InlineObjectClassDescription methodsFor:'instance creation'!
+
+values:slotValues
+    "return a new inline object instance of myself,
+     given slot values (must be in my inst-slot order).
+     I must be the class of an existing concrete inline object,
+     not the (abstract) InlineObject class itself."
+
+    ^ (slotValues copyAs:Array) changeClassTo:self
+
+    "
+     |proto protoClass|
+
+     proto := InlineObject slotNames:#('foo' 'bar' 'baz') values:#(1 2 3).
+     protoClass := proto class.
+     protoClass setName:'Foo'.
+     (protoClass values:#( 10 20 30 )) inspect.
+    "
+! !
+
+!InlineObject::InlineObjectClassDescription methodsFor:'queries'!
+
+name
+    "although inline objects usually have no name, we return something
+     useful here - there are many places (inspectors) where
+     a classes name is asked for."
+
+    ^ name ? #'someInlineObject'
+!
+
+nameSpace
+    ^ nil
+
+    "Created: / 13-08-2010 / 18:23:33 / cg"
+!
+
+package
+    "return libbasic, so the methods of my subclass-instances (i.e. the inline objects)
+     are not seen as extensions in the browser)"
+
+    ^ InlineObject package
+! !
+
 !InlineObject::InlineObjectPrototype class methodsFor:'documentation'!
 
 copyright