--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ProcessMonitor.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,264 @@
+StandardSystemView subclass:#ProcessMonitor
+ instanceVariableNames:'listView processes listUpdateDelay updateDelay runnableColor suspendedColor
+ updateBlock listUpdateBlock updateProcess'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Debugger'
+!
+
+ProcessMonitor comment:'
+'!
+
+!ProcessMonitor class methodsFor:'startup'!
+
+start
+ |m|
+
+ m := self new.
+ m label:'Process Monitor'.
+ m icon:(Form fromFile:'PMonitor.icon' resolution:100).
+ m minExtent:(100 @ 100).
+
+ m open.
+ ^ m
+
+ "ProcessMonitor start"
+! !
+
+!ProcessMonitor methodsFor:'initialization'!
+
+initialize
+ |v|
+
+ super initialize.
+
+ self extent:(font widthOf:'name/id state prio usedStack maxStack')
+ + 40 @
+ 100.
+
+ v := ScrollableView for:SelectionInListView in:self.
+ v origin:0.0@0.0 corner:1.0@1.0.
+ listView := v scrolledView.
+ listView font:font.
+ listView middleButtonMenu:(PopUpMenu
+ labels:#(
+ 'inspect'
+ 'debug'
+ '-'
+ 'resume'
+ 'suspend'
+ 'terminate'
+ )
+ selectors:#(inspectProcess
+ debugProcess
+ nil
+ resumeProcess
+ suspendProcess
+ terminateProcess
+ )
+ receiver:self
+ for:listView).
+ listView multipleSelectOk:true.
+ listView keyboardHandler:self.
+
+ updateDelay := 0.5.
+ listUpdateDelay := 5.
+ true "ProcessorScheduler isPureEventDriven" ifTrue:[
+ updateBlock := [self updateStatus].
+ listUpdateBlock := [self updateList].
+ ].
+ viewBackground := Black.
+ device hasColors ifTrue:[
+ runnableColor := Color green.
+ suspendedColor := Color red.
+ ] ifFalse:[
+ runnableColor := suspendedColor := Color white
+ ]
+
+ "ProcessMonitor start"
+!
+
+realize
+ super realize.
+ self enableKeyEvents.
+ self updateList.
+ self updateStatus.
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock after:updateDelay.
+ Processor addTimedBlock:listUpdateBlock after:listUpdateDelay.
+ ] ifFalse:[
+ updateProcess := [
+ [true] whileTrue:[
+ 1 to:9 do:[:i |
+ (Delay forSeconds:0.5) wait.
+ self updateStatus.
+ ].
+ (Delay forSeconds:0.5) wait.
+ self updateList
+ ]
+ ] forkAt:9.
+ updateProcess name:'process update'.
+ ].
+ runnableColor := runnableColor on:device.
+ suspendedColor := suspendedColor on:device.
+! !
+
+!ProcessMonitor methodsFor:'destroying'!
+
+destroy
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:updateBlock.
+ Processor removeTimedBlock:listUpdateBlock.
+ ] ifFalse:[
+ updateProcess terminate
+ ].
+ super destroy
+! !
+
+!ProcessMonitor methodsFor:'menu actions'!
+
+selectedProcessesDo:aBlock
+ |p nr|
+
+ (listView selection isKindOf:Collection) ifTrue:[
+ listView selection do:[:n |
+ nr := n - 2.
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ nr := listView selection - 2.
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ].
+!
+
+debugProcess
+ self selectedProcessesDo:[:p |
+ Debugger openOn:p
+ ]
+!
+
+inspectProcess
+ self selectedProcessesDo:[:p |
+ p inspect
+ ]
+!
+
+terminateProcess
+ self selectedProcessesDo:[:p |
+ p terminate
+ ]
+!
+
+resumeProcess
+ self selectedProcessesDo:[:p |
+ p resume
+ ]
+!
+
+suspendProcess
+ self selectedProcessesDo:[:p |
+ p suspend
+ ]
+! !
+
+!ProcessMonitor methodsFor:'events'!
+
+canHandle:key
+ ^ key == #InspectIt
+!
+
+keyPress:key x:x y:y
+ key == #InspectIt ifTrue:[
+ ^ self inspectProcess.
+ ].
+ ^ super keyPress:key x:x y:y
+! !
+
+!ProcessMonitor methodsFor:'drawing'!
+
+updateList
+ "update list of processes"
+
+ |newList|
+
+ newList := Process allInstances.
+ "sort by id - take core of nil ids of dead processes"
+ newList sort:[:p1 :p2 |
+ |id1 id2|
+
+ id1 := p1 id.
+ id2 := p2 id.
+ id1 isNil ifTrue:[true]
+ ifFalse:[
+ id2 isNil ifTrue:[false]
+ ifFalse:[id1 < id2]
+ ]
+ ].
+ newList ~= processes ifTrue:[
+ processes := WeakArray withAll:newList.
+ self updateStatus
+ ].
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:listUpdateBlock after:listUpdateDelay
+ ].
+!
+
+updateStatus
+ "update status display of processes"
+
+ |oldList list line|
+
+ oldList := listView list.
+ processes notNil ifTrue:[
+ list := OrderedCollection new.
+ list add:'name/id state prio usedStack maxStack'.
+ list add:'-------------------------------------------------------------------'.
+
+ processes do:[:aProcess |
+ |nm|
+
+ aProcess notNil ifTrue:[
+ nm := aProcess nameOrId.
+ nm size > 27 ifTrue:[
+ line := (nm copyTo:27) , ' '
+ ] ifFalse:[
+ line := aProcess nameOrId printStringPaddedTo:28.
+ ].
+ line := line , (aProcess state printStringPaddedTo:12).
+ line := line , (aProcess priority printStringLeftPaddedTo:4).
+ line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ list add:line
+ ].
+ ].
+ ].
+ list ~= oldList ifTrue:[
+ "avoid flicker"
+ oldList size == list size ifTrue:[
+ list keysAndValuesDo:[:idx :entry |
+ (oldList at:idx) ~= entry ifTrue:[
+ listView at:idx put:entry
+ ]
+ ]
+ ] ifFalse:[
+ listView setList:list.
+ ]
+ ].
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock after:updateDelay
+ ]
+! !