"
 COPYRIGHT (c) 1993 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.
"

StandardSystemView subclass:#ProcessMonitor
	 instanceVariableNames:'listView processes listUpdateDelay updateDelay 
				updateBlock listUpdateBlock updateProcess hideDead
				runColor suspendedColor waitColor cpuUsages'
	 classVariableNames:''
	 poolDictionaries:''
	 category:'Interface-Tools'
!

!ProcessMonitor class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 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.
"
!

version
"
$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.7 1995-02-08 03:21:02 claus Exp $
"
!

documentation
"
    This view shows smalltalks (light-weight) processes, and also offers
    a popup menu for various useful operations on them.
    Especially 'debug' is useful, to see what a process is currently
    doing.
    The information shown is:
	id         - the numeric id of the process
	name       - the name (if any) of the process
		     (the name has no semantic meaning; its for the processMonitor)
	state      - what is it doing;
			wait      - waiting on a semaphore
			eventWait - waiting on a view-event semaphore
			ioWait    - waiting on an io-semaphore
			timeWait  - waiting for a time-semaphore
			run       - run, but currently not scheduled
			active    - really running 
			suspended - suspended; not waiting on a semaphore
			light     - not yet started (i.e. has no stack yet)
        
	prio       - the processes priority (1..30)
	usedStack  - the current stack use
	totalStack - the stack currently allocated
"
! !

!ProcessMonitor class methodsFor:'defaults'!

defaultLabel
    ^ 'Process Monitor'
!

defaultIcon
    |i|

    i := Image fromFile:'bitmaps/ProcMon.xbm'.
    i notNil ifTrue:[^ i].
    ^ super defaultIcon
! !

!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'  
			 'abort'
			 'terminate'
			 '-'  
			 'raise prio'  
			 'lower prio'  
			)
	     selectors:#(
"/                         hideDead:
"/                         nil
			 inspectProcess  
			 debugProcess  
			 nil  
			 resumeProcess  
			 suspendProcess  
			 abortProcess
			 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 := [
	    |id cnt|

	    "
	     every 20ms, we look which process runs;
	     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 |
"/                    cpuUsages := IdentityDictionary new.
"/                    1 to:25 do:[:i |
"/                        (Delay forSeconds:0.02) wait.
"/                        id := Processor interruptedProcess id.
"/                        cnt := cpuUsages at:id ifAbsent:[0].
"/                        cpuUsages at:id put:cnt + 1.
"/                    ].
		    (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
		]
	    ]
	]
    ].
"/    self updateStatus.
"/    self updateList.
!

selectedProcessesSend:aSelector
    self selectedProcessesDo:[:p |
	p perform:aSelector
    ]
! !

!ProcessMonitor methodsFor:'menu actions'!

hideDead:aBoolean
    hideDead := aBoolean
!

debugProcess
    self selectedProcessesDo:[:p |
       Debugger openOn:p
    ]
! 

inspectProcess
    self selectedProcessesSend:#inspect
! 

abortProcess
    self selectedProcessesDo:[:p |
	p interruptWith:[AbortSignal raise]
    ]
! 

terminateProcess
    self selectedProcessesSend:#terminate
! 

resumeProcess
    self selectedProcessesSend:#resume
! 

suspendProcess
    self selectedProcessesSend:#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                         cpu state    prio   usedStack  totalStack'.
	    list add:'id   name                           state    prio   usedStack  totalStack'.
	    list add:'--------------------------------------------------------------------------'.

	    interrupted := Processor interruptedProcess.

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

		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).
			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
	    ]
	].
	"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 addTimedBlock:updateBlock afterSeconds:updateDelay
    ]
! !