"

 COPYRIGHT (c) 1997 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libtool' }"

"{ NameSpace: Smalltalk }"

SystemStatusMonitor subclass:#TimerQueueMonitor

	instanceVariableNames:'timeouts showTime'

	classVariableNames:''

	poolDictionaries:''

	category:'Monitors-ST/X'

!

!TimerQueueMonitor class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1997 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    This view shows smalltalk's external stream instances - a debugging tool.

    [disclaimer:]

        this is based on 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.

        However, after all those years, they are still very very useful (and not found in many other systems)  

    [see also:]

        Stream ExternalStream

        WindowGroup

        ProcessMonitor

        SemaphoreMonitor OSProcessMonitor

    [author:]

        Claus Gittinger

    [start with:]

        ExternalStreamMonitor open

"

! !

!TimerQueueMonitor class methodsFor:'defaults'!

defaultLabel

    ^ 'External Streams Monitor'

    "Created: 23.1.1997 / 02:52:53 / cg"

! !

!TimerQueueMonitor class methodsFor:'menu specs'!

mainMenu

    "This resource specification was automatically generated

     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the MenuEditor may not be able to read the specification."

    "

     MenuEditor new openOnClass:TimerQueueMonitor andSelector:#mainMenu

     (Menu new fromLiteralArrayEncoding:(TimerQueueMonitor mainMenu)) startUp

    "

    <resource: #menu>

    ^ 

     #(Menu 

       (MenuItem

          label: 'File'

          submenuChannel: fileMenu

       ) 

       (MenuItem

          label: 'View'

          submenuChannel: viewMenu

       )

     )

! !

!TimerQueueMonitor methodsFor:'initialization'!

initialize

    super initialize.

    showTime := true.

! !

!TimerQueueMonitor methodsFor:'queries'!

numberOfHeadlines

    ^ 2 + (showTime == true ifTrue:1 ifFalse:0)

    "Modified: / 29-10-2018 / 15:24:14 / Claus Gittinger"

! !

!TimerQueueMonitor methodsFor:'updating'!

titleLine

    ^ 'When       Process                                  Action/Semaphore'.

    "

     TimeQueueMonitor open

    "

!

updateList

    "update list of timeouts"

    |newInfo t list|

    shown ifTrue:[

        newInfo := Processor timeoutList.

        self updateStatus:newInfo

    ].

    self installDelayedUpdate.

    "Modified: / 29-10-2018 / 15:39:43 / Claus Gittinger"

!

updateStatus:newInfo

    "update status display of timeouts"

    |numberOfHeadlines newTimeoutList oldList list oldSelection newSelection osTimeStampOfList|

    newInfo isNil ifTrue:[^ self].

    shown ifTrue:[

        osTimeStampOfList := newInfo first.

        newTimeoutList := newInfo second.

        newTimeoutList sort:[:t1 :t2 | (t1 at:'time') < (t2 at:'time') ].

        numberOfHeadlines := self numberOfHeadlines.

        oldList := listView list.

"/        oldSelection := listView selection.

"/        oldSelection notNil ifTrue:[

"/            oldSelection := oldSelection 

"/                                select:[:lNr | lNr > numberOfHeadlines]

"/                                thenCollect:[:lineNr | 

"/                                    timeouts at:(lineNr - numberOfHeadlines) ifAbsent:nil 

"/                                ].

"/            newSelection := OrderedCollection new.

"/        ].

        list := OrderedCollection new:(newTimeoutList size + numberOfHeadlines).

        (showTime == true) ifTrue:[

            list add:'Time: ',(Time now printString).

        ].

        list add:self titleLine.

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

        newTimeoutList notNil ifTrue:[

            newTimeoutList do:[:aTimeout |

                |time process processName action actionName sema semaName deltaTime

                 color line|

                time := aTimeout at:'time'.

                action := aTimeout at:'action'.

                process := aTimeout at:'process'.

                sema := aTimeout at:'sema'.

                processName := process isNil ifTrue:[''] ifFalse:[process name].

                actionName := action isNil ifTrue:[''] ifFalse:[action printString].

                semaName := sema isNil ifTrue:[''] ifFalse:[sema displayString].

                deltaTime := TimeDuration milliseconds:(time - osTimeStampOfList).

                line := (deltaTime printString) paddedTo:10.

                line := line , ' ' , ((processName contractTo:40) paddedTo:40).

                action notNil ifTrue:[

                    line := line , ' ' , ((actionName contractTo:40) paddedTo:40).

                ] ifFalse:[

                    line := line , ' ' , ((semaName contractTo:40) paddedTo:40).

                ].

    "/            isOpen ifFalse:[

    "/                color := Color red.

    "/            ] ifTrue:[

    "/                color := Color blue.

    "/            ].

    "/            line := line withColor:color.

                list add:line.

    "/            oldSelection notNil ifTrue:[

    "/                (oldSelection includesIdentical:aStream) 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 few entries cannot be selected"

            1 to:numberOfHeadlines do:[:lNr | listView attributeAt:lNr put:#disabled].

        ].

        newSelection notNil ifTrue:[

            listView selectWithoutScroll:newSelection

        ].

        listView flush

    ].

    self installDelayedUpdate.

    "Modified: / 11-10-2017 / 13:56:14 / cg"

    "Modified: / 07-06-2019 / 22:10:36 / Claus Gittinger"

! !

!TimerQueueMonitor class methodsFor:'documentation'!

version_CVS

    ^ '$Header$'

! !