StandardSystemView subclass:#ProcessMonitor

	 instanceVariableNames:'listView processes listUpdateDelay updateDelay 

				updateBlock listUpdateBlock updateProcess hideDead

				runColor suspendedColor waitColor'

	 classVariableNames:''

	 poolDictionaries:''

	 category:'Interface-Tools'

!

!ProcessMonitor class methodsFor:'startup'!

open

    |m|

    m := self new.

    m label:'Process Monitor'.

    m icon:(Form fromFile:'PMonitor.icon' resolution:100).

    m minExtent:(100 @ 100).

    m open.

    ^ m

    "

     ProcessMonitor open

    "

! !

!ProcessMonitor methodsFor:'initialization'!

initialize

    |v menu|

    super initialize.

    hideDead := true.

    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.

    menu := (PopUpMenu 

		labels:#(

"/ hideDead functionality no longer needed; 

"/ since ProcSched knownProcesses only returns living ones

"/

"/                         '\c hide dead'

"/                         '-'

			 'inspect' 

			 'debug'  

			 '-'  

			 'resume'  

			 'suspend'  

			 'terminate'

			 '-'  

			 'raise prio'  

			 'lower prio'  

			)

	     selectors:#(

"/                         hideDead:

"/                         nil

			 inspectProcess  

			 debugProcess  

			 nil  

			 resumeProcess  

			 suspendProcess  

			 terminateProcess

			 nil  

			 raisePrio

			 lowerPrio

			)

		receiver:self

		     for:listView).

"/    menu checkToggleAt:#hideDead: put:hideDead.

    listView middleButtonMenu:menu. 

    listView multipleSelectOk:true.

    listView keyboardHandler:self.

    updateDelay := 0.5.

    listUpdateDelay := 5.

    "/ true 

    ProcessorScheduler isPureEventDriven

    ifTrue:[

	updateBlock := [self updateStatus].

	listUpdateBlock := [self updateList].

    ].

    device hasColors ifTrue:[

	runColor := Color green.

	suspendedColor := Color yellow.

	waitColor := Color red.

    ] ifFalse:[

	runColor := suspendedColor := waitColor := Color black

    ]

    "

     ProcessMonitor open

    "

!

realize

    super realize.

    updateBlock notNil ifTrue:[

	Processor addTimedBlock:updateBlock afterSeconds:updateDelay.

	Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.

    ] ifFalse:[

	updateProcess := [

	    "

	     every half second, the status is updated.

	     every 5 seconds, the list of processes is

	     built up again

	    "

	    [true] whileTrue:[

		1 to:9 do:[:i |

		    (Delay forSeconds:0.5) wait.

		    self updateStatus.

		].

		(Delay forSeconds:0.5) wait.

		self updateList.

	    ]

	]  forkAt:(Processor userSchedulingPriority + 1).

	updateProcess name:'process update'.

	"

	 raise my own priority

	"

	Processor activeProcess priority:(Processor userSchedulingPriority + 2)

    ].

    waitColor := waitColor on:device.

    runColor := runColor on:device.

    suspendedColor := suspendedColor on:device.

!

mapped

    super mapped.

    self updateStatus.

    self updateList.

! !

!ProcessMonitor methodsFor:'destroying'!

destroy

    updateBlock notNil ifTrue:[

	Processor removeTimedBlock:updateBlock.

	Processor removeTimedBlock:listUpdateBlock.

    ] ifFalse:[

	updateProcess terminate

    ].

    super destroy

! !

!ProcessMonitor methodsFor:'private'!

selectedProcessesDo:aBlock

    |p nr sel|

    sel := listView selection.

    sel isNil ifTrue:[^ self].

    (sel isKindOf:Collection) ifTrue:[

	sel do:[:n |

	    nr := n - 2.   "for headlines"

	    nr notNil ifTrue:[

		nr > 0 ifTrue:[

		    p := processes at:nr.

		    p notNil ifTrue:[

		       aBlock value:p

		    ]

		]

	    ]

	]

    ] ifFalse:[

	nr := sel - 2.     "for headlines"

	nr notNil ifTrue:[

	    nr > 0 ifTrue:[

		p := processes at:nr.

		p notNil ifTrue:[

		   aBlock value:p

		]

	    ]

	]

    ].

! !

!ProcessMonitor methodsFor:'menu actions'!

hideDead:aBoolean

    hideDead := aBoolean

!

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

    ]

! 

raisePrio

    self selectedProcessesDo:[:p |

       p priority:(p priority + 1)

    ]

! 

lowerPrio

    self selectedProcessesDo:[:p |

       p priority:(p priority - 1)

    ]

! !

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

    shown ifTrue:[

	(Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[

	    newList := Process allInstances.

	] ifFalse:[

	    newList := ProcessorScheduler knownProcesses asOrderedCollection.

	].

	"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

	].

    ].

    updateBlock notNil ifTrue:[

	Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay

    ].

!

updateStatus

    "update status display of processes"

    shown ifTrue:[

	oldList := listView list.

	processes notNil ifTrue:[

	    list := OrderedCollection new.

	    dIndex := 1.

	    1 to:processes size do:[:index |

		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 := ' '

			].

			] ifFalse:[

			].

			line := line , nm.

			line := line , (aProcess priority printStringLeftPaddedTo:3).

			line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).

			line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).

			(Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[

			    con := aProcess suspendedContext.

			    con isNil ifTrue:[

				aProcess == Processor activeProcess ifTrue:[

				    con := thisContext

				]

			    ].

			    con notNil ifTrue:[

				line := line , '    '.

				line := line , ((ObjectMemory addressOf:con) printStringRadix:16).

				line := line , ' .. '.

				[con sender notNil] whileTrue:[

				    con := con sender

				].

				line := line , ((ObjectMemory addressOf:con) printStringRadix:16).

			    ]

			].

			list add:line.

			processes at:dIndex put:aProcess.

			dIndex := dIndex + 1

		    ]

		].

	    ].

	    dIndex to:processes size do:[:index |

		processes at:index put:nil

	    ]

	].

	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 afterSeconds:updateDelay

    ]

! !