Registry.st
author Claus Gittinger <cg@exept.de>
Fri, 15 Dec 1995 13:47:55 +0100
changeset 759 908363ce8a32
parent 630 b785d23d7c5b
child 1145 a094d90e11bf
permissions -rw-r--r--
interest is written with one 'r' (shame on me)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
Object subclass:#Registry
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    14
	 instanceVariableNames:'registeredObjects handleArray cleanState'
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    15
	 classVariableNames:''
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    16
	 poolDictionaries:''
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    17
	 category:'System-Support'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
!Registry class methodsFor:'documentation'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
88
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    22
copyright
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    23
"
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    24
 COPYRIGHT (c) 1993 by Claus Gittinger
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    25
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    26
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    27
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    28
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    30
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    31
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    32
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    33
"
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    34
!
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    35
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    36
documentation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    37
"
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    38
    Registries provide an easy interface to using WeakArrays. 
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    39
    A class, which wants to be informed of instance-death, can put a created object
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    40
    into a registry. The registry will create a (shallow-)copy of the object, and
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    41
    watch out for death of the original object. When it dies, the copy will
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    42
    be sent the #disposed-message.
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    43
    The trick with the shallow copy is especially nice, you can think of it as
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    44
    being the original object which died.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    45
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    46
    All objects, which keep external resources (such as fileDescriptors, fonts, 
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    47
    colormap-entries etc.) should be registered, so that the underlying resource
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    48
    can be freed when the object goes away.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    49
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    50
    Of course, you too can use it to do whatever you need to do in case of the
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    51
    death of an object.
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    52
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    53
    Registries use #shallowCopyForFinalization to aquire the copy of the original,
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    54
    this can be redefined in registered classes for faster copying 
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    55
    (typically, not all internal state but only some device handles are needed for 
317
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    56
    finalization). I if the to-be-registered object is large, this method may also
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    57
    return a stub (placeHolder) object. (i.e. there is no need for the copy to be
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    58
    of the same class as the original, as long as it implements disposed and frees
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    59
    the relevant OS resources ...)
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    60
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    61
    See axample uses in Form, Color, ExternalStream and Font
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    62
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    63
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    64
a27a279701f8 Initial revision
claus
parents:
diff changeset
    65
!Registry methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    66
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
contents
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
    "return the collection of registered objects"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
    ^ registeredObjects
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
register:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
    "register anObject, so that a copy of it gets the disposed message
2
claus
parents: 1
diff changeset
    75
     when anObject dies (some time in the future)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
375
claus
parents: 359
diff changeset
    77
    ^ self register:anObject as:(anObject shallowCopyForFinalization)
claus
parents: 359
diff changeset
    78
!
claus
parents: 359
diff changeset
    79
claus
parents: 359
diff changeset
    80
register:anObject as:aHandle
claus
parents: 359
diff changeset
    81
    "register anObject, so that I later receive informDispose: with aHandle
claus
parents: 359
diff changeset
    82
     (some time in the future)"
claus
parents: 359
diff changeset
    83
claus
parents: 359
diff changeset
    84
    |newColl newPhantoms
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    85
     size  "{ Class: SmallInteger }"
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    86
     index "{ Class: SmallInteger }"
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    87
     p|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    88
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
    registeredObjects isNil ifTrue:[
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    90
	registeredObjects := WeakArray new:10.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    91
	registeredObjects watcher:self.
375
claus
parents: 359
diff changeset
    92
	handleArray := Array basicNew:10.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    93
	registeredObjects at:1 put:anObject.
375
claus
parents: 359
diff changeset
    94
	handleArray at:1 put:aHandle.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    95
	cleanState := true.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    96
	ObjectMemory addDependent:self.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    97
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    98
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
    99
a27a279701f8 Initial revision
claus
parents:
diff changeset
   100
    index := registeredObjects identityIndexOf:anObject ifAbsent:[0].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   101
    index ~~ 0 ifTrue:[
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   102
	"already registered"
375
claus
parents: 359
diff changeset
   103
	handleArray at:index put:aHandle.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   104
	self error:'object is already registered'.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   105
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   106
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
a27a279701f8 Initial revision
claus
parents:
diff changeset
   108
    "search for a free slot, on the fly look for leftovers"
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   109
    index := registeredObjects identityIndexOf:nil startingAt:1.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   110
    index ~~ 0 ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   111
	"is there a leftover ?"
375
claus
parents: 359
diff changeset
   112
	p := handleArray at:index.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   113
	p notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   114
	    "tell the phantom"
375
claus
parents: 359
diff changeset
   115
	    handleArray at:index put:nil.
claus
parents: 359
diff changeset
   116
	    self informDispose:p.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   117
	    p := nil.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   118
	].
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   119
	registeredObjects at:index put:anObject.
375
claus
parents: 359
diff changeset
   120
	handleArray at:index put:aHandle.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   121
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   122
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
    "no free slot, add at the end"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   126
    size := registeredObjects size.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   127
    index := size + 1.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   128
    newColl := WeakArray new:(size * 2).
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   129
    newColl replaceFrom:1 to:size with:registeredObjects.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   130
    registeredObjects := newColl.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   131
    registeredObjects watcher:self.
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   132
    registeredObjects at:index put:anObject.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   133
359
claus
parents: 317
diff changeset
   134
    newPhantoms := Array basicNew:(size * 2).
375
claus
parents: 359
diff changeset
   135
    newPhantoms replaceFrom:1 to:size with:handleArray.
claus
parents: 359
diff changeset
   136
    handleArray := newPhantoms.
claus
parents: 359
diff changeset
   137
    handleArray at:index put:aHandle.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   138
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   139
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   140
registerChange:anObject
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   141
    "a registered object has changed, create a new phantom"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   142
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   143
    |index|
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   144
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   145
    index := registeredObjects identityIndexOf:anObject ifAbsent:[0].
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   146
    index ~~ 0 ifTrue:[
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   147
	handleArray at:index put:anObject shallowCopyForFinalization.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   148
    ]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   149
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   150
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   151
unregister:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
    "remove registration of anObject, without telling the phantom;
759
908363ce8a32 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 630
diff changeset
   153
     should be sent, if we are no more interested in destruction of
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   154
     anObject (i.e. it no longer holds external resources)."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   155
a27a279701f8 Initial revision
claus
parents:
diff changeset
   156
    |index|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
    index := registeredObjects identityIndexOf:anObject ifAbsent:[0].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
    index ~~ 0 ifTrue:[
375
claus
parents: 359
diff changeset
   160
	handleArray at:index put:nil.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   161
	registeredObjects at:index put:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   162
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   163
! !
2
claus
parents: 1
diff changeset
   164
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   165
!Registry methodsFor:'dispose handling'!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   166
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   167
informDispose
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   168
    "an instance has been destroyed - look which one it was"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   169
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   170
    |phantom
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   171
     sz "{ Class: SmallInteger }"|
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   172
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   173
    cleanState ifTrue:[
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   174
	sz := handleArray size.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   175
	1 to:sz do:[:index |
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   176
	    (registeredObjects at:index) isNil ifTrue:[
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   177
		phantom := handleArray at:index.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   178
		phantom notNil ifTrue:[
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   179
		    handleArray at:index put:nil.
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   180
		    self informDispose:phantom
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   181
		]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   182
	    ]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   183
	]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   184
    ]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   185
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   186
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   187
informDispose:someHandle
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   188
    someHandle disposed
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   189
! !
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   190
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   191
!Registry methodsFor:'enumerating'!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   192
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   193
do:aBlock
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   194
    "evaluate aBlock for each registered object"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   195
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   196
    registeredObjects notNil ifTrue:[
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   197
	registeredObjects nonNilElementsDo:aBlock
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   198
    ]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   199
! !
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   200
2
claus
parents: 1
diff changeset
   201
!Registry methodsFor:'restart handling'!
claus
parents: 1
diff changeset
   202
claus
parents: 1
diff changeset
   203
update:aParameter
10
claus
parents: 3
diff changeset
   204
    aParameter == #earlyRestart ifTrue:[
375
claus
parents: 359
diff changeset
   205
	handleArray notNil ifTrue:[
claus
parents: 359
diff changeset
   206
	    handleArray atAllPut:nil
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   207
	]
10
claus
parents: 3
diff changeset
   208
    ].
claus
parents: 3
diff changeset
   209
    aParameter == #returnFromSnapshot ifTrue:[
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   210
	cleanState := true
2
claus
parents: 1
diff changeset
   211
    ]
claus
parents: 1
diff changeset
   212
! !
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   213
630
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   214
!Registry class methodsFor:'documentation'!
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   215
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   216
version
759
908363ce8a32 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 630
diff changeset
   217
    ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.22 1995-12-15 12:47:47 cg Exp $'
630
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   218
! !