"
 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.
"

'From Smalltalk/X, Version:2.10.5 on 24-mar-1995 at 11:25:51 am'!

SimpleView 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.15 1995-06-06 04:20:59 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; it exists for the processMonitor only)
	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 (this info is useless, since at
				    update time, its always the update process which is
				    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 (i.e. the maximum ever needed)
"
! !

!ProcessMonitor class methodsFor:'defaults'!

defaultLabel
    ^ 'Process Monitor'
!

defaultIcon
    |i|

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

!ProcessMonitor class methodsFor:'startup'!

open
    |top monitor|

    top := StandardSystemView new.
    monitor := self origin:0.0@0.0 corner:1.0@1.0 in:top.
    top extent:monitor preferredExtent.
    top label:self defaultLabel.
    top icon:self defaultIcon.
    top open

    "
     ProcessMonitor open
    "
! !

!ProcessMonitor methodsFor:'drawing'!

titleLine
"/  ^ 'id   name                         cpu state    prio   usedStack  totalStack'.
    ^ 'id   name                           state    prio   usedStack  totalStack'.
!

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 removeTimedBlock:listUpdateBlock.
	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:self titleLine.
	    list add:(String new:self titleLine size withAll:$-).

	    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).
			(Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
			    line := line , '(' , aProcess numberOfStackSegments printString , ')'.
			    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 removeTimedBlock:updateBlock.
	Processor addTimedBlock:updateBlock afterSeconds:updateDelay
    ]
!

updateView
    self updateList.
    self updateStatus
! !

!ProcessMonitor methodsFor:'initialization'!

initialize
    |v menu|

    super initialize.

    hideDead := true.

    v := ScrollableView for:SelectionInListView in:self.
    v origin:0.0@0.0 corner:1.0@1.0.

"/    self extent:(font widthOf:self titleLine) + v scrollBar width @ 100.

    listView := v scrolledView.
    listView font:font.
    listView menuHolder:self; menuPerformer:self; menuMessage:#processMenu. 

    listView multipleSelectOk:true.
    listView delegate:(KeyboardForwarder toView: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
    "
!

mapped
    super mapped.
    self updateStatus.
    self updateList.
!

startUpdateProcess
    updateBlock notNil ifTrue:[
	Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
	Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
    ] ifFalse:[
	updateProcess := [
	    Process terminateSignal handle:[:ex |
		updateProcess := nil
	    ] do:[
		|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:'monitor [' , 
			   Processor activeProcess id printString ,
			   '] update'.
	"
	 raise my own priority
	"
	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:'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
		]
	    ]
	]
    ].
!

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

!ProcessMonitor methodsFor:'menu actions'!

hideDead:aBoolean
    hideDead := aBoolean
!

terminateProcess
    "terminate the selected process"

    self selectedProcessesSend:#terminate
!

debugProcess
    "open a debugger on the selected process"

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

abortProcess
    "abort (raise AbortSignal in) the selected process"

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

inspectProcess
    "open an inspector on the selected process"

    self selectedProcessesSend:#inspect
!

resumeProcess
    "resume the selected process (i.e. let it run) "

    self selectedProcessesSend:#resume
!

processMenu
    |labels selectors m|

    labels := resources array:#(
"/ hideDead functionality no longer needed; 
"/ since ProcSched knownProcesses only returns living ones
"/
"/                         '\c hide dead'
"/                         '-'
			 'inspect' 
			 'debug'  
			 '-'  
			 'resume'  
			 'suspend'  
			 'stop'  
			 'abort'
			 'terminate'
			 '-'  
			 'raise prio'  
			 'lower prio'  
			).
    selectors := #(
"/                         hideDead:
"/                         nil
			 inspectProcess  
			 debugProcess  
			 nil  
			 resumeProcess  
			 suspendProcess  
			 stopProcess  
			 abortProcess
			 terminateProcess
			 nil  
			 raisePrio
			 lowerPrio
			).

    updateProcess isNil ifTrue:[
	labels := (resources array:#('update' '-')) , labels.
	selectors := #(updateView nil) , selectors
    ].

    m := PopUpMenu labels:labels
		   selectors:selectors.

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

    ^ m
!

stopProcess
    "stop the selected process - not even interrupts will wake it up"

    self selectedProcessesSend:#stop
!

suspendProcess
    "suspend the selected process - interrupts will let it run again"

    self selectedProcessesSend:#suspend
!

raisePrio
    "raise the selected processes priority"

    self selectedProcessesDo:[:p |
       p priority:(p priority + 1)
    ]
!

lowerPrio
    "lower the selected processes priority"

    self selectedProcessesDo:[:p |
       p priority:(p priority - 1)
    ]
! !

!ProcessMonitor methodsFor:'destroying'!

destroy
    updateBlock notNil ifTrue:[
	Processor removeTimedBlock:updateBlock.
	Processor removeTimedBlock:listUpdateBlock.
    ] ifFalse:[
	updateProcess notNil ifTrue:[updateProcess terminate]
    ].
    super destroy
! !

!ProcessMonitor methodsFor:'queries'!

preferredExtent
    ^ (font widthOf:self titleLine) + 40 @ 100
! !

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