#FEATURE by cg
class: NewSystemBrowser
added:
#hasRecentlyDebuggedHistoryHolder
#recentlyDebuggedHistoryMenu
class: NewSystemBrowser class
comment/format in: #browseMenu
changed: #searchMenu
"{ 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"
shown ifTrue:[
self updateStatus:Processor timeoutList.
].
self installDelayedUpdate.
"Modified: / 29-10-2018 / 15:39:43 / Claus Gittinger"
"Modified: / 05-02-2020 / 15:32:35 / Stefan Vogel"
!
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$'
! !