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"

    |oldList list line dIndex con interrupted|

    shown ifTrue:[
	oldList := listView list.
	processes notNil ifTrue:[
	    list := OrderedCollection new.
	    list add:'id   name                     state    prio   usedStack  totalStack'.
	    list add:'-------------------------------------------------------------------'.

	    interrupted := Processor interruptedProcess.

	    dIndex := 1.
	    1 to:processes size do:[:index |
		|aProcess nm st|

		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 >= 24 ifTrue:[
			    nm := (nm copyTo:23) , ' '
			] ifFalse:[
			    nm := (nm printStringPaddedTo:24).
			].
			line := line , nm.
			st := aProcess state.
			(st == #run
			 and:[aProcess == interrupted]) ifTrue:[
			    line := line , '*' , (st printStringPaddedTo:9).
			] ifFalse:[
			    line := line , ' ' , (st printStringPaddedTo:9).
			].
			line := line , (aProcess priority printStringLeftPaddedTo:3).
			line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
			line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
			line := line , '(' , aProcess numberOfStackSegments printString , ')'.
			(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.
		"the first two entries cannot be selected"
		listView attributeAt:1 put:#disabled.
		listView attributeAt:2 put:#disabled.
	    ]
	].
    ].
    updateBlock notNil ifTrue:[
	Processor addTimedBlock:updateBlock afterSeconds:updateDelay
    ]
! !