SemaphoreMonitor.st
changeset 1692 1e2436b73ccc
parent 1053 9b1b15ef1e34
child 1760 07c940be883e
equal deleted inserted replaced
1691:41764d983be2 1692:1e2436b73ccc
    65 ! !
    65 ! !
    66 
    66 
    67 !SemaphoreMonitor methodsFor:'drawing'!
    67 !SemaphoreMonitor methodsFor:'drawing'!
    68 
    68 
    69 titleLine
    69 titleLine
    70     ^ ' id     name                   count owner waiting process(es)                   '.
    70     ^ ' id     name                   count owner   waiting process(es)                   '.
    71 
    71 
    72     "
    72     "
    73      SemaphoreMonitor open
    73      SemaphoreMonitor open
    74     "
    74     "
    75 
    75 
    76     "Modified: 24.1.1997 / 23:08:13 / cg"
    76     "Modified: / 17.6.1998 / 14:52:48 / cg"
    77 !
    77 !
    78 
    78 
    79 updateList
    79 updateList
    80     "update list of semaphores"
    80     "update list of semaphores"
    81 
    81 
   105 !
   105 !
   106 
   106 
   107 updateStatus
   107 updateStatus
   108     "update status display of semaphores"
   108     "update status display of semaphores"
   109 
   109 
   110     |oldList list |
   110     |oldList list oldSelection newSelection|
   111 
   111 
   112     shown ifTrue:[
   112     shown ifTrue:[
   113         oldList := listView list.
   113         oldList := listView list.
       
   114         oldSelection := listView selectionValue.
       
   115         oldSelection notNil ifTrue:[
       
   116             oldSelection := oldSelection collect:[:line | line asCollectionOfWords first asNumber].
       
   117             newSelection := OrderedCollection new.
       
   118         ].
   114 
   119 
   115         semaphores notNil ifTrue:[
   120         semaphores notNil ifTrue:[
   116             list := OrderedCollection new:(semaphores size + 2).
   121             list := OrderedCollection new:(semaphores size + 2).
   117             list add:self titleLine.
   122             list add:self titleLine.
   118             list add:(String new:self titleLine size withAll:$-).
   123             list add:(String new:self titleLine size withAll:$-).
   126 
   131 
   127                 str := '' writeStream.
   132                 str := '' writeStream.
   128                 waiters notNil ifTrue:[
   133                 waiters notNil ifTrue:[
   129                     waiters do:[:aProcess |
   134                     waiters do:[:aProcess |
   130                         str nextPut:$[.
   135                         str nextPut:$[.
       
   136                         str nextPutAll:(aProcess id printString).
       
   137                         str nextPutAll:' '''.
   131                         str nextPutAll:(aProcess name contractTo:40).
   138                         str nextPutAll:(aProcess name contractTo:40).
   132                         str nextPut:$].
   139                         str nextPutAll:''']'.
   133                         str space.
   140                         str space.
   134                     ].
   141                     ].
   135                 ].
   142                 ].
   136                 waitersNames := str contents.
   143                 waitersNames := str contents.
   137 
   144 
   144                     nm := ''
   151                     nm := ''
   145                 ].
   152                 ].
   146                 id := aSemaphore identityHash bitShift:-12.
   153                 id := aSemaphore identityHash bitShift:-12.
   147                 owner := aSemaphore lastOwnerId.
   154                 owner := aSemaphore lastOwnerId.
   148                 owner isNil ifTrue:[
   155                 owner isNil ifTrue:[
   149                     owner := '   '
   156                     owner := '     '
   150                 ] ifFalse:[
   157                 ] ifFalse:[
   151                     owner := owner printStringLeftPaddedTo:3
   158                     owner := owner printStringLeftPaddedTo:5
   152                 ].
   159                 ].
   153                 list add:(
   160                 list add:(
   154                           (id printStringPaddedTo:6)
   161                           (id printStringPaddedTo:6)
   155                           , ' '
   162                           , ' '
   156                           , ((nm contractTo:25) paddedTo:25)
   163                           , ((nm contractTo:25) paddedTo:25)
   160                           , owner
   167                           , owner
   161                           , ' '
   168                           , ' '
   162                           , (waiters size printStringLeftPaddedTo:3)
   169                           , (waiters size printStringLeftPaddedTo:3)
   163                           , ' '
   170                           , ' '
   164                           , waitersNames).
   171                           , waitersNames).
   165 
   172                 oldSelection notNil ifTrue:[
       
   173                     (oldSelection includes:id) ifTrue:[
       
   174                         newSelection add:list size.
       
   175                     ]
       
   176                 ]
   166             ].
   177             ].
   167         ].
   178         ].
   168         "avoid flicker"
   179         "avoid flicker"
   169         (oldList notNil and:[oldList size == list size]) ifTrue:[
   180         (oldList notNil and:[oldList size == list size]) ifTrue:[
   170             list keysAndValuesDo:[:idx :entry |
   181             list keysAndValuesDo:[:idx :entry |
   176             listView setList:list.
   187             listView setList:list.
   177             "the first two entries cannot be selected"
   188             "the first two entries cannot be selected"
   178             listView attributeAt:1 put:#disabled.
   189             listView attributeAt:1 put:#disabled.
   179             listView attributeAt:2 put:#disabled.
   190             listView attributeAt:2 put:#disabled.
   180         ].
   191         ].
       
   192         newSelection notNil ifTrue:[
       
   193             listView selectWithoutScroll:newSelection
       
   194         ].
   181         listView flush
   195         listView flush
   182     ].
   196     ].
   183     updateBlock notNil ifTrue:[
   197     updateBlock notNil ifTrue:[
   184         Processor removeTimedBlock:updateBlock.
   198         Processor removeTimedBlock:updateBlock.
   185         Processor addTimedBlock:updateBlock afterSeconds:updateDelay
   199         Processor addTimedBlock:updateBlock afterSeconds:updateDelay
   186     ]
   200     ]
   187 
   201 
   188     "Modified: 3.7.1996 / 13:56:01 / stefan"
   202     "Modified: / 3.7.1996 / 13:56:01 / stefan"
   189     "Modified: 8.2.1997 / 12:26:20 / cg"
   203     "Modified: / 17.6.1998 / 14:53:44 / cg"
   190 ! !
   204 ! !
   191 
   205 
   192 !SemaphoreMonitor methodsFor:'menu'!
   206 !SemaphoreMonitor methodsFor:'menu'!
       
   207 
       
   208 debugWaiters
       
   209     "open a debugger on the selected semaphores waiting processes"
       
   210 
       
   211     self selectedSemaphoresDo:[:aSema | 
       
   212         aSema waitingProcesses do:[:aProcess |
       
   213             DebugView openOn:aProcess 
       
   214         ]
       
   215     ]
       
   216 
       
   217     "Modified: / 23.1.1997 / 03:12:06 / cg"
       
   218     "Created: / 17.6.1998 / 14:56:55 / cg"
       
   219 !
   193 
   220 
   194 inspectSemaphore
   221 inspectSemaphore
   195     "open an inspector on the selected semaphores"
   222     "open an inspector on the selected semaphores"
   196 
   223 
   197     self selectedSemaphoresDo:[:aSema | aSema inspect]
   224     self selectedSemaphoresDo:[:aSema | aSema inspect]
   198 
   225 
   199     "Modified: 23.1.1997 / 03:12:06 / cg"
   226     "Modified: 23.1.1997 / 03:12:06 / cg"
   200     "Created: 24.1.1997 / 23:11:50 / cg"
   227     "Created: 24.1.1997 / 23:11:50 / cg"
       
   228 !
       
   229 
       
   230 inspectWaiters
       
   231     "open an inspector on the selected semaphores waiting processes"
       
   232 
       
   233     self selectedSemaphoresDo:[:aSema | 
       
   234         aSema waitingProcesses do:[:aProcess |
       
   235             aProcess inspect
       
   236         ]
       
   237     ]
       
   238 
       
   239     "Modified: / 23.1.1997 / 03:12:06 / cg"
       
   240     "Created: / 17.6.1998 / 14:17:41 / cg"
   201 !
   241 !
   202 
   242 
   203 selectedSemaphoresDo:aBlock
   243 selectedSemaphoresDo:aBlock
   204     "evaluate aBlock on all selected semaphores"
   244     "evaluate aBlock on all selected semaphores"
   205 
   245 
   244 !
   284 !
   245 
   285 
   246 statusMenu
   286 statusMenu
   247     "return a popUpMenu"
   287     "return a popUpMenu"
   248 
   288 
       
   289     <resource: #programMenu>
       
   290 
   249     |labels selectors m sel|
   291     |labels selectors m sel|
   250 
   292 
   251     labels := resources array:#(
   293     labels := resources array:#(
   252                          'inspect' 
   294                          'inspect' 
       
   295                          'inspect waiters' 
       
   296                          'debug waiters' 
   253                          '-'  
   297                          '-'  
   254                          'signal'  
   298                          'signal'  
   255                         ).
   299                         ).
   256     selectors := #(
   300     selectors := #(
   257                          inspectSemaphore  
   301                          inspectSemaphore  
       
   302                          inspectWaiters  
       
   303                          debugWaiters  
   258                          nil  
   304                          nil  
   259                          signalSemaphore
   305                          signalSemaphore
   260                         ).
   306                         ).
   261 
   307 
   262     updateProcess isNil ifTrue:[
   308     updateProcess isNil ifTrue:[
   274                          signalSemaphore
   320                          signalSemaphore
   275                       )
   321                       )
   276     ].
   322     ].
   277     ^ m
   323     ^ m
   278 
   324 
   279     "Modified: 23.1.1997 / 03:08:19 / cg"
   325     "Modified: / 17.6.1998 / 14:17:05 / cg"
   280 ! !
   326 ! !
   281 
   327 
   282 !SemaphoreMonitor methodsFor:'queries'!
   328 !SemaphoreMonitor methodsFor:'queries'!
   283 
   329 
   284 preferredExtent
   330 preferredExtent
   302 ! !
   348 ! !
   303 
   349 
   304 !SemaphoreMonitor class methodsFor:'documentation'!
   350 !SemaphoreMonitor class methodsFor:'documentation'!
   305 
   351 
   306 version
   352 version
   307     ^ '$Header: /cvs/stx/stx/libtool/SemaphoreMonitor.st,v 1.11 1997-03-02 10:23:25 cg Exp $'
   353     ^ '$Header: /cvs/stx/stx/libtool/SemaphoreMonitor.st,v 1.12 1998-06-17 12:58:41 cg Exp $'
   308 ! !
   354 ! !