--- a/ProcMonitor.st Fri Nov 24 19:27:30 1995 +0100
+++ b/ProcMonitor.st Fri Nov 24 21:51:16 1995 +0100
@@ -10,12 +10,12 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.7 on 29-sep-1995 at 02:24:01' !
+'From Smalltalk/X, Version:2.10.8 on 24-nov-1995 at 21:40:29' !
SimpleView subclass:#ProcessMonitor
instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock
- listUpdateBlock updateProcess hideDead runColor suspendedColor
- waitColor cpuUsages showDetail'
+ listUpdateBlock updateProcess hideDead runColor suspendedColor
+ waitColor cpuUsages showDetail'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
@@ -37,10 +37,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/ProcMonitor.st,v 1.25 1995-11-13 17:35:06 cg Exp $'
-!
-
documentation
"
This view shows smalltalks (light-weight) processes, and also offers
@@ -72,16 +68,16 @@
!ProcessMonitor class methodsFor:'defaults'!
-defaultLabel
- ^ 'Process Monitor'
-!
-
defaultIcon
|i|
i := Image fromFile:'ProcMon.xbm'.
i notNil ifTrue:[^ i].
^ StandardSystemView defaultIcon
+!
+
+defaultLabel
+ ^ 'Process Monitor'
! !
!ProcessMonitor class methodsFor:'startup'!
@@ -128,32 +124,33 @@
|newList|
shown ifTrue:[
- showDetail ifTrue:[
- newList := Process allInstances.
- ] ifFalse:[
- newList := ProcessorScheduler knownProcesses asOrderedCollection.
- ].
+ showDetail ifTrue:[
+ newList := Process allInstances asOrderedCollection.
+ ] ifFalse:[
+ newList := ProcessorScheduler knownProcesses asOrderedCollection.
+ ].
+ newList := newList select:[:p | p id notNil].
- "sort by id - take care of nil ids of dead processes"
- newList sort:[:p1 :p2 |
- |id1 id2|
+ "sort by id - take care of nil ids of dead processes"
+ newList sort:[:p1 :p2 |
+ |id1 id2|
- (p1 isNil or:[(id1 := p1 id) isNil])
- ifTrue:[true]
- ifFalse:[
- (p2 isNil or:[(id2 := p2 id) isNil])
- ifTrue:[false]
- ifFalse:[id1 < id2]
- ]
- ].
- newList ~= processes ifTrue:[
- processes := WeakArray withAll:newList.
- self updateStatus
- ].
+ (p1 isNil or:[(id1 := p1 id) isNil])
+ ifTrue:[true]
+ ifFalse:[
+ (p2 isNil or:[(id2 := p2 id) isNil])
+ ifTrue:[false]
+ ifFalse:[id1 < id2]
+ ]
+ ].
+ newList ~= processes ifTrue:[
+ processes := WeakArray withAll:newList.
+ self updateStatus
+ ].
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:listUpdateBlock.
- Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
+ Processor removeTimedBlock:listUpdateBlock.
+ Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
].
!
@@ -163,147 +160,152 @@
|oldList list line dIndex con interrupted plist aProcess nm st c c0 n found sender|
shown ifTrue:[
- oldList := listView list.
- processes notNil ifTrue:[
- list := OrderedCollection new.
- list add:self titleLine.
- list add:(String new:self titleLine size withAll:$-).
+ oldList := listView list.
+ processes notNil ifTrue:[
+ list := OrderedCollection new.
+ list add:self titleLine.
+ list add:(String new:self titleLine size withAll:$-).
- interrupted := Processor interruptedProcess.
+ interrupted := Processor interruptedProcess.
- dIndex := 1.
- 1 to:processes size do:[:index |
+ dIndex := 1.
+ 1 to:processes size do:[:index |
+ |totalStack|
- aProcess := processes at:index.
- aProcess notNil ifTrue:[
- (aProcess id notNil or:[hideDead not]) ifTrue:[
- line := aProcess id printStringPaddedTo:5.
- (nm := aProcess name) isNil ifFalse:[
- nm := nm printString
- ] ifTrue:[
- nm := ' '
- ].
- nm size >= 29 ifTrue:[
- nm := (nm contractTo:28) , ' '
- ] ifFalse:[
- nm := (nm printStringPaddedTo:29).
- ].
- line := line , nm.
+ aProcess := processes at:index.
+ aProcess notNil ifTrue:[
+ (aProcess id notNil or:[hideDead not]) ifTrue:[
+ line := aProcess id printStringPaddedTo:5.
+ (nm := aProcess name) isNil ifFalse:[
+ nm := nm printString
+ ] ifTrue:[
+ nm := ' '
+ ].
+ nm size >= 29 ifTrue:[
+ nm := (nm contractTo:28) , ' '
+ ] ifFalse:[
+ nm := (nm printStringPaddedTo:29).
+ ].
+ line := line , nm.
"/ n := cpuUsages at:(aProcess id) ifAbsent:[0].
"/ n ~~ 0 ifTrue:[
"/ line := line , ((n * 4) printStringLeftPaddedTo:3)
"/ ] ifFalse:[
"/ line := line , ' '
"/ ].
- st := aProcess state.
- (st == #run
- and:[aProcess == interrupted]) ifTrue:[
- c := ' *'.
- ] ifFalse:[
- c := ' '.
- ].
- line := line , c , (st printStringPaddedTo:9).
- line := line , (aProcess priority printStringLeftPaddedTo:3).
- line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
+ st := aProcess state.
+ (st == #run
+ and:[aProcess == interrupted]) ifTrue:[
+ c := ' *'.
+ ] ifFalse:[
+ c := ' '.
+ ].
+ line := line , c , (st printStringPaddedTo:9).
+ line := line , (aProcess priority printStringLeftPaddedTo:3).
+ line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
- n := aProcess numberOfStackSegments.
- n == 0 ifTrue:[
- con := nil
- ] ifFalse:[
- con := aProcess suspendedContext.
- con isNil ifTrue:[
- aProcess == Processor activeProcess ifTrue:[
- con := thisContext
- ]
- ]
- ].
- showDetail ifTrue:[
- line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
- line := line , '(' , n printString , ')'.
- con notNil ifTrue:[
- line := line , ' '.
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- line := line , ' .. '.
- c := con.
- [(sender := c sender) notNil] whileTrue:[
- c := sender
- ].
- line := line , ((ObjectMemory addressOf:c) printStringRadix:16).
- ] ifFalse:[
- line := line , (String new:20)
- ].
- line := line , ' '.
- line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
- ].
+ n := aProcess numberOfStackSegments.
+"/ n == 0 ifTrue:[
+"/ con := nil
+"/ ] ifFalse:[
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ].
+"/ ].
+ showDetail ifTrue:[
+ aProcess id == 0 ifTrue:[
+ line := line , ('unlimited' leftPaddedTo:13).
+ ] ifFalse:[
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ line := line , '(' , n printString , ')'.
+ ].
+ con notNil ifTrue:[
+ line := line , ' '.
+ line := line , (((ObjectMemory addressOf:con) printStringRadix:16) leftPaddedTo:8 with:$0).
+ line := line , ' .. '.
+ c := con.
+ [(sender := c sender) notNil] whileTrue:[
+ c := sender
+ ].
+ line := line , (((ObjectMemory addressOf:c) printStringRadix:16) leftPaddedTo:8 with:$0).
+ ] ifFalse:[
+ line := line , (String new:20)
+ ].
+ line := line , ' '.
+ line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
+ ].
- con notNil ifTrue:[
- "/ search for a semaphore-wait in the top 10 contexts
- found := false.
- c := con.
- 1 to:10 do:[:n |
- found ifFalse:[
- c notNil ifTrue:[
- (c receiver isMemberOf:Semaphore) ifTrue:[
- c selector == #wait ifTrue:[
- found := true.
- ]
- ].
- c := c sender.
- ]
- ]
- ].
- found ifFalse:[
- c := con.
- 1 to:10 do:[:n |
- found ifFalse:[
- c notNil ifTrue:[
- (c receiver ~~ Processor) ifTrue:[
- found := true.
- ] ifFalse:[
- c := c sender.
- ]
- ]
- ]
- ]
- ].
- found ifFalse:[
- c := con
- ].
- [c notNil and:[c isBlockContext]] whileTrue:[
- c := c home
- ].
- c notNil ifTrue:[
- n := c receiver class name , '>>' , c selector.
- line := line , ' ' , n
- ]
- ].
- list add:line.
- processes at:dIndex put:aProcess.
- dIndex := dIndex + 1
- ]
- ].
- ].
- dIndex to:processes size do:[:index |
- processes at:index put:nil
- ]
- ].
- "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.
- ]
+ con notNil ifTrue:[
+ "/ search for a semaphore-wait in the top 10 contexts
+ found := false.
+ c := con.
+ 1 to:10 do:[:n |
+ found ifFalse:[
+ c notNil ifTrue:[
+ (c receiver isMemberOf:Semaphore) ifTrue:[
+ c selector == #wait ifTrue:[
+ found := true.
+ ]
+ ].
+ c := c sender.
+ ]
+ ]
+ ].
+ found ifFalse:[
+ c := con.
+ 1 to:10 do:[:n |
+ found ifFalse:[
+ c notNil ifTrue:[
+ (c receiver ~~ Processor) ifTrue:[
+ found := true.
+ ] ifFalse:[
+ c := c sender.
+ ]
+ ]
+ ]
+ ]
+ ].
+ found ifFalse:[
+ c := con
+ ].
+ [c notNil and:[c isBlockContext]] whileTrue:[
+ c := c home
+ ].
+ c notNil ifTrue:[
+ n := c receiver class name , '>>' , c selector.
+ line := line , ' ' , n
+ ]
+ ].
+ list add:line.
+ processes at:dIndex put:aProcess.
+ dIndex := dIndex + 1
+ ]
+ ].
+ ].
+ dIndex to:processes size do:[:index |
+ processes at:index put:nil
+ ]
+ ].
+ "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.
+ ]
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
]
!
@@ -314,6 +316,10 @@
!ProcessMonitor methodsFor:'events'!
+canHandle:key
+ ^ key == #InspectIt
+!
+
keyPress:key x:x y:y
<resource: #keyboard ( #InspectIt ) >
@@ -321,10 +327,6 @@
^ self inspectProcess.
].
^ super keyPress:key x:x y:y
-!
-
-canHandle:key
- ^ key == #InspectIt
! !
!ProcessMonitor methodsFor:'initialization'!
@@ -378,6 +380,15 @@
self updateList.
!
+realize
+ super realize.
+ waitColor := waitColor on:device.
+ runColor := runColor on:device.
+ suspendedColor := suspendedColor on:device.
+
+ self startUpdateProcess.
+!
+
startUpdateProcess
updateBlock notNil ifTrue:[
Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
@@ -420,19 +431,49 @@
"
Processor activeProcess priority:(Processor userSchedulingPriority + 2)
].
-!
-
-realize
- super realize.
- waitColor := waitColor on:device.
- runColor := runColor on:device.
- suspendedColor := suspendedColor on:device.
-
- self startUpdateProcess.
! !
!ProcessMonitor methodsFor:'menu actions'!
+abortProcess
+ "abort (raise AbortSignal in) the selected process"
+
+ self selectedProcessesDo:[:p |
+ p interruptWith:[AbortSignal raise]
+ ]
+!
+
+debugProcess
+ "open a debugger on the selected process"
+
+ self selectedProcessesDo:[:p |
+ Debugger openOn:p
+ ]
+!
+
+detail
+ showDetail := showDetail not.
+ self updateView
+!
+
+hideDead:aBoolean
+ hideDead := aBoolean
+!
+
+inspectProcess
+ "open an inspector on the selected process"
+
+ self selectedProcessesSend:#inspect
+!
+
+lowerPrio
+ "lower the selected processes priority"
+
+ self selectedProcessesDo:[:p |
+ p priority:(p priority - 1)
+ ]
+!
+
processMenu
|labels selectors m|
@@ -483,43 +524,14 @@
^ m
!
-terminateProcess
- "terminate the selected process"
-
- self selectedProcessesSend:#terminate
-!
-
-hideDead:aBoolean
- hideDead := aBoolean
-!
-
-debugProcess
- "open a debugger on the selected process"
+raisePrio
+ "raise the selected processes priority"
self selectedProcessesDo:[:p |
- Debugger openOn:p
- ]
-!
-
-abortProcess
- "abort (raise AbortSignal in) the selected process"
-
- self selectedProcessesDo:[:p |
- p interruptWith:[AbortSignal raise]
+ p priority:(p priority + 1)
]
!
-inspectProcess
- "open an inspector on the selected process"
-
- self selectedProcessesSend:#inspect
-!
-
-detail
- showDetail := showDetail not.
- self updateView
-!
-
resumeProcess
"resume the selected process (i.e. let it run) "
@@ -538,20 +550,10 @@
self selectedProcessesSend:#suspend
!
-raisePrio
- "raise the selected processes priority"
+terminateProcess
+ "terminate the selected process"
- self selectedProcessesDo:[:p |
- p priority:(p priority + 1)
- ]
-!
-
-lowerPrio
- "lower the selected processes priority"
-
- self selectedProcessesDo:[:p |
- p priority:(p priority - 1)
- ]
+ self selectedProcessesSend:#terminate
! !
!ProcessMonitor methodsFor:'private'!
@@ -598,3 +600,8 @@
preferredExtent
^ (font widthOf:self titleLine) + 40 @ 100
! !
+
+!ProcessMonitor class methodsFor:'documentation'!
+
+version
+^ '$Header: /cvs/stx/stx/libtool/Attic/ProcMonitor.st,v 1.26 1995-11-24 20:51:16 cg Exp $'! !
--- a/ProcessMonitor.st Fri Nov 24 19:27:30 1995 +0100
+++ b/ProcessMonitor.st Fri Nov 24 21:51:16 1995 +0100
@@ -10,12 +10,12 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.7 on 29-sep-1995 at 02:24:01' !
+'From Smalltalk/X, Version:2.10.8 on 24-nov-1995 at 21:40:29' !
SimpleView subclass:#ProcessMonitor
instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock
- listUpdateBlock updateProcess hideDead runColor suspendedColor
- waitColor cpuUsages showDetail'
+ listUpdateBlock updateProcess hideDead runColor suspendedColor
+ waitColor cpuUsages showDetail'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
@@ -37,10 +37,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.25 1995-11-13 17:35:06 cg Exp $'
-!
-
documentation
"
This view shows smalltalks (light-weight) processes, and also offers
@@ -72,16 +68,16 @@
!ProcessMonitor class methodsFor:'defaults'!
-defaultLabel
- ^ 'Process Monitor'
-!
-
defaultIcon
|i|
i := Image fromFile:'ProcMon.xbm'.
i notNil ifTrue:[^ i].
^ StandardSystemView defaultIcon
+!
+
+defaultLabel
+ ^ 'Process Monitor'
! !
!ProcessMonitor class methodsFor:'startup'!
@@ -128,32 +124,33 @@
|newList|
shown ifTrue:[
- showDetail ifTrue:[
- newList := Process allInstances.
- ] ifFalse:[
- newList := ProcessorScheduler knownProcesses asOrderedCollection.
- ].
+ showDetail ifTrue:[
+ newList := Process allInstances asOrderedCollection.
+ ] ifFalse:[
+ newList := ProcessorScheduler knownProcesses asOrderedCollection.
+ ].
+ newList := newList select:[:p | p id notNil].
- "sort by id - take care of nil ids of dead processes"
- newList sort:[:p1 :p2 |
- |id1 id2|
+ "sort by id - take care of nil ids of dead processes"
+ newList sort:[:p1 :p2 |
+ |id1 id2|
- (p1 isNil or:[(id1 := p1 id) isNil])
- ifTrue:[true]
- ifFalse:[
- (p2 isNil or:[(id2 := p2 id) isNil])
- ifTrue:[false]
- ifFalse:[id1 < id2]
- ]
- ].
- newList ~= processes ifTrue:[
- processes := WeakArray withAll:newList.
- self updateStatus
- ].
+ (p1 isNil or:[(id1 := p1 id) isNil])
+ ifTrue:[true]
+ ifFalse:[
+ (p2 isNil or:[(id2 := p2 id) isNil])
+ ifTrue:[false]
+ ifFalse:[id1 < id2]
+ ]
+ ].
+ newList ~= processes ifTrue:[
+ processes := WeakArray withAll:newList.
+ self updateStatus
+ ].
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:listUpdateBlock.
- Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
+ Processor removeTimedBlock:listUpdateBlock.
+ Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
].
!
@@ -163,147 +160,152 @@
|oldList list line dIndex con interrupted plist aProcess nm st c c0 n found sender|
shown ifTrue:[
- oldList := listView list.
- processes notNil ifTrue:[
- list := OrderedCollection new.
- list add:self titleLine.
- list add:(String new:self titleLine size withAll:$-).
+ oldList := listView list.
+ processes notNil ifTrue:[
+ list := OrderedCollection new.
+ list add:self titleLine.
+ list add:(String new:self titleLine size withAll:$-).
- interrupted := Processor interruptedProcess.
+ interrupted := Processor interruptedProcess.
- dIndex := 1.
- 1 to:processes size do:[:index |
+ dIndex := 1.
+ 1 to:processes size do:[:index |
+ |totalStack|
- aProcess := processes at:index.
- aProcess notNil ifTrue:[
- (aProcess id notNil or:[hideDead not]) ifTrue:[
- line := aProcess id printStringPaddedTo:5.
- (nm := aProcess name) isNil ifFalse:[
- nm := nm printString
- ] ifTrue:[
- nm := ' '
- ].
- nm size >= 29 ifTrue:[
- nm := (nm contractTo:28) , ' '
- ] ifFalse:[
- nm := (nm printStringPaddedTo:29).
- ].
- line := line , nm.
+ aProcess := processes at:index.
+ aProcess notNil ifTrue:[
+ (aProcess id notNil or:[hideDead not]) ifTrue:[
+ line := aProcess id printStringPaddedTo:5.
+ (nm := aProcess name) isNil ifFalse:[
+ nm := nm printString
+ ] ifTrue:[
+ nm := ' '
+ ].
+ nm size >= 29 ifTrue:[
+ nm := (nm contractTo:28) , ' '
+ ] ifFalse:[
+ nm := (nm printStringPaddedTo:29).
+ ].
+ line := line , nm.
"/ n := cpuUsages at:(aProcess id) ifAbsent:[0].
"/ n ~~ 0 ifTrue:[
"/ line := line , ((n * 4) printStringLeftPaddedTo:3)
"/ ] ifFalse:[
"/ line := line , ' '
"/ ].
- st := aProcess state.
- (st == #run
- and:[aProcess == interrupted]) ifTrue:[
- c := ' *'.
- ] ifFalse:[
- c := ' '.
- ].
- line := line , c , (st printStringPaddedTo:9).
- line := line , (aProcess priority printStringLeftPaddedTo:3).
- line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
+ st := aProcess state.
+ (st == #run
+ and:[aProcess == interrupted]) ifTrue:[
+ c := ' *'.
+ ] ifFalse:[
+ c := ' '.
+ ].
+ line := line , c , (st printStringPaddedTo:9).
+ line := line , (aProcess priority printStringLeftPaddedTo:3).
+ line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
- n := aProcess numberOfStackSegments.
- n == 0 ifTrue:[
- con := nil
- ] ifFalse:[
- con := aProcess suspendedContext.
- con isNil ifTrue:[
- aProcess == Processor activeProcess ifTrue:[
- con := thisContext
- ]
- ]
- ].
- showDetail ifTrue:[
- line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
- line := line , '(' , n printString , ')'.
- con notNil ifTrue:[
- line := line , ' '.
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- line := line , ' .. '.
- c := con.
- [(sender := c sender) notNil] whileTrue:[
- c := sender
- ].
- line := line , ((ObjectMemory addressOf:c) printStringRadix:16).
- ] ifFalse:[
- line := line , (String new:20)
- ].
- line := line , ' '.
- line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
- ].
+ n := aProcess numberOfStackSegments.
+"/ n == 0 ifTrue:[
+"/ con := nil
+"/ ] ifFalse:[
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ].
+"/ ].
+ showDetail ifTrue:[
+ aProcess id == 0 ifTrue:[
+ line := line , ('unlimited' leftPaddedTo:13).
+ ] ifFalse:[
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ line := line , '(' , n printString , ')'.
+ ].
+ con notNil ifTrue:[
+ line := line , ' '.
+ line := line , (((ObjectMemory addressOf:con) printStringRadix:16) leftPaddedTo:8 with:$0).
+ line := line , ' .. '.
+ c := con.
+ [(sender := c sender) notNil] whileTrue:[
+ c := sender
+ ].
+ line := line , (((ObjectMemory addressOf:c) printStringRadix:16) leftPaddedTo:8 with:$0).
+ ] ifFalse:[
+ line := line , (String new:20)
+ ].
+ line := line , ' '.
+ line := line , (aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:5).
+ ].
- con notNil ifTrue:[
- "/ search for a semaphore-wait in the top 10 contexts
- found := false.
- c := con.
- 1 to:10 do:[:n |
- found ifFalse:[
- c notNil ifTrue:[
- (c receiver isMemberOf:Semaphore) ifTrue:[
- c selector == #wait ifTrue:[
- found := true.
- ]
- ].
- c := c sender.
- ]
- ]
- ].
- found ifFalse:[
- c := con.
- 1 to:10 do:[:n |
- found ifFalse:[
- c notNil ifTrue:[
- (c receiver ~~ Processor) ifTrue:[
- found := true.
- ] ifFalse:[
- c := c sender.
- ]
- ]
- ]
- ]
- ].
- found ifFalse:[
- c := con
- ].
- [c notNil and:[c isBlockContext]] whileTrue:[
- c := c home
- ].
- c notNil ifTrue:[
- n := c receiver class name , '>>' , c selector.
- line := line , ' ' , n
- ]
- ].
- list add:line.
- processes at:dIndex put:aProcess.
- dIndex := dIndex + 1
- ]
- ].
- ].
- dIndex to:processes size do:[:index |
- processes at:index put:nil
- ]
- ].
- "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.
- ]
+ con notNil ifTrue:[
+ "/ search for a semaphore-wait in the top 10 contexts
+ found := false.
+ c := con.
+ 1 to:10 do:[:n |
+ found ifFalse:[
+ c notNil ifTrue:[
+ (c receiver isMemberOf:Semaphore) ifTrue:[
+ c selector == #wait ifTrue:[
+ found := true.
+ ]
+ ].
+ c := c sender.
+ ]
+ ]
+ ].
+ found ifFalse:[
+ c := con.
+ 1 to:10 do:[:n |
+ found ifFalse:[
+ c notNil ifTrue:[
+ (c receiver ~~ Processor) ifTrue:[
+ found := true.
+ ] ifFalse:[
+ c := c sender.
+ ]
+ ]
+ ]
+ ]
+ ].
+ found ifFalse:[
+ c := con
+ ].
+ [c notNil and:[c isBlockContext]] whileTrue:[
+ c := c home
+ ].
+ c notNil ifTrue:[
+ n := c receiver class name , '>>' , c selector.
+ line := line , ' ' , n
+ ]
+ ].
+ list add:line.
+ processes at:dIndex put:aProcess.
+ dIndex := dIndex + 1
+ ]
+ ].
+ ].
+ dIndex to:processes size do:[:index |
+ processes at:index put:nil
+ ]
+ ].
+ "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.
+ ]
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
]
!
@@ -314,6 +316,10 @@
!ProcessMonitor methodsFor:'events'!
+canHandle:key
+ ^ key == #InspectIt
+!
+
keyPress:key x:x y:y
<resource: #keyboard ( #InspectIt ) >
@@ -321,10 +327,6 @@
^ self inspectProcess.
].
^ super keyPress:key x:x y:y
-!
-
-canHandle:key
- ^ key == #InspectIt
! !
!ProcessMonitor methodsFor:'initialization'!
@@ -378,6 +380,15 @@
self updateList.
!
+realize
+ super realize.
+ waitColor := waitColor on:device.
+ runColor := runColor on:device.
+ suspendedColor := suspendedColor on:device.
+
+ self startUpdateProcess.
+!
+
startUpdateProcess
updateBlock notNil ifTrue:[
Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
@@ -420,19 +431,49 @@
"
Processor activeProcess priority:(Processor userSchedulingPriority + 2)
].
-!
-
-realize
- super realize.
- waitColor := waitColor on:device.
- runColor := runColor on:device.
- suspendedColor := suspendedColor on:device.
-
- self startUpdateProcess.
! !
!ProcessMonitor methodsFor:'menu actions'!
+abortProcess
+ "abort (raise AbortSignal in) the selected process"
+
+ self selectedProcessesDo:[:p |
+ p interruptWith:[AbortSignal raise]
+ ]
+!
+
+debugProcess
+ "open a debugger on the selected process"
+
+ self selectedProcessesDo:[:p |
+ Debugger openOn:p
+ ]
+!
+
+detail
+ showDetail := showDetail not.
+ self updateView
+!
+
+hideDead:aBoolean
+ hideDead := aBoolean
+!
+
+inspectProcess
+ "open an inspector on the selected process"
+
+ self selectedProcessesSend:#inspect
+!
+
+lowerPrio
+ "lower the selected processes priority"
+
+ self selectedProcessesDo:[:p |
+ p priority:(p priority - 1)
+ ]
+!
+
processMenu
|labels selectors m|
@@ -483,43 +524,14 @@
^ m
!
-terminateProcess
- "terminate the selected process"
-
- self selectedProcessesSend:#terminate
-!
-
-hideDead:aBoolean
- hideDead := aBoolean
-!
-
-debugProcess
- "open a debugger on the selected process"
+raisePrio
+ "raise the selected processes priority"
self selectedProcessesDo:[:p |
- Debugger openOn:p
- ]
-!
-
-abortProcess
- "abort (raise AbortSignal in) the selected process"
-
- self selectedProcessesDo:[:p |
- p interruptWith:[AbortSignal raise]
+ p priority:(p priority + 1)
]
!
-inspectProcess
- "open an inspector on the selected process"
-
- self selectedProcessesSend:#inspect
-!
-
-detail
- showDetail := showDetail not.
- self updateView
-!
-
resumeProcess
"resume the selected process (i.e. let it run) "
@@ -538,20 +550,10 @@
self selectedProcessesSend:#suspend
!
-raisePrio
- "raise the selected processes priority"
+terminateProcess
+ "terminate the selected process"
- self selectedProcessesDo:[:p |
- p priority:(p priority + 1)
- ]
-!
-
-lowerPrio
- "lower the selected processes priority"
-
- self selectedProcessesDo:[:p |
- p priority:(p priority - 1)
- ]
+ self selectedProcessesSend:#terminate
! !
!ProcessMonitor methodsFor:'private'!
@@ -598,3 +600,8 @@
preferredExtent
^ (font widthOf:self titleLine) + 40 @ 100
! !
+
+!ProcessMonitor class methodsFor:'documentation'!
+
+version
+^ '$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.26 1995-11-24 20:51:16 cg Exp $'! !