CachingRegistry.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Thu, 30 Jun 2016 21:12:35 +0100
branchjv
changeset 20079 8d884971c2ed
parent 18261 22bdfc405bca
parent 20043 0be0ccf00b36
child 20398 8cb53f870d39
permissions -rw-r--r--
Merge
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 1999 by eXept Software AG
18249
7d686f203624 oops package def was missing
Claus Gittinger <cg@exept.de>
parents: 4434
diff changeset
     3
	      All Rights Reserved
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    12
"{ Package: 'stx:libbasic' }"
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    14
"{ NameSpace: Smalltalk }"
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
Registry subclass:#CachingRegistry
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	instanceVariableNames:'keptReferences cacheSize'
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	classVariableNames:''
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	poolDictionaries:''
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	category:'System-Support'
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!CachingRegistry class methodsFor:'documentation'!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
copyright
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
 COPYRIGHT (c) 1999 by eXept Software AG
18249
7d686f203624 oops package def was missing
Claus Gittinger <cg@exept.de>
parents: 4434
diff changeset
    28
	      All Rights Reserved
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
 This software is furnished under a license and may be used
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
 only in accordance with the terms of that license and with the
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 be provided or otherwise made available to, or used by, any
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
 other person.  No title to or ownership of the software is
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
 hereby transferred.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
documentation
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
    A CachingRegistry behaves generally like a registry;
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    However, it keeps hard references to the last n registered objects,
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    preventing them from being garbage collected (and finalized).
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    This is useful for resources, which do not cost too much memory,
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    46
    but are expensive to allocate - a special candidate of this kind are
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    XFonts. With a CachingRegistry, fonts are kept a bit longer alive
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
    and can therefore often be reused - even if temporarily unreferenced.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    This is kind of experimental.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
    [author:]
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    54
        Claus Gittinger (cg@exept)
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
    [see also:]
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
    [instance variables:]
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    59
        keptObjects             Collection      hard referenced objects
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    60
        cacheSize               Integer         number of hard references
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
    [class variables:]
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
! !
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
!CachingRegistry methodsFor:'private'!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
cacheSize:aNumber
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
    keptReferences := OrderedCollection new:aNumber.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
    cacheSize := aNumber.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
! !
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
!CachingRegistry methodsFor:'registering objects'!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
register:anObject as:aHandle
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
    keptReferences removeIdentical:anObject ifAbsent:nil.
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    77
    aHandle notNil ifTrue:[
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    78
        keptReferences addLast:anObject.
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    79
        keptReferences size > cacheSize ifTrue:[
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    80
            keptReferences removeFirst.
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    81
        ].
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
    ].
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
    super register:anObject as:aHandle.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    86
removeKey:anObject ifAbsent:absentBlock
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    87
    keptReferences removeIdentical:anObject ifAbsent:nil.
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    88
    super removeKey:anObject ifAbsent:absentBlock.
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    91
safeRemoveKey:anObject
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
    keptReferences removeIdentical:anObject ifAbsent:nil.
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    93
    super safeRemoveKey:anObject.
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
! !
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
!CachingRegistry class methodsFor:'documentation'!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
version
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    99
    ^ '$Header$'
17865
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
   100
!
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
   101
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
   102
version_SVN
17911
a99f15c5efa5 Updated with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17910
diff changeset
   103
    ^ '$Id: CachingRegistry.st 10761 2012-01-19 11:46:00Z vranyj1 $'
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
! !
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
   105
17910
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
   106
17911
a99f15c5efa5 Updated with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17910
diff changeset
   107