"{ NameSpace: Smalltalk }"

    This view shows smalltalk's semaphores - a debugging tool.

    [disclaimer:]

        this is one of the oldest tools in the system, written in the early 90's.

        It does in no way reflect the way GUIs are designed/written these days.

        Semaphore SemaphoreSet

        Process ProcessorScheduler

        WindowGroup

        ProcessMonitor

        Claus Gittinger

        SemaphoreMonitor open

        oldList := listView list.

        oldSelection := listView selectionValue.

        oldSelection notNil ifTrue:[

            oldSelection := oldSelection collect:[:line | line asCollectionOfWords first asNumber].

            newSelection := OrderedCollection new.

        ].

        newSemaphoreList notNil ifTrue:[

            semaphores := WeakArray withAll:newSemaphoreList.

        ].

        semaphores notNil ifTrue:[

            list := OrderedCollection new:(semaphores size + self numberOfHeadlines).

            list add:self titleLine.

            list add:(String new:self titleLine size withAll:$-).

            semaphores validElementsDo:[:aSemaphore |

                |waiters waitersNames nm id str owner color line count|

                "/ need a copy - it may change while being enumerated

                [

                    count := aSemaphore count.

                    waiters := aSemaphore waitingProcesses copy.

                ] valueUninterruptably.

                str := '' writeStream.

                [

                    waiters notNil ifTrue:[

                        waiters do:[:aProcess |

                            str nextPut:$[.

                            aProcess id printOn:str.

                            str nextPutAll:' '''.

                            str nextPutAll:(aProcess name contractTo:40).

                            str nextPutAll:'''<'.

                            aProcess priority printOn:str.

                            str nextPutAll:'>]'.

                            str space.

                        ].

                    ]

                ] valueUninterruptably.

                waitersNames := str contents.

                (aSemaphore respondsTo:#name) ifTrue:[

                    nm := aSemaphore name.

                    nm isNil ifTrue:[

                        nm := ''

                    ]

                ] ifFalse:[

                    nm := ''

                ].

                id := aSemaphore identityHash bitShift:-12.

                owner := aSemaphore lastOwnerId.

                owner isNil ifTrue:[

                    owner := '     '

                ] ifFalse:[

                    owner := owner printStringLeftPaddedTo:5

                ].

                line := (id printStringPaddedTo:6)

                          , ' '

                          , ((nm contractTo:25) paddedTo:25)

                          , ' '

                          , (count printStringLeftPaddedTo:3)

                          , ' '

                          , owner printString

                          , ' '

                          , (waiters size printStringLeftPaddedTo:3)

                          , ' '

                          , waitersNames.

                count > 0 ifTrue:[

                    waiters size > 0 ifTrue:[

                        "this happens if a low priority process is ready to run but didn't wake up yet"

                        color := Color red.

                    ] ifFalse:[

                        "fine, this semaphore is available"

                        color := Color blue.

                    ].

                    line := line colorizeAllWith:color.

                ] ifFalse:[

                    waiters size > 0 ifTrue:[

                        line := line colorizeAllWith:Color brown.

                    ].

                ].

                list add:line.

                oldSelection notNil ifTrue:[

                    (oldSelection includes:id) ifTrue:[

                        newSelection add:list size.

                    ]

                ]

            ].

        ].

        "avoid flicker"

        (oldList notNil and:[oldList size == list size]) ifTrue:[

            list keysAndValuesDo:[:idx :entry |

                (oldList at:idx) ~= entry ifTrue:[

                    listView at:idx put:entry

                ]

            ]

        ] ifFalse:[

            listView setList:list.

            "the first two entries cannot be selected"

            listView attributeAt:1 put:#disabled.

            listView attributeAt:2 put:#disabled.

        ].

        newSelection notNil ifTrue:[

            listView selectWithoutScroll:newSelection

        ].

        listView flush

        Processor removeTimedBlock:updateBlock.

        Processor addTimedBlock:updateBlock afterSeconds:updateDelay

        sel do:[:n |

            nr := n - self numberOfHeadlines.

            nr notNil ifTrue:[

                nr > 0 ifTrue:[

                    p := semaphores at:nr.

                    (p notNil and:[p ~~ 0]) ifTrue:[

                       aBlock value:p

                    ]

                ]

            ]

        ]

        nr := sel - self numberOfHeadlines.    

        nr notNil ifTrue:[

            nr > 0 ifTrue:[

                p := semaphores at:nr.

                (p notNil and:[p ~~ 0]) ifTrue:[

                   aBlock value:p

                ]

            ]

        ]

numberOfHeadlines

    ^ 2

    ^ '$Header$'