"{ Encoding: utf8 }"

"

 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:]

        TimerQueueMonitor open

"

! !

!TimerQueueMonitor class methodsFor:'defaults'!

defaultLabel

    ^ 'TimerQueue 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:'menu'!

browseAction

    self selectedEntriesDo:[:entry |

        |action|

        (action := entry at:'action' ifAbsent:[nil]) notNil ifTrue:[

            |home mthd|

            (home := action home) notNil ifTrue:[

                (mthd := home method) notNil ifTrue:[      

                    SystemBrowser default openInClass:mthd mclass selector:mthd selector

                ]

            ]

        ]

    ]

!

debugProcess

    self selectedEntriesDo:[:entry |

        |process sema|

        (process := entry at:'process' ifAbsent:[nil]) isNil ifTrue:[

            (sema := entry at:'sema' ifAbsent:[nil]) notNil ifTrue:[

                process := sema waitingProcesses firstIfEmpty:nil

            ]

        ].

        process notNil ifTrue:[

            Debugger openOn:process

        ]

    ]

!

inspectProcess

    self selectedEntriesDo:[:entry |

        |process|

        (process := entry at:'process' ifAbsent:[nil]) notNil ifTrue:[

            process inspect.

        ]

    ]

!

inspectSemaphore

    self selectedEntriesDo:[:entry |

        |sema|

        (sema := entry at:'sema' ifAbsent:[nil]) notNil ifTrue:[

            sema inspect.

        ]

    ]

!

selectedEntriesDo:aBlock

    |t sel|

    [

        t := timeouts copy.

        sel := listView selection

    ] valueUninterruptably.

    (sel ? #()) do:[:eachIndex |

        |entry|

        entry := t at:(eachIndex - self numberOfHeadlines) ifAbsent:[nil].

        aBlock value:entry

    ]

!

statusMenu

    "return a popUpMenu"

    <resource: #programMenu>

    |labels selectors m|

    labels := resources array:#(

                         'Inspect Semaphore'

                         'Inspect Process'

                         '-'

                         'Debug Process'

                         'Browse Action'

                        ).

    selectors := #(

                         inspectSemaphore

                         inspectProcess

                         nil

                         debugProcess

                         browseAction

                        ).

    m := PopUpMenu labels:labels

                   selectors:selectors.

    listView hasSelection ifFalse:[

        m disableAll:#(

                         inspectSemaphore

                         inspectProcess

                         debugProcess

                         browseAction

                      )

    ].

    ^ m

    "Modified: / 17-06-1998 / 14:17:05 / cg"

    "Modified: / 23-02-2017 / 15:18:50 / stefan"

! !

!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 millis|

                time := aTimeout at:'time'.

                action := aTimeout at:'action'.

                process := aTimeout at:'process'.

                sema := aTimeout at:'sema'.

                process isNil ifTrue:[

                    sema notNil ifTrue:[

                        process := sema waitingProcesses firstIfEmpty:nil

                    ]

                ].

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

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

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

                millis := (time - osTimeStampOfList).

                millis > 1000 ifTrue:[

                    millis > 2000 ifTrue:[

                        millis > 5000 ifTrue:[

                            millis := millis roundTo:500.

                        ] ifFalse:[

                            millis := millis roundTo:100.

                        ]

                    ] ifFalse:[

                        millis := millis roundTo:10

                    ].

                ].

                deltaTime := TimeDuration milliseconds:millis.

                line := (deltaTime printString) paddedTo:11.

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

                action notNil ifTrue:[

                    line := line , ' ' , (actionName contractTo:50) .

                ] ifFalse:[

                    line := line , ' ' , (semaName contractTo:50).

                ].

    "/            isOpen ifFalse:[

    "/                color := Color red.

    "/            ] ifTrue:[

    "/                color := Color blue.

    "/            ].

    "/            line := line withColor:color.

                list add:line.

                oldSelection notNil ifTrue:[

                    (oldSelection contains:[:tmo | 

                                    (tmo at:'process') == process

                                      and:[ (tmo at:'action') == action

                                      and:[ (tmo at:'sema') == sema ]]]

                    ) 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.

        timeouts := newTimeoutList.

    ].

    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$'

! !