SharedPool.st
author Claus Gittinger <cg@exept.de>
Sat, 15 Jan 2011 14:20:27 +0100
changeset 13210 2ceae489a80b
parent 13208 3e8317f5e070
child 13211 c64d16143d54
permissions -rw-r--r--
changed: #initializeFrom:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8728
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     1
"
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     2
 COPYRIGHT (c) 2004 by eXept Software AG
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     3
              All Rights Reserved
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     4
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     5
 This software is furnished under a license and may be used
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     6
 only in accordance with the terms of that license and with the
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     8
 be provided or otherwise made available to, or used by, any
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
     9
 other person.  No title to or ownership of the software is
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    10
 hereby transferred.
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    11
"
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
    12
"{ Package: 'stx:libbasic' }"
68e006f46d87 initial checkin
ca
parents:
diff changeset
    13
68e006f46d87 initial checkin
ca
parents:
diff changeset
    14
Object subclass:#SharedPool
68e006f46d87 initial checkin
ca
parents:
diff changeset
    15
	instanceVariableNames:''
68e006f46d87 initial checkin
ca
parents:
diff changeset
    16
	classVariableNames:''
68e006f46d87 initial checkin
ca
parents:
diff changeset
    17
	poolDictionaries:''
68e006f46d87 initial checkin
ca
parents:
diff changeset
    18
	category:'Kernel-Classes'
68e006f46d87 initial checkin
ca
parents:
diff changeset
    19
!
68e006f46d87 initial checkin
ca
parents:
diff changeset
    20
68e006f46d87 initial checkin
ca
parents:
diff changeset
    21
!SharedPool class methodsFor:'documentation'!
68e006f46d87 initial checkin
ca
parents:
diff changeset
    22
8728
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    23
copyright
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    24
"
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    25
 COPYRIGHT (c) 2004 by eXept Software AG
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    26
              All Rights Reserved
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    27
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    28
 This software is furnished under a license and may be used
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    29
 only in accordance with the terms of that license and with the
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    31
 be provided or otherwise made available to, or used by, any
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    32
 other person.  No title to or ownership of the software is
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    33
 hereby transferred.
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    34
"
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    35
!
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8551
diff changeset
    36
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
    37
documentation
68e006f46d87 initial checkin
ca
parents:
diff changeset
    38
"
68e006f46d87 initial checkin
ca
parents:
diff changeset
    39
    A shared pool represents a set of bindings which are accessible to all classes
68e006f46d87 initial checkin
ca
parents:
diff changeset
    40
    which import the pool in its 'pool dictionaries'.
68e006f46d87 initial checkin
ca
parents:
diff changeset
    41
    SharedPool is NOT a dictionary but rather a name space.
68e006f46d87 initial checkin
ca
parents:
diff changeset
    42
    Bindings are represented by 'class variables' - as long as we have no better way to represent
12220
c26b8b402a71 changed: #documentation
Claus Gittinger <cg@exept.de>
parents: 12169
diff changeset
    43
    them at least. This is done to make stc happy (or at least, to not be forced to adapt it
c26b8b402a71 changed: #documentation
Claus Gittinger <cg@exept.de>
parents: 12169
diff changeset
    44
    to any new semantics).
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
    45
"
68e006f46d87 initial checkin
ca
parents:
diff changeset
    46
! !
68e006f46d87 initial checkin
ca
parents:
diff changeset
    47
9091
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    48
!SharedPool class methodsFor:'Compatibility-V''Age'!
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    49
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    50
declareConstant:constantName value:value
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    51
    self == SharedPool ifTrue:[ self error ].
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    52
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    53
    (self classVarNames includes:constantName) ifFalse:[
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    54
        self addClassVarName:constantName
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    55
    ].
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    56
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    57
    self classVarAt:constantName put:value.
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    58
! !
35b746ada800 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8728
diff changeset
    59
13181
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    60
!SharedPool class methodsFor:'code generation'!
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    61
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    62
initializeFrom:aDictionary
13207
5f62183ab0e9 comment/format in: #initializeFrom:
Claus Gittinger <cg@exept.de>
parents: 13181
diff changeset
    63
    "given a dictionary, generate my classvars and the init code"
13181
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    64
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    65
    |code|
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    66
13210
2ceae489a80b changed: #initializeFrom:
Claus Gittinger <cg@exept.de>
parents: 13208
diff changeset
    67
    self addClassVarNames:(aDictionary keys asSortedCollection).
13181
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    68
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    69
    code := String streamContents:[:s |
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    70
        s nextPutLine:'initialize'.
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    71
        aDictionary keys asSortedCollection do:[:k |
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    72
            |v|
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    73
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    74
            v := aDictionary at:k.
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    75
            s nextPutLine:('    %1 := %2.' bindWith:k with:v storeString).
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    76
        ].
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    77
    ].
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    78
    self class compile:code classified:'initialization'
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    79
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    80
    "
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    81
     OLEStatusCodeConstants initializeFrom:aDictionary
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    82
    "
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    83
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    84
    "Created: / 21-12-2010 / 17:58:25 / cg"
13210
2ceae489a80b changed: #initializeFrom:
Claus Gittinger <cg@exept.de>
parents: 13208
diff changeset
    85
    "Modified: / 15-01-2011 / 14:19:59 / cg"
13181
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    86
! !
Claus Gittinger <cg@exept.de>
parents: 13097
diff changeset
    87
13207
5f62183ab0e9 comment/format in: #initializeFrom:
Claus Gittinger <cg@exept.de>
parents: 13181
diff changeset
    88
13097
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    89
!SharedPool class methodsFor:'misc ui support'!
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    90
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    91
iconInBrowserSymbol
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    92
    <resource: #programImage>
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    93
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    94
    self == SharedPool ifTrue:[^ super iconInBrowserSymbol].
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    95
    ^ #sharedPoolBrowserIcon
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    96
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    97
    "Created: / 14-10-2010 / 12:04:32 / cg"
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    98
! !
d07ec91b3105 added: #iconInBrowserSymbol
Claus Gittinger <cg@exept.de>
parents: 13005
diff changeset
    99
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
   100
!SharedPool class methodsFor:'name lookup'!
68e006f46d87 initial checkin
ca
parents:
diff changeset
   101
12169
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   102
at:name
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   103
    "retrieve a pool variable by name"
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   104
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   105
    ^ self at:name ifAbsent:[self errorKeyNotFound:name]
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   106
!
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   107
10853
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   108
at:name ifAbsent:aBlock
12169
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   109
    "retrieve a pool variable by name"
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   110
10853
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   111
    (self includesKey:name) ifFalse:[^ aBlock value].
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   112
    ^ self classVarAt:name
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   113
!
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   114
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
   115
bindingOf: varName
68e006f46d87 initial checkin
ca
parents:
diff changeset
   116
    "Answer the binding of some variable resolved in the scope of the receiver"
68e006f46d87 initial checkin
ca
parents:
diff changeset
   117
68e006f46d87 initial checkin
ca
parents:
diff changeset
   118
    | aSymbol binding |
68e006f46d87 initial checkin
ca
parents:
diff changeset
   119
11305
83f14d00b6a7 Change #halt: to #shouldImplement or #assert:
Stefan Vogel <sv@exept.de>
parents: 10853
diff changeset
   120
    self shouldImplement.       "not yet finished"
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
   121
    aSymbol := varName asSymbol.
68e006f46d87 initial checkin
ca
parents:
diff changeset
   122
68e006f46d87 initial checkin
ca
parents:
diff changeset
   123
    "First look in classVar dictionary."
68e006f46d87 initial checkin
ca
parents:
diff changeset
   124
    binding := self classPool bindingOf: aSymbol.
13005
2ba0600be7aa changed: #bindingOf:
Claus Gittinger <cg@exept.de>
parents: 12220
diff changeset
   125
    binding notNil ifTrue:[^binding].
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
   126
68e006f46d87 initial checkin
ca
parents:
diff changeset
   127
    "Next look in shared pools."
68e006f46d87 initial checkin
ca
parents:
diff changeset
   128
    self sharedPools do:[:pool |
13005
2ba0600be7aa changed: #bindingOf:
Claus Gittinger <cg@exept.de>
parents: 12220
diff changeset
   129
        binding := pool bindingOf: aSymbol.
2ba0600be7aa changed: #bindingOf:
Claus Gittinger <cg@exept.de>
parents: 12220
diff changeset
   130
        binding notNil ifTrue:[^binding].
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
   131
    ].
68e006f46d87 initial checkin
ca
parents:
diff changeset
   132
68e006f46d87 initial checkin
ca
parents:
diff changeset
   133
    "subclassing and environment are not preserved"
68e006f46d87 initial checkin
ca
parents:
diff changeset
   134
    ^nil
13005
2ba0600be7aa changed: #bindingOf:
Claus Gittinger <cg@exept.de>
parents: 12220
diff changeset
   135
2ba0600be7aa changed: #bindingOf:
Claus Gittinger <cg@exept.de>
parents: 12220
diff changeset
   136
    "Modified: / 08-08-2010 / 14:46:09 / cg"
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
   137
!
68e006f46d87 initial checkin
ca
parents:
diff changeset
   138
68e006f46d87 initial checkin
ca
parents:
diff changeset
   139
bindingsDo: aBlock
68e006f46d87 initial checkin
ca
parents:
diff changeset
   140
self halt:'unfinished implementation'.
68e006f46d87 initial checkin
ca
parents:
diff changeset
   141
    ^ self classPool bindingsDo: aBlock
68e006f46d87 initial checkin
ca
parents:
diff changeset
   142
!
68e006f46d87 initial checkin
ca
parents:
diff changeset
   143
68e006f46d87 initial checkin
ca
parents:
diff changeset
   144
classBindingOf: varName
68e006f46d87 initial checkin
ca
parents:
diff changeset
   145
    "For initialization messages grant the regular scope"
68e006f46d87 initial checkin
ca
parents:
diff changeset
   146
11305
83f14d00b6a7 Change #halt: to #shouldImplement or #assert:
Stefan Vogel <sv@exept.de>
parents: 10853
diff changeset
   147
    self shouldImplement.       "not yet finished"
83f14d00b6a7 Change #halt: to #shouldImplement or #assert:
Stefan Vogel <sv@exept.de>
parents: 10853
diff changeset
   148
    ^ super bindingOf: varName
8551
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   149
!
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   150
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   151
includesKey:aSymbol
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   152
    ^ self keys includes:aSymbol
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   153
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   154
    "
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   155
     OpenGLConstants includesKey:#GL3Bytes
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   156
    "
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   157
!
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   158
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   159
keys
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   160
    ^ self classVarNames
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   161
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   162
    "
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   163
     OpenGLConstants keys
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   164
    "
10853
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   165
!
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   166
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   167
keysDo:aBlock
72acafda369f dictionary compatible protocol added
Claus Gittinger <cg@exept.de>
parents: 9091
diff changeset
   168
    ^ self keys do:aBlock
8551
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   169
! !
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   170
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   171
!SharedPool class methodsFor:'printing & storing'!
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   172
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   173
displayString
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   174
    "return a printed represenation - here, a reminder is appended,
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   175
     that this is not a regular class"
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   176
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   177
    self == SharedPool ifTrue:[
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   178
        ^ super displayString
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   179
    ].
de314b9f8fa3 sharedPools
ca
parents: 8538
diff changeset
   180
    ^ self name , ' (* SharedPool *)'
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
   181
! !
68e006f46d87 initial checkin
ca
parents:
diff changeset
   182
68e006f46d87 initial checkin
ca
parents:
diff changeset
   183
!SharedPool class methodsFor:'queries'!
68e006f46d87 initial checkin
ca
parents:
diff changeset
   184
68e006f46d87 initial checkin
ca
parents:
diff changeset
   185
isSharedPool
68e006f46d87 initial checkin
ca
parents:
diff changeset
   186
    ^ self ~~ SharedPool
68e006f46d87 initial checkin
ca
parents:
diff changeset
   187
! !
68e006f46d87 initial checkin
ca
parents:
diff changeset
   188
68e006f46d87 initial checkin
ca
parents:
diff changeset
   189
!SharedPool class methodsFor:'documentation'!
68e006f46d87 initial checkin
ca
parents:
diff changeset
   190
68e006f46d87 initial checkin
ca
parents:
diff changeset
   191
version
13210
2ceae489a80b changed: #initializeFrom:
Claus Gittinger <cg@exept.de>
parents: 13208
diff changeset
   192
    ^ '$Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.14 2011-01-15 13:20:27 cg Exp $'
12169
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   193
!
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   194
8fcbd9a9237e added: #at:
Claus Gittinger <cg@exept.de>
parents: 11305
diff changeset
   195
version_CVS
13210
2ceae489a80b changed: #initializeFrom:
Claus Gittinger <cg@exept.de>
parents: 13208
diff changeset
   196
    ^ '$Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.14 2011-01-15 13:20:27 cg Exp $'
8538
68e006f46d87 initial checkin
ca
parents:
diff changeset
   197
! !