HierarchicalClassRevisionList.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Thu, 14 Jun 2018 22:19:39 +0100
branchjv
changeset 18227 d25a407ba86d
parent 15950 23be8cf85415
permissions -rw-r--r--
Mini testrunner: show "green" if there's at least one pass and rest is pass or skip This is more meaningfull result then showing "gray" if there's at least one skip.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2626
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     1
"
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     2
 COPYRIGHT (c) 2000 by eXept Software AG
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     3
              All Rights Reserved
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     4
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     5
 This software is furnished under a license and may be used
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     6
 only in accordance with the terms of that license and with the
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     8
 be provided or otherwise made available to, or used by, any
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
     9
 other person.  No title to or ownership of the software is
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    10
 hereby transferred.
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    11
"
12650
e0f607754b9a Merged 18d06283743d and ff31bac2fd1b (branch default - CVS HEAD)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12125
diff changeset
    12
"{ Package: 'stx:libtool' }"
2626
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    13
15950
23be8cf85415 Bugfix in merge tool.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12650
diff changeset
    14
"{ NameSpace: Smalltalk }"
23be8cf85415 Bugfix in merge tool.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12650
diff changeset
    15
2613
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    16
HierarchicalList subclass:#HierarchicalClassRevisionList
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    17
	instanceVariableNames:'itemComputationList semaphoreCritical itemTask currentItemInTask
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    18
		dataColl'
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    19
	classVariableNames:'Lobby'
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    20
	poolDictionaries:''
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    21
	category:'Interface-Browsers-Support'
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    22
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    23
2625
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    24
!HierarchicalClassRevisionList class methodsFor:'documentation'!
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    25
2626
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    26
copyright
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    27
"
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    28
 COPYRIGHT (c) 2000 by eXept Software AG
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    29
              All Rights Reserved
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    30
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    31
 This software is furnished under a license and may be used
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    32
 only in accordance with the terms of that license and with the
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    33
 inclusion of the above copyright notice.   This software may not
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    34
 be provided or otherwise made available to, or used by, any
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    35
 other person.  No title to or ownership of the software is
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    36
 hereby transferred.
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    37
"
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    38
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    39
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    40
!
Claus Gittinger <cg@exept.de>
parents: 2625
diff changeset
    41
2625
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    42
documentation
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    43
"
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    44
    This is not yet finished (work in progress) - do not use.
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    45
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    46
    [author:]
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    47
        Pierre Schwarz (ps@exept.de)
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    48
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    49
    [see also:]
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    50
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    51
    [instance variables:]
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    52
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    53
    [class variables:]
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    54
"
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    55
d70f0361a027 doc; halts removed
Claus Gittinger <cg@exept.de>
parents: 2613
diff changeset
    56
! !
2613
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    57
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    58
!HierarchicalClassRevisionList class methodsFor:'instance creation'!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    59
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    60
new
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    61
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    62
    ^ super new initialize
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    63
! !
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    64
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    65
!HierarchicalClassRevisionList methodsFor:'accessing'!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    66
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    67
dataColl
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    68
    "return the value of the instance variable 'classRevisionColl' (automatically generated)"
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    69
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    70
    ^ dataColl
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    71
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    72
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    73
dataColl:something
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    74
    "set the value of the instance variable 'classRevisionColl' (automatically generated)"
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    75
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    76
    dataColl := something.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    77
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    78
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    79
icons
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    80
"
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    81
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    82
<return: Dictionary of: Symbol->Image>
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    83
"
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    84
    |icons|
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    85
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    86
    icons := Dictionary new.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    87
    icons at:#loadedRevision put:(Smalltalk imageFromFileNamed:'red_ball.xpm' forClass:self class).
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    88
    icons at:#unloadedRevision put:(Smalltalk imageFromFileNamed:'green_ball.xpm' forClass:self class).
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    89
    icons at:#unloadedClassItem put:(Smalltalk imageFromFileNamed:'small_folder_yellow_grey1.xpm' forClass:self class).
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    90
    icons at:#loadingClassItem put:(Smalltalk imageFromFileNamed:'small_folder_yellow_search.xpm' forClass:self class).
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    91
    icons at:#loadedClassItem put:(Smalltalk imageFromFileNamed:'small_folder_yellow.xpm' forClass:self class).
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    92
    ^icons
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    93
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    94
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    95
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    96
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    97
itemComputationList
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    98
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
    99
    ^ itemComputationList ifNil:[itemComputationList := IdentitySet new]
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   100
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   101
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   102
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   103
semaphoreCritical
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   104
    "return the value of the instance variable 'semaphoreCritical' (automatically generated)"
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   105
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   106
    ^ semaphoreCritical ifNil:[semaphoreCritical := RecursionLock new]
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   107
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   108
! !
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   109
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   110
!HierarchicalClassRevisionList methodsFor:'finalization'!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   111
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   112
disposed
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   113
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   114
    self stopItemTask.    
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   115
    Lobby unregister:self.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   116
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   117
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   118
! !
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   119
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   120
!HierarchicalClassRevisionList methodsFor:'initialization'!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   121
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   122
initialize
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   123
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   124
    self showRoot:false.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   125
    dataColl := OrderedCollection new.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   126
    self root:ClassItemRootForRevision new.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   127
    Lobby ifNil:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   128
        Lobby := Registry new.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   129
    ].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   130
    Lobby register:self.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   131
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   132
! !
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   133
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   134
!HierarchicalClassRevisionList methodsFor:'protocol'!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   135
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   136
getDataForItem: anItem
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   137
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   138
    self semaphoreCritical critical:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   139
        |theList|
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   140
        currentItemInTask == anItem ifTrue:[^self].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   141
        (theList := self itemComputationList) removeIdentical:anItem ifAbsent:[nil].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   142
        theList add:anItem.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   143
        self startItemTask]
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   144
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   145
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   146
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   147
itemTaskCycle
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   148
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   149
    |theItem|
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   150
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   151
    [
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   152
        theItem := nil.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   153
        self semaphoreCritical critical:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   154
            self itemComputationList notEmpty
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   155
                ifTrue:[theItem := self itemComputationList remove:(self itemComputationList last) ifAbsent:[nil]]
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   156
        ].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   157
        (theItem notNil and:[theItem needsChildren])ifTrue:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   158
            currentItemInTask:=theItem.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   159
            theItem computeRevisions.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   160
            currentItemInTask:=nil
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   161
        ].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   162
        theItem notNil
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   163
    ] whileTrue.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   164
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   165
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   166
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   167
newData: aClassRevisionColl
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   168
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   169
    dataColl := aClassRevisionColl.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   170
    self root:ClassItemRootForRevision new.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   171
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   172
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   173
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   174
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   175
startItemTask
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   176
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   177
    self semaphoreCritical critical:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   178
        itemTask ifNil:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   179
            itemTask := Process for:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   180
                                            self itemTaskCycle
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   181
                                        ]
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   182
                               priority:(Processor userBackgroundPriority).
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   183
            itemTask addExitAction:[itemTask := nil].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   184
            itemTask resume.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   185
        ].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   186
    ].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   187
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   188
!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   189
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   190
stopItemTask
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   191
    |task|
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   192
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   193
    self semaphoreCritical critical:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   194
        (task := itemTask) notNil ifTrue:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   195
            itemTask := nil.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   196
            Exception handle:[:ex|] do:[
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   197
                task terminateWithAllSubprocesses.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   198
                task waitUntilTerminated.
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   199
            ]
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   200
        ]
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   201
    ].
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   202
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   203
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   204
! !
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   205
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   206
!HierarchicalClassRevisionList class methodsFor:'documentation'!
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   207
4dd07aefaf20 initial checkin
ps
parents:
diff changeset
   208
version
12125
0c49a3b13e43 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12123
diff changeset
   209
    ^ '$Header: /cvs/stx/stx/libtool/HierarchicalClassRevisionList.st,v 1.3 2000/02/18 14:08:26 cg Exp $'
12650
e0f607754b9a Merged 18d06283743d and ff31bac2fd1b (branch default - CVS HEAD)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12125
diff changeset
   210
!
e0f607754b9a Merged 18d06283743d and ff31bac2fd1b (branch default - CVS HEAD)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12125
diff changeset
   211
e0f607754b9a Merged 18d06283743d and ff31bac2fd1b (branch default - CVS HEAD)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12125
diff changeset
   212
version_HG
e0f607754b9a Merged 18d06283743d and ff31bac2fd1b (branch default - CVS HEAD)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12125
diff changeset
   213
e0f607754b9a Merged 18d06283743d and ff31bac2fd1b (branch default - CVS HEAD)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12125
diff changeset
   214
    ^ '$Changeset: <not expanded> $'
12125
0c49a3b13e43 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12123
diff changeset
   215
! !
12650
e0f607754b9a Merged 18d06283743d and ff31bac2fd1b (branch default - CVS HEAD)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 12125
diff changeset
   216